|
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: 23776 (0x5ce0)
Notes: pts_type(SC)
Names: »KMDIO.SC«
└─⟦75255755f⟧ Bits:30009693 Philips computer tape "600410"
└─⟦this⟧ »NJREMIT/KMDIO.SC«
└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
└─⟦this⟧ »REMIT2/KMDIO.SC«
IDENT KMDIO 03.01.XXX.1
DDUM KMD08
PDIV
ENTRY WRITFD
ENTRY WRITVO
ENTRY WRITJT
ENTRY WTALLY
ENTRY WRITID
ENTRY CRKJ
ENTRY GRASPV
ENTRY LINOPT
ENTRY CRVO
ENTRY WCHECK
ENTRY WCHUPD
EXT CLEAR8
EXT RADEL
EXT SPCHK5
EXT SPLIN8
EXT SPERR
EXT FRMTJT
EXT FRMXJT
EXT ADM
EXT CYWRT
EXT FRMXVO
EXT FRMXTA
EXT ABORT
EXT RAWRIT
EXT LEVRD
EXT CHDATO
EXT LEVIN
EXT VARRD
EXT VARWRT
EXT IDXGET
EXT CHDATO
EXT TRINS
EXT WSTRCH
EXT TRGETF
EXT WAITF
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 TFELT901
CLEAR TFELT911
CLEAR TFELT921
CLEAR TFELT931
CLEAR TFELT941
MOVE GSWBIN3,GTREGDEX
SUB GSWBIN3,CBIN11
IB GSWBIN3,WRFD001,WRFD002,WRFD001,WRFD002
B WRFD003
WRFD001
MOVE GTREGNR,=D'1' TRANS 18,28 -> TRANS 1
B WRFD003
WRFD002
MOVE GTREGNR,=D'6' TRANS 19,29 -> TRANS 6
WRFD003
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
* RESET GTREGNR
MOVE GTREGNR,CREGTAB(GTREGDEX,CBIN1)
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 ?
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
TBT TFELT90,WRFD090
TBT TFELT91,WRFD091
TBT TFELT92,WRFD092
TBT TFELT93,WRFD093
TBT TFELT94,WRFD094
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,GTLEVTXT,CBIN0
CLEAR TFELT90
SET TFELT901
B WRFD095
WRFD091
MOVE SPINPUT,=X'26393100'
XCOPY SPINPUT,CBIN3,CBIN22,GTLEVNVN,CBIN0
CLEAR TFELT91
SET TFELT911
B WRFD095
WRFD092
MOVE SPINPUT,=X'26393200'
XCOPY SPINPUT,CBIN3,CBIN8,GTLEVNVN,CBIN22
XCOPY SPINPUT,CBIN11,CBIN14,GTLEVADR,CBIN0
CLEAR TFELT92
SET TFELT921
B WRFD095
WRFD093
MOVE SPINPUT,=X'26393300'
XCOPY SPINPUT,CBIN3,CBIN18,GTLEVADR,CBIN14
XCOPY SPINPUT,CBIN21,CBIN4,GTLEVBY,CBIN0
CLEAR TFELT93
SET TFELT931
B WRFD095
WRFD094
MOVE SPINPUT,=X'26393400'
XCOPY SPINPUT,CBIN3,CBIN16,GTLEVBY,CBIN4
XCOPY SPINPUT,CBIN19,CBIN6,GTLEVPDI,CBIN0
SET TFELT941
CLEAR TFELT94
WRFD095
B WRFD025
*
WRFD080
CLEAR CSPLITFL
CLEAR CPFLG
CMP CBIN0,CBIN0 OK, SET CR=0
RET
*
WRFDERR
*
* HERE MUST BEE RECOVERRY
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
*
*
WCHECK PROC P
*
* THE PROCEDURE PRODUCES A STRAKS-CHECK OR
* A TRANSACTIONRECORD
*
TBT GTBDTFLG,WCH010 BUNDTCHECK ?
TBT GTSTRFLG,WCH050 STRAKSCHECK ?
B WCH090
WCH010 BUNDTCHECK
TBT GTCYFLG,WCH011
TBT TTCY2FLG,WCH090
TBF TTCY1FLG,WCH015
MOVE GTDUPF(CBIN1),TTARKSAV
MOVE GTDUPF(CBIN4),TTCYKTOT
B WCH015
WCH011
TBT TTCY1FLG,WCH090
WCH015
MOVE GTLEVNR,GTDUPF(CBIN2)
PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 TRY TO FIND LEV
BNOK WCH020 ERROR OR NOT FOUND
PERF TRGETF,GSWBIN7 GET A FREE RECORD
BNOK WCH095
MOVE GTLEVNR,GTDUPF(CBIN2)
PERF VARRD TRY TO FIND LEV
BNOK WCH020 ERROR OR NOT FOUND
CLEAR GTSWFLAG
PERF TRINS,GSWBIN7
BNOK WCH095
* UPDATE VAR.INFO AND REWRITE
B WCH090
WCH020
PERF SPLIN8,CBIN11,CBIN1
DELAY CBIN10
B WCH010
WCH050 STRAKSCHECK
MOVE GTLEVNR,GTDUPF(CBIN2)
PERF VARRD
BOK WCH051
SET TTLEVFLG
WCH051
TBT GTCYFLG,WCH060 CYKEL/STABEL
TBT TTCY2FLG,WCH057
TBF TTCY1FLG,WCH055
MOVE GTDUPF(CBIN4),TTCYKTOT
WCH055
PERF WCHUPD
PERF WSTRCH,CBIN0 WRITE STRAKSCHECK
BNOK WCH095
WCH057
PERF LEVRD
BOK WCH059
MOVE GTRETUR,CBIN3
PERF LEVIN
BNOK WCH057
PERF WSTRCH,CBIN1
BNOK WCH095
B WCH090
WCH059
PERF WSTRCH,CBIN1
BNOK WCH095
B WCH080
WCH060
TBT TTCY2FLG,WCH070
B WCH090
WCH070 STABEL
PERF WCHUPD UPDATE VAR.INFO
PERF WSTRCH,CBIN0 EDIT CHECKLINE
* SKRIV CHECK HVIS FYLDT OP
WCH080
PERF VARWRT
BNOK WCH095
WCH090
CMP CBIN0,CBIN0
B WCH099
WCH095
CMP CBIN0,CBIN1
WCH099
RET
PEND
EJECT
WCHUPD PROC
* THE PROCEDURE UPDATES VAR.INFO ON LEV,
* AFTER A TRANS 18,19,28 OR 29
MOVE GSWBCD6,GTDATO
PERF CHDATO
MOVE GTREGF(CBIN10),GSWBCD7 UDB.DATO
MOVE GTREGF(CBIN11),GTDUPF(CBIN4) UDB. BELOB
ADD GTREGF(CBIN12),GTDUPF(CBIN4) UDB ]TD
TBF GTBDTFLG,WCHUPD90
CBL GTDUPF(CBIN4),=D'0',WCHUPD12
ADD GTREGF(CBIN14),GTDUPF(CBIN4) VENT DEBET
B WCHUPD14
WCHUPD12
ADD GTREGF(CBIN15),GTDUPF(CBIN4) VENT KREDIT
WCHUPD14
ADD GTREGF(CBIN16),GTDUPF(CBIN4) SKYLDIGT BELOB
MOVE GSWBCD6,GTREGF(CBIN13) GET LOW VALORDATE
CBL GSWBCD6,=D'1',WCHUP155
CBG GSWBCD6,=D'800000',WCHUP150
PERF CHDATO TO GSWBCD7
MOVE GTREGF(CBIN13),GSWBCD7
WCHUP150
MOVE GSWBCD6,GTDUPF(CBIN7)
PERF CHDATO
CBG GSWBCD7,GTREGF(CBIN13),WCHUPD16 NEW LOW?
WCHUP155
MOVE GTREGF(CBIN13),GTDUPF(CBIN7) YES
B WCHUPD90
WCHUPD16
MOVE GSWBCD6,GTREGF(CBIN13)
PERF CHDATO
MOVE GTREGF(CBIN13),GSWBCD7
WCHUPD90
RET
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
PERF FRMTJT GET FORMAT ACORDING TO TYPE
B JT20
JT10 PERF FRMXJT,GSWBIN1 GET SPECIAL FORMAT
JT20
MOVE GSWBIN1,TTCNTNR 'TAELLER' NR IN BINARY
TBT GTNWFLG,JT50
EDWRT KJTAPE,GTSTRFMT EDWRT JOURNAL
JT30
TBF CF9094,JT35
CBL GTREGDEX,CBIN8,JT35
CBG GTREGDEX,CBIN9,JT35
TBF TFELT901,JT31
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTLEVTXT,CBIN0
WRITE KJTAPE,SPINPUT
JT31
TBF TFELT911,JT32
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTLEVNVN,CBIN0
WRITE KJTAPE,SPINPUT
JT32
TBF TFELT921,JT33
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN8,GTLEVNVN,CBIN22
XCOPY SPINPUT,CBIN21,CBIN14,GTLEVADR,CBIN0
WRITE KJTAPE,SPINPUT
JT33
TBF TFELT931,JT34
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN18,GTLEVADR,CBIN14
MOVE GSWBIN1,=W'31'
XCOPY SPINPUT,GSWBIN1,CBIN4,GTLEVBY,CBIN0
WRITE KJTAPE,SPINPUT
JT34
TBF TFELT941,JT35
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN16,GTLEVBY,CBIN4
MOVE GSWBIN1,=W'29'
XCOPY SPINPUT,GSWBIN1,CBIN6,GTLEVPDI,CBIN0
WRITE KJTAPE,SPINPUT
JT35
*
DSC0 KJTAPE,TSTAT TEST STATUS OF JOURNAL
BOK JTRET
PERF SPLIN8,CBIN1,CBIN1 'SKIFT JOURNAL'
SET TTJTEND
JTRET
RET
JT50
EDWRT .NW,KJTAPE,GTSTRFMT
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
EJECT
CRKJ PROC
********************
*
* DOES A CARRIAGE RETURN ON TTP WITHOUT WAIT
*
********************
EDWRT .NW,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
EJECT
WRITVO PROC
*
* WRITE VOUCHER
*
* IN CYCLE POSITION AND WRITE
* (MAY BE NEW PAGE)
*
* NOT CYCLE GET LINE NR
* POSITION VOUCHER
* WRITE
* AND RELEASE VOUCHER
*
********************
TBT GTCYFLG,CYVOUCH
* NOT IN CYCLE
WOBILAG
PERF SPLIN8,CBIN2,CBIN0 WRITE BILAG
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
DSC0 .NW,KVOUCH,RLEAS RELEASE VOUCHER
RET
* IN CYCLE
CYVOUCH
SET TTCYTRFL AFTER A CORRECT TRANS
TBT GTCYWRTF,WO5
PERF CYWRT
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
*
*
*
*
GRASPV PROC
********************
*
* GRASP VOUCHER
*
********************
WAIT KVOUCH
DSC0 KVOUCH,GRASP GRASP VOUCHER
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,CBIN4,LINOP2 ONLY ENTER KEY ALLOWED
LINOP0
CBG SPBINW1,CBIN3,LINOP2 CHECK LENGTH
MOVE GSWBCD3,SPINPUT GET LINE NR
CBG GSWBCD3,=D'90',LINOP4 SPECIAL FORMATS?
PERF SPCHK5 OK, CHECK LINENR
CBE SPBINW3,CBIN3,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,CBIN0
B LINRET
LINOP2
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 FRMXTA,CBIN6
PERF WTALLY
*
*
WRID50
WAIT KTALLY
CBE WRITVAR2,CBIN3,WRID80
CBE WRITVAR2,CBIN4,WRID73
MOVE GSWSTR20,CPCKBUF
PERF WRITJT,=W'12'
CBG WRITVAR1,CBIN3,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'
CBL WRITVAR1,CBIN4,WRID76 1,2,3,6
CBL WRITVAR1,CBIN6,WRID90 4,5
WRID76
PERF FRMXTA,CBIN6
PERF WTALLY
WAIT KTALLY
B WRID85
WRID80
CBG WRITVAR1,CBIN3,WRID90
WRID85
PERF FRMXTA,CBIN7
PERF WTALLY
WAIT KTALLY
WRID90
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
FMEL 'B99999',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
FILLR '&',1
FMEL '99',GSWBCD3
FBP GSWBCD3,PLAB10
FMEL 'TTTTTTTTTTTTT9-',GTDUPF(GSWBIN5)
FEXIT
PLAB10
FMEL 'TTTTTTTTTTTTT9',GTDUPF(GSWBIN5)
FMEND
END