|
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: 36686 (0x8f4e)
Notes: pts_type(SC)
Names: »RGADM.SC«
└─⟦38a30a456⟧ Bits:30009662 Philips computer tape "600104"
└─⟦this⟧ »OD-KOM/RGADM.SC«
IDENT RGADM 840127 EV DDUM KMD08 PDIV ENTRY ADM ENTRY ADMRET ENTRY A5RET1 ENTRY A5RET2 EXT A45ELJ EXT KBTEST EXT A5KONV EXT ADM600 EXT ABORT EXT EMPTYT EXT RGREAD EXT TRPAGE EXT WRITLO 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 SLUTID EXT LAMPON EXT LAMPOF EXT SOPRD EXT BCKUP EXT CLEJ EXT CLBEH EXT CLEDB EXT SKIFT 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 CLSVOL EXT ASGVOL EXT WRITID EXT KTOPR EXT KTPRT INCLUDE EQUATE EJECT ************************ * * * ADM FUNCTIONS * * * ADM 1 EJ EDB T[LLERE * ADM 2 BEHOLDNINGST[LLERE * ADM 3 OPRETTELSE KONTOPLAN * ADM 4 * ADM 5 KONVERTERING * ADM 6 DATATRANSMISSION * ADM 7 * ADM 8 * 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 * ADM 12 DISKETTE SKIFT * ADM 13 AUTOSUM * ADM 14 DAGS DATO * ADM 15 * ADM 16 * 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 45 ELEKTRONISK JOURNAL * * ******************** EJECT ADM PROC ADMNO ******************* * * BRANCH TO SELECTED ADM ROUTINE * ******************* TBT GTLOKSPG,ADM002 MOVE GSWSTR9,=C'TOTAL ' TBF GTSPGFLG,ADM001 MOVE GSWSTR9,=C'SUBTOTAL ' ADM001 MOVE GSWBIN1,ADMNO 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, C ADM00,ADM00,ADM00,ADM00,ADM00, 36,40 C ADM00,ADM00,ADM00,ADM00,ADM45 41,45 B ADM00 * ADM002 LOCAL INQUIRIES MOVE GSWBIN1,ADMNO CMP GSWBIN1,CBIN11 TEST IF INQUIRIES BE ADM11 SUB GSWBIN1,=W'22' ADJUST IB GSWBIN1,ADM23,ADM24,ADM25 ADM00 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' PERF WRITLO,CBIN7 ADM2RET CLEAR GTADMFLG CLEAR GTDYFLG B ADMRET * * ADM3 * OPRETTELSE KONTOPLAN B KTOPR BRANCH TO OTHER MODULE * * ADM4 * DUMMY * B ADMRET EJECT ADM5 * KONVERTERING * ADM0500 TEST CBCACTVF QUIT IF AUTOMATIC BATCH BP ADMRET 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,CPCKBUF,CRECBCD ADD CRECBCD,=D'1' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR BNOK ADM0500 PERF WRITID,CPCKBUF,CBIN2,CBIN2 ADM0513 TBT C5MDISK,ADM0513A PERF CLSVOL,CBIN1 ADM0513A PERF CLSVOL,CBIN2 MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'1' PERF LAMPOF,=W'2047' 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 B A5KONV * * A5RET1 B ADM0513 * * A5RET2 B ADM0515 * * * * EQUVALENT TO END OF ADM5 MODULE * * ADM05006 SOP 6 TBT C5MDISK,A05006A PERF ASGVOL,CBIN1 ASSIGN SYSTEM DISK BNOK ADM0513 A05006A PERF BCKUP,=W'1' WITHOUT BACKUP BNOK ADM0513 B ADM05RET * * * * * ADM05007 SOP 7 TBT C5MDISK,A05007A PERF ASGVOL,CBIN1 BNOK ADM0513 A05007A 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 * * DUMMY *** B ADMRET * * ADM8 * * DUMMY *** 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 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 MOVE TTSUPMRK,=C'G' SET TTSUPFLG B SUPLOK SUPL02 SET TTSUPFLG MOVE TTSUPMRK,=C'N' B SUPLOK SUPL04 SUPL10 MOVE TTSUPMRK,=C' ' 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 IB GSWBIN1,SPGL01,SPGL02,SPGL03,SPGL04, C SPGL05,SPGL06,SPGL07,SPGL08,SPGL09, C SPGL10,SPGL11 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 MUL TTEJEDB,=D'-1' VEND MOVE GSWBCD6,TTCASH ADD GSWBCD6,TTEJEDB 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 PERF KBTEST BOK SPG08RET QUIT IF MAK KEY TBT GTGLSPG,SPG0825 NEW REGSET CBNL GTRECNR,CRECNR,SPG08RET PERF RGREAD,DK02,=D'2' READ RECORD BNOK SPG0820 IF TRANS 11, OR TR >= 12, OR NOT SAME MACHINE, OR DISK ERROR B SPG0828 SPG0825 OLD REGSET CBNL GTRECNR,CGLRECNR,SPG08RET PERF RGREAD,DK05,=D'5' READ RECORD BNOK SPG0820 IF TRANS 11, OR TR >= 12, OR NOT SAME MACHINE, OR DISK ERROR SPG0828 * * 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. CBE GTLBNRIN,=D'0',SPGFOUND CMP GTLBNR,GTLBNRIN ACTUAL - WANTED EKSP. BL SPG0830 WANTED EKSP. PASSED BE SPG0840 FOUND * NOT YET FOUND * JUMP TO FIND RECORD MOVE GSWBCD3,GTLBNR SUB GSWBCD3,GTLBNRIN GTRECNR = MOVE GSWBIN1,GSWBCD3 GTRECNR - SUB 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 * CLEAR TTSUPFLG MOVE TTSUPMRK,CBLANKS CBNE GTUSED(CBIN6),CBIN10,SPG0880 MOVE TSWBCD2,GTDATO MOVE GSWBCD1,GTDUPF(CBIN6) SUB GSWBCD1,TSWBCD2 BZ SPG0880 SAME YEAR BP SPG0875 NEW YEAR SET TTSUPFLG MOVE TTSUPMRK,=C'G' B SPG0880 SPG0875 SET TTSUPFLG MOVE TTSUPMRK,=C'N' SPG0880 * PERF TRPAGE SET GTDIVTR SET DIVERSE TRANS CLEAR GTREGFLG * B ADM11RET * SPG08RET MOVE SPKEY,CBIN1 CLEAR GTLOKSPG CLEAR TTSUPFLG MOVE TTSUPMRK,=C' ' 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' READ RECORD BNOK SPG1020 IF TR 11, OR TR >= 12, OR NOT SAME MACHINE, OR DISK ERROR B SPG1028 SPG1025 OLD REGSET CBNL GTRECNR,CGLRECNR,SPG1090 PERF RGREAD,DK05,=D'5' READ RECORD BNOK SPG1020 IF TR 11, OR TR >= 12, OR NOT SAME MACHINE, OR DISK ERROR SPG1028 CBL GTLBNR,GSWBCD7,SPG1090 TOO FAR CMP GTLBNR,GTLBNRIN ACTUAL - WANTED EKSP. BL SPG1040 WANTED EKSP. PASSED BE SPG1040 FOUND * NOT YET FOUND MOVE GSWBCD3,GTLBNR SUB GSWBCD3,GTLBNRIN GTRECNR = MOVE GSWBIN1,GSWBCD3 GTRECNR - SUB GTRECNR,GSWBIN1 ( GTLBNR - GTLBNRIN ) B SPG1022 * SPG1040 MOVE TTDBKRM,=C'K' CBE TTDKDEX,CBIN1,SPG1060 MOVE TTDBKRM,=C'D' SPG1060 CLEAR TTSUPFLG MOVE TTSUPMRK,=C' ' CBNE GTUSED(CBIN6),CBIN10,SPG1070 MOVE TSWBCD2,GTDATO MOVE GSWBCD1,GTDUPF(CBIN6) SUB GSWBCD1,TSWBCD2 BZ SPG1070 BP SPG1065 SET TTSUPFLG 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 CBG GSWBIN1,CMAXLIN,SPG1090 NO MORE LINES SUB GTLBNRIN,=D'1' NEXT LBNR B SPG1020 SPG1090 TBF TTTSTFLG,SPG10RET CLEAR TTSUPFLG MOVE TTSUPMRK,=C' ' MOVE TTCYM,=C' ' 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 * * * * ADM11RET CLEAR GTSPGFLG MOVE GSWSTR9,=C' ' B ADMRET * * ADM12 * FLOPPY DISC EXCHANGE * TBT GTTESTFL,ADM12RET TBF GTMASTFL,ADM1250 DISKETTE SKIFT MOVE GSWBCD1,CBCFROM TBF CBCSENDF,ADM1205 MOVE GSWBCD1,CSENDNR ADM1205 MOVE GSWBCD2,CRECNR 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 WAIT KJTAPE EDWRT .NW,KJTAPE,GTSTRFMT PERF WRITLO,CBIN5 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,ADM14RET SET GTDYFLG SET SPPROMPT SET SPME MOVE GSWBCD3,=X'FF' ADM1410 ATTFMT OPENFRM PERF SPCLRN IB SPBINW2,ADM14000,ADM14000,ADM14RET B ADM14000 ADM14RET CLEAR SPME CLEAR GTDYFLG B ADMRET * * ADM15 * DUMMY B ADMRET * * ADM16 * DUMMY * B ADMRET * * ADM17 ******************************************* * * SET NEW 'KASSEKONTONR' * ******************************************* * ADM17000 TBT GTKASSE,ADM17RET MOVE SPKEY,CBIN2 SET SPPROMPT PERF PACKCL MOVE GTDUPF(CBIN2),=D'0' MOVE GTDUPF(CBIN5),=D'17' ADM FUNCTION NO MOVE GTDUPF(CBIN1),TTCASHAC MOVE GTDUPF(CBIN4),TTSTCASH ATTFMT ADM17FRM PERF SPCLRN CBE GTDUPF(CBIN1),=D'0',ADM17000 IB SPBINW2,ADM17RET,ADM17RET,ADM1730 B ADM17000 ADM1730 MOVE TTCASHAC,GTDUPF(CBIN1) MOVE TTSTCASH,GTDUPF(CBIN4) PERF WRITJT,=W'13' PERF WRITLO,CBIN7 ADM17RET B ADMRET * * ADM18 * SET NEW VERSURKONTONR ADM18000 VERSUR KONTONR TBT GTKASSE,ADM18RET MOVE SPKEY,CBIN2 SET SPPROMPT ATTFMT ADM18FRM PERF SPCLRN CBE TVERSUR,=D'0',ADM18000 IB SPBINW2,ADM18RET,ADM18RET,ADM18RET B ADM18000 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,=W'7',CALCSUB CBE SPBINW2,=W'15',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,=W'3',CALCBEG B ADMRET * * ADM20 **************************************************** * * CONTROLDIGIT-VALUE CALCULATION * **************************************************** * SET SPPROMPT CALCD00 WAIT KTALLY ATTFMT CCDFRM01 PERF SPCLRA GET NUMBER CBNE SPBINW2,=W'3',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,=W'3',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 WRITLO,CBIN3 PERF TCONFW,TTASKNR MOVE GTTESTMK,=C'T' SET GTTESTFL B ADM21RET ADM2150 PERF WRITJT,=W'10' PERF WRITLO,CBIN4 CLEAR GTTESTFL MOVE GTTESTMK,=C' ' PERF TCONFR,TTASKNR ADM21RET B ADMRET * * 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 * * 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 * 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 * 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 * * ADM45 * ELEKTRONISK JOURNAL B A45ELJ * * * * * 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 * KONV4FMT FRMT FSL FCOPY ='KORREKT' FILLR '?',1 FILLR X'07',1 FLINK FMTFKI FMEND * OPENFRM FRMT FSL FCOPY ='ADM ' FBT GTDYFLG,OPFR05 FTAB 1 FCOPY =C'KASSE]BNING' OPFR05 FNL FBF GTMASTFL,OPFR10 FCOPY =C'DAGS-DATO' FKI 11,MINL=6,MAXL=6,ME,SCHK=2,REWRT,NCLR FMEL '99E-99E-99',CMASKDAT FNL FCOPY =C'DAG NR' FKI 11,MINL=1,MAXL=3,ME,APPL=102 FMEL 'ZZZ',CRELDAY FNL OPFR10 FCOPY ='POST-DATO' FKI 11,MINL=6,MAXL=6,ME,SCHK=2,REWRT,APPL=107 FMEL '99E-99E-99',GTDATO 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 'TTT.TTT.TTT.TT9.99-',GTDUPF(CBIN4) SALDO FLINK FMTFKI AFRM210 FMEND * ADM17FRM FRMT FSL FBT GTSPGFLG,ADML1705 FCOPY ='ADM ' ADML1705 FTAB 6 FCOPY ='KASSE-KONTO ' FNL FCOPY ='KONTONR' FILLR ' ',6 FCOPY ='SALD0' FNL FBT GTSPGFLG,ADM1701 FKI 1,MINL=10,MAXL=10,ME,SCHK=1 ADM1701 FMEL '99999999E-99',GTDUPF(CBIN1) FKI 14,MAXL=14,REWRT,SCHK=4 FMEL 'TTT.TTT.TTT.TT9.99-',GTDUPF(CBIN4) FBF GTSPGFLG,ADM1702 FLINK FMTFKI ADM1702 FMEND * ADM18FRM FRMT FSL FCOPY ='ADM ' FCOPY ='VERSUR KONTONR REMIT ' FNL FCOPY =C'KONTONR' FNL FKI 1,MINL=10,MAXL=10,ME,SCHK=1 FMEL '99999999E-99',TVERSUR FMEND * ADM12FRM FRMT FSL FCOPY ='DISK SKIFT ' FBF CBCACTVF,F12100 FNL FCOPY =C'AUTOMATISK ' FCOPY =C'DATATRANSMISSION ' FBT CBCSENDF,F12050 FCOPY =C'AKTIV ' FB F12060 F12050 FCOPY =C'SENDER ' F12060 FNL FMEL 'ZZZZ9',GSWBCD1 FILLR ' ',5 FMEL 'ZZZZ9',GSWBCD2 FNL F12100 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 'SP' FILLR X'5C',1 FTEXT 'RGE' 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 'TTTTTTTVTTX,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 FCOPY =C'BEL' FILLR X'5C',1 FILLR 'B',1 FMEND * FMTEND FRMT FNL FKI 1,MAXL=1,APPL=90,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 'ZZZ.ZZZ.ZZZ.ZZ9.99-',TTCASH FNL FCOPY ='EJ EDB' FTAB 14 FMEL 'ZZZ.ZZZ.ZZZ.ZZ9.99-',TTEJEDB FNL FTAB 14 FMEL 'ZZZ.ZZZ.ZZZ.ZZ9.99-',GSWBCD6 FLINK FMTFKI FMEND * * CALCULATION-FORMATS * * CALFRM02 FRMT FSL FCOPY =C'REGNEFUNKTION' FNL FNL FKI 1,MINL=1,MAXL=11,SCHK=4,APPL=91,DUPL=GSWBCD1 FMEL 'TTT.TTT.TTX.XX-',GSWBCD1 FMEND * CALFRM05 FRMT FSL FCOPY =C'REGNEFUNKTION' FNL FNL FCOPY =C'TOTAL ' FNL FMEL 'ZZZ.ZZZ.ZZ9.99-',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