COMMON /MAICOM/ ENTRY 00069 BYTE ENTRY(14,20) 00070 BYTE LINE(80),LINE2(80),HEADER(80) 00072 BYTE USRNAM(80) 00073 BYTE FILNAM(40),FILN2(40),MBNAME(40) 00074 BYTE MYNAME(20) 00075 BYTE TAB 00076 BYTE USRRET(14) 00077 BYTE BUIC(2),BTEMP 00078 c BYTE REPLY,QUERY 00079 BYTE REPLY,QUERY,gnull,gnorp 00080 c added cause f4p won't take a null string '' and to keep even byte 00081 INTEGER UIC 00082 INTEGER MAXLIN 00083 LOGICAL*1 EOMAIL,VALID,EQUAL,TMPLET,NONAME,FOUND,NEWBOX 00084 EQUIVALENCE (UIC,BUIC) 00085 DATA QUERY /'?'/ 00086 DATA TAB /"11/ 00087 DATA MAXLIN /80/ 00088 DATA NENTRY /20/ !NUMBER OF ENTRIES IN MAICOM 00089 DATA NEWMAI /14/ !BYTE FLAGGING NEW MAIL IN MAICOM 00090 NEWBOX = .FALSE. 00097 c make sure the null byte is really null 00098 gnull=0 00099 CALL WHOME (MYNAME) 00101 D CALL DEBUG ('MYNAME',MYNAME,0) 00102 D GOTO 9950 00104 CALL ERRSET(29,,,,.FALSE.) 00105 D9950 CONTINUE 00106 ASSIGN 32757 TO I32758 00108 GO TO 32758 00108 32757 CONTINUE 00109 c IF (EQUAL(USRNAM,'')) PROMPT-FOR-USER-NAMES 00109 IF(.NOT.(EQUAL(USRNAM,gnull))) GO TO 32756 00110 ASSIGN 32754 TO I32755 00110 GO TO 32755 00110 32754 CONTINUE 00110 32756 IF(.NOT.(EQUAL(USRNAM,'ME'))) GO TO 32752 00112 ASSIGN 32750 TO I32751 00112 GO TO 32751 00112 32750 GO TO 32753 00113 32752 IF(.NOT.(EQUAL(USRNAM,'?'))) GO TO 32749 00113 ASSIGN 32747 TO I32748 00113 GO TO 32748 00113 32747 GO TO 32753 00114 32749 ASSIGN 32745 TO I32746 00114 GO TO 32746 00114 32745 CONTINUE 00115 32753 CALL EXIT 00117 32744 CONTINUE 00119 IF(.NOT.(LENGTH(FILNAM).GT.0)) GO TO 32743 00120 WRITE (5,20) 00121 20 FORMAT (' Use your user name, not "ME", to mail ', 00122 1 'yourself a letter.') 00123 CALL EXIT 00124 32743 GO TO I32744 00126 32742 CONTINUE 00128 D CALL DEBUG ('OLD','LB0:[1,100]WHODID.LST',3) 00130 OPEN (UNIT=3,NAME='LB0:[1,100]WHODID.LST',TYPE='OLD',READONLY) 00131 DO 32741 I=1,5 00133 READ (3,11) L,USRRET 00133 32741 CONTINUE 00133 GO TO 32739 00134 32740 IF(EQUAL(USRRET,USRNAM) .OR. LENGTH(USRRET).LE.1) GO TO 32738 00134 32739 READ (3,11) L,LINE2 00135 LINE2(L+1) = 0 00136 DO 32737 I=1,L 00137 IF (LINE2(I).EQ.']') LINE2(I) = ',' 00138 32737 CONTINUE 00139 DECODE (L,44,LINE2) USRRET,BUIC 00140 44 FORMAT (5X,14A1,5X,2O4) 00141 I = 14 00142 32736 IF(.NOT.(USRRET(I).EQ.' ' .AND. I.GE.1)) GO TO 32735 00143 USRRET(I) = 0 00144 I = I-1 00145 GO TO 32736 00146 32735 BTEMP = BUIC(1) 00148 BUIC(1) = BUIC(2) 00149 BUIC(2) = BTEMP 00150 GO TO 32740 00151 32738 NONAME = LENGTH(USRRET).LE.1 00152 CLOSE (UNIT=3) 00153 GO TO I32742 00154 32734 CONTINUE 00156 WRITE (3,29) (HEADER(I),I=1,LENGTH(HEADER)-1) 00158 32733 IF(.NOT.(.TRUE.)) GO TO 32732 00159 D CALL ERRSNS 00160 READ (2,29,END=123,ERR=1000) LINE2 00161 LINE2(80) = 0 00162 CALL TRUNC(LINE2) 00163 WRITE (3,291) TAB,(LINE2(I),I=1,LENGTH(LINE2)-1) 00164 291 FORMAT (81A1) 00165 GO TO 32733 00166 32732 CONTINUE 00167 123 CONTINUE 00167 CLOSE (UNIT=3) 00168 CALL WFOWN(0) 00170 CALL WDFFP(-1) 00171 GO TO I32734 00172 32731 CONTINUE 00174 CALL ASNLUN (3,'SY',0) 00175 IF(.NOT.(.NOT.NEWBOX)) GO TO 32729 00176 CALL WDFFP("135400) 00178 D CALL ERRSNS 00179 D CALL DEBUG ('NEW',MBNAME,3) 00180 OPEN (UNIT=3,NAME=MBNAME,ACCESS='SEQUENTIAL',ERR=112, 00181 1 TYPE='NEW',CARRIAGECONTROL='LIST') 00182 NEWBOX = .TRUE. 00183 GO TO 32730 00184 32729 CONTINUE 00186 D CALL ERRSNS 00186 D CALL DEBUG ('OLD',MBNAME,3) 00187 OPEN (UNIT=3,NAME=MBNAME,ACCESS='SEQUENTIAL',ERR=113, 00188 1 TYPE='OLD',CARRIAGECONTROL='LIST') 00189 CALL FEOF(3) 00190 32730 ASSIGN 32727 TO I32728 00192 GO TO 32728 00192 32727 VALID = .TRUE. 00193 CALL WDFFP(-1) 00194 GO TO I32731 00195 32726 CONTINUE 00197 IF (INDEX(FILNAM,'.').EQ.0) CALL CONCAT (FILNAM,'.MAI') 00198 CALL ASNLUN (3,'SY',0) 00199 D CALL ERRSNS 00200 D CALL DEBUG ('UNK',FILNAM,3) 00201 OPEN (UNIT=3,NAME=FILNAM,ACCESS='SEQUENTIAL',ERR=114, 00202 1 TYPE='UNKNOWN',CARRIAGECONTROL='LIST') 00203 CALL FEOF(3) 00204 ASSIGN 32725 TO I32728 00205 GO TO 32728 00205 32725 VALID = .TRUE. 00206 GO TO I32726 00207 32724 CONTINUE 00209 CALL MVSTR(FILNAM,'LETTER.TMP') 00210 CALL ASNLUN (2,'SY',0) 00211 D CALL DEBUG ('NEW',FILNAM,2) 00212 OPEN (UNIT=2,NAME=FILNAM,TYPE='NEW',CARRIAGECONTROL='LIST') 00213 WRITE (5,36) 00214 36 FORMAT (/' Terminate your letter by typing on a ', 00215 1 'line by itself.') 00216 READ (5,11,END=380) L,LINE2 00217 LINE2(L+1) = 0 00218 32723 IF(.NOT.(.TRUE.)) GO TO 32722 00219 WRITE (2,29) (LINE2(I),I=1,LENGTH(LINE2)-1) 00220 READ (5,11,END=380) L,LINE2 00221 LINE2(L+1) = 0 00222 GO TO 32723 00223 32722 CONTINUE 00224 380 CONTINUE 00224 CLOSE (UNIT=5) 00225 CLOSE (UNIT=2) 00226 GO TO I32724 00227 32721 CONTINUE 00229 GO TO 32719 00230 32720 IF(VALID) GO TO 32718 00230 32719 WRITE (5,31) 00231 31 FORMAT ('$Place the letter in (filename or TRASH): ') 00232 READ (5,11) L,FILNAM 00233 FILNAM(L+1) = 0 00234 IF (L.GT.0) CALL UCASE(FILNAM) 00235 IF(.NOT.(L.EQ.0)) GO TO 32716 00237 ASSIGN 32715 TO I32731 00237 GO TO 32731 00237 32715 GO TO 32717 00238 32716 IF(.NOT.(EQUAL(FILNAM,'TRASH'))) GO TO 32714 00238 VALID = .TRUE. 00238 GO TO 32717 00239 32714 ASSIGN 32713 TO I32726 00239 GO TO 32726 00239 32713 CONTINUE 00240 32717 IF(.NOT.(.FALSE.)) GO TO 32712 00241 112 CONTINUE 00242 D IERR = 112 00243 D GOTO 120 00244 113 CONTINUE 00245 D IERR = 113 00246 D GOTO 120 00247 114 CONTINUE 00248 D IERR = 114 00249 D120 WRITE (5,9960) IERR,IERR1,IERR2,IERR3,IERR4 00250 VALID = .FALSE. 00251 32712 GO TO 32720 00253 32718 CLOSE (UNIT=2,DISPOSE='DELETE') 00254 GO TO I32721 00255 32728 CONTINUE 00257 VALID = .TRUE. 00259 32711 IF(.NOT.(.TRUE.)) GO TO 32710 00260 D CALL ERRSNS 00261 READ (2,11,ERR=1001,END=110) L,LINE2 00262 LINE2(L+1) = 0 00263 WRITE (3,29) (LINE2(I),I=1,LENGTH(LINE2)-1) 00265 GO TO 32711 00266 32710 CONTINUE 00267 110 CLOSE (UNIT=3) 00267 GO TO I32728 00268 32709 CONTINUE 00270 DO 32708 I=1,80 00271 HEADER(I) = 0 00271 32708 CONTINUE 00271 CALL MVSTR (HEADER,MYNAME) 00272 CALL CONCAT (HEADER,': ') 00273 CALL DATE (HEADER(LENGTH(HEADER))) 00274 CALL TRUNC(HEADER) 00275 CALL CONCAT (HEADER,' ') 00276 CALL TIME (HEADER(LENGTH(HEADER))) 00277 CALL TRUNC (HEADER) 00278 D CALL DEBUG ('HEADER',HEADER,0) 00279 GO TO I32709 00280 32707 CONTINUE 00282 IENTRY = 0 00286 FOUND = .FALSE. 00287 32706 IF(.NOT.(IENTRY .LT. NENTRY )) GO TO 32705 00288 IENTRY = IENTRY+1 00289 IF(.NOT.(EQUAL(ENTRY(1,IENTRY),USRNAM))) GO TO 32704 00290 ENTRY(NEWMAI,IENTRY) = 1 00291 FOUND = .TRUE. 00292 D CALL DEBUG (' NOTIFIED',USRNAM,0) 00293 D WRITE (5,9906) ENTRY(13,IENTRY) 00294 D9906 FORMAT (' ON TT',O8) 00295 32704 GO TO 32706 00297 32705 WRITE (5,54) (USRNAM(I),I=1,LENGTH(USRNAM)-1) 00298 IF(.NOT.(FOUND)) GO TO 32702 00299 WRITE (5,55) 00299 GO TO 32703 00299 32702 WRITE (5,56) 00300 32703 CONTINUE 00301 54 FORMAT ('$',80A1) 00301 55 FORMAT ('+ has been notified.') 00302 56 FORMAT ('+ is not logged in but will be notified.') 00303 GO TO I32707 00304 32701 CONTINUE 00306 IF (INDEX(FILNAM,'.').EQ.0) CALL CONCAT (FILNAM,'.MAI') 00307 CALL ASNLUN (2,'SY',0) 00308 D CALL DEBUG ('OLD',FILNAM,2) 00309 IF(.NOT.(TMPLET)) GO TO 32699 00310 OPEN (UNIT=2,NAME=FILNAM,TYPE='OLD') 00310 GO TO 32700 00310 32699 OPEN (UNIT=2,NAME=FILNAM,TYPE='OLD',READONLY) 00311 32700 GO TO I32701 00312 32698 CONTINUE 00314 CALL MVSTR (MBNAME(1),'LB0:[10,0]') 00315 CALL CONCAT (MBNAME,MYNAME) 00316 CALL CONCAT (MBNAME,'.MAI') 00317 D CALL ERRSNS 00318 D CALL DEBUG ('OLD',MBNAME,1) 00319 OPEN (UNIT=1,NAME=MBNAME,TYPE='OLD',ERR=101) 00320 IF(.NOT.(.FALSE.)) GO TO 32697 00321 101 WRITE (5,102) 00322 102 FORMAT (' Your mailbox is empty.') 00323 D CALL ERRSNS (N1,N2,N3,N4) 00324 D WRITE (5,9909) N1,N2,N3,N4 00325 D9909 FORMAT (' ERRSNS RETURN:',4I8) 00326 CALL EXIT 00327 32697 EOMAIL = .FALSE. 00329 ASSIGN 32695 TO I32696 00330 GO TO 32696 00330 32695 GO TO I32698 00331 32694 CONTINUE 00333 USRNAM(LENGTH(USRNAM)+1) = 0 00334 ICOM = INDEX(USRNAM,',') 00335 IF(.NOT.(ICOM.EQ.0)) GO TO 32692 00336 ICOM = LENGTH(USRNAM) 00336 GO TO 32693 00336 32692 USRNAM(ICOM) = 0 00337 32693 CONTINUE 00338 D CALL DEBUG ('USRNAM',USRNAM,0) 00338 ASSIGN 32691 TO I32742 00340 GO TO 32742 00340 32691 CONTINUE 00341 42 FORMAT (' No such user as ',20A1) 00341 IF(.NOT.(NONAME)) GO TO 32689 00342 WRITE (5,42) (USRNAM(I),I=1,LENGTH(USRNAM)-1) 00342 GO TO 32690 00342 32689 CALL MVSTR(FILN2,'LB0:[10,0]') 00344 CALL CONCAT (FILN2,USRNAM) 00345 CALL CONCAT (FILN2,'.MAI') 00346 CALL WDFFP("135400) 00348 CALL WFOWN(UIC) 00350 D CALL ERRSNS 00351 D CALL DEBUG ('UNK',FILN2,3) 00352 OPEN (UNIT=3,NAME=FILN2,ACCESS='SEQUENTIAL',ERR=1002, 00353 1 TYPE='UNKNOWN',CARRIAGECONTROL='LIST') 00354 CALL FEOF(3) 00357 32690 GO TO I32694 00359 32758 CONTINUE 00361 CALL GETMCR(LINE) 00362 DO 32688 I=1,MAXLIN 00363 IF (LINE(I).EQ."15) LINE(I) = 0 00364 32688 CONTINUE 00365 USRNAM(1) = 0 00366 FILNAM(1) = 0 00367 MBNAME(1) = 0 00368 ISP = INDEX(LINE,' ') !NOTE: PDS PUTS SPACE AFTER TASK 00369 IF(.NOT.(ISP.GT.0)) GO TO 32687 00370 CALL MVSTR (LINE(1),LINE(ISP+1)) 00371 ISP = INDEX(LINE,' ') 00372 IF (ISP.GT.0) LINE(ISP) = 0 00373 CALL MVSTR(USRNAM,LINE) 00374 32687 IF (ISP.GT.0) CALL MVSTR(FILNAM,LINE(ISP+1)) 00376 D CALL DEBUG('LINE',LINE,0) 00377 D CALL DEBUG('USRNAM',USRNAM,0) 00378 D CALL DEBUG('FILNAM',FILNAM,0) 00379 GO TO I32758 00380 32686 CONTINUE 00382 WRITE (5,34) 00383 34 FORMAT ('$Name of file to send ( to type letter now): ') 00384 READ (5,11) L,FILNAM 00385 FILNAM(L+1) = 0 00386 CALL UCASE (FILNAM) 00387 TMPLET = (LENGTH(FILNAM).LE.1) 00388 IF(.NOT.(TMPLET)) GO TO 32685 00389 ASSIGN 32684 TO I32724 00389 GO TO 32724 00389 32684 CONTINUE 00389 32685 GO TO I32686 00390 32755 CONTINUE 00392 WRITE (5,10) 00393 10 FORMAT ('$To: ') 00394 READ (5,11) L,(USRNAM(I),I=1,78) 00395 11 FORMAT (Q,80A1) 00396 USRNAM(L+1) = 0 00397 CALL UCASE (USRNAM) 00398 GO TO I32755 00399 32696 CONTINUE 00401 D CALL ERRSNS 00402 READ (1,25,ERR=1003,END=105) LINE 00403 25 FORMAT (80A1) 00404 LINE(80) = 0 00405 CALL TRUNC(LINE) 00406 IF(.NOT.(.FALSE.)) GO TO 32683 00407 105 EOMAIL = .TRUE. 00408 D CALL DEBUG (' EOMAIL','TRUE',0) 00409 32683 GO TO I32696 00411 32751 CONTINUE 00413 ASSIGN 32682 TO I32744 00414 GO TO 32744 00414 32682 ASSIGN 32681 TO I32698 00415 GO TO 32698 00415 32681 IF(EOMAIL) GO TO 32680 00416 ASSIGN 32678 TO I32679 00417 GO TO 32679 00417 32678 ASSIGN 32677 TO I32721 00418 GO TO 32721 00418 32677 ASSIGN 32675 TO I32676 00419 GO TO 32676 00419 32675 GO TO 32681 00420 32680 CLOSE (UNIT=1,DISP='DELETE') 00422 GO TO I32751 00423 32674 CONTINUE 00425 CALL MVSTR (FILN2,USRNAM(2)) 00426 IF (INDEX(FILN2,'.').EQ.0) CALL CONCAT (FILN2,'.MLS') 00427 CALL ASNLUN (2,'SY',0) 00428 D CALL DEBUG ('OLD',FILN2,2) 00429 OPEN (UNIT=2,NAME=FILN2,TYPE='OLD',ERR=130) 00430 IF(.NOT.(.FALSE.)) GO TO 32673 00431 130 CALL MVSTR (FILN2,'LB0:[10,3]') 00432 CALL CONCAT (FILN2,USRNAM(2)) 00433 IF (INDEX(FILN2,'.').EQ.0) CALL CONCAT (FILN2,'.MLS') 00434 D CALL ERRSNS 00435 D CALL DEBUG ('OLD',FILN2,2) 00436 OPEN (UNIT=2,NAME=FILN2,TYPE='OLD',ERR=1004) 00437 32673 READ (2,29) USRNAM 00439 USRNAM(80) = 0 00440 CALL TRUNC(USRNAM) 00441 D CALL DEBUG (' USRNAM',USRNAM,0) 00442 CLOSE (UNIT=2) 00443 GO TO I32674 00444 32676 CONTINUE 00446 FILNAM(1) = 0 00447 WRITE (5,60) (USRNAM(I),I=1,LENGTH(USRNAM)-1),QUERY 00448 60 FORMAT (' Do you want to reply to',(1X,40a1)) 00449 READ (5,61) REPLY 00450 61 FORMAT (A1) 00451 IF(.NOT.(REPLY.EQ.'Y' .OR. REPLY.EQ.'y')) GO TO 32672 00452 ASSIGN 32671 TO I32746 00452 GO TO 32746 00452 32671 CONTINUE 00452 32672 GO TO I32676 00453 32670 CONTINUE 00455 1000 CONTINUE 00456 D IERR = 1000 00457 D GOTO 1020 00458 1001 CONTINUE 00459 D IERR = 1001 00460 D GOTO 1020 00461 1002 CONTINUE 00462 D IERR = 1002 00463 D GOTO 1020 00464 1003 CONTINUE 00465 D IERR = 1003 00466 D GOTO 1020 00467 1004 CONTINUE 00468 D IERR = 1004 00469 D GOTO 1020 00470 D1020 CALL ERRSNS(IERR1,IERR2,IERR3,IERR4) 00471 D WRITE (5,9960) IERR,IERR1,IERR2,IERR3,IERR4 00472 D9960 FORMAT (' ERROR AT ',I5/' RETURN FROM ERRSNS:',4I8) 00473 WRITE (5,1200) 00474 1200 FORMAT (' MAIL -- FATAL FILE ERROR') 00475 CALL EXIT 00476 GO TO I32670 00477 32746 CONTINUE 00479 IF(.NOT.(USRNAM(1).EQ.'@')) GO TO 32669 00480 ASSIGN 32668 TO I32674 00480 GO TO 32674 00480 32668 CONTINUE 00480 32669 IF(.NOT.(LENGTH(FILNAM).LE.1)) GO TO 32667 00481 ASSIGN 32666 TO I32686 00481 GO TO 32686 00481 32666 CONTINUE 00481 32667 ASSIGN 32665 TO I32701 00482 GO TO 32701 00482 32665 ASSIGN 32664 TO I32709 00483 GO TO 32709 00483 32664 GO TO 32662 00484 32663 IF(LENGTH(USRNAM).LE.1) GO TO 32661 00484 32662 ASSIGN 32660 TO I32694 00485 GO TO 32694 00485 32660 ASSIGN 32659 TO I32734 00486 GO TO 32734 00486 32659 ASSIGN 32658 TO I32707 00487 GO TO 32707 00487 32658 REWIND 2 00488 CALL MVSTR (USRNAM,USRNAM(ICOM+1)) 00490 GO TO 32663 00491 32661 IF(.NOT.(TMPLET)) GO TO 32656 00492 CLOSE (UNIT=2,DISPOSE='DELETE') 00492 GO TO 32657 00492 32656 CLOSE (UNIT=2) 00493 32657 GO TO I32746 00494 32748 CONTINUE 00496 ASSIGN 32655 TO I32744 00497 GO TO 32744 00497 32655 ASSIGN 32654 TO I32698 00498 GO TO 32698 00498 32654 IF(EOMAIL) GO TO 32653 00499 ASSIGN 32651 TO I32652 00500 GO TO 32652 00500 32651 GO TO 32654 00501 32653 GO TO I32748 00502 32652 CONTINUE 00504 IF(.NOT.(LINE(1).EQ.TAB)) GO TO 32650 00506 ASSIGN 32649 TO I32670 00506 GO TO 32670 00506 32649 CONTINUE 00506 32650 WRITE (5,27) (LINE(I),I=1,LENGTH(LINE)-1) 00507 27 FORMAT (/1X,80A1) 00508 GO TO 32647 00509 32648 IF(EOMAIL.OR.(LINE(1).NE.TAB)) GO TO 32646 00509 32647 ASSIGN 32645 TO I32696 00509 GO TO 32696 00509 32645 GO TO 32648 00509 32646 GO TO I32652 00510 32679 CONTINUE 00512 IF(.NOT.(LINE(1).EQ.TAB)) GO TO 32644 00514 ASSIGN 32643 TO I32670 00514 GO TO 32670 00514 32643 CONTINUE 00514 32644 ISP = INDEX(LINE,':') 00516 CALL MVSTR(USRNAM,LINE,ISP) 00517 FILNAM(1) = 0 00518 CALL ASNLUN (2,'SY',0) 00519 D CALL DEBUG ('NEW','LETTER.TMP',2) 00520 OPEN (UNIT=2,NAME='LETTER.TMP',TYPE='NEW',CARRIAGECONTROL='LIST', 00521 1 DISP='DELETE') 00522 GO TO 32641 00523 32642 IF(EOMAIL.OR.(LINE(1).NE.TAB)) GO TO 32640 00523 32641 WRITE (5,28) (LINE(I),I=1,LENGTH(LINE)-1) 00524 28 FORMAT (1X,80A1) 00525 WRITE (2,29) (LINE(I),I=1,LENGTH(LINE)-1) 00526 29 FORMAT (80A1) 00527 ASSIGN 32639 TO I32696 00528 GO TO 32696 00528 32639 GO TO 32642 00529 32640 REWIND 2 00530 GO TO I32679 00531 END 00533 SUBROUTINE WHOME (OUTMSG) 00535 BYTE OUTMSG(20) 00539 INTEGER USRBUF(160) 00540 INTEGER TTTYPE 00541 DATA TTTYPE /'TT'/ 00542 DATA LUBUF /160/ 00543 CALL GETUSR (USRBUF,LUBUF,IER) 00545 IF(.NOT.(IER.LT.0)) GO TO 32758 00546 WRITE (5,101) IER 00547 101 FORMAT (' ERROR',I8) 00548 STOP 00549 32758 CALL GETLUN (5,OUTMSG) 00553 MYTI = OUTMSG(3) 00554 D WRITE (5,9901) MYTI 00555 D9901 FORMAT (' MY TI: IS ',O8) 00556 DO 32757 I=8,LUBUF,8 00558 D WRITE (5,9902) (USRBUF(J),J=I-7,I) 00559 D9902 FORMAT (1X,6A2,2X,A2,O2) 00560 IF(.NOT.(USRBUF(I-1).EQ.TTTYPE)) GO TO 32756 00561 IF(.NOT.(USRBUF(I).EQ.MYTI)) GO TO 32755 00562 CALL MVSTR(OUTMSG,USRBUF(I-7),10) 00563 D CALL DEBUG ('OUTMSG',OUTMSG,0) 00564 RETURN 00565 32755 CONTINUE 00567 32756 CONTINUE 00568 32757 CONTINUE 00568 WRITE (5,10) MYTI 00569 10 FORMAT (' CANNOT IDENTIFY USER AT TI: ',O8) 00570 STOP 00571 END 00572 SUBROUTINE UCASE(STRING) 00574 BYTE STRING(1) 00575 L = LENGTH(STRING)-1 00576 IF (L.LE.0) RETURN 00577 DO 32758 I=1,L 00578 IF (STRING(I).GE.'a'.AND.STRING(I).LE.'z') STRING(I) = 00579 1 STRING(I)-"40 00580 32758 CONTINUE 00581 RETURN 00582 END 00583 SUBROUTINE CONCAT(A,B) 00584 BYTE A(1),B(1) 00585 CALL MVSTR(A(LENGTH(A)),B) 00586 END 00587 SUBROUTINE DEBUG(LABEL,STRING,IUNIT) 00588 D BYTE LABEL(1),STRING(1) 00589 D WRITE (5,9901) IUNIT,(LABEL(I),I=1,LENGTH(LABEL)-1),':',' ', 00590 D 1 (STRING(I),I=1,LENGTH(STRING)-1) 00591 D9901 FORMAT (1X,I4,1X,80A1/6X,80A1) 00592 END 00593