|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 23878 (0x5d46)
Notes: pts_type(SC)
Names: »KMDIO.SC«
└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
└─⟦this⟧ »NJ-AMT/KMDIO.SC«
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
└─⟦this⟧ »NJ-AMT/KMDIO.SC«
IDENT KMDIO 831026 EV
DDUM KMD08
PDIV
ENTRY WRITFD
ENTRY WRITVO
ENTRY WRITJT
ENTRY WTALLY
ENTRY WRITID
ENTRY CRKJ
ENTRY GRASPV
ENTRY LINOPT
ENTRY CRVO
ENTRY WCHECK
ENTRY CLEAR8
EXT RADEL
EXT SPCHK5
EXT SPLIN8
EXT SPERR
EXT FRMTJT
EXT FRMXJT
EXT ADM
EXT CYWRT
EXT FRMXVO
EXT FRMXTA
EXT FRMXKV
EXT REPL00
EXT ABORT
EXT RAWRIT
EXT WAITF
EXT WRITLO
INCLUDE EQUATE
EJECT
WRITFD PROC
TBF CSKIFTWN,WRFD00
PERF ADM,CBIN12 DISKETTE SKIFT
TBF CSKIFTWN,WRFD00
CMP CBIN1,CBIN0
RET
WRFD00
PERF WAITF,CPFLG
CLEAR TFELT90
CLEAR CSPLITFL
MOVE CTWBIN1,CBIN0 NO. OF WRITTEN RECORDS
PERF EDATNR
MOVE GSWBIN5,CBIN0
WRFD005
SET CSWFLAG
CBE CRECLGD,=W'128',WRFD006
CLEAR CSWFLAG
WRFD006
EDIT CPCKBUF,PCKINIT
EDIT CPCKBUF,TREC1 INSERT HEADER INF
MOVE GSWBIN3,CBIN10
MOVE GSWBIN4,CRECLGD
SUB GSWBIN4,CBIN11
MATCH CPCKBUF,GSWBIN3,GSWBIN4,CBLANKS,CBIN0,CBIN2
MOVE GSWBIN4,CRECLGD
SUB GSWBIN4,CBIN1
SUB GSWBIN4,GSWBIN3 REMAINING LENGTH
CBE GTREGNR,=D'12',WRFD070
TBT CSPLITFL,WRFD025 IF SPLIT PACK REST
WRFD020
ADD GSWBIN5,CBIN1
CBNL GSWBIN5,CBINMAX,WRFD070
CBE GTUSED(GSWBIN5),CBIN0,WRFD020 USED FIELD ?
CBE GTUSED(GSWBIN5),=W'90',WRFD090
CBE GTUSED(GSWBIN5),=W'91',WRFD091
CBE GTUSED(GSWBIN5),=W'92',WRFD092
CBE GTUSED(GSWBIN5),=W'93',WRFD093
CBE GTUSED(GSWBIN5),=W'94',WRFD094
MOVE SPINPUT,=X'00' YES
MOVE GSWBCD3,GTUSED(GSWBIN5) CONVERT
EDIT SPINPUT,PFRM1
WRFD025
MOVE GSWSTR1,=X'00'
MOVE GSWBIN6,CBIN0 FIND LENGTH
MOVE GSWBIN10,=W'30'
MATCH SPINPUT,GSWBIN6,GSWBIN10,GSWSTR1,CBIN0,CBIN1
CLEAR CSPLITFL
CBG GSWBIN6,GSWBIN4,WRFD030 OVERFLOW ?
COPY CPCKBUF,GSWBIN3,GSWBIN6,SPINPUT,CBIN0 NO
ADD GSWBIN3,GSWBIN6
SUB GSWBIN4,GSWBIN6 ADJUST POINTERS
B WRFD020 SEE IF MORE
WRFD030
COPY CPCKBUF,GSWBIN3,GSWBIN4,SPINPUT,CBIN0
MOVE GSWSTR1,=X'21' CONTINUATION MARK
ADD GSWBIN3,GSWBIN4
COPY CPCKBUF,GSWBIN3,CBIN1,GSWSTR1,CBIN0
DLETE SPINPUT,CBIN0,GSWBIN4
SET CSPLITFL
PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR
BNOK WRFDERR
TBT GTTESTFL,WRFD005
ADD CTWBIN1,CBIN1
ADD CRECNR,CBIN1
ADD CRECBCD,=D'1'
B WRFD005 GO AND PACK REST
WRFD070
MOVE GSWSTR1,=X'7F'
COPY CPCKBUF,GSWBIN3,CBIN1,GSWSTR1,CBIN0
PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR
BNOK WRFDERR
TBT GTTESTFL,WRFD080
ADD CTWBIN1,CBIN1
ADD CRECNR,CBIN1
ADD CRECBCD,=D'1'
PERF RADEL,DK02,CRECNR
BNOK WRFDERR
*
* LOOK FOR ACCOUNT NO
* IN KONTOPLAN. IF FOUND,
* SET FLAG GTKORTFL
*
CBL CRECNR,CMAXREC,WRFD080
CLEAR CPFLG
CLEAR CSPLITFL
MOVE SPBINW4,CBIN21
MOVE GTWBCD2,=D'2' FILE CODE
MOVE GTWBCD1,=D'50' ERROR CODE
MOVE GSWSTR9,=C'DISCFEJL '
PERF SPERR
CMP CBIN0,CBIN0
RET
WRFD090
MOVE SPINPUT,=X'26393000'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN1),CBIN0
B WRFD095
WRFD091
MOVE SPINPUT,=X'26393100'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN2),CBIN0
B WRFD095
WRFD092
MOVE SPINPUT,=X'26393200'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN3),CBIN0
B WRFD095
WRFD093
MOVE SPINPUT,=X'26393300'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN4),CBIN0
B WRFD095
WRFD094
MOVE SPINPUT,=X'26393400'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN5),CBIN0
WRFD095
SET TFELT90
PERF MATCH,=C'&',=C'+'
PERF MATCH,=C'!',=C'/'
B WRFD025
*
WRFD080
CLEAR CSPLITFL
CLEAR CPFLG
CMP CBIN0,CBIN0 OK, SET CR=0
RET
WRFDERR
SUB CRECNR,CTWBIN1
MOVE GSWBCD1,CTWBIN1
SUB CRECBCD,GSWBCD1
SET CSKIFTWN
CLEAR CPFLG
SET GTREGFLG
CMP CBIN1,CBIN0 NOK, CR<>0
RET
PEND
EJECT
********************************************
* EDATNR
* FINDS DATASETNR FOR THE TRANSACTIONS
* AND PUT THE INFORMATION IN RELEVANT FIELDS
************************************************
EDATNR PROC
CLEAR TTR11FLG
CBG GTREGNR,=D'12',EDAT100
MOVE CEDATNR,=D'1'
CBG GTREGNR,=D'10',EDAT010
MOVE GTUSED(CBIN5),CBIN9 UPDATE D/K MARK
MOVE GTDUPF(CBIN5),TTDKBCD
EDAT010
CBNE GTREGNR,=D'11',EDAT020
SET TTR11FLG
EDAT020
RET
EDAT100
CBG GTREGNR,=D'42',EDAT110
MOVE CEDATNR,=D'3' TR 40-42
B EDAT020
EDAT110
CBG GTREGNR,=D'47',EDAT120
MOVE CEDATNR,=D'5' TR 45-47
B EDAT020
EDAT120
CBG GTREGNR,=D'49',EDAT130
MOVE CEDATNR,=D'4' TR 48-49
B EDAT020
EDAT130
MOVE CEDATNR,=D'2' TR 50-54
B EDAT020
PEND
EJECT
WRITJT PROC $JTLIT
PLIT $JTLIT
********************
* THIS ROUTINE MAKES OUTPUT ON JOURNAL TAPE
* DEPENDING ON TRANSACTION TYPE
********************
WAIT KVOUCH
WAIT KTALLY
TBT GTSPGFLG,JTRET
MOVE GSWBIN1,$JTLIT
CBG GSWBIN1,CBIN0,JT10
TBF CSPOOL,JT04
TBT TSPOOL,JT05
JT04 WRITE ON JOURNAL
PERF FRMTJT GET FORMAT ACORDING TO TYPE
B JT20
JT05 EL. JOURNAL
PERF WRITLO,CBIN0
BNOK JT04
MOVE GSWBIN1,TTCNTNR
B JT35
JT10
PERF FRMXJT,GSWBIN1 SPECIAL FORMAT
JT20
MOVE GSWBIN1,TTCNTNR 'TAELLER' NR IN BINARY
EDWRT KJTAPE,GTSTRFMT EDWRT JOURNAL
CBL GTREGDEX,CBIN8,JT40
CBG GTREGDEX,CBIN9,JT40
MOVE GSWBIN1,$JTLIT
CBG GSWBIN1,CBIN0,JT40
TBF TFELT90,JT35 ANY 90-94
TBF TSPOOL,JT30
TBT CSPOOL,JT35
JT30
CBNE GTUSED(CBIN20),=W'90',JT31
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN1),CBIN0
WRITE KJTAPE,SPINPUT
JT31
CBNE GTUSED(CBIN21),=W'91',JT32
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN2),CBIN0
WRITE KJTAPE,SPINPUT
JT32
CBNE GTUSED(CBIN22),=W'92',JT33
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN3),CBIN0
WRITE KJTAPE,SPINPUT
JT33
MOVE GSWBIN1,=W'23'
CBNE GTUSED(GSWBIN1),=W'93',JT34
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN4),CBIN0
WRITE KJTAPE,SPINPUT
JT34
MOVE GSWBIN1,=W'24'
CBNE GTUSED(GSWBIN1),=W'94',JT35
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN5),CBIN0
WRITE KJTAPE,SPINPUT
JT35
JT40
WAIT KJTAPE
DSC0 KJTAPE,TSTAT TEST STATUS OF JOURNAL
BOK JTRET
PERF SPLIN8,CBIN1,CBIN1 'SKIFT JOURNAL'
SET TTJTEND
JTRET
RET
PEND
EJECT
WTALLY PROC
*******************
*
* WRITE TALLY ROLL
*
********************
WAIT KVOUCH
WAIT KTALLY
EDWRT .NW,KTALLY,GTSTRFMT EDWRT WITH THE FORMAT
RET STORED IN GTSTRFMT
PEND
*
*
CRKJ PROC
********************
*
* DOES A CARRIAGE RETURN ON TTP WITHOUT WAIT
*
********************
EDWRT KJTAPE,CRJTFMT
RET
CRJTFMT FRMT
FILLR ' ',2
FILLR X'0D',1
FMEND
PEND
*
*
CRVO PROC
*******************
*
* DOES A CARRIAGE RETURN ON VOUCHER WITH WAIT
*
********************
EDWRT KVOUCH,CRVOFMT
RET
CRVOFMT FRMT
FILLR ' ',2
FILLR X'09',1
FMEND
PEND
GRASPV PROC
********************
*
* GRASP VOUCHER
*
********************
WAIT KVOUCH
DSC0 KVOUCH,GRASP GRASP VOUCHER
RET
PEND
WCHECK PROC
RET
PEND
EJECT
WRITVO PROC
*
* WRITE VOUCHER
*
* IN CYCLE POSITION AND WRITE
* (MAY BE NEW PAGE)
*
* NOT CYCLE GET LINE NR
* POSITION VOUCHER
* WRITE 1-5 LINES
* AND RELEASE VOUCHER
*
********************
TBT GTCYFLG,CYVOUCH
* NOT IN CYCLE
WOBILAG
PERF SPLIN8,CBIN2,CBIN0 "LINIE NR"
PERF GRASPV
CLEAR GTSWFLAG
PERF LINOPT SEE IF DEFAULT LINE
BNOK WOBILAG
CBG GSWBIN1,=W'90',WO90
MOVE GSWBIN1,TTLINNR
B WO100
WO90 MOVE GSWBIN2,=W'100'
SUB GSWBIN2,GSWBIN1
IB GSWBIN2, C
WO99,WO98,WO97,WO96,WO95, C
WO94,WO93,WO92,WO91
WO99
PERF FRMXVO,CBIN6
MOVE GSWBIN1,=W'35'
B WO100
WO98
PERF FRMXVO,CBIN4
MOVE GSWBIN1,CBIN14
B WO100
WO97
PERF FRMXVO,CBIN5
MOVE GSWBIN1,CBIN14
B WO100
WO96
PERF FRMXVO,CBIN17
MOVE GSWBIN1,=W'37'
B WO100
WO95
WO94
WO93
DSC0 KVOUCH,RLEAS
B WOBILAG
WO92 SHORT 'BILAG'
PERF SPLIN8,CBIN2,CBIN0
PERF GRASPV
SET GTSWFLAG
PERF LINOPT
BNOK WO92
CBG GSWBIN1,=W'90',WO92
MOVE GSWBIN1,TTLINNR
CLEAR GTSWFLAG
PERF FRMXVO,CBIN19
B WO100
WO91
MOVE GTRETUR,CBIN3 INDICATE KONTOKORT
RET
*
WO100
DSC1 KVOUCH,POS,GSWBIN1 POSITION VOUCHER
EDWRT KVOUCH,GTSTRFMT EDWRT WITH CURRENT FORMAT
PERF CRVO
PERF TSTMUL
BNOK WO110
PERF MULLIN
PERF MULLIN
PERF MULLIN
PERF MULLIN
WO110
DSC0 .NW,KVOUCH,RLEAS RELEASE VOUCHER
RET
* IN CYCLE
CYVOUCH
SET TTCYTRFL AFTER A CORRECT TRANS
TBT GTCYWRTF,WO5
MOVE GTBSUM1,=D'0'
PERF CYWRTS
BNOK WO5
RET
*
WO5
TBT TTTSTFLG,WO10
SET TTTSTFLG
PERF SPLIN8,CBIN5,CBIN2 WRITE 'BILAG'
PERF GRASPV
PERF CLEAR8
WO10
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1 POSITION VOUCHER
EDWRT .NW,KVOUCH,GTSTRFMT
*****
*
* WRITING OF TEXTLINE
* FOR CHECK ON WORKSET
*
*****
SUB TTLINNR,=D'2' NEXT LINE
CBL TTLINNR,=D'4',NEWPG NEW PAGE?
RET NO
*
NEWPG NEW PAGE
TBT TTPSEFLG,WORET T: IF SUBTOTAL
WAIT KVOUCH
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1
MOVE GSWSTR9,=C'TRP '
PERF FRMXVO,CBIN2
EDWRT KVOUCH,GTSTRFMT
DSC0 KVOUCH,RLEAS
SET GTCYTRPF
WORET
RET
PEND
EJECT
TSTMUL PROC
* THE PROCEDURE DECIDES IF MULTIPLE LINES C A N
* OCCUR, WHICH MEANS:
CBE GTUSED(CBIN20),=W'90',TSTM01
MOVE GTFELT90(CBIN1),CBLANKS
TSTM01
CBE GTUSED(CBIN21),=W'91',TSTM02
MOVE GTFELT90(CBIN2),CBLANKS
TSTM02
CBE GTUSED(CBIN22),=W'92',TSTM03
MOVE GTFELT90(CBIN3),CBLANKS
TSTM03
MOVE GSWBIN1,=W'23'
CBE GTUSED(GSWBIN1),=W'93',TSTM04
MOVE GTFELT90(CBIN4),CBLANKS
TSTM04
ADD GSWBIN1,CBIN1
CBE GTUSED(GSWBIN1),=W'94',TSTM05
MOVE GTFELT90(CBIN5),CBLANKS
TSTM05
CBE GTREGDEX,CBIN6,TSTM30
CBE GTREGDEX,CBIN8,TSTM20
CBE GTREGDEX,CBIN9,TSTM30
TSTM10
CMP CBIN1,CBIN0
RET
TSTM20
TSTM30
MOVE GSWBIN11,CBIN1
TSTM40
MOVE GSWBIN10,CBIN5
TSTM50
MOVE SPINPUT,GTFELT90(GSWBIN10)
MOVE GSWBIN7,=W'35'
PERF REPL00,SPINPUT,GSWBIN7
MOVE GTFELT90(GSWBIN10),SPINPUT
SUB GSWBIN10,CBIN1
BP TSTM50 MORE LEFT?
TSTM90
CMP CBIN0,CBIN0
RET
PEND
MULLIN PROC
* THE PROCEDURE WRITES 1 OF THE MULTIPLE
* LINES ON THE VOUCHER
ADD GSWBIN11,CBIN1
PERF TEST90,GSWBIN11 CAN BE 3-4-5=90-91,92-93,94
BNOK MUL090
PERF PGTEST
PERF FRMXKV,GSWBIN11
EDWRT KVOUCH,NLIN
EDWRT KVOUCH,GTSTRFMT
PERF CRVO
MUL090
RET
PEND
NLIN FRMT
FNL
FMEND
TEST90 PROC P
IB P,TEST9010,TEST9020,TEST9030,TEST9040,TEST9050
B TEST9090
TEST9010
TEST9020
CBNE GTUSED(CBIN10),CBIN0,TEST9025
CBNE GTUSED(CBIN7),CBIN0,TEST9025
B TEST9090
TEST9025
PERF FRMXKV,P
B TEST9080
TEST9030 FELT 90-91
CBNE GTFELT90(CBIN1),CBLANKS,TEST9032
CBE GTFELT90(CBIN2),CBLANKS,TEST9090
TEST9032
PERF FRMXKV,P
B TEST9080
TEST9040 FELT 92-93
CBNE GTFELT90(CBIN3),CBLANKS,TEST9042
CBE GTFELT90(CBIN4),CBLANKS,TEST9090
TEST9042
PERF FRMXKV,P
B TEST9080
TEST9050
CBE GTFELT90(CBIN5),CBLANKS,TEST9090
PERF FRMXKV,P
TEST9080
CMP CBIN0,CBIN0
RET
TEST9090
CMP CBIN0,CBIN1
RET
PEND
CYWRTS PROC
ADD GTBSUM1,=D'1'
MOVE GSWBIN1,GTBSUM1
IB GSWBIN1,CYWRTS10,CYWRTS20,CYWRTS30, C
CYWRTS40,CYWRTS50
CYWRTS05
MOVE GTBSUM1,=D'0'
CMP CBIN1,CBIN0
RET
CYWRTS10
PERF CYWRT
BNOK CYWRTS05
ADD GTBSUM1,=D'1'
CYWRTS20
PERF TSTMUL
BNOK CYWRTS90 ONLY 1 LINE
CYWRTS30
CYWRTS40
CYWRTS50
MOVE GSWBIN11,GTBSUM1
PERF TEST90,GSWBIN11
BOK CYWRTS55
CBG GSWBIN11,CBIN5,CYWRTS90
B CYWRTS57
CYWRTS55
PERF CYWRT WRITE THE CURRENT FORMAT
BNOK CYWRTS05
CYWRTS57
PERF CYWRTS OBS: R E C U R S I V E
CYWRTS90
MOVE GTBSUM1,=D'0'
CMP CBIN0,CBIN0
RET
PEND
PGTEST PROC
SUB TTLINNR,=D'2'
CBNL TTLINNR,=D'4',PGTE90
MOVE TTCYKTOT,GTREGF(CBIN4)
WAIT KVOUCH
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1
MOVE GSWSTR9,=C'TRP '
PERF FRMXVO,CBIN2
EDWRT KVOUCH,GTSTRFMT
PGTE20
DSC0 KVOUCH,RLEAS
PERF SPLIN8,CBIN2,CBIN0 "LINIE NR"
PERF GRASPV
CLEAR GTSWFLAG
PERF LINOPT
BNOK PGTE20
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1
MOVE GSWSTR9,=C'TRP '
PERF FRMXVO,CBIN2
EDWRT KVOUCH,GTSTRFMT
PGTE90
RET
PEND
EJECT
LINOPT PROC
********************
*
* CHECK LINE NUMBER, IF ANY
*
********************
TBT GTSWFLAG,LINST
TESTIO KEYB SEE IF INPUT FINISHED
BNOK LINOP1 NO, ABORT
LINST
WAIT KEYB
CBE SPBINW2,=W'18',LINOP0 SLUT KEY
CBNE SPBINW2,=W'4',LINOP2 ONLY ENTER KEY ALLOWED
LINOP0
CBG SPBINW1,=W'3',LINOP2 CHECK LENGTH
MOVE GSWBCD3,SPINPUT GET LINE NR
CBG GSWBCD3,=D'90',LINOP4 SPECIAL FORMATS?
PERF SPCHK5 OK, CHECK LINENR
CBE SPBINW3,=W'3',LINOP2 ERROR IN LINE NR
MOVE TTLINNR,GSWBIN1 GET CONVERTED LINE NO.
LIN90
CMP CBIN0,CBIN0 SET CR=0,OK
B LINRET
LINOP1
CALL ABORT,KEYB ABORT I/O
CBL GTDFLIN,=W'90',LINOP101
MOVE GSWBCD3,GTDFLIN
B LINOP4
LINOP101
MOVE GSWBCD3,GTDFLIN
MOVE SPINPUT,GSWBCD3
PERF SPCHK5
MOVE TTLINNR,GSWBIN1 SET DEFAULT LINE NO
CMP CBIN0,CBIN0 SET CR=0, OK
MOVE GSWBIN1,=W'0'
B LINRET
LINOP2
WAIT KVOUCH
DSC0 KVOUCH,RLEAS RELEASE VOUCHER
DSC0 KEYB,SKIB
CMP CBIN0,CBIN1 SET CR<>0, NOT OK
RET
LINOP4
MOVE GSWBIN1,GSWBCD3
B LIN90
LINRET
PERF CLEAR8 DELETE LINE 8
RET
PEND
EJECT
WRITID PROC WRITVAR1,WRITVAR2
********************
*
* PRINTS HEADING IDENTIFIED BY WRITVAR1
* PRINTS ID IDENTIFIED BY WRITVAR2
*
* PRINTS ON JOURNAL AND TALLY
*
*
* WRITVAR1:
* 1 FEJL
* 2 OPSTART
* 3 DISKETTE SKIFT
* 4 KONVERTERING
* 5 DATATRANSMISSION
* 6 BACKUP
*
* WRITVAR2:
* CHARACTERS PRINTED FROM PACKBUFFER:
* 1 1-20 + 40-59
* 2 1-20 + 23-42, IF KONVERTERING
* 2 1-20 + VOLID, IF NOT KONVERTERING
* 3 NOTHING
* 4 VOLID
*
*
*
********************
*
WAIT KJTAPE
IB WRITVAR1,WRID31,WRID32,WRID33,WRID34,WRID35,WRID36
B WRID50
WRID34
MOVE GSWSTR20,=C'FEJL '
B WRID50
WRID31
MOVE GSWSTR20,=C'OPSTART '
B WRID40
WRID32
MOVE GSWSTR20,=C'DISKETTE SKIFT '
B WRID40
WRID33
MOVE GSWSTR20,=C'KONVERTERING '
B WRID40
WRID35
MOVE GSWSTR20,=C'DATATRANSMISSION '
B WRID40
WRID36
MOVE GSWSTR20,=C'BACKUP '
WRID40
PERF WRITJT,=W'12'
PERF WRITLO,CBIN15
PERF FRMXTA,CBIN6
PERF WTALLY
*
*
WRID50
WAIT KTALLY
CBE WRITVAR2,CBIN3,WRID80
CBE WRITVAR2,CBIN4,WRID73
MOVE GSWSTR20,CPCKBUF
PERF WRITJT,=W'12'
PERF WRITLO,CBIN15
CBG WRITVAR1,=W'3',WRID60
PERF FRMXTA,CBIN6
PERF WTALLY
WAIT KTALLY
*
WRID60
CBE WRITVAR2,CBIN2,WRID70
MOVE GSWBIN2,CBIN20
MOVE GSWBIN1,=W'40'
COPY GSWSTR20,CBIN0,GSWBIN2,CPCKBUF,GSWBIN1
B WRID75
WRID70
CBNE WRITVAR1,CBIN4,WRID72
MOVE GSWBIN2,CBIN20
MOVE GSWBIN1,=W'23'
COPY GSWSTR20,CBIN0,GSWBIN2,CPCKBUF,GSWBIN1
B WRID75
WRID72
CBG WRITVAR1,CBIN2,WRID80
WRID73
MOVE GSWSTR20,CBLANKS
MOVE GSWBCD3,CVOLNO
EDIT GSWSTR20,FRVOLID
WRID75
PERF WRITJT,=W'12'
PERF WRITLO,CBIN15
CBL WRITVAR1,=W'4',WRID76 1,2,3,6
CBL WRITVAR1,=W'6',WRID90 4,5
WRID76
PERF FRMXTA,CBIN6
PERF WTALLY
WAIT KTALLY
B WRID85
WRID80
CBG WRITVAR1,=W'3',WRID90
WRID85
PERF FRMXTA,CBIN7
PERF WTALLY
WAIT KTALLY
WRID90
RET
PEND
EJECT
CLEAR8 PROC
* DELETE FIRST 14 CHARACTERS
* OF LINE 8
MOVE GSWBIN2,=X'1801' INDICATE LAST LINE
DSC1 SCREEN,06,GSWBIN2
MOVE GSWBIN2,CBIN14
DSC1 SCREEN,02,GSWBIN2 ERASE 14 CHARS
RET
PEND
MATCH PROC $FROM,$TO
PLIT $FROM,$TO
MOVE GSWSTR2,$TO REPLACEMENT CHARACTER
MOVE GSWBIN6,CBIN3 GET STARTING POSITION
MOVE GSWSTR1,$FROM SEARCH CHARACTER
MOVE GSWBIN10,CBIN22 LENGTH OF SEARCH
MA0100
MATCH SPINPUT,GSWBIN6,GSWBIN10,GSWSTR1,CBIN0,CBIN1
BNOK MA0200 SEARCH COMPLETE
XCOPY SPINPUT,GSWBIN6,CBIN1,GSWSTR2,CBIN0
MOVE GSWBIN10,CBIN22 LENGTH OF SEARCH
SUB GSWBIN10,GSWBIN6 SUB CHARACTERS ALREADY TESTED
B MA0100 GO CONTINUE SEARCH
MA0200
RET
PEND
EJECT
*************************************************
*
* FORMATS FOR WRITFD
*
********************************************************
*
PCKINIT FRMT
FILLR ' ',40
FILLR ' ',40
FBT CSWFLAG,INIT10
FILLR X'00',48
FEXIT
INIT10
FILLR ' ',48
FMEND
*
FRVOLID FRMT
FMEL '999999',CMASKDAT
FILLR ' ',1
FMEL '99999',GSWBCD3
FMEND
*
TREC1 FRMT
FMEL '999',GTMSK
FILLR C'G',1
FMEL '99',CEDATNR
FMEL '99999',CRECBCD
FBT CSPLITFL,TREC40
FMEL '99',GTREGNR
FCOPY =C'&01'
FMEL '9999',CKMDNR
FBF GTKASSE,TREC40
FBT TTR11FLG,TREC10
FCOPY =C'&02'
FMEL '999999',GTDATO
TREC10
FCOPY =C'&03'
FMEL '999',GTMSK
FBT TTR11FLG,TREC40
FCOPY =C'&04'
FMEL '99999',TTLBNR
TREC40
FMEND
*
PFRM1 FRMT
FCOPY =C'&'
FMEL '99',GSWBCD3
FBP GSWBCD3,PLAB10
FMEL 'TTTTTTTTTTTTT9-',GTDUPF(GSWBIN5)
FEXIT
PLAB10
FMEL 'TTTTTTTTTTTTT9',GTDUPF(GSWBIN5)
FMEND
END