         SYSTEM   SIG7FDP
         SYSTEM   BPM
*
*        GETCOM   GET CURRENT DATE, TIME AND SENSE SWITCH SETTING
*                 THIS ROUTINE WILL PICK UP THE CURRENT DATE, TIME, AND
*                 PSEUDO-SENSE SWITCH SETTINGS, AND MAKE THEM AVAILABLE
*                 TO THE USER PROGRAM
*                 THE ROUTINE WILL OPTIONALLY PICK UP THE CURRENT NUMBER
*                 OF LINES PER PAGE FROM A PRINTER DCB
*                 THIS VALUE IS SET BY THE (LINES, VALUE) PARAMETER IN
*                 THE !ASSIGN CARD
*
*      USER SYNTAX:
*        ENTER    GETCOM  DATA-NAME-1, PRINT-FILE-NAME
*
*                 GETCOM: THE ENTRY POINT IN THE RUN-TIME ROUTINE
*            DATA-NAME-1: A 26 BYTE AREA (DISPLAY) INTO WHICH WILL BE
*                         INSERTED THE FOLLOWING INFORMATION
*         BYTES 1-6: THE PSEUDO-SWITCH SETTINGS, "0" IS OFF, "1" IS ON
*         BYTES 7-8: BLANK
*              9-26: TIME AND DATE, IN THE MONITOR FORM HH:MM MON DD,'YY
*                     (HOURS, MINUTES, MONTHS, DAY, YEAR)
*             25-26: NUMBER OF LINES PER PAGE IN THE PRINTER DCB
*
*        AUTHER   YOW-YUAN ROBERT LIN
*
         REF      C:ABA                                                 GETCOM
         DEF      GETCOM,GETCOM1                                        GETCOM
         OPEN     SAVE,RETURN,DEST,LOOP,STZERO,BYE,NEEDLNS,STLNS
         OPEN     FPT,BLANK,GENOUTP,BGADDR,SAVEAREA
         OPEN     WAIT,STOREM,ONLINE,ASK,BUFR,MSGSW                     GETCOM
GETCOM1  RES      0                                                     GETCOM
         MTW,1    MSGSW             SET TO 1 MESS WANTED                GETCOM
GETCOM   LCI      10
         STM,14   SAVE              SAVE R14-R7
         STW,15   RETURN
         AWM,14   RETURN
         CI,14    1                                                     GETCOM
         BGE      %+4                                                   GETCOM
         LI,2     X'9A'                                                 GETCOM
         STB,2    10                                                    GETCOM
         B        C:ABA                                                 GETCOM
         LI,4     X'7FFFF'          MASK
         AND,4    *15               R4 = BYTE ADDR OF DEST, ON A WORD BOUNDARY
         STW,4    BGADDR            STORE BEGIN ADDR OF OUTPUT
         LI,5     7
         LW,4     BLANK             CLEAR BUF
         STW,4    SAVEAREA-1,5
         BDR,5    %-1
         LI,4     WA(SAVEAREA)
         LI,1     X'40'
         LI,2     X'F0'
         LI,3     X'F1'
         LI,6     7                 R4 = DISPLACEMENT
         LI,5     2                 R5 = INDEX
         STB,1    *4,6
         AI,6     -1
         BDR,5    %-2
         LW,7     0                 R7 = ADDR OF T.C.B.
         LW,7     12,7              R7(B26-31) = SENSE SWITCH SETTING
         LW,1     6                 R1 = DISPLACEMENT
         LI,5     6                 R5 = INDEX
LOOP     LI,6     0
         DW,6     L(2)
         CI,6     0
         BE       STZERO
         STB,3    *4,1              SET DEST
         B        %+2
STZERO   STB,2    *4,1              RESET DEST
         AI,1     -1
         BDR,5    LOOP
         MTW,0    *X'4F'            SEE JIT FOR ONLINE STATUS           GETCOM
         BLZ      ONLINE            IF 0 BIT IS A 1(NEG) ONLINE         GETCOM
         LI,7     X'C2'             STORE B FOR BATCH                   GETCOM
         B        STOREM                                                GETCOM
ONLINE   RES      0                                                     GETCOM
         LI,7     X'D6'             STORE O FOR ONLINE                  GETCOM
         MTW,0    MSGSW             SEE IF S.SW WANTED                  GETCOM
         BEZ      STOREM            NO                                  GETCOM
         M:KEYIN  (MESS,ASK),(REPLY,BUFR),(SIZE,7),(ECB,ECB)            GETCOM
WAIT     RES      0                                                     GETCOM
         LW,7     ECB               IF BIT 0 IS A 1 NOT DONE            GETCOM
         BLZ      WAIT                                                  GETCOM
         LD,8     MOVEBUFR          FROM/TO ADDR                        GETCOM
         MBS,8    0                 MOVE 6 S.SW                         GETCOM
STOREM   RES      0                                                     GETCOM
         LI,5     6                 INDEX                               GETCOM
         STB,7    SAVEAREA,5        O/B AFTER S.SWITCHES                GETCOM
         AI,4     2                 UPDATE POINTR
         OR,4     L(X'10000000')
         STW,4    FPT               STORE ADDR FOR M:TIME
         AND,4    L(X'1FFFF')       REMAIN WORD ADDR
,FPT     M:TIME   ADDR
         BDR,14   NEEDLNS
BYE      LI,4     BA(SAVEAREA)
         LW,5     BGADDR
         AW,5     GENOUTP
         MBS,4    0
         LCI      10
         LM,14    SAVE
         B        *RETURN
NEEDLNS  AI,15    1
         LI,1     X'1FFFF'
         AND,1    *15               R1 = ADDR OF LVA
         LW,3     10,1
         SAS,3    -17               R3 = LVA (PRINTLINES PER PAGE)
STLNS    LI,5     -2                R4 = INDEX
         AI,4     4
         LI,1     1                 DISPLACEMENT
         LI,2     0
         DW,2     L(10)
         OR,2     L(X'F0')          BUILD UP EBCDIC
         STB,2    *4,1
         AI,1     -1
         BIR,5    STLNS+3
         B        BYE
ADDR     RES      1                 DUMMY ADDRESS
RETURN   RES      1
SAVE     RES      10
BLANK    TEXT     '    '
GENOUTP  GEN,8,24 26,0
BGADDR   RES      1
SAVEAREA RES      7
MSGSW    DATA     0                 SET TO 1 IF S.SW WANTED             GETCOM
ASK      TEXTC    'KEYIN THE 6 COBOL SENSE SWITCHES AS 1 OR 0'          GETCOM
BUFR     DATA     0,0                                                   GETCOM
ECB      DATA     0                                                     GETCOM
         BOUND    8                                                     GETCOM
MOVEBUFR DATA     BA(BUFR)+1                                            GETCOM
         GEN,8,24 6,BA(SAVEAREA)                                        GETCOM
         CLOSE    SAVE,RETURN,DEST,LOOP,STZERO,BYE,NEEDLNS,STLNS
         CLOSE    FPT,BLANK,GENOUTP,BGADDR,SAVEAREA
         CLOSE    WAIT,STOREM,ONLINE,ASK,BUFR,MSGSW                     GETCOM
         END
