DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦c87caed30⟧

    Length: 42936 (0xa7b8)
    Notes: pts_type(SC)
    Names: »RGADM.SC«

Derivation

└─⟦75255755f⟧ Bits:30009693 Philips computer tape "600410"
    └─⟦this⟧ »NJREMIT/RGADM.SC« 
└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
    └─⟦this⟧ »REMIT2/RGADM.SC« 

PTS(SC)

	IDENT RGADM 	03.01.XXX.1 
 DDUM KMD08 
 PDIV 
 ENTRY ADM
 ENTRY ADMRET 
 ENTRY A5RET1 
 ENTRY A5RET2 
* 
 EXT CLKF 
 EXT CLEJ 
 EXT CLEDB
 EXT CLBEH
 EXT SKIFT
 EXT STRTID 
 EXT SLUTID 
 EXT SOPRD
 EXT LAMPON 
 EXT LAMPOF 
 EXT BCKUP
 EXT KLRFMT 
 EXT ADM600 
 EXT A5KONV 
 EXT BUDREG 
 EXT AD4100 
 EXT AD4200 
 EXT AD4300 
 EXT ABORT
 EXT EMPTYT 
 EXT RGREAD 
 EXT TRPAGE 
 EXT WRITJT 
 EXT SPCLRN 
 EXT SPCLRA 
 EXT SPINF1 
 EXT FRMXTA 
 EXT WTALLY 
 EXT FRMTKV 
 EXT CRVO 
 EXT TCONFR 
 EXT FRMXSP 
 EXT SUM
 EXT PACKCL 
 EXT CLEAR8 
 EXT SPLIN8 
 EXT GRASPV 
 EXT FRMXVO 
 EXT FRMXJT 
 EXT KORT 
 EXT MODP 
 EXT KVIT 
 EXT LSTINT 
 EXT SUBTOT 
 EXT CYK
 EXT DIVTR
 EXT TCONFW 
 EXT RAWRIT 
 EXT ASGVOL 
 EXT CLSVOL 
 EXT WRITID 
 EXT KTOPR
 EXT KTPRT
 EXT ONLINE 
 EXT TXTOPR 
 EXT TXTPRT 
 EXT LEVOPR 
 EXT LEVDEL 
 EXT LEVPRT 
 EXT LEVSPG 
 EXT KFREAD 
 EXT KFWRIT 
* 
 INCLUDE EQUATE 
 EJECT
************************
* 
* 
*          ADM FUNCTIONS          * 
* 
*     ADM  1     EJ EDB T[LLERE 
*     ADM  2     BEHOLDNINGST[LLERE 
*     ADM  3     OPRETTELSE KONTOPLAN 
*     ADM  4     OPRETTELSE TEXTREGISTER
*     ADM  5     KONVERTERING 
*     ADM  6     DATATRANSMISSION 
*     ADM  7     3270 ONLINE
*     ADM  8     CHANGE (SPG.) CHECK LBNR 
*     ADM  9     DEFAULT LINE NO. 
*     ADM 10     SUPPLEMENT POST
*     ADM 11     SPOERGE
*          SPG  1     BILAG  EJ EDB 
*          SPG  2     BILAG  BEHOLDNINGST[LLERE 
*          SPG  3     BILAG  EDB T[LLERE
*          SPG  4     AABNE KASSER
*          SPG  5     UDSKRIFT KONTOPLAN
*          SPG  6     ENKELT BEHOLDNINGST[LLER
*          SPG  7     KASSEBEHOLDNING 
*          SPG  8     SPG. P] POSTERINGER 
*          SPG  9     -"-  GL. REGSET 
*          SPG 10     SPG. PRINT INTERVAL 
*          SPG 11     -"-  GL. REGSET 
*          SPG 14     PRINT TEXTREG.
*          SPG 15     SPG LEVREG
*          SPG 16     PRINT LEVREG
*          SPG 17     BILAG LOKAL REMITTERING 
*     ADM 12     DISKETTE SKIFT 
*     ADM 13     AUTOSUM
*     ADM 14     DAGS DATO
*     ADM 15     OPRETTELSE LEVERAND
*     ADM 16     DELETE LEVERAND
*     ADM 17     NEW KASSEKONTO 
*     ADM 18     NEW VERSURKONTO
*     ADM 19     REGNEFUNKTION
*     ADM 20     CHECKCIFFER
*     ADM 21     TEST MODE
*     ADM 22     [NDRE EKSP LBNR (NOT IN USE) 
*     ADM 23     MODPOST
*     ADM 24     KONTOKORT
*     ADM 25     KVITTERING 
*     ADM 26     SUM FUNKTION 
*     ADM 27     LISTE FUNCTION 
*     ADM 28     SUBTOTAL 
*     ADM 29     TEST AF VOUCHER
*     ADM 30     CYCLE SLUT 
*     ADM 31     CYCLE 1 START (CYCLE)
*     ADM 32     CYCLE 2 START (STABEL) 
*     ADM 33
*     ADM 34     4 CYCLE, PAUSE IN CYCLE/STABEL 
*     ADM 35     DIVERSE TRANS
*     ADM 36
*     ADM 37
*     ADM 38
*     ADM 39
*     ADM 40     BUDGET TRANS 
*     ADM 41     DAN PRINTFILE, UPD. DIVERSE
*     ADM 42     PRINT PRINTLEV 
*     ADM 43     CLEAN PRINTLEV 
* 
* 
********************
 EJECT
ADM PROC ADMNO
******************* 
* 
*         BRANCH TO SELECTED ADM ROUTINE
* 
******************* 
 TBT CCONVERT,ADM003
 TBT GTLOKSPG,ADM002
 MOVE GSWSTR9,=C'TOTAL '
 TBF GTSPGFLG,ADM001
 MOVE GSWSTR9,=C'SUBTOTAL ' 
ADM001
 MOVE GSWBIN1,ADMNO 
 TBF GTTTPFLG,ADMGTP NO TTP 
 IB GSWBIN1,ADM1,ADM2,ADM3,ADM4,ADM5,ADM6,ADM7,		C
		ADM8,ADM9,ADM10,ADM11,ADM12,ADM13,ADM14,ADM15,ADM16,		C 
		ADM17,ADM18,ADM19,ADM20,ADM21,ADM22,ADM23,ADM24,		C 
		ADM25,ADM26,ADM27,ADM28,ADM29,ADM30,ADM31,ADM32,		C 
		ADM33,ADM34,ADM35,ADM36,ADM37,ADM38,ADM39,ADM00,		C 
		ADM41,ADM42,ADM43 
 B ADM00
ADMGTP
 IB GSWBIN1,ADM00,ADM00,ADM3,ADM4,ADM00,ADM00,		C 
		ADM7,ADM00,ADM00,ADM00,ADM11,		C
		ADM00,ADM00,ADM00,ADM15,ADM16,		C 
		ADM00,ADM00,ADM00,ADM00,ADM00,		C 
		ADM00,ADM00,ADM00,ADM00,		C 
		ADM00,ADM00,ADM00,ADM00,ADM00,		C 
		ADM00,ADM00,ADM00,ADM00,ADM00,		C 
		ADM00,ADM00,ADM00,ADM00,ADM40,		C 
		ADM41,ADM42,ADM43,ADM00,ADM00 
 B ADM00
* 
ADM002			LOCAL INQUIRIES
 MOVE GSWBIN1,ADMNO 
 CMP GSWBIN1,CBIN11 TEST IF INQUIRIES 
 BE ADM11 
 SUB GSWBIN1,CBIN22 
 IB GSWBIN1,ADM23,ADM24,ADM25 
ADM00 
 B ADMRET 
* 
ADM003			CONVERSION MODE
 MOVE GSWBIN1,ADMNO 
 SUB GSWBIN1,CBIN4
 IB GSWBIN1,ADM5,ADM6 
 B ADMRET 
* 
 EJECT
* 
* 
ADM1
* EJ-EDB TAELLERE * 
ADM1000 
 SET GTADMFLG 
 TBT GTKASSE,ADM1RET
 MOVE SPKEY,CBIN2 
 SET SPPROMPT 
	SET	GTDYFLG
ADM1010 
 ATTFMT ADMFRM1 
 PERF SPCLRN
 IB SPBINW2,ADM1RET,ADM1RET,ADM1020 
 B ADM1000
ADM1020 
 TBF GTDYFLG,ADM1RET
	CLEAR	GTDYFLG
 B ADM1010
ADM1RET 
 CLEAR GTADMFLG 
 CLEAR GTDYFLG
 B ADMRET 
* 
* 
ADM2
* BEHOLDNINGSTAELLERE * 
ADM2000 
 SET GTADMFLG 
 TBT GTSPGFLG,ADM2001 
 TBT GTKASSE,ADM2RET
 TBT GTTESTFL,ADM2RET 
ADM2001 
 SET SPPROMPT 
	SET	GTDYFLG
 ATTFMT ADM2FRM1
 PERF SPCLRN
 IB SPBINW2,ADM2RET,ADM2RET,ADM2020 
 B ADM2000
ADM2020 
 PERF PACKCL
 MOVE GTDUPF(CBIN5),=D'2' ADM FUNCTION NO 
 MOVE GTDUPF(CBIN2),GSWBCD1 COUNTER NO
 MOVE GTDUPF(CBIN1),CBACC(GSWBIN6,CBIN1) REG. KNT. NO 
 MOVE GTDUPF(CBIN4),CBACC(GSWBIN6,CBIN3) SALDO
 CLEAR GTDYFLG
 SET SPPROMPT 
 ATTFMT ADM2FRM1
 PERF SPCLRN
 IB SPBINW2,ADM2RET,ADM2RET,ADM2030 
 B ADM2000
ADM2030 
 CBE GTDUPF(CBIN1),CBACC(GSWBIN6,CBIN1),ADM2040 
 MOVE CBACC(GSWBIN6,CBIN2),=D'0' CLEAR PERIODE
ADM2040 
 MOVE CBACC(GSWBIN6,CBIN1),GTDUPF(CBIN1)
 MOVE CBACC(GSWBIN6,CBIN3),GTDUPF(CBIN4)
 PERF WRITJT,=W'13' 
ADM2RET 
 CLEAR GTADMFLG 
 CLEAR GTDYFLG
 B ADMRET 
* 
* 
ADM3
*     OPRETTELSE KONTOPLAN
 B KTOPR BRANCH TO OTHER MODULE 
* 
* 
ADM4
 PERF TXTOPR TEXT OPRETTELSER 
 B ADMRET 
 EJECT
ADM5
* KONVERTERING *
ADM0500 
 SET CCONVFLG 
 CLEAR SPKEYFLG 
 TEST GTKASSE 
 BNZ ADM05RET BRANCH IF TRUE
 CMP TTASKNR,CBIN1
 BNE ADM05RET 
 CMP CTASKNR,CBIN0
 BNE ADM05RET 
 SET SPPROMPT 
 MOVE SPKEY,CBIN2 
 ATTFMT KONFRMT 
 PERF SPCLRN
 IB SPBINW2,ADM05RET,ADM05RET,ADM0510 
 B ADM0500
			WRITE EOF RECORD 
			AND CLOSE ALL FILES
ADM0510 
 TBT CCONVERT,ADM0513 NO WRITE IF CONVERT 
 SUB CRECBCD,=D'1'
 PERF SLUTID,CRECBCD
 ADD CRECBCD,=D'1'
 PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR
 BNOK ADM0500 
 PERF WRITID,CBIN2,CBIN2
ADM0513 
 PERF CLSVOL,CBIN1
 PERF CLSVOL,CBIN2
 MOVE CRECNR,CBIN1
 MOVE CRECBCD,=D'1' 
 PERF LAMPOF,=W'2047' 
 TBT C5MDISK,ADM0514
 PERF LAMPON,=W'64' LAMP 5
ADM0514 
 PERF LAMPON,=W'32' LAMP 6
 PERF LAMPON,=W'16' LAMP 7
 PERF LAMPON,=W'2' LAMP 10
ADM0515 
 PERF SOPRD 
 IB GSWBIN2,		C 
		ADM05010,ADM05009,ADM05008,ADM05007,ADM05006,		C
		ADM05005,ADM05004,ADM05003,ADM05002,ADM05001
ADM05001
ADM05002
ADM05003
ADM05004
ADM05008
ADM05009
 B ADM0515
* 
ADM05010			LAMP 10
 B ADM0513 CLOSE AND SOPRD
* 
* 
* 
* 
* 
ADM05005			SOP 5
 TBT C5MDISK,ADM0515 CONVERSION NOT ALLOWED 
*     EQUIVALENT TO START OF ADM5 MODULE
 B A5KONV 
*   KONVERTERING
A5RET1
 B ADM0513
A5RET2
 B ADM0515
*     EQUVALENT TO END OF ADM5 MODULE 
* 
* 
ADM05006			SOP 6
 PERF ASGVOL,CBIN1 ASSIGN SYSTEM DISK 
 BNOK ADM0513 
 PERF BCKUP,=W'1' WITHOUT BACKUP
 BNOK ADM0513 
 B ADM05RET 
* 
* 
* 
* 
* 
ADM05007			SOP 7
 PERF ASGVOL,CBIN1
 BNOK ADM0513 
 PERF BCKUP,=W'2' WITH BACKUP 
 BNOK ADM0513 
 B ADM05RET 
* 
* 
* 
* 
* 
ADM05RET
 PERF LAMPOF,=W'2047' 
 SET SPKEYFLG 
 CLEAR CCONVFLG 
 B ADMRET 
* 
* 
ADM6
* DATATRANSMISSION *
 B ADM600 
* 
* 
ADM7
* 
*     JUMP TO 3270 ONLINE 
 PERF ONLINE
 B ADMRET 
* 
* 
ADM8
* 
**********
* 
*     CHANGE OR INQUIRY ON CHECK NUMBER 
* 
**********
ADM08000
 CLEAR GTSPGFLG 
 TBT GTMASTFL,ADM08010
 SET GTSPGFLG 
ADM08010
 SET SPPROMPT 
 MOVE GTDUPF(CBIN5),=D'8' ADM NO. 
 MOVE GTDUPF(CBIN2),=D'0' 
 MOVE GTDUPF(CBIN1),=D'0' 
 PERF KFREAD,CBIN4,CBIN1,CBIN0,GTKFVAL
 MOVE GTDUPF(CBIN4),GTKFVAL GET OLD NUMBER
 ATTFMT ADM08FRM
 PERF SPCLRN
 IB SPBINW2,ADM08RET,ADM08RET,ADM08100
 B ADM08010 
ADM08100
 MOVE GTKFVAL,GTDUPF(CBIN4) WRITE NEW NUMBER
 PERF KFWRIT,CBIN4,CBIN1,CBIN0,GTKFVAL
 MOVE CCHKLBNR,GTKFVAL SET NUMBER 
 PERF WRITJT,=W'13' WRITE ON JOURNAL
ADM08RET
 PERF PACKCL
 B ADMRET 
* 
* 
ADM9
********************
* 
*          SET DEFAULT LINE NUMBER
* 
********************
ADM0900 
 MOVE GSWBCD5,GTDFLIN 
	PERF	FRMXSP,CBIN13	ASK FOR DEFAULT LINE
	SET	SPPROMPT 
	PERF	SPCLRN
 IB SPBINW2,ADM09RET,ADM09RET,ADM0910 
 B ADM0900
ADM0910 
	CLEAR SPPROMPT 
 MOVE GTDFLIN,GSWBCD5 
ADM09RET
	CMP	CBIN0,CBIN0	SET CR = 0 
 B ADMRET 
* 
* 
ADM10 
 TBF GTKASSE,ADM10RET 
********************
* 
*          SET OR CLEAR SUPPLEMENT INFORMATION
* 
********************
	TBT	TTSUPFLG,SUPL10
	SET	TTSUPFLG 
	MOVE	TTSUPMRK,=C'S'
	B	SUPLOK 
SUPL10
	MOVE	TTSUPMRK,CBLANKS
	CLEAR	TTSUPFLG 
SUPLOK
 SET GTREGFLG 
	PERF	SPINF1
ADM10RET
	CMP	CBIN0,CBIN0	SET CR = 0, OK 
 B ADMRET 
* 
* 
ADM11 
* LOCAL INQUIRIES * 
 TBT GTLOKSPG,SPGL08
ADM1100 
 ATTFMT SPGFM00 
 SET SPPROMPT 
 SET GTSPGFLG 
 MOVE GSWSTR9,=C'SUBTOTAL ' 
 PERF SPCLRA
 IB SPBINW2,ADM11RET,ADM11RET,ADM1110 
 B ADM11RET 
ADM1110 
 MOVE GSWBIN1,GSWBCD3 
 TBF GTTTPFLG,ADM11GTP
 TBT GTBDTFLG,ADM11REM SOME FUNKTIONS NOT ALLOWED 
 TBT GTSTRFLG,ADM11REM IN 'LOKAL' REMITTERING 
 IB GSWBIN1,SPGL01,SPGL02,SPGL03,SPGL04,		C 
		SPGL05,SPGL06,SPGL07,SPGL08,SPGL09,		C
		SPGL10,SPGL11,SPGL12,SPGL13,SPGL14,		C
		SPGL15,SPGL16,SPGL17
 B ADM1100
* 
ADM11REM
 IB GSWBIN1,		C 
		SPGL01,SPGL02,SPGL03,SPGL04,SPGL05,		C
		SPGL06,SPGL07,SPGL00,SPGL00,SPGL00,		C
		SPGL00,SPGL12,SPGL13,SPGL14,SPGL15,		C
		SPGL16,SPGL17 
ADM11GTP
 IB GSWBIN1,SPGL00,SPGL00,SPGL00,SPGL04,SPGL00,		C
		SPGL00,SPGL00,SPGL00,SPGL00,SPGL00,		C
		SPGL00,SPGL00,SPGL00,SPGL14,SPGL15,		C
		SPGL16,SPGL00 
SPGL00
 B ADM1100
SPGL01
 PERF CLEJ
 B ADM11RET 
* 
SPGL02
 PERF CLBEH 
 B ADM11RET 
* 
SPGL03
 PERF CLEDB 
 B ADM11RET 
* 
SPGL04
 MOVE GSWBCD3,CTASKNR 
 SET SPPROMPT 
 ATTFMT SPGFM04 
 PERF SPCLRA
 B ADM11RET 
SPGL05
 PERF KTPRT UDSKRIV KONTOPLAN 
 B ADM11RET 
SPGL06
 PERF ADM,CBIN2 BEHOLDNINGST[LLERE
 B ADM11RET 
SPGL07
 MOVE GSWBCD7,=D'0' 
 TBF CSTRKFLG,SPG0730 
 MOVE GSWBCD5,=D'0' 
 B SPG0720
SPG0710 
 PERF KFREAD,CBIN3,CBIN1,GSWBCD5,GTKFVAL
 ADD GSWBCD7,GTKFVAL
 PERF KFREAD,CBIN3,CBIN2,GSWBCD5,GTKFVAL
 ADD GSWBCD7,GTKFVAL
SPG0720 
 PERF KFREAD,CBIN2,CBIN1,GSWBCD5,GTKFVAL
 ADD GSWBCD7,GTKFVAL
 ADD GSWBCD5,=D'1'
 CBL GSWBCD5,=D'5',SPG0710
 MUL GSWBCD7,=D'-1' VEND
SPG0730 
 MUL TTEJEDB,=D'-1' VEND
 MOVE GSWBCD6,TTCASH
 ADD GSWBCD6,TTEJEDB
 ADD GSWBCD6,GSWBCD7
 SET SPPROMPT 
 ATTFMT SPGFM17 
 PERF SPCLRA
 MUL TTEJEDB,=D'-1' VEND TILBAGE
 B ADM11RET 
* 
* 
SPGL08			LOCAL INQUIRIES
 TBT GTLOKSPG,SPG0820 ALREADY ACTIVE, CONTINUE
 TEST GTKASSE 
 BZ SPG08MAK ONLY IF 'KASSE FUNCTIONS 
 CLEAR GTGLSPG
SPG0805 
 SET SPPROMPT 
 ATTFMT SPGFM08 INQUIRY FORMAT
 PERF SPCLRA
*     GTLBNRIN     CONTAINS FIRST (OR ONLY) TRANSACTION 
*                  OF INTEREST (EKSP. LB.NR.) 
*     GSWBCD6      CONTAINS FIELD NO. OF WANTED FIELD 
*     GSWBCD7      CONTAINS FIELD CONTENT OF WANTED FIELD 
* 
 IB SPBINW2,SPG08MAK,SPG08MAK,SPG0810 
 B SPG0805
* 
SPG0810			SPG-CONDITION ENTERED 
 MOVE SPKEY,CBIN3 
 SET GTLOKSPG 
 TBT GTGLSPG,SPG0815
 MOVE GTRECNR,CRECNR POINT TO START OF DSET 
 B SPG0820
SPG0815 
 MOVE GTRECNR,CGLRECNR
* 
SPG0820 
 SUB GTRECNR,CBIN1 NEXT RECORD
SPG0822 
 CBNG GTRECNR,CBIN1,SPG08RET
 TBT GTGLSPG,SPG0825
			NEW REGSET 
 CBNL GTRECNR,CRECNR,SPG08RET 
 PERF RGREAD,DK02,=D'2',CBIN1 READ RECORD 
 BNOK SPG0820 IF TRANS 11, OR 
			NOT SAME MACHINE, OR 
			DISK ERROR 
 B SPG0828
SPG0825 
			OLD REGSET 
 CBNL GTRECNR,CGLRECNR,SPG08RET 
 PERF RGREAD,DK05,=D'5',CBIN1 READ RECORD 
 BNOK SPG0820 IF TRANS 11, OR 
			NOT SAME MACHINE, OR 
			DISK ERROR 
SPG0828 
 CBE GTREGNR,=D'12',SPG0820 TR 12 
* 
*     SAME MACHINE: 
*     GTREGNR      TRANSTYPE
*     GTREGDEX     TRANSTYPE - INDEX
*     CEORFLG      TRUE 
*     TTEORFLG     TRUE 
*     GTLBNR       EKSP. OF CURRENT RECORD
*     GTUSED       SAT FOR PRESENT FIELDS 
*     GTDUPF       -     -     -     -
*     GTREGF       -     -     -     -
*     DEB/KRE      RELEVANT ROUTINE PERFORMED 
*        GTDBKRC
*        GTDBKRS
*        TTDKBCD
*        TTDKDEX
* 
 CALL EMPTYT,GTLBNRIN 
 BNOK SPG0830 IF NO SPECIFIC EKSP.
 CMP GTLBNR,GTLBNRIN ACTUAL - WANTED EKSP.
 BL SPG0830 WANTED EKSP. PASSED 
 BE SPG0840 FOUND 
*     NOT YET FOUND 
*     JUMP TO FIND RECORD 
 MOVE GSWBIN1,GTLBNR
 SUB GTRECNR,GSWBIN1 GTRECNR= 
 MOVE GSWBIN1,GTLBNRIN GTRECNR -
 ADD GTRECNR,GSWBIN1 ( GTLBNR - GTLBNRIN )
 B SPG0822
* 
SPG0830 
 CBE GSWBCD6,=D'0',SPG08RET NO FIELDS WANTED
 B SPG0850 SEARCH FIELD 
* 
SPG0840 
 CBE GSWBCD6,=D'0',SPGFOUND RECORD FOUND
* 
SPG0850			CHECK FIELD 
 MOVE GSWBIN1,GSWBCD6 GET FIELD INDEX 
 MOVE GSWBIN2,CFLTDEX(GSWBIN1)
 MOVE GSWBIN2,GTUSED(GSWBIN2) 
 CBE GSWBIN1,GSWBIN2,SPG0860 FIELD PRESENT
 MUL GSWBIN2,=W'-1' 
 CBE GSWBIN1,GSWBIN2,SPG0860 FIELD PRESENT
 B SPG0820 FIELD NOT PRESENT
* 
SPG0860			CHECK FIELD CONTENT 
 MOVE GSWBIN2,CFLTDEX(GSWBIN1)
 CBNE GSWBCD7,GTDUPF(GSWBIN2),SPG0820 
* 
* 
SPGFOUND			A WANTED RECORD FOUND
* 
 MOVE TTDBKRM,=C'K' 
 CBE TTDKDEX,CBIN1,SPG0870
 MOVE TTDBKRM,=C'D' 
SPG0870 
*     TEST FOR SUPPLEMENT YEAR
 CLEAR TTSUPFLG 
 MOVE TTSUPMRK,CBLANKS
 CBE GTUSED(CBIN6),CBIN0,SPG0880
 MOVE TSWBCD2,GTDATO ISOLATE LAST DIGIT 
 MOVE GSWBCD1,GTDUPF(CBIN6) 
 SUB GSWBCD1,TSWBCD2
 BZ SPG0880 
 SET TTSUPFLG SUPPLEMENT YEAR 
 MOVE TTSUPMRK,=C'S'
SPG0880 
* 
 PERF TRPAGE
 SET GTDIVTR SET DIVERSE TRANS
 CLEAR GTREGFLG 
* 
 B ADM11RET 
* 
SPG08RET
 MOVE SPKEY,CBIN1 
 CLEAR GTLOKSPG 
 CLEAR TTSUPFLG 
 MOVE TTSUPMRK,CBLANKS
SPG08MAK
 B ADM11RET 
**
* 
* 
SPGL09			INQ. OLD REGSET
 TBF CGLREGFL,SPG09MAK ALLOWED? 
 TBF GTKASSE,SPG09MAK ONLY IF 'KASSE' 
 SET GTGLSPG INDICATE OLD REGSET
 B SPG0805
SPG09MAK
 B ADM11RET 
* 
* 
* 
*          PRINT OUT OF SPECIFIED TRANSACTIONS
* 
SPGL10			PRINT A INTERVAL 
 TEST GTCYFLG 
 BNZ SPG10MAK NOT IN CYCLE
 TEST TTLSTFLG
 BNZ SPG10MAK NOT IN LISTE
 TEST GTKASSE 
 BZ SPG10MAK ONLY IF 'KASSE FUNCTIONS 
 CLEAR GTGLSPG INDICATE CURRENT REGSET
SPG1005 
 SET SPPROMPT 
 ATTFMT SPGFM10 SCREEN FORMAT 
 PERF SPCLRA
*     GTLBNRIN   HIGHEST EKS.LBNR WANTED (FIRST PRINTED)
*     GSWBCD7    LOWEST EKS.LBNR WANTED 
 IB SPBINW2,SPG10MAK,SPG10MAK,SPG1010 
 B SPG1005
* 
SPG1010 
 SET GTLOKSPG 
 CLEAR TTTSTFLG INITIATE FIRST TIME 
 TBT GTGLSPG,SPG1015
 MOVE GTRECNR,CRECNR POINT TO LAST RECORD 
 B SPG1020
SPG1015 
 MOVE GTRECNR,CGLRECNR
SPG1020 
 SUB GTRECNR,CBIN1 PREVIOUS RECORD
SPG1022 
 CBNG GTRECNR,CBIN1,SPG1090 
 TBT GTGLSPG,SPG1025
			NEW REGSET 
 CBNL GTRECNR,CRECNR,SPG1090
 PERF RGREAD,DK02,=D'2',CBIN1 READ RECORD 
 BNOK SPG1020 IF TR 11, OR
			NOT SAME MACHINE, OR 
			DISK ERROR 
 B SPG1028
SPG1025 
			OLD REGSET 
 CBNL GTRECNR,CGLRECNR,SPG1090
 PERF RGREAD,DK05,=D'5',CBIN1 READ RECORD 
 BNOK SPG1020 IF TR 11, OR
			NOT SAME MACHINE, OR 
			DISK ERROR 
SPG1028 
 CBE GTREGNR,=D'12',SPG1020 TR 12 
 CBL GTLBNR,GSWBCD7,SPG1090 TOO FAR 
 CMP GTLBNR,GTLBNRIN ACTUAL - WANTED EKSP.
 BL SPG1040 WANTED EKSP. PASSED 
 BE SPG1040 FOUND 
*     NOT YET FOUND 
 MOVE GSWBIN1,GTLBNR
 SUB GTRECNR,GSWBIN1 GTRECNR =
 MOVE GSWBIN1,GTLBNRIN GTRECNR -
 ADD GTRECNR,GSWBIN1 ( GTLBNR - GTLBNRIN )
 B SPG1022
* 
SPG1040 
 MOVE TTDBKRM,=C'K' 
 CBE TTDKDEX,CBIN1,SPG1060
 MOVE TTDBKRM,=C'D' 
SPG1060 
 SET TTSUPFLG 
 MOVE TTSUPMRK,=C'S'
 CBNE GTUSED(CBIN6),CBIN0,SPG1070 
 CLEAR TTSUPFLG 
 MOVE TTSUPMRK,CBLANKS
SPG1070 
 TBT TTTSTFLG,SPG1080 
 SET TTTSTFLG 
 PERF SPLIN8,CBIN5,CBIN2 WRITE 'BILAG'
 PERF GRASPV
 PERF CLEAR8
 MOVE TTLINNR,=D'6' LINE 25 
 MOVE TTCYM,=C'K' KVIT
SPG1080 
 MOVE GSWBIN1,TTLINNR 
 DSC1 KVOUCH,POS,GSWBIN1 POSITION VOUCHER 
 PERF FRMTKV GET FORMAT 
 EDWRT KVOUCH,GTSTRFMT WRITE
 PERF CRVO
 ADD TTLINNR,=D'2' ONE LINE UP
 MOVE GSWBIN1,TTLINNR 
 CBNL GSWBIN1,CVOUTOP,SPG1090 NO MORE LINES 
 SUB GTLBNRIN,=D'1' NEXT LBNR 
 B SPG1020
SPG1090 
 TBF TTTSTFLG,SPG10RET
 CLEAR TTSUPFLG 
 MOVE TTSUPMRK,CBLANKS
 MOVE TTCYM,CBLANKS 
 WAIT KVOUCH
 DSC0 KVOUCH,RLEAS
SPG10RET
 CLEAR GTLOKSPG 
SPG10MAK
 B ADM11RET 
* 
* 
SPGL11			PRINT INTERVAL, OLD REGSET 
 TBF CGLREGFL,SPG11MAK ALLOWED? 
 TBT GTCYFLG,SPG11MAK NOT IN CYCLE
 TBT TTLSTFLG,SPG11MAK NOT IN LISTE 
 TBF GTKASSE,SPG11MAK ONLY IF 'KASSE' 
 SET GTGLSPG
 B SPG1005
SPG11MAK
 B ADM11RET 
* 
* 
SPGL12
**  DUMMY  ** 
 B ADM11RET 
**
SPGL13
**  DUMMY  ** 
 B ADM11RET 
* 
* 
SPGL14			PRINT TEXTREGISTER 
 PERF TXTPRT
 B ADM11RET 
* 
* 
SPGL15			SPG. LEVERAND. 
 PERF LEVSPG
 B ADM11RET 
* 
* 
SPGL16			PRINT LEVERAND.
 PERF LEVPRT
 B ADM11RET 
* 
* 
SPGL17			BILAG LOKAL REMITTERING
 PERF CLKF
 B ADM11RET 
* 
* 
ADM11RET
 CLEAR GTSPGFLG 
 MOVE GSWSTR9,CBLANKS 
 B ADMRET 
* 
* 
ADM12 
* FLOPPY DISC EXCHANGE *
 TBT GTTESTFL,ADM12RET
 TBF GTMASTFL,ADM1250 DISKETTE SKIFT
 SET SPPROMPT 
 ATTFMT ADM12FRM
 PERF SPCLRA
 IB SPBINW2,ADM12RET,ADM12RET,ADM1210 
 B ADM12RET 
ADM1210 
 SET CSKIFTFL 
 PERF SKIFT 
 B ADM12RET 
* 
* 
*          FOR NON MASTER 
* 
ADM1250 
 TBF CSKIFTFL,FDEXIT T=CHANGE DISK
 TBF CWFLAG,FDEXIT
 PERF SPLIN8,CBIN8,CBIN2 'DISKETTE SKIFT' 
FD10
 DELAY CBIN20 WAIT A SECOND 
 TBT CSKIFTFL,FD10 FINISHED?
			YES
 MOVE GSWBIN1,CBIN11
 PERF FRMXJT,GSWBIN1
 EDWRT .NW,KJTAPE,GTSTRFMT
 CALL ABORT,KEYB
 DSC0 KEYB,SKIB 
 PERF CLEAR8
 DELAY CBIN20 
 CALL ABORT,KJTAPE
* 
FDEXIT
ADM12RET
 B ADMRET 
* 
* 
ADM13 
********************************************* 
* 
*          SET CLEAR AUTOSUM FLAG 
* 
************************************************
* 
 TBT GTASUMFL,ADM13CL 
 SET GTASUMFL SET AUTOSUM 
 PERF SUM INITIATE SUM
 B ADM13OK
ADM13CL 
 CLEAR GTASUMFL CLEAR AUTOSUM 
ADM13OK 
 CMP CBIN0,CBIN0
 B ADMRET 
* 
* 
ADM14 
*********************************************** 
* 
*              SET 'DAGS DATO'
* 
*********************************************** 
* 
ADM14000
 SET GTDYFLG
 SET SPPROMPT 
 SET SPME 
 MOVE GSWBCD3,=X'FF'
 CBG GTDATO,=D'1',ADM1410 
 MOVE GTDATO,=X'FF' 
ADM1410 
 PERF KLRFMT,CBIN1
 PERF SPCLRN
 IB SPBINW2,ADM14000,ADM14000,ADM14RET
 B ADM14000 
ADM14RET
 CLEAR SPME 
 CLEAR GTDYFLG
 B ADMRET 
* 
* 
ADM15 
 PERF LEVOPR OPRETTELSE LEVERAND
 B ADMRET 
* 
* 
ADM16 
 PERF LEVDEL DELETE LEVERAND
 B ADMRET 
* 
* 
ADM17 
******************************************* 
* 
*            SET NEW 'KASSEKONTONR' 
* 
******************************************* 
* 
ADM17000
 TBT GTKASSE,ADM17RET 
 MOVE SPKEY,CBIN2 
 SET SPPROMPT 
 PERF PACKCL
 MOVE GTDUPF(CBIN5),=D'17' ADM NO.
 MOVE GTDUPF(CBIN4),=D'0' VALUE 
 CLEAR GTDYFLG  READ BET-FORM 
 CLEAR GTSWFLAG INITIAL NOT CASH
 ATTFMT ADM17FRM
 PERF SPCLRA
 IB SPBINW2,ADM17RET,ADM17RET,ADM17100
 B ADM17000 
* 
ADM17100
 MOVE GSWBIN2,GTDUPF(CBIN2) BET-FORM
 CBG GSWBIN2,CBIN5,ADM17000 TEST 0<=BFO<6 
 CBE GSWBIN2,CBIN5,ADM17500 CASH
*     READ ACCOUNT NO 
 PERF KFREAD,CBIN2,CBIN0,GSWBIN2,GTKFVAL
 BNOK ADM17000
 MOVE GTDUPF(CBIN1),GTKFVAL 
ADM17200
 SET GTDYFLG READ ACCOUNT NO
 ATTFMT ADM17FRM
 PERF SPCLRN
 IB SPBINW2,ADM17000,ADM17000,ADM17300
 B ADM17200 
* 
ADM17300
 MOVE GTKFVAL,GTDUPF(CBIN1) ACCOUNT NO
 MOVE GSWBIN2,GTDUPF(CBIN2) BET-FORM
 PERF KFWRIT,CBIN2,CBIN0,GSWBIN2,GTKFVAL
 BNOK ADM17200
 MOVE GTKFVAL,=D'0' CLEAR MOVEMENT
 PERF KFWRIT,CBIN2,CBIN1,GSWBIN2,GTKFVAL
 B ADM17900 
* 
*     CASH ACCOUNT
ADM17500
 MOVE GTDUPF(CBIN1),TTCASHAC CASH ACCOUNT 
 MOVE GTDUPF(CBIN4),TTSTCASH CASH VALUE 
 SET GTDYFLG READ NEW ACCOUNT NO
 SET GTSWFLAG READ NEW CASH VALUE 
 ATTFMT ADM17FRM
 PERF SPCLRN
 IB SPBINW2,ADM17000,ADM17000,ADM17600
 B ADM17500 
ADM17600
 MOVE TTCASHAC,GTDUPF(CBIN1)
 MOVE TTSTCASH,GTDUPF(CBIN4)
* 
* 
ADM17900
 PERF WRITJT,=W'13' 
 PERF PACKCL
ADM17RET
 B ADMRET 
* 
* 
ADM18 
* SET NEW VERSURKONTONR 
ADM18000
 TBT GTKASSE,ADM18RET 
 MOVE SPKEY,CBIN2 
 SET SPPROMPT 
 PERF PACKCL
 MOVE GTDUPF(CBIN5),=D'18' ADM NO.
 MOVE GTDUPF(CBIN4),=D'0' VALUE 
 CLEAR GTDYFLG READ BET-FORM
 ATTFMT ADM18FRM
 PERF SPCLRA
 IB SPBINW2,ADM18RET,ADM18RET,ADM18100
 B ADM18000 
ADM18100
 MOVE GSWBIN2,GTDUPF(CBIN2) BET-FORM
 CBL GSWBIN2,CBIN1,ADM18000 TEST 0<BFO<6
 CBG GSWBIN2,CBIN5,ADM18000 
 CBE GSWBIN2,CBIN5,ADM18200 CASH-VERSUR 
 PERF KFREAD,CBIN3,CBIN0,GSWBIN2,GTKFVAL
 BNOK ADM18000
 MOVE GTDUPF(CBIN1),GTKFVAL 
 B ADM18300 
* 
ADM18200
 MOVE GTDUPF(CBIN1),TVERSUR 
* 
ADM18300
 SET GTDYFLG READ NEW ACCOUNT NO
 ATTFMT ADM18FRM
 PERF SPCLRN
 IB SPBINW2,ADM18000,ADM18000,ADM18500
 B ADM18300 
* 
ADM18500
 MOVE GSWBIN2,GTDUPF(CBIN2) BET-FORM
 CBE GSWBIN2,CBIN5,ADM18600 
 MOVE GTKFVAL,GTDUPF(CBIN1) 
 PERF KFWRIT,CBIN3,CBIN0,GSWBIN2,GTKFVAL
 BNOK ADM18300
 MOVE GTKFVAL,=D'0' CLEAR KREDIT
 PERF KFWRIT,CBIN3,CBIN1,GSWBIN2,GTKFVAL
			CLEAR DEBET
 PERF KFWRIT,CBIN3,CBIN2,GSWBIN2,GTKFVAL
 B ADM18900 
* 
ADM18600
 MOVE TVERSUR,GTDUPF(CBIN1) 
* 
ADM18900
 PERF WRITJT,=W'13' 
 PERF PACKCL
* 
ADM18RET
 B ADMRET 
* 
* 
ADM19 
********************
* 
*      CALCULATOR FUNCTION
* 
********************
CALCBEG 
 MOVE SPKEY,CBIN1 
  MOVE GSWBCD2,=D'0'          TOTAL=0 
  MOVE GSWBCD1,=D'0'     NUMBER=0 
 PERF FRMXTA,CBIN1    '* ' ON TALLY 
 PERF WTALLY
 ATTFMT CALFRM02
 SET SPPROMPT 
 PERF SPCLRA
 B CALCFRST 
CALCNEXT
 CLEAR SPPROMPT 
 PERF SPCLRN
CALCFRST
 IB SPBINW2,CALCNEXT,CALCNEXT,CALCADD,CALCNEG 
 CBE SPBINW2,CBIN7,CALCSUB
  CBE SPBINW2,CBIN15,CALCTOT
 B  CALCNEXT
CALCNEG 
  MUL  GSWBCD1,=D'-1' 
CALCADD 
 ADD  GSWBCD2,GSWBCD1 
 MOVE GSWBCD6,GSWBCD1 
 PERF FRMXTA,CBIN5
 PERF WTALLY    NUMBER ON TALLY 
 B CALCNEXT 
CALCSUB 
 MOVE GSWBCD6,GSWBCD2 
 MOVE GSWSTR9,=C'SUBTOTAL ' 
 PERF FRMXTA,CBIN3
 PERF WTALLY     SUBTOTAL ON TALLY
 B CALCNEXT 
CALCTOT 
 MOVE GSWBCD6,GSWBCD2 
 MOVE GSWSTR9,=C'TOTAL '
 PERF FRMXTA,CBIN2
 PERF  WTALLY     TOTAL ON TALLY
 SET SPPROMPT 
 ATTFMT CALFRM05
 PERF SPCLRA   TOTAL ON SCREEN
 CBE SPBINW2,CBIN3,CALCBEG
 B ADMRET 
* 
* 
ADM20 
****************************************************
* 
*            CONTROLDIGIT-VALUE CALCULATION 
* 
****************************************************
* 
 SET SPPROMPT 
CALCD00 
 WAIT  KTALLY 
 ATTFMT  CCDFRM01 
 PERF SPCLRA    GET NUMBER
  CBNE  SPBINW2,CBIN3,CALCDRET
 CBE GSWBCD5,=D'10',CALCD06 
 EDWRT .NW,KTALLY,CCDFRM03  CONTROLDIGIT ON TALLY 
 CLEAR GTDYFLG
CALCD05 
 ATTFMT CCDFRM02
 PERF SPCLRA    CONTROLDIGIT ON SCREEN
 CBE SPBINW2,CBIN3,CALCD00
 B CALCDRET 
CALCD06 
 SET GTDYFLG	ERROR  (CONTR.DIGIT=10)
 B CALCD05
* 
CALCDRET
 CLEAR GTDYFLG
 B ADMRET 
* 
* 
ADM21 
********************
* 
*          SET/CLEAR TEST MODE
*          (NO WRITE ON DISKS 
*           T ON JOURNAL, VOUCHER, SCREEN 
*           NO 'BEHOLDNINGST[LLERE' 
* 
********************
 TBT GTMASTFLG,ADM21RET 
 TBT GTKASSE,ADM21RET 
 TBT GTTESTFL,ADM2150 
 PERF WRITJT,=W'9'
 PERF TCONFW,TTASKNR
 MOVE GTTESTMK,=C'T'
 SET GTTESTFL 
 B ADM21RET 
ADM2150 
 PERF WRITJT,=W'10' 
 CLEAR GTTESTFL 
 MOVE GTTESTMK,CBLANKS
 PERF TCONFR,TTASKNR
ADM21RET
 B ADMRET 
* 
* 
 EJECT
ADM22 
**********
* 
* 
**********
 TBF CADM22F,ADM22RET FUNCTION ALLOWED? 
 TBT GTKASSE,ADM22RET KASSE CLOSED? 
 MOVE SPKEY,CBIN2 
 MOVE GSWBCD5,TTSTLBNR
 MUL GSWBCD5,=D'-1' 
ADM2200 
 SET SPPROMPT 
 ATTFMT ADM22FRM
 PERF SPCLRN
 IB SPBINW2,ADM22RET,ADM22RET,ADM2210 
 B ADM2200
ADM2210 
 MUL GSWBCD5,=D'-1' 
 MOVE TTSTLBNR,GSWBCD5
ADM22RET
 B ADMRET 
* 
* 
 EJECT
ADM23 
* MODPOSTERING *
 PERF MODP
 B ADMRET 
* 
ADM24 
* KONTOKORT * 
 PERF KORT
 B ADMRET 
* 
ADM25 
* RECEIPT * 
 PERF KVIT
 B ADMRET 
* 
ADM26 
* SUMMARIZE * 
 PERF SUM 
 B ADMRET 
* 
ADM27 
* LISTE * 
 PERF LSTINT
 B ADMRET 
* 
ADM28 
* SUBTOTAL *
 PERF SUBTOT
 B ADMRET 
* 
 EJECT
ADM29 
********************
* 
*          TEST PRINT ON VOUCHER
* 
********************
 DSC0 KVOUCH,RLEAS RLEASE 
 PERF SPLIN8,CBIN5,CBIN2 ASK FOR 'BILAG'
 PERF GRASPV AND GRASP
 PERF CLEAR8
 MOVE GSWBIN1,CVOUTOP 
ADM2910 
 CBL GSWBIN1,CBIN6,ADM29RET 
 DSC1 KVOUCH,POS,GSWBIN1 POSITION ON LINE 
 PERF FRMXVO,CBIN16 GET FORMAT
 EDWRT KVOUCH,GTSTRFMT PRINT
 SUB GSWBIN1,CBIN8
 B ADM2910
ADM29RET
 DSC0 KVOUCH,RLEAS
 B ADMRET 
* 
 EJECT
ADM30 
* CYCLE END 
 PERF CYK,CBIN10
 B ADMRET 
* 
ADM31 
* CYCLE START * 
 PERF CYK,CBIN1 
 B ADMRET 
* 
ADM32 
* STABEL START *
 PERF CYK,CBIN2 
 B ADMRET 
* 
ADM33 
* DUMMY * 
	B	ADMRET 
* 
ADM34 
* 4-CYCLE, PAUSE IN CYCLE,STABEL
 PERF CYK,CBIN4 
	B	ADMRET 
* 
ADM35 
* VARIOUS TRANSACTIONS *
 PERF DIVTR 
 B ADMRET 
* 

ADM36 
* DUMMY 
 B ADMRET 
* 
ADM37 
* DUMMY 
 B ADMRET 
* 
ADM38 
* DUMMY 
 B ADMRET 
* 
ADM39 
* DUMMY 
 B ADMRET 
* 
ADM40 
 PERF BUDREG
 B ADMRET 
* 
ADM41 
* CREATE PRINTLEV 
 B AD4100 
* 
ADM42 
* PRINT PRINTLEV
 B AD4200 
* 
ADM43 
* CLEAN PRINTLEV
 B AD4300 
 EJECT
* 
* 
* 
*     END OF ADM FUNCTIONS
* 
ADMRET
 RET
 PEND 
* 
 EJECT
* 
* 
************************************************* 
* 
*         FORMATS 
* 
************************************************* 
* 
FMTFKI FRMT 
 FNL
 FKI 1
 FMEL 'B',TSWBCD2 
 FMEND
* 
KONFRMT FRMT
 FSL
 FCOPY =C'KONVERTERING '
 FILLR X'07',1
 FLINK FMTFKI 
 FMEND
* 
ADMFRM1 FRMT
 FSL
 FBT GTSPGFLG,ADML0001
 FCOPY ='ADM  ' 
ADML0001
 FTAB 6 
 FCOPY ='EJ-EDB T[LLER '
 FNL
 FCOPY ='NR'
 FILLR ' ',2
 FCOPY ='KONTONR' 
 FNL
 FBF GTDYFLG,AFRM20 
 FKI 1,MINL=3,MAXL=3,ME,APPL=100
AFRM20
 FMEL 'ZZZ',GSWBCD1 
 FBT GTDYFLG,AFRM10 
 FKI 5,MINL=10,MAXL=10,ME,REWRT,SCHK=1
 FMEL '99999999E-99',CTR12NR(GSWBIN6) 
AFRM10
 FMEND
* 
ADM2FRM1 FRMT 
 FSL
 FBT GTSPGFLG,ADML0201
 FCOPY ='ADM  ' 
ADML0201
 FTAB 6 
 FCOPY ='BEHOLDNINGST[LLERE'
 FNL
 FCOPY ='NR'
 FILLR ' ',2
 FCOPY ='KONTONR' 
 FILLR ' ',6
 FCOPY =C'SALDO'
 FNL
 FBF GTDYFLG,AFRM220
 FKI 1,MINL=1,MAXL=2,ME,APPL=101
AFRM220 
 FMEL 'ZZ',GSWBCD1
 FTAB 5 
 FBT GTDYFLG,AFRM210
 FBT GTSPGFLG,AFRM225 
 FBT GTTESTFL,AFRM225 
 FKI 5,MAXL=10,ME,SCHK=1,REWRT
AFRM225 
 FMEL 'ZZZZZZZZE-ZZ',GTDUPF(CBIN1)
 FTAB 18
 FBT GTSPGFLG,AFRM230 
 FBT GTTESTFL,AFRM230 
 FKI 18,MAXL=14,REWRT,SCHK=4
AFRM230 
 FMEL 'TTTVTTTVTTTVTT9V99-',GTDUPF(CBIN4) SALDO 
 FLINK FMTFKI 
AFRM210 
 FMEND
* 
ADM08FRM FRMT 
 FSL
 FBT GTSPGFLG,ADML0801
 FCOPY ='ADM  ' 
ADML0801
 FTAB 6 
 FCOPY ='CHECK LBNR'
 FNL
 FBT GTSPGFLG,ADML0802
 FKI 1,MINL=1,MAXL=5,ME 
ADML0802
 FMEL 'XXXXX',GTDUPF(CBIN4) 
 FBF GTSPGFLG,ADML0809
 FLINK FMTFKI 
ADML0809
 FMEND
* 
ADM17FRM FRMT 
 FSL
 FBT GTSPGFLG,ADML1701
 FCOPY ='ADM  ' 
ADML1701
 FTAB 6 
 FCOPY ='PENGE-KONTO' 
 FTAB 30
 FCOPY ='BFO '
 FBT GTDYFLG,ADML1702 
 FKI 34,MINL=1,MAXL=1,ME
ADML1702
 FMEL 'X',GTDUPF(CBIN2) BET-FORM
 FBF GTDYFLG,ADML1708 
 FNL
 FCOPY ='KONTONR' 
 FNL
 FBT GTSPGFLG,ADML1703
 FKI 1,MINL=10,MAXL=10,ME,SCHK=1
ADML1703
 FMEL '99999999E-99',GTDUPF(CBIN1)
 FBF GTSWFLAG,ADML1708
 FTAB 14
 FBT GTSPGFLG,ADML1704
 FKI 14,MAXL=13,REWRT,SCHK=4
ADML1704
 FMEL 'TTTVTTTVTTTVTT9V99-',GTDUPF(CBIN4) 
ADML1708
 FBF GTSPGFLG,ADML1709
 FLINK FMTFKI 
ADML1709
 FMEND
* 
* 
ADM18FRM FRMT 
 FSL
 FCOPY ='ADM  ' 
 FCOPY ='VERSUR KONTONR REMIT ' 
 FTAB 30
 FCOPY ='BFO '
 FBT GTDYFLG,ADML1802 
 FKI 34,MINL=1,MAXL=1,ME
ADML1802
 FMEL 'X',GTDUPF(CBIN2) 
 FBF GTDYFLG,ADML1808 
 FNL
 FCOPY ='KONTONR' 
 FNL
 FKI 1,MINL=10,MAXL=10,ME,SCHK=1
 FMEL '99999999E-99',GTDUPF(CBIN1)
ADML1808
 FMEND
* 
ADM12FRM FRMT 
 FSL
 FCOPY ='DISKETTE SKIFT ' 
 FILLR X'07',1
 FLINK FMTFKI 
 FMEND
* 
SPGFM00 FRMT
 FSL
 FCOPY ='KLAR ' 
 FLINK SPGFMSPG 
 FKI 13,MINL=1,MAXL=2 
 FMEL 'ZZ',GSWBCD3
 FMEND
* 
SPGFMSPG FRMT 

 FTEXT X'53505C524745'

 FMEND
* 
SPGFM04 FRMT
 FSL
 FNL
 FMEL '99',GSWBCD3
 FCOPY ='  ]BNE KASSER' 
 FNL
 FMEL 'BBZZZ-',CMASK(CBIN1) 
 FMEL 'BBZZZ-',CMASK(CBIN2) 
 FMEL 'BBZZZ-',CMASK(CBIN3) 
 FMEL 'BBZZZ-',CMASK(CBIN4) 
 FNL
 FMEL 'BBZZZ-',CMASK(CBIN5) 
 FMEL 'BBZZZ-',CMASK(CBIN6) 
 FMEL 'BBZZZ-',CMASK(CBIN7) 
 FMEL 'BBZZZ-',CMASK(CBIN8) 
 FNL
 FMEL 'BBZZZ-',CMASK(CBIN9) 
 FMEL 'BBZZZ-',CMASK(CBIN10)
 FMEL 'BBZZZ-',CMASK(CBIN11)
 FMEL 'BBZZZ-',CMASK(CBIN12)
 FLINK FMTFKI 
 FMEND
* 
* 
SPGFM08 FRMT
 FSL
 FLINK SPGFMSPG 
 FBF GTGLSPG,SPGL081
 FILLR '*',1
SPGL081 
 FNL
 FCOPY =C' EKS.LBNR'
 FKI 14,MAXL=5
 FMEL 'XXXXX',GTLBNRIN
 FNL
 FCOPY =C'REGKONTONR' 
 FKI 14,MINL=10,MAXL=10,SCHK=1,REWRT,APPL=108 
 FMEL 'XXXXXXXXE-XX',GSWBCD7
 FNL
 FCOPY =C'CPR/CIR/NR' 
 FKI 14,MINL=7,MAXL=10,SCHK=1,REWRT,APPL=109
 FMEL 'XXXXXXE-XXXX',GSWBCD7
 FNL
 FLINK FBELOB 
 FKI 14,MAXL=12,SCHK=4,REWRT,APPL=110 
 FMEL 'TVTTTVTTTVTTX,XX-',GSWBCD7 
 FNL
 FCOPY =C' DIVERSE' 
 FKI 14,MAXL=2,APPL=111 
 FMEL 'XX',GSWBCD6
 FKI 18,MAXL=13,SCHK=4,REWRT
 FMEL 'TTTTTTTTTTTTX-',GSWBCD7
 FNL
 FLINK FMTEND 
 FMEND
* 
SPGFM10 FRMT
 FSL
 FLINK SPGFMSPG 
 FBF GTGLSPG,SPGL101
 FILLR '*',1
SPGL101 
 FNL
 FCOPY =C'BILAG'
 FCOPY =C' EKS.LBNR'
 FILLR ' ',1
 FTEXT C'FRA' 
 FKI 20,MAXL=5,ME 
 FMEL 'XXXXX',GSWBCD7 
 FNL
 FTAB 16
 FTEXT C'TIL' 
 FKI 20,MAXL=5,ME 
 FMEL 'XXXXX',GTLBNRIN
 FNL
 FLINK FMTEND 
 FMEND
* 
* 
FBELOB FRMT 

 FTEXT X'42454C5C4B'
 FMEND
* 
FMTEND FRMT 
 FNL
 FKI 1,MAXL=1,APPL=121,VERIF
 FMEL 'B',TSWBCD2 
 FMEND
* 
* 
SPGFM17 FRMT
 FSL
 FTAB 6 
 FCOPY ='KASSE-KONTO '
 FNL
 FCOPY ='KONTONR' 
 FILLR ' ',6
 FCOPY ='SALDO' 
 FNL
 FMEL '99999999E-99',TTCASHAC 
 FTAB 14
 FMEL 'ZZZVZZZVZZZVZZ9V99-',TTCASH
 FNL
 FCOPY ='EJ EDB'
 FTAB 14
 FMEL 'ZZZVZZZVZZZVZZ9V99-',TTEJEDB 
 FNL
 FBF CSTRKFLG,SPL1710 
 FCOPY ='LOKAL REMIT' 
 FTAB 14
 FMEL 'ZZZVZZZVZZZVZZ9V99-',GSWBCD7 
 FNL
SPL1710 
 FTAB 14
 FMEL 'ZZZVZZZVZZZVZZ9V99-',GSWBCD6 
 FLINK FMTFKI 
 FMEND
* 
*           CALCULATION-FORMATS 
* 
* 
CALFRM02  FRMT
  FSL 
 FCOPY =C'REGNEFUNKTION'
 FNL
 FNL
 FKI 1,MINL=1,MAXL=11,SCHK=4,APPL=122,DUPL=GSWBCD1
 FMEL 'TVTTTVTTTVTTX,XX-',GSWBCD1 
 FMEND
* 

CALFRM05 FRMT 
 FSL
 FCOPY  =C'REGNEFUNKTION' 
 FNL
 FNL
 FCOPY =C'TOTAL ' 
 FNL
 FMEL 'ZZZVZZZVZZZVZZ9V99-',GSWBCD2 
 FLINK FMTFKI 
  FMEND 
* 
* 
*        CONTROLDIGIT-FORMATS 
* 
* 
CCDFRM01  FRMT
  FSL 
  FCOPY =C'CHECKCIFFER' 
  FCOPY  ='BEREGNING' 
 FNL
 FNL
 FCOPY =C'BEREGNING'
 FTEXT 'SGRUNDLAG'
 FNL
  FKI  1,MINL=1,MAXL=10,REWRT,APPL=105
 FMEL  'ZZZZZZZZZE-9',GSWBCD6 
 FMEND
* 
CCDFRM02 FRMT 
  FSL 
 FCOPY  =C'CHECKCIFFER' 
  FCOPY  ='BEREGNING' 
 FBT GTDYFLG,CCDLAB02 
 FLINK CCDFRM03 
 FB CCDLAB03
CCDLAB02
 FNL
 FNL
 FCOPY ='CHECKCIFFER' 
 FILLR ' ',1
 FCOPY ='FEJL ' 
CCDLAB03
 FLINK FMTFKI 
 FMEND
* 
CCDFRM03 FRMT 
 FNL
 FNL
 FMEL 'ZZZZZZZZZE-9',GSWBCD6
 FILLR ' ',1
 FNL
 FCOPY =C'CHECKCIFFER'
  FILLR  '=',1
 FMEL 'B9B',GSWBCD5 
 FNL
 FMEL 'ZZZZZZZZZE-9',GSWBCD6
 FMEL  '9B',GSWBCD5 
 FMEND
* 
ADM22FRM FRMT 
 FSL
 FCOPY ='LBNR  '
 FMEL '***99',TTLBNR
 FILLR '-',3
 FKI 15,MAXL=5
 FMEL '***99',GSWBCD5 
 FMEND
* 
* 
* 
 END

Full view