      SUBROUTINE MESAGE(MESSAGE_TYPE,MESSAGE_NUMBER,OUTPUT_FLAG,        00121 
     1 TEXT,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13)                 00122 
      IMPLICIT COMPLEX (A-H,J-Z)        !Force explicit variable typing 00132 
      INTEGER*2 BIT_DATE      !LOCAL, "Suppress date/time bit"          00136 
      INTEGER*2 BIT_OPER      !LOCAL, "CO: output desired bit"          00137 
      INTEGER*2 BIT_TRACE     !LOCAL, "Traceback desired bit"           00138 
      INTEGER*2 DS            !LOCAL, Code for system service msg       00139 
      INTEGER*2 IO            !LOCAL, Code for IO message               00140 
      INTEGER*2 MAX_CHAR      !LOCAL, Max # char in raw message         00141 
      INTEGER*2 MAX_PAR       !LOCAL, Max # parameters Pn in subr call  00142 
      INTEGER*2 Q             !LOCAL, Code for user message             00143 
      INTEGER*2 USER          !LOCAL, Code for user message             00144 
      PARAMETER (BIT_DATE='4'O)         !bit 2                          00146 
      PARAMETER (BIT_OPER='1'O)         !bit 0                          00147 
      PARAMETER (BIT_TRACE='2'O)        !bit 1                          00148 
      PARAMETER (DS='4002'O)                                            00149 
      PARAMETER (IO='4003'O)                                            00150 
      PARAMETER (MAX_CHAR=128)  !At least 4 smaller than TEXT_MSG       00151 
      PARAMETER (MAX_PAR=13)    !Must agree with subr arg list!!        00152 
      PARAMETER (Q='4001'O)                                             00153 
      PARAMETER (USER='4004'O)                                          00154 
      INCLUDE '($SSDEF)/NOLIST'                                         00156 
      INTEGER*4 ARG_MAP       !LOCAL, Bit map for subr call arguments   00160 
      LOGICAL*2 CONT          !LOCAL, .FALSE. if formatting error       00161 
      INTEGER*4 FAOLLST(2*MAX_PAR+1)!LOCAL, Item list for $FAOL         00162 
      INTEGER*2 FAOLLST_PNT   !LOCAL, Pointer into FAOLLST              00163 
      INTEGER*4 I             !LOCAL, scratch                           00164 
      CHARACTER*9 IMAGE       !LOCAL, image name                        00165 
      INTEGER*2 J             !LOCAL, scratch                           00166 
      INTEGER*2 ISTAT(2)      !LOCAL, EQUIV (STATUS,ISTAT)              00167 
      BYTE      LETTER        !LOCAL, scratch                           00168 
      INTEGER*2 MESSAGE_TYPE  !EXT, Type of message to put out          00169 
      INTEGER*2 MESSAGE_NUMBER!EXT, Message number                      00170 
      INTEGER*2 NARGS         !LOCAL, # of arguments in subr call       00171 
      INTEGER*2 NP            !LOCAL, # of next P to use                00172 
      INTEGER*2 NPARM         !LOCAL, # of P's actually given in call   00173 
      INTEGER*2 OUTPUT_FLAG   !EXT, Control bits for message            00174 
      BYTE      P1(1)         !EXT, Parameter 1                         00175 
      BYTE      P2(1)         !EXT, Parameter 2                         00176 
      BYTE      P3(1)         !EXT, Parameter 3                         00177 
      BYTE      P4(1)         !EXT, Parameter 4                         00178 
      BYTE      P5(1)         !EXT, Parameter 5                         00179 
      BYTE      P6(1)         !EXT, Parameter 6                         00180 
      BYTE      P7(1)         !EXT, Parameter 7                         00181 
      BYTE      P8(1)         !EXT, Parameter 8                         00182 
      BYTE      P9(1)         !EXT, Parameter 9                         00183 
      BYTE      P10(1)        !EXT, Parameter 10                        00184 
      BYTE      P11(1)        !EXT, Parameter 11                        00185 
      BYTE      P12(1)        !EXT, Parameter 12                        00186 
      BYTE      P13(1)        !EXT, Parameter 13                        00187 
      INTEGER*4 P_ADDR(MAX_PAR)!LOCAL, Addresses of P1-Pn               00188 
      INTEGER*2 POINT_IN      !LOCAL, Pointer in TEXT                   00189 
      INTEGER*2 POINT_OUT     !LOCAL, Pointer in TEXT_MSG               00190 
      INTEGER*4 STATUS        !LOCAL, a VMS return status               00191 
      INTEGER*4 STATUS_LEN    !LOCAL, length of STATUS_MSG              00192 
      CHARACTER*132 STATUS_MSG!LOCAL, text for status message           00193 
      INTEGER*4 SYS$FAOL      !FCT, Format input text                   00194 
      BYTE      TEXT(1)       !EXT, Text to output                      00195 
      CHARACTER*132 TEXT_MSG  !LOCAL, Unformatted TEXT to output        00196 
      CHARACTER*132 TEXT_OUT  !LOCAL, Formatted TEXT to output          00197 
      INTEGER*4 TEXT_OUT_LEN  !LOCAL, # char in TEXT_OUT                00198 
      EQUIVALENCE (STATUS,ISTAT(1))                                     00200 
      ASSIGN 32757 TO I32758                                            00203 
      GO TO 32758                                                       00203 
32757 ASSIGN 32755 TO I32756                                            00205 
      GO TO 32756                                                       00205 
32755 IF((Q).EQ.(MESSAGE_TYPE))THEN                                     00208 
      ASSIGN 32753 TO I32754                                            00208 
      GO TO 32754                                                       00208 
32753 CONTINUE                                                          00209 
      ELSEIF((DS).EQ.(MESSAGE_TYPE))THEN                                00209 
      ASSIGN 32751 TO I32752                                            00209 
      GO TO 32752                                                       00209 
32751 CONTINUE                                                          00210 
      ELSEIF((IO).EQ.(MESSAGE_TYPE))THEN                                00210 
      ASSIGN 32749 TO I32750                                            00210 
      GO TO 32750                                                       00210 
32749 CONTINUE                                                          00211 
      ELSEIF((USER).EQ.(MESSAGE_TYPE))THEN                              00211 
      ASSIGN 32747 TO I32748                                            00211 
      GO TO 32748                                                       00211 
32747 CONTINUE                                                          00212 
      ELSE                                                              00212 
      ASSIGN 32745 TO I32746                                            00212 
      GO TO 32746                                                       00212 
32745 CONTINUE                                                          00213 
      ENDIF                                                             00213 
      RETURN                                                            00215 
32756 CONTINUE                                                          00216 
      CONT=.TRUE.               !No formatting errors yet               00218 
      FAOLLST_PNT=1             !Use 1st item                           00219 
      NP=1                      !Use first P                            00220 
      POINT_IN=1                !Begin at the beginning                 00221 
      POINT_OUT=1               !       "                               00222 
      IF( IAND(OUTPUT_FLAG,BIT_DATE) .EQ. 0 )THEN                       00224 
      TEXT_MSG(POINT_OUT:POINT_OUT+6) = '!%D -- '                       00228 
      POINT_OUT=POINT_OUT+7                                             00229 
      FAOLLST(FAOLLST_PNT)=0    !==>use current time                    00230 
      FAOLLST_PNT=FAOLLST_PNT+1                                         00231 
      ENDIF                                                             00232 
      DO I=1,9                                                          00236 
      TEXT_MSG(POINT_OUT:POINT_OUT)=IMAGE(I:I)                          00237 
      POINT_OUT=POINT_OUT+1                                             00238 
      ENDDO                                                             00239 
      TEXT_MSG(POINT_OUT:POINT_OUT+3) = ' -- '                          00240 
      POINT_OUT=POINT_OUT+4                                             00241 
      IF(NARGS.GT.3 .AND. (IAND(ARG_MAP,8).NE.0) )THEN                  00245 
      ASSIGN 32743 TO I32744                                            00245 
      GO TO 32744                                                       00245 
32743 CONTINUE                                                          00245 
      ENDIF                                                             00245 
D     TYPE*,'MESAGE: Length of unformatted text=',POINT_OUT-1           00247 
D     TYPE*,'MESAGE: Unformatted text=',TEXT_MSG                        00248 
      IF(CONT)THEN                                                      00250 
      STATUS=SYS$FAOL(TEXT_MSG(1:POINT_OUT-1),TEXT_OUT_LEN,TEXT_OUT,    00254 
     1 FAOLLST)                                                         00255 
D     TYPE*,'MESAGE: Formatted text length=',TEXT_OUT_LEN               00256 
      IF(STATUS.NE.SS$_NORMAL)THEN                                      00257 
      CALL LIB$PUT_OUTPUT ('MESAGE:  $FAOL ERROR')                      00258 
      ASSIGN 32741 TO I32742                                            00259 
      GO TO 32742                                                       00259 
32741 ASSIGN 32739 TO I32740                                            00260 
      GO TO 32740                                                       00260 
32739 CONTINUE                                                          00261 
      ENDIF                                                             00261 
      ENDIF                                                             00262 
      CALL LIB$PUT_OUTPUT( TEXT_OUT(1:TEXT_OUT_LEN) )                   00266 
      GO TO I32756                                                      00267 
32758 CONTINUE                                                          00268 
      CALL ARGS (NARGS,ARG_MAP)                                         00272 
      NPARM = NARGS-4           !# of P's given                         00274 
D     TYPE*,'MESAGE: NARGS=',NARGS,' NPARM=',NPARM                      00276 
      P_ADDR(1) = %LOC(P1)      !Get addresses of all parameters        00278 
      P_ADDR(2) = %LOC(P2)                                              00279 
      P_ADDR(3) = %LOC(P3)                                              00280 
      P_ADDR(4) = %LOC(P4)                                              00281 
      P_ADDR(5) = %LOC(P5)                                              00282 
      P_ADDR(6) = %LOC(P6)                                              00283 
      P_ADDR(7) = %LOC(P7)                                              00284 
      P_ADDR(8) = %LOC(P8)                                              00285 
      P_ADDR(9) = %LOC(P9)                                              00286 
      P_ADDR(10) = %LOC(P10)                                            00287 
      P_ADDR(11) = %LOC(P11)                                            00288 
      P_ADDR(12) = %LOC(P12)                                            00289 
      P_ADDR(13) = %LOC(P13)                                            00290 
      CALL IMAGE_NAME(IMAGE)                                            00295 
      GO TO I32758                                                      00296 
32744 CONTINUE                                                          00297 
      DOWHILE(TEXT(POINT_IN).NE.0 .AND. CONT)                           00299 
      IF(TEXT(POINT_IN) .EQ.'%')THEN                                    00301 
      IF(NP.LE.MAX_PAR .AND. NP.LE.NPARM)THEN                           00305 
      ASSIGN 32737 TO I32738                                            00306 
      GO TO 32738                                                       00306 
32737 CONTINUE                                                          00308 
      ELSE                                                              00308 
      CONT=.FALSE.                                                      00309 
      CALL LIB$PUT_OUTPUT('MESAGE: Too many formatted items')           00310 
      ASSIGN 32736 TO I32740                                            00311 
      GO TO 32740                                                       00311 
32736 CONTINUE                                                          00312 
      ENDIF                                                             00312 
      ELSE                                                              00314 
      TEXT_MSG(POINT_OUT:POINT_OUT)=CHAR(TEXT(POINT_IN))                00318 
      POINT_OUT=POINT_OUT+1                                             00319 
      IF(TEXT(POINT_IN).EQ.'!')THEN                                     00320 
      TEXT_MSG(POINT_OUT:POINT_OUT)='!' !FAOL directive to force !      00321 
      POINT_OUT=POINT_OUT+1                                             00322 
      ENDIF                                                             00323 
      ENDIF                                                             00324 
      POINT_IN=POINT_IN+1               !Next position                  00326 
      IF(POINT_OUT.GT.MAX_CHAR)THEN                                     00327 
      CONT=.FALSE.                                                      00328 
      CALL LIB$PUT_OUTPUT('MESAGE--Input text string too long')         00329 
      ASSIGN 32735 TO I32740                                            00330 
      GO TO 32740                                                       00330 
32735 CONTINUE                                                          00331 
      ENDIF                                                             00331 
      ENDDO                                                             00332 
      GO TO I32744                                                      00333 
32746 CONTINUE                                                          00334 
      IF(IAND(OUTPUT_FLAG,BIT_OPER) .NE. 0)THEN                         00338 
      ISTAT(1)=MESSAGE_NUMBER                           !830614MAO      00342 
      ISTAT(2)=MESSAGE_TYPE                             !830614MAO      00343 
      IF(STATUS.NE.0)THEN                                               00344 
      ASSIGN 32734 TO I32742                                            00344 
      GO TO 32742                                                       00344 
32734 CONTINUE                                                          00344 
      ENDIF                                                             00344 
      ENDIF                                                             00347 
      IF( IAND(OUTPUT_FLAG,BIT_TRACE) .NE.0)THEN                        00349 
      ASSIGN 32733 TO I32740                                            00349 
      GO TO 32740                                                       00349 
32733 CONTINUE                                                          00349 
      ENDIF                                                             00349 
      GO TO I32746                                                      00350 
32754 CONTINUE                                                          00351 
      TYPE*,MESSAGE_TYPE,' - ',MESSAGE_NUMBER,' - ',                    00355 
     1 ' Q message file not yet implemented'                            00356 
      IF(IAND(OUTPUT_FLAG,BIT_TRACE) .NE.0)THEN                         00360 
      ASSIGN 32732 TO I32740                                            00360 
      GO TO 32740                                                       00360 
32732 CONTINUE                                                          00360 
      ENDIF                                                             00360 
      GO TO I32754                                                      00361 
32750 CONTINUE                                                          00362 
      CALL ERRSNS (,STATUS,,,)  !Get RMS error                          00364 
      IF(.NOT.STATUS)THEN                                               00365 
      ASSIGN 32731 TO I32742                                            00365 
      GO TO 32742                                                       00365 
32731 CONTINUE                                                          00365 
      ENDIF                                                             00365 
      ASSIGN 32730 TO I32740                                            00366 
      GO TO 32740                                                       00366 
32730 GO TO I32750                                                      00373 
32742 CONTINUE                                                          00374 
      CALL SYS$GETMSG(%VAL(STATUS),STATUS_LEN,STATUS_MSG,%VAL(15),)     00379 
      CALL LIB$PUT_OUTPUT(STATUS_MSG(1:STATUS_LEN))                     00380 
      GO TO I32742                                                      00381 
32752 CONTINUE                                                          00382 
      STATUS = MESSAGE_NUMBER                                           00388 
      ASSIGN 32729 TO I32742                                            00389 
      GO TO 32742                                                       00389 
32729 ASSIGN 32728 TO I32740                                            00390 
      GO TO 32740                                                       00390 
32728 GO TO I32752                                                      00394 
32748 CONTINUE                                                          00395 
      TYPE*,MESSAGE_TYPE,' - ',MESSAGE_NUMBER,' - ',                    00399 
     1 ' USER message file not yet implemented'                         00400 
      IF(IAND(OUTPUT_FLAG,BIT_TRACE) .NE.0)THEN                         00404 
      ASSIGN 32727 TO I32740                                            00404 
      GO TO 32740                                                       00404 
32727 CONTINUE                                                          00404 
      ENDIF                                                             00404 
      GO TO I32748                                                      00405 
32740 CONTINUE                                                          00406 
      CALL LIB$SIGNAL ( %VAL(0), )                                      00417 
      GO TO I32740                                                      00418 
32738 CONTINUE                                                          00419 
      POINT_IN = POINT_IN+1             !point to char after %          00421 
      IF((0).EQ.( TEXT(POINT_IN) ))THEN                                 00424 
      TEXT_MSG(POINT_OUT:POINT_OUT)='%'                                 00428 
      POINT_OUT=POINT_OUT+1                                             00429 
      POINT_IN=POINT_IN-1       !point back to null                     00430 
      ELSEIF(('V').EQ.( TEXT(POINT_IN) ))THEN                           00432 
      POINT_IN=POINT_IN+1       !Check if is %VA                        00433 
      IF(TEXT(POINT_IN).NE.'A')THEN                                     00434 
      CONT=.FALSE.              !Give up                                00435 
      CALL LIB$PUT_OUTPUT('MESAGE: %Vx, x is not A')                    00436 
      ASSIGN 32726 TO I32740                                            00437 
      GO TO 32740                                                       00437 
32726 CONTINUE                                                          00439 
      ELSE                                                              00439 
      I=-1                                                              00443 
      I32725=.TRUE.                                                     00444 
      DOWHILE(((I32725)).OR.(LETTER.NE.0))                              00444 
      I32725=.FALSE.                                                    00444 
      I=I+1                                                             00445 
      CALL LIB$MOVC3(1,%VAL(P_ADDR(NP)+I),LETTER)                       00446 
D     TYPE*,'CHAR ',I,' IN %VA STRING =',LETTER                         00447 
      ENDDO                                                             00448 
      FAOLLST(FAOLLST_PNT)=I                                            00452 
      FAOLLST(FAOLLST_PNT+1) = P_ADDR(NP)                               00453 
      NP=NP+1                                                           00454 
      FAOLLST_PNT=FAOLLST_PNT+2                                         00455 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!AD'                           00459 
      POINT_OUT=POINT_OUT+3                                             00460 
      ENDIF                                                             00461 
      ELSEIF(('A').EQ.( TEXT(POINT_IN) ))THEN                           00463 
      FAOLLST(FAOLLST_PNT)=1                                            00467 
      FAOLLST(FAOLLST_PNT+1) = P_ADDR(NP)                               00468 
      NP=NP+1                                                           00469 
      FAOLLST_PNT=FAOLLST_PNT+2                                         00470 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!AD'                           00474 
      POINT_OUT=POINT_OUT+3                                             00475 
      ELSEIF(('N').EQ.( TEXT(POINT_IN) ))THEN                           00477 
      TEXT_MSG(POINT_OUT:POINT_OUT+1)='!/'                              00481 
      POINT_OUT=POINT_OUT+2                                             00482 
      ELSE                                                              00484 
      CALL LIB$MOVC3(2,%VAL(P_ADDR(NP)),FAOLLST(FAOLLST_PNT))           00488 
      NP=NP+1                                                           00489 
      FAOLLST_PNT=FAOLLST_PNT+1                                         00490 
      IF(('D').EQ.(TEXT(POINT_IN)))THEN                                 00495 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!SW'                           00499 
      POINT_OUT=POINT_OUT+3                                             00500 
      ELSEIF(('M').EQ.(TEXT(POINT_IN)))THEN                             00502 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!UW'                           00506 
      POINT_OUT=POINT_OUT+3                                             00507 
      ELSEIF(('U').EQ.(TEXT(POINT_IN)))THEN                             00509 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!ZW'                           00514 
      POINT_OUT=POINT_OUT+3                                             00515 
      ELSEIF(('O').EQ.(TEXT(POINT_IN)))THEN                             00517 
      IF(FAOLLST(FAOLLST_PNT-1) .GT. 32767)THEN                         00521 
      FAOLLST(FAOLLST_PNT-1) = 65536-FAOLLST(FAOLLST_PNT-1)             00522 
      TEXT_MSG(POINT_OUT:POINT_OUT) = '-'                               00523 
      POINT_OUT=POINT_OUT+1                                             00524 
      ENDIF                                                             00525 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!OW'                           00527 
      POINT_OUT=POINT_OUT+3                                             00528 
      ELSEIF(('P').EQ.(TEXT(POINT_IN)))THEN                             00530 
      TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!OW'                           00534 
      POINT_OUT=POINT_OUT+3                                             00535 
      ELSE                                                              00537 
      CONT=.FALSE.              !Give up                                00541 
      CALL LIB$PUT_OUTPUT('MESAGE: %x, x unknown format')               00542 
      ASSIGN 32724 TO I32740                                            00543 
      GO TO 32740                                                       00543 
32724 CONTINUE                                                          00545 
      ENDIF                                                             00545 
      ENDIF                                                             00548 
      GO TO I32738                                                      00549 
      END                                                               00550 
