// JOB VSB005,,5A00,5A00
// OPR '*****VSB005**--VSBAL2-  TEST DAM FILE WITH BAL PROGRAM'
// OPR '*****VSB005A -BEGIN TO ASSEMBLE --VSBAL2--'
// DVC 20  // LFD PRNTR
// WORK1    DVC=50,VOL=SDIVSB
// WORK2 DVC=50,VOL=SDIVSB
// EXEC ASM
/$
VSBAL2   TITLE 'JOB---VSB005    PROGRAM---VSBAL2   ** ASSMB-DAM **     X
               -**** T. GALLETTI/SDI E-TEAM'
VSBAL2   START 0
         PRINT ON,NOGEN
VIA      BALR  2,0
         USING *,2,3,4
A        LM    3,4,ADR
         L     13,=A(SAVE)
         B     VAI
SAVE     DS    18F
ADR      DC    A(A+4096)
         DC    A(A+2*4096)
TAB      DC    C'0123456789ABCDEF'
MSG1     DC    CL26'FILES OPENED BAL-DAM  LOAD'
MSG2     DC    CL39'ENTER NR OF RCDS TO BE LOADED INTO FILE'
MSG3     DC    CL29'FOUR DIGITS FROM 0001 TO 0999'
MSG6     DC    C'END OF BAL-DAM FILE LOAD'
MSG5     DC    C'END OF BAL-DAM FILE RETRIEVAL'
MSG4     DC    C'BEGIN RETRIEVAL FUNCTION ON BAL-DAM FILE'
HEAD1    DC    C' **************JOB-----VSB005   -BAL-PROGRAM'
HEAD2    DC    C' **************PROGRAM-VSBAL2   -LOAD BAL-DAM'
MSG7     DS    0CL34
         DC    C'DISC-ERROR  FN.E '
CM1      DS    CL2
         DC    C'  FN.C '
CM2      DS    CL8
ERRMSG1  DC    CL15'KEYIN INCORRECT'
REPLY1   DS    CL4
ZWORK    DC    C'0999'
ZONED    DC    C'0999'
PKWRK    DS    CL4
PK1      DC    PL4'1'
COUNT    DC    PL4'0'
FULL     DS    F
         CNOP  0,8
DW       DC    XL8'0'
ADDID    DC    XL4'1'                   IDLOC ADDRESS
ADDRR    DC    XL4'1'                   SEEK ADDRESS  RRRRRRRR
UNO      DC    XL4'1'
RTWK     DC    PL4'0'
IOAR     DS    0CL240
         DS    CL8
         DC    C'** DAM-RECORD **/'
         DS    CL215
ZZ       DC    XL4'00'
PRAR     DS    CL120                    PRINT AREA
PK100    DC    PL4'100'
SW       DC    X'00'
PK50     DC    PL4'50'
         EJECT
VAI      OPEN  DAMFIL                   OPEN DAM FILE
         OPEN  PRINT                         PRINT FILE
         MVC   IOAR+25(214),IOAR+8      FILL BAL-DAM IOAREA
         MVC   PRAR(120),PRAR-1         BLANK IN PRINT AREA
         BAL   7,RHEAD
         MVC   PRAR+40(26),MSG1
         BAL   8,RPRINT                 PRINT FIRST MSG
         CNTRL PRINT,SP,2               SKIP 2 LINES
         OPR   MSG1,26                  REQUEST OPERATOR TO MAKE
V1       OPR   MSG2,39                          KEYIN VIA CONSOLE
         MVC   REPLY1,ZONED
         OPR   MSG3,29,,REPLY,REPLY1,4
*  VALIDATE OPERATOR KEYIN
         MVZ   ZWORK,REPLY1
         CLC   ZWORK,ZONED              CHECK FOR NUMERIC DIGITS
         BE    V2
ERR1     OPR   ERRMSG1,15               KEYIN INCORRECT
         MVC   ZWORK,ZONED
         B     V1
V2       CLC   REPLY1,ZONED
         BH    ERR1
         PACK  PKWRK,REPLY1
         CP    PKWRK,PK1                KEYIN LESS 1
         BL    ERR1
WRITE    EQU   *
         L     5,ADDRR
         CVD   5,DW
         UNPK  IOAR(8),DW+4(4)
         MVZ   IOAR+7(1),ZWORK
         WRITE DAMFIL,ID                WRITE  DAM FILE
         WAITF DAMFIL
         MVC   PRAR(40),IOAR            PRINT LOAD RECORD DAM FILE
         BAL   8,RPRINT
         CP    PKWRK,COUNT
         BNH   CLOSE
         MVC   ADDRR,ADDID              MOVE IDLOC IN SEEKADR
         AP    COUNT,PK1
         B     WRITE
CLOSE    CLOSE DAMFIL
         CNTRL PRINT,SP,2               SKIP 2 LINES
         MVC   PRAR+40(24),MSG6
         BAL   8,RPRINT                 PRINT END OF LOAD BAL-DAM
         OPR   MSG6,24
         BAL   7,RHEAD
         MVC   PRAR+40(40),MSG4
         BAL   8,RPRINT                 PRINT BEGIN RETRIEVAL
         OPR   MSG4,40
         CNTRL PRINT,SP,2               SKIP 2 LINES
         OPEN  DAMFIL
         MVI   IOAR,X'40'               CLEAR
         MVC   IOAR+1(239),IOAR         DISC IOAREA
         MVC   COUNT,PK100              RETRIEVAL EACH 100 RECORD
         MVC   RTWK,PK1                 RETRIEVAL FIRST RECORD
READ     EQU   *
         MVC   DW,ZZ                    CLEAR
         MVC   DW+4(4),RTWK
         CVB   5,DW
         ST    5,ADDRR
         READ  DAMFIL,ID                RETRIEVE  RECORD
         WAITF DAMFIL
         UNPK  PRAR+5(8),RTWK           CODE TO RETRIEVE
         MVZ   PRAR+12(1),ZWORK
         MVC   PRAR+20(40),IOAR         RECORD RETRIEVED
         BAL   8,RPRINT
         AP    RTWK,COUNT
         CP    PKWRK,RTWK
         BH    READ
         CLI   SW,X'FF'                 END OF RETRIEVAL
         BE    EOJ
         MVI   SW,X'FF'
         MVC   COUNT,PK50               RETRIEVAL EACH 50 RECORD
         MVC   RTWK,PK50
         B     READ
EOJ      EQU   *
         CNTRL PRINT,SP,2               SKIP 2 LINES
         MVC   PRAR+40(29),MSG5
         BAL   8,RPRINT
         OPR   MSG5,29
         CNTRL PRINT,SK,15              SKIP AT NEW PAGE
CLEOJ    CLOSE DAMFIL
         CLOSE PRINT
         EOJ
RPRINT   PUT   PRINT                    PRINT LINE
         MVC   PRAR(120),PRAR-1         CLEAR AREA PRINT
         BR    8
ERROUT   EQU   *
         UNPK  CM1(1),DAMFILE(1)
         MVN   CM1+1(1),DAMFILE
         MVZ   CM1(2),ZZ
         TR    CM1,TAB
         UNPK  CM2(1),DAMFILC(1)
         MVN   CM2+1(1),DAMFILC
         UNPK  CM2+2(1),DAMFILC+1(1)
         MVN   CM2+3(1),DAMFILC+1
         UNPK  CM2+4(1),DAMFILC+2(1)
         MVN   CM2+5(1),DAMFILC+2
         UNPK  CM2+6(1),DAMFILC+3(1)
         MVN   CM2+7(1),DAMFILC+3
         MVZ   CM2,ZZ
         TR    CM2,TAB
         OPR   MSG7,34                  DISPLAY ERROR/SENSE BYTES
         BR    14
*****    ROUTINE PRINT HEADER ON EACH PAGE
RHEAD    EQU   *
         CNTRL PRINT,SK,15              SKIP AT NEW PAGE
         MVC   PRAR(44),HEAD1
         PUT   PRINT
         MVC   PRAR(45),HEAD2
         PUT   PRINT
         CNTRL PRINT,SP,2
         MVC   PRAR(120),PRAR-1
         BR    7
****     ROUTINE OVERFLOW
HEADER   ST    14,FULL
         BAL   7,RHEAD
         L     14,FULL
         BR    14
         EJECT
DAMFIL   DTFDA BLKSIZE=240,                                            X
               ERROR=ERROUT,                                           X
               IDLOC=ADDID,                                            X
               IOAREA1=IOAR,                                           X
               READID=YES,                                             X
               RECFORM=FIXUNB,                                         X
               RELATIV=R,                                              X
               SEEKADR=ADDRR,                                          X
               TYPEFLE=OUTPUT,                                         X
               WRITEID=YES
PRINT    DTFPR BLKSIZE=120,                                            X
               CONTROL=YES,                                            X
               IOAREA1=PRAR,                                           X
               PRINTOV=HEADER,                                         X
               RCFM=FIXUNB,                                            X
               PRAD=1
         END   VSBAL2
/*
// OPR '*****VSB005B -BEGIN TO LINK AND CATALOG --VSBAL2--'
// DVC 20  // LFD PRNTR
// DVC 50  // VOL SDIVSB  // LBL VSBLIB  // LFD LOAD
// WORK1    DVC=50,VOL=SDIVSB
// EXEC LNKEDT
/$
 LINKOP OUT=LOAD
 LOADM VSBAL2
/*
// OPR '*****VSB005C -BEGIN TO EXECUTE --VSBAL2--'
// DVC 20  // LFD PRINT
// DVC 50  // VOL SDIVSB  // LBL VSBLIB  // LFD LOAD
// DVC 50  // VOL SDIVSB  // LBL BALDAM   // LFD DAMFIL
// EXEC VSBAL2,LOAD
// OPR '*****VSB005C -END --VSBAL2--'
// OPR '*****VSB005**-DISC LOADED VSN=SDIVSB FNAME=BAL-DAM'
/&
