|
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: 43110 (0xa866)
Notes: pts_type(SC)
Names: »RGADM.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/RGADM.SC«
IDENT RGADM 820906 NJ DDUM KMD08 PDIV ENTRY ADM ENTRY ADMRET ENTRY A5RET1 ENTRY A5RET2 * EXT CLKF EXT CLEJ EXT CLEDB EXT CLBEH EXT SKIFT 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 AD46 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 EXT KBTEST 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 DELETE OLD PRINTRECORDS * ADM 44 * ADM 45 * ADM 46 REORG INDEXFILE (LYNGBY ONLY) * * ******************** 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,ADM44,ADM45,ADM46 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,ADM44,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 * ********** 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 TBF CFSUPFLG,SUPL01 MOVE GSWBCD1,GTDATO DDMMYY DIV GSWBCD1,=D'100' DDMM MOVE GSWBCD2,GTDATO DIV GSWBCD2,=D'10000' DD MUL GSWBCD2,=D'100' DD00 SUB GSWBCD1,GSWBCD2 MM CBE GSWBCD1,=D'12',SUPL02 FORSUP SUPL01 SET TTSUPFLG MOVE TTSUPMRK,=C'G' B SUPLOK SUPL02 SET TTSUPFLG MOVE TTSUPMRK,=C'N' NEW YEAR B SUPLOK SUPL10 MOVE TTSUPMRK,=' ' 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,=' ' CBNE GTUSED(CBIN6),CBIN10,SPG0880 MOVE TSWBCD2,GTDATO ISOLATE LAST DIGIT MOVE GSWBCD1,GTDUPF(CBIN6) SUB GSWBCD1,TSWBCD2 BZ SPG0880 BP SPG0875 SET TTSUPFLG SUPPLEMENT YEAR MOVE TTSUPMRK,=C'G' FORSUPPLEMENT B SPG0880 SPG0875 SET TTSUPFLG MOVE TTSUPMRK,=C'N' SUPPLEMENT SPG0880 PERF TRPAGE SET GTDIVTR SET DIVERSE TRANS CLEAR GTREGFLG B ADM11RET * SPG08RET MOVE SPKEY,CBIN1 CLEAR GTLOKSPG CLEAR TTSUPFLG MOVE TTSUPMRK,=' ' 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 CLEAR TTSUPFLG MOVE TTSUPMRK,=' ' CBNE GTUSED(CBIN6),CBIN10,SPG1070 YEAR NOT USED MOVE TSWBCD2,GTDATO ISOLATE LAST DIGIT MOVE GSWBCD1,GTDUPF(CBIN6) SUB GSWBCD1,TSWBCD2 BZ SPG1070 SAME YEAR BP SPG1065 SET TTSUPFLG DIFF YEAR, SO SUPPLEMENT MOVE TTSUPMRK,=C'G' B SPG1070 SPG1065 SET TTSUPFLG MOVE TTSUPMRK,=C'N' 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,=' ' MOVE TTCYM,=' ' 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,=' ' 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 TBT TTSUPFLG,ADM1420 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 ADM1420 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,=' ' 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 * ******************** ATTFMT ADM29FM1 PERF SPCLRA CBNE SPBINW2,CBIN3,ADM29RET CBE TSWBCD2,=D'2',ADM2920 DSC0 KVOUCH,RLEAS RLEASE PERF SPLIN8,CBIN5,CBIN2 ASK FOR 'BILAG' PERF GRASPV AND GRASP PERF CLEAR8 MOVE GSWBIN1,CVOUTOP ADM2910 DSC1 KVOUCH,POS,GSWBIN1 POSITION ON LINE PERF FRMXVO,CBIN16 GET FORMAT EDWRT KVOUCH,GTSTRFMT PRINT SUB GSWBIN1,CBIN8 CBG GSWBIN1,CBIN6,ADM2910 DSC0 KVOUCH,RLEAS ADM29RET B ADMRET * ADM2920 EDWRT KJTAPE,ADM29FM2 PERF KBTEST BNOK ADM2920 B ADMRET ADM29FM1 FRMT FSL FTEXT 'BILAG=1,JOURNAL=2' FLINK FMTFKI FMEND ADM29FM2 FRMT FILLR ' ',2 FILLR '/',50 FEOR FILLR ' ',2 FILLR '-',50 FMEND 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 * ADM44 B ADMRET * ADM45 B ADMRET * ADM46 PERF AD46 B ADMRET EJECT * * * * END OF ADM FUNCTIONS * ADMRET RET PEND EJECT * * ************************************************* * * FORMATS * ************************************************* * FMTFKI FRMT FNL FKI 1 FMEL '9',TSWBCD2 FMEND * KONFRMT FRMT FSL FCOPY =C'KONVERTERING ' 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 'ZZZZZZZZE-ZZ',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 'ZZZZZZZZE-ZZ',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 ' FCOPY ='KONTONR' FCOPY =' 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 'ZZZZZZZZE-ZZ',GTDUPF(CBIN1) ADML1808 FMEND * ADM12FRM FRMT FSL FCOPY ='DISKETTE SKIFT ' 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 FTEXT 'REG' FCOPY ='KONTONR' 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'42454C5C42' 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 'ZZZZZZZZE-ZZ',TTCASHAC FTAB 14 FMEL 'ZZZVZZZVZZZVZZ9V99-',TTCASH FNL FCOPY ='EJ EDB' FTAB 14 FMEL 'ZZZVZZZVZZZVZZ9V99-',TTEJEDB FNL FBF CSTRKFLG,SPL1710 FCOPY ='LOKAL' FCOPY =' 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