|
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: 39548 (0x9a7c)
Notes: pts_type(SC)
Names: »RGADM.SC«
└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
└─⟦this⟧ »NJ-AMT/RGADM.SC«
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
└─⟦this⟧ »NJ-AMT/RGADM.SC«
IDENT RGADM 831026 EV DDUM KMD08 PDIV ENTRY ADM ENTRY ADM117 ENTRY ADMRET ENTRY A5RET1 ENTRY A5RET2 EXT A5KONV EXT ADM600 EXT AD4500 EXT KBTEST EXT ABORT EXT EMPTYT EXT RGREAD EXT TRPAGE EXT LOGSPG EXT WRITJT EXT WRITLO 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 SLUTID EXT LAMPON EXT LAMPOF EXT SOPRD EXT STRTID EXT BCKUP EXT CLEJ EXT CLBEH EXT CLEDB EXT SKIFT EXT FRMXJT EXT KORT EXT MODP EXT KVIT EXT LSTINT EXT SUBTOT EXT CYK EXT DIVTR EXT TCONFW EXT SQWRIT EXT RAREAD EXT RAWRIT EXT ASGVOL EXT CLSVOL EXT WRITID EXT KTOPR EXT KTPRT EXT ONLINE EXT GETMSK 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 3270 ONLINE * 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 * SPG 12 SPG. EL. JOURNAL * 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 36 * ADM 37 * ADM 38 * ADM 39 CHANGE MACHINE NO * ADM 45 SPOOL ADMINISTRATION * * ******************** 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,ADM00,ADM5,ADM6,ADM7, C ADM00,ADM9,ADM10,ADM11,ADM12,ADM13,ADM14,ADM00,ADM00, C ADM17,ADM18,ADM19,ADM20,ADM21,ADM22,ADM23,ADM24, C ADM25,ADM26,ADM27,ADM28,ADM29,ADM30,ADM31,ADM32, C ADM33, C ADM34, C ADM35, C ADM00, C ADM00, C ADM00, C ADM39, C ADM00, C ADM00, C ADM00, C ADM00, C ADM00, C ADM45 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,CBIN16 ADM2RET CLEAR GTADMFLG CLEAR GTDYFLG B ADMRET * * ADM3 * OPRETTELSE KONTOPLAN B KTOPR BRANCH TO OTHER MODULE EJECT ADM5 * KONVERTERING * ADM0500 SET CCONVFLG CLEAR SPKEYFLG TBT GTKASSE,ADM0505 TBF GTMASTFL,ADM0505 CBNE CTASKNR,CBIN0,ADM0505 SET SPPROMPT MOVE SPKEY,CBIN2 ATTFMT KONFRMT PERF SPCLRN IB SPBINW2,ADM0505,ADM0505,ADM0510 B ADM0500 ADM0505 B ADM05RET 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,CBIN3,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 * EQUIVALENT TO START OF ADM5 MODULE B A5KONV * KONVERTERING A5RET1 B ADM0513 A5RET2 B ADM0515 * * * * EQUVALENT TO END OF ADM5 MODULE * * ADM05006 SOP 6 TBT C5MDISK,A05006A PERF ASGVOL,CBIN1 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 * * JUMP TO 3270 ONLINE PERF ONLINE 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 CBG GSWBCD1,=D'2',ADM10RET SET TTSUPFLG MOVE TTSUPMRK,=C'G' B SUPLOK SUPL02 SET TTSUPFLG MOVE TTSUPMRK,=C'N' B SUPLOK 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 PERF ADM117 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' 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' 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 GSWBCD3,GTLBNR SUB GSWBCD3,GTLBNRIN MOVE GSWBIN1,GSWBCD3 SUB GTRECNR,GSWBIN1 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 SUPP.YEAR CLEAR TTSUPFLG MOVE TTSUPMRK,=C' ' CBNE GTUSED(CBIN6),CBIN10,SPG0880 REG]R? MOVE TSWBCD2,GTDATO LAST DIGIT MOVE GSWBCD1,GTDUPF(CBIN6) SUB GSWBCD1,TSWBCD2 BZ SPG0880 SAME YEAR BP SPG0875 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 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 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 GSWBCD3,GTLBNR SUB GSWBCD3,GTLBNRIN MOVE GSWBIN1,GSWBCD3 SUB GTRECNR,GSWBIN1 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 SAME YEAR 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 * * SPGL12 PRINT INTERVAL EL.JOURNAL TBF CSPOOL,SPG12MAK TBF TSPOOL,SPG12MAK TBT GTCYFLG,SPG12MAK TBT TTLSTFLG,SPG12MAK TBF GTKASSE,SPG12MAK PERF LOGSPG SPG12MAK B ADM11RET * * ADM11RET CLEAR GTSPGFLG MOVE GSWSTR9,=C' ' 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 PERF WRITLO,CBIN14 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' * *********************************************** * ADM1400 SET GTDYFLG SET SPPROMPT SET SPME MOVE GTDATO,CMASKDAT MOVE GSWBCD3,CRELDAY ATTFMT OPENFRM PERF SPCLRN CBNE SPBINW2,CBIN3,ADM1400 MOVE GTWBCD2,=D'14' MOVE GTWBCD1,=D'0' MOVE GSWSTR9,=C'ADM *' PERF WRITJT,=W'14' PERF WRITLO,CBIN17 CLEAR SPME CLEAR GTDYFLG 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,CBIN16 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,CBIN12 PERF TCONFW,GTUWB MOVE GTTESTMK,=C'T' SET GTTESTFL B ADM21RET ADM2150 PERF WRITJT,=W'10' PERF WRITLO,CBIN13 CLEAR GTTESTFL MOVE GTTESTMK,=C' ' PERF TCONFR,GTUWB 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 * ******************** 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' FNL FKI 1,MINL=1,MAXL=1 FMEL 'Z',TSWBCD2 FMEND ADM29FM2 FRMT FILLR ' ',2 FILLR '/',50 FEOR FILLR ' ',2 FILLR '-',50 FMEND * 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 * ADM39 * DISPLAY OR CHANGE MACHINE NO * CLEAR GTSPGFLG TBF GTKASSE,A3910 SET GTSPGFLG A3910 SET SPPROMPT MOVE GSWBCD3,GTMSK ATTFMT ADM39FMT PERF SPCLRN IB SPBINW2,A39RET,A39RET,A3920 B A3910 A3920 TBT GTSPGFLG,A39RET CBE GTMSK,GSWBCD3,A39RET UNCHANGED * CHECK CHANGED MACHINE NO PERF GETMSK,GSWBCD3,GSWBIN6,GSWBIN5 BNOK A3910 CBNE TTASKNR,GSWBIN6,A3910 NOT THIS TASK CBL GTMSK,=D'1',A3950 NO PREVIOUS MACHINE * REWRITE OLD DATA PERF TCONFW,GTUWB A3950 MOVE GTMSK,GSWBCD3 MOVE GTUWB,GSWBIN5 USE TB2,GTUWB PERF TCONFR,GTUWB PERF WRITJT,=W'16' WRITE NEW MACHINE ON JOURNAL MOVE GSWBIN1,=W'27' PERF WRITLO,GSWBIN1 A39RET CLEAR GTSPGFLG B ADMRET * * ADM45 * SPOOL ADMINISTRATION B AD4500 * * END OF ADM FUNCTIONS * ADMRET RET PEND * * ADM117 PROC MUL TTEJEDB,=D'-1' VEND MOVE GSWBCD6,TTCASH ADD GSWBCD6,TTEJEDB SET SPPROMPT ATTFMT SPGFM17 PERF SPCLRA MUL TTEJEDB,=D'-1' VEND TILBAGE RET PEND EJECT ************************************************* * * FORMATS * ************************************************* * * FMTFKI FRMT FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * KONFRMT FRMT FSL FCOPY =C'KONVERTERING ' 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 FMEL '99E-99E-99',GTDATO FNL FCOPY =C'DAG NR' FKI 11,MINL=1,MAXL=3,ME,APPL=107 FMEL 'ZZZ',GSWBCD3 DUMMY 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 ='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 '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 FCOPY =X'42454C5C42' BELOB 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 * * 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 '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=122,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 * ADM39FMT FRMT FSL FCOPY ='MASKIN NR' FKI 11,MAXL=3 FMEL '999',GSWBCD3 FMEND * END