|
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: 62056 (0xf268)
Notes: pts_type(SC)
Names: »RGADM.SC«
└─⟦9ad21746d⟧ Bits:30009682 Philips computer tape "600304"
└─⟦this⟧ »NJ-AMT/RGADM.SC«
IDENT RGADM 02.01.XXX.1 DDUM KMD08 PDIV ENTRY RGADM ENTRY ADM ENTRY CLEJ ENTRY CLEDB ENTRY CLBEH ENTRY RGA120 ENTRY ZERO ENTRY SKIFT ENTRY STRTWR ENTRY STRTID ENTRY SLUTID ENTRY SOPRD ENTRY LAMPOF ENTRY LAMPON ENTRY ADMRET * ENTRY TCLOSE ENTRY TR2GEN ENTRY WAHEAD ENTRY WALINE ENTRY BCKUP * EXT ADM600 EXT CNFWRT EXT RADEL EXT ABORT EXT EMPTYT EXT RGREAD EXT TRPAGE EXT SETKRE EXT SETDEB EXT WRITJT EXT INITRG EXT SPCLRN EXT SPCLRS EXT SPCLRA EXT SPINF1 EXT FRMXTA EXT WTALLY EXT FRMTKV EXT CRVO EXT TCONFR EXT FRMXSP EXT SPCHK5 EXT SUM EXT PACKCL EXT CLEAR8 EXT SPLIN8 EXT SLUT EXT GRASPV EXT FRMXVO EXT FRMXJT EXT KORT EXT MODP EXT KVIT EXT LSTINT EXT SUBTOT EXT CYK EXT DIVTR EXT TCONFW EXT CONFWR EXT WRITFD EXT SQWRIT EXT RAREAD EXT RAWRIT EXT ASGVOL EXT CLSVOL EXT CRKJ EXT BACKUP EXT CONRDX EXT RSTORE EXT SETMK EXT WRITID EXT KTOPR EXT KTPRT EXT ONLINE * INCLUDE EQUATE * EJECT RGADM SET SPPROMPT MOVE SPKEY,CBIN2 ATTFMT ADFRM01 PERF SPCLRA IB SPBINW2,RGADM,RGADM,RGADM,RGADM,RGA100,RGA200,RGA300, C RGADM,RGADM,RGA007 B RGADM * RGA007 GO ONLINE PERF ADM,CBIN7 B RGADM * RGA100 * ******************************************************** * * OPEN ROUTINE * ******************************************************** * TBT CCONVFLG,RGADM CLEAR GTDYFLG SET SPPROMPT SET SPME MOVE GSWBCD3,=X'FF' ERASE RGA105 ATTFMT OPENFRM PERF SPCLRN IB SPBINW2,RGADM,RGADM,RGA110 B RGADM RGA110 MOVE TTEJEDB,=D'0' MUL TTSTLBNR,=D'-1' SET POSITIVE (OPEN) MUL CMASK(TTASKNR),=D'-1' SET CMASK >0, OPEN MOVE TTCASH,TTSTCASH CBNE TTSTLBNR,=D'0',RGA115 MOVE TTSTLBNR,=D'1' RGA115 MOVE TTLBNR,TTSTLBNR SUB TTLBNR,=D'1' MOVE TTRECOPN,CRECBCD PERF ZERO PERF TCONFW,TTASKNR STORE INF FROM ADM FUNC. PERF CONFWR PERF WRITJT,=W'5' OPEN MES ON JT SET GTKASSE ADD CTASKNR,CBIN1 RGA120 PERF INITRG START REGISTRATION PERF TCLOSE CLOSE BNOK RGA120 SUB CTASKNR,CBIN1 B RGADM EJECT TCLOSE PROC MOVE SPKEY,CBIN2 TCL000 SET SPPROMPT ATTFMT CLFRM01 PERF SPCLRA IB SPBINW2,TCLMAK,TCLMAK,TCL010 B TCL000 TCL010 * CLEAR FLAGS CLEAR GTSUMKEY CLEAR TTTSTFLG CLEAR TTCY1FLG CLEAR TTCY2FLG CLEAR TTLSTFLG CLEAR TTPSEFLG CLEAR TTSUMFLG CLEAR TTSUPFLG CLEAR GTCYFLG CLEAR GTSUBFLG MOVE TTSUPMRK,=C' ' MOVE TTSUMMRK,=C' ' MOVE GTTEXT,=C' ' MOVE GTSUM,=D'0' WAIT KVOUCH DSC0 KVOUCH,RLEAS * TR12 ACCUMULATORS MOVE GTREGNR,=D'2' MOVE GTREGDEX,CBIN2 PERF PACKCL MOVE GSWBIN1,CBIN1 TCL025 MOVE GTDUPF(GSWBIN1),=X'FF' ADD GSWBIN1,CBIN1 CBL GSWBIN1,CBINMAX,TCL025 MOVE GSWBCD5,=D'0' TCL030 ADD GSWBCD5,=D'1' ACC NR TCL035 MOVE GSWBIN5,GSWBCD5 CONVERT CBG GSWBIN5,CTR12(TTASKNR,CBIN2),TCL100 ADD GSWBIN5,CTR12(TTASKNR,CBIN1) MOVE GTDUPF(CBIN1),CTR12NR(GSWBIN5) CBE GTDUPF(CBIN1),=D'0',TCL030 MOVE GTUSED(CBIN1),CBIN5 INDICATE UPDATED MOVE GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN1) CBE GTDUPF(CBIN4),=D'0',TCL040 MOVE GTUSED(CBIN4),=W'-8' MOVE GSWSTR20,=C'EJ-EDB T[LLER ' MOVE GTWBCD1,GSWBCD5 PERF TR2GEN,CBIN1 GENERATE TR2 WITH KREDIT BNOK TCL035 TCL040 MOVE GSWBIN5,GSWBCD5 ADD GSWBIN5,CTR12(TTASKNR,CBIN1) MOVE GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN2) CBE GTDUPF(CBIN4),=D'0',TCL030 MOVE GTUSED(CBIN4),=W'-8' MOVE GSWSTR20,=C'EJ-EDB T[LLER ' MOVE GTWBCD1,GSWBCD5 PERF TR2GEN,CBIN2 GENERATE TR2 WITH DEBET BNOK TCL040 B TCL030 EJECT TCL100 MOVE GSWSTR9,=C'TOTAL ' PERF CLEJ EJ EDB MOVE TTEJEDB,=D'0' TCL205 CASH MOVEMENT MOVE GTDUPF(CBIN1),TTCASHAC ACCOUNTNR MOVE GTDUPF(CBIN4),TTCASH CURRENT CASH SUB GTDUPF(CBIN4),TTSTCASH INITIAL CASH MOVE GTUSED(CBIN1),CBIN5 MOVE GTUSED(CBIN4),=W'-8' MOVE GSWSTR20,=C'KASSE-KONTO ' MOVE GTWBCD1,=D'0' SET GTTFLG PERF TR2GEN,CBIN0 BNOK TCL205 TBF CCLKTFLG,TCL230 PERF KORT ASK FOR KONTOKORT TCL230 CBE TVERSUR,=D'0',TCL235 MOVE GTDUPF(CBIN1),TVERSUR REMIT ACC MOVE GTDUPF(CBIN4),TTACC(CBIN6,CBIN1) ADD GTDUPF(CBIN4),TTACC(CBIN6,CBIN2) CBE GTDUPF(CBIN4),=D'0',TCL235 MOVE GTUSED(CBIN1),CBIN5 MOVE GTUSED(CBIN4),=W'-8' MUL GTDUPF(CBIN4),=D'-1' MOVE GSWSTR20,=C'VERSUR KONTONR REMIT ' MOVE GTWBCD1,=D'0' PERF TR2GEN,CBIN0 BNOK TCL230 TBF CCLKTFLG,TCL235 PERF KORT * * WRITING OF DISC JOURNAL AND VOUCHER * TCL235 MOVE GSWSTR9,=C'TOTAL ' PERF CLEDB * * BEHOLDNINGST[LLERE * PERF CLBEH * TCL500 MOVE TTSTCASH,TTCASH MOVE TTSTLBNR,TTLBNR ADD TTSTLBNR,=D'1' MUL TTSTLBNR,=D'-1' SET NEGATIVE (CLOSE) MUL CMASK(TTASKNR),=D'-1' SET CMASK < 0, CLOSE CLEAR GTTFLG TCL550 MOVE TTRECOPN,CRECBCD PERF ZERO PERF TCONFW,TTASKNR STORE NEW INITIAL VALUES PERF CONFWR BNOK TCL550 CLEAR GTKASSE TCLRET * ZERONIZE COUNTERS * TRANS 12 COUNTERS MOVE GSWSTR20,=C'*' PERF WRITJT,=W'12' CMP CBIN0,CBIN0 DUMMY RET TCLNOK10 TCLMAK CMP CBIN0,CBIN1 RET PEND EJECT RGA200 ************************************************ * * PERFORM OF SELECTED ADM ROUTINE * ************************************************* * MOVE GSWBIN1,GSWBCD3 PERF ADM,GSWBIN1 B RGADM EJECT ZERO PROC * * ZERONIZE COUNTERS * TRANS 12 COUNTERS MOVE GSWBIN1,CTR12(TTASKNR,CBIN1) MOVE GSWBIN2,GSWBIN1 ADD GSWBIN2,CTR12(TTASKNR,CBIN2) TCL610 ADD GSWBIN1,CBIN1 CBG GSWBIN1,GSWBIN2,TCL615 MOVE C12ACC(GSWBIN1,CBIN1),=D'0' MOVE C12ACC(GSWBIN1,CBIN2),=D'0' B TCL610 TCL615 * ACCUMULATORS MOVE GSWBIN1,CBIN0 TCL620 ADD GSWBIN1,CBIN1 MOVE TTACC(GSWBIN1,CBIN1),=D'0' MOVE TTACC(GSWBIN1,CBIN2),=D'0' CBL GSWBIN1,CBIN8,TCL620 RET PEND EJECT CLEJ PROC ***************************************************** * * NOW ALL ACCUMULATORS NOT = 0 * HAS BEEN REGISTRATED * A VOUCHER PRINT OF ALL TR12 ACC * IS NOW PERFORMED ** ******************************************************** MOVE TTLINNR,=D'25' MOVE GSWSTR20,='EJ-EDB T[LLER ' CBE CTR12(TTASKNR,CBIN2),CBIN0,TCLEJRET PERF WAHEAD,CBIN8 MOVE GTWBCD1,=D'0' TCL110 ADD GTWBCD1,=D'1' MOVE GSWBIN5,GTWBCD1 CONVERT CBG GSWBIN5,CTR12(TTASKNR,CBIN2),TCL200 ADD GSWBIN5,CTR12(TTASKNR,CBIN1) MOVE GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN1) ADD GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN2) MOVE GTDUPF(CBIN1),CTR12NR(GSWBIN5) CBE GTDUPF(CBIN1),=D'0',TCL110 CBG TTLINNR,=D'0',TCL190 DSC0 KVOUCH,RLEAS MOVE TTLINNR,=D'25' PERF WAHEAD,CBIN8 TCL190 PERF WALINE,CBIN9 B TCL110 TCL200 DSC0 KVOUCH,RLEAS TCLEJRET RET PEND EJECT CLEDB PROC * * WRITING OF DISC JOURNAL AND VOUCHER * MOVE GSWSTR20,=C'EDB-T[LLERE ' PERF WRITJT,=W'6' PERF WAHEAD,CBIN8 MOVE GSWBCD5,=D'0' MOVE GTREGF(CBIN1),=D'0' TOTAL MOVE GTREGF(CBIN2),=D'0' TCL240 TBT GTSPGFLG,TCL242 MOVE GTREGNR,=D'11' TCL242 ADD GSWBCD5,=D'1' TCL245 MOVE GSWBIN5,GSWBCD5 CBG GSWBIN5,CBIN6,TCL300 ADD GTREGF(CBIN1),TTACC(GSWBIN5,CBIN1) ADD GTREGF(CBIN2),TTACC(GSWBIN5,CBIN2) MOVE GTUSED(CBIN4),CBIN0 MOVE GTDUPF(CBIN4),TTACC(GSWBIN5,CBIN1) ADD GTDUPF(CBIN4),TTACC(GSWBIN5,CBIN2) MOVE GTDUPF(CBIN6),TTACC(GSWBIN5,CBIN1) MOVE GTDUPF(CBIN5),TTACC(GSWBIN5,CBIN2) DEBET TBT GTSPGFLG,TCL290 MOVE GTUSED(CBIN6),=W'-53' MOVE GTUSED(CBIN5),=W'-52' MOVE GTDUPF(CBIN1),GSWBCD5 MOVE GTUSED(CBIN1),=W'50' MOVE GTDUPF(CBIN2),=D'2' MARK FOR TOTAL MOVE GTUSED(CBIN2),=W'51' PERF CRKJ PERF WRITFD BNOK TCL245 TCL290 MOVE GSWBIN5,GSWBCD5 RESTORE MOVE GTWBCD1,GSWBCD5 PERF WRITJT,=W'7' PERF WALINE,CBIN10 B TCL240 TCL300 PERF PACKCL MOVE GTDUPF(CBIN4),GTREGF(CBIN1) ADD GTDUPF(CBIN4),GTREGF(CBIN2) MOVE GTDUPF(CBIN5),TTACC(CBIN8,CBIN1) ADD GTDUPF(CBIN5),TTACC(CBIN8,CBIN2) PERF WALINE,CBIN11 MOVE GTDUPF(CBIN5),TTACC(CBIN1,CBIN1) MOVE GTDUPF(CBIN6),TTACC(CBIN1,CBIN2) MOVE GSWBIN1,CBIN1 TCL310 ADD GSWBIN1,CBIN1 CBG GSWBIN1,CBIN4,TCL320 ADD GTDUPF(CBIN5),TTACC(GSWBIN1,CBIN1) ADD GTDUPF(CBIN6),TTACC(GSWBIN1,CBIN2) B TCL310 TCL320 TBT GTSPGFLG,TCL329 * ADJUST FOR 'KASSE INDBERETNING' MOVE GSWBCD1,TTCASH SUB GSWBCD1,TTSTCASH CBL GSWBCD1,=D'0',TCL323 SUB GTDUPF(CBIN6),GSWBCD1 B TCL325 TCL323 SUB GTDUPF(CBIN5),GSWBCD1 TCL325 * ADJUST FOR 'VERSUR INDBERETNING' MOVE GSWBCD1,TTACC(CBIN6,CBIN1) ADD GSWBCD1,TTACC(CBIN6,CBIN2) MUL GSWBCD1,=D'-1' 'VEND' CBL GSWBCD1,=D'0',TCL328 SUB GTDUPF(CBIN6),GSWBCD1 B TCL329 TCL328 SUB GTDUPF(CBIN5),GSWBCD1 TCL329 MUL GTDUPF(CBIN5),=D'-1' MUL GTDUPF(CBIN6),=D'-1' MOVE GSWBCD1,TTCASH SUB GSWBCD1,TTSTCASH MOVE GTDUPF(CBIN4),GSWBCD1 PERF WALINE,CBIN12 DSC0 KVOUCH,RLEAS RET PEND EJECT CLBEH PROC * * BEHOLDNINGST[LLERE * TCL400 MOVE TTLINNR,=D'25' MOVE GSWBIN2,CBEH(TTASKNR,CBIN2) CMP GSWBIN2,CBIN0 BE CLBEHRET ADD GSWBIN2,CBEH(TTASKNR,CBIN1) MOVE GTWBCD2,GSWBIN2 TCL405 ATTFMT CLFRM04 SET SPPROMPT PERF SPCLRA IB SPBINW2, C TCL415,TCL415,TCL412,TCL411,TCL415, C TCL415,TCL415,TCL415,TCL413,TCL415, C TCL415,TCL415,TCL413 TCL415 B TCL400 TCL411 TBT GTSPGFLG,TCL400 MOVE GSWSTR20,=C'SLET SALDO ' MOVE GSWBIN6,CBIN1 B TCL420 TCL412 TBT GTSPGFLG,TCL400 MOVE GSWSTR20,=C'SLET PERIODE ' MOVE GSWBIN6,CBIN2 B TCL420 TCL413 MOVE GSWSTR20,=C'SUBTOTAL ' MOVE GSWBIN6,CBIN3 B TCL420 TCL420 MOVE GTWBCD1,=D'0' MOVE GSWBCD6,=D'0' MOVE GSWBCD7,=D'0' TCL425 PERF GRASPV MOVE GSWBIN3,CVOUTOP ADD GSWBIN3,CBIN6 DSC1 KVOUCH,POS,GSWBIN3 PERF CLEAR8 PERF FRMXVO,CBIN13 HEAD ON VOUCHER EDWRT KVOUCH,GTSTRFMT TCL430 ADD GTWBCD1,=D'1' MOVE GSWBIN3,GTWBCD1 ADD GSWBIN3,CBEH(TTASKNR,CBIN1) MOVE GSWBIN4,GTWBCD2 CBG GSWBIN3,GSWBIN4,TCL490 CBE CBACC(GSWBIN3,CBIN1),=D'0',TCL430 * ADD TO TOTAL, PERIODE AND SALDO ADD GSWBCD6,CBACC(GSWBIN3,CBIN2) PERIODE ADD GSWBCD7,CBACC(GSWBIN3,CBIN3) SALDO PERF FRMXVO,CBIN14 EDWRT KVOUCH,GTSTRFMT TBT GTTESTFL,TCL433 IB GSWBIN6,TCL431,TCL432,TCL433 B TCL433 TCL431 MOVE CBACC(GSWBIN3,CBIN3),=D'0' SALDO TCL432 MOVE CBACC(GSWBIN3,CBIN2),=D'0' PERIODE TCL433 SUB TTLINNR,=D'1' CBG TTLINNR,=D'0',TCL430 DSC0 KVOUCH,RLEAS MOVE TTLINNR,=D'25' B TCL425 TCL490 * WRITE TOTAL LINE PERF FRMXVO,CBIN18 EDWRT KVOUCH,GTSTRFMT DSC0 KVOUCH,RLEAS CLBEHRET RET PEND 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 * 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 * * ******************** 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 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' ADM2RET CLEAR GTADMFLG CLEAR GTDYFLG B ADMRET * * ADM3 * OPRETTELSE KONTOPLAN B KTOPR BRANCH TO OTHER MODULE * * ADM4 * DUMMY * 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 PERF LAMPON,=W'1024' LAMP 1 ON DSC1 FD01,LOAD,CBIN7 LOAD IBM BBEOD ADM0535 BNOK ADM0513 ADM0535 DSC0 FD01,RWIND PERF LAMPOF,=W'1024' LAMP 1 OFF PERF LAMPON,=W'512' LAMP 2 ON PERF ASGVOL,CBIN2 BNOK ADM0513 PERF LAMPOF,=W'512' LAMP 2 OFF PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'64' LAMP 5 ON MOVE GSWBIN6,CBIN1 MOVE GSWBIN1,=W'128' READ HEADER PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,GSWBIN6 BOK ADM0536 PERF STRTID,CVOLNO SET UP STRTID PERF WRITID,CBIN3,CBIN1 B ADM0540 ADM0536 PERF WRITID,CBIN3,CBIN1 PRINT HEADER MOVE GSWBIN6,CBIN0 MOVE GSWBIN1,=W'40' DELETE AND WRITE HEADER MOVE GSWSTR20,CBLANKS COPY CPCKBUF,GSWBIN1,CBIN20,GSWSTR20,GSWBIN6 ADM0540 PERF SQWRIT,FD01,=D'1',CPCKBUF BNOK ADM0568 CLEAR CERRORFL MOVE GSWBCD6,=D'0' FOR TEST PURPOSE MOVE CRECNR,CBIN1 ADM0550 START LOOP ADD CRECNR,CBIN1 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,CRECNR BNOK ADM0560 NOT OK TBT CERRORFL,ADM0560 CBE GTWBCD1,=D'4',ADM0565 END OF DATA MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CPCKBUF,CBIN0,CBIN5 BE ADM0570 SLUTD: END OF CONVERT TBF CTESTFLG,ADM0578 * THIS PART CAN BE USED TO CHANGE * TTLBNR DURING CONVERSION. * CAN ONLY BE USED IN DEBUGGER MODE MOVE GSWSTR20,=C'&04' MOVE GSWBIN5,=W'30' MOVE GSWBIN2,CBIN0 MATCH CPCKBUF,GSWBIN5,CBIN20,GSWSTR20,GSWBIN2,CBIN3 BNOK ADM0578 ADD GSWBIN5,CBIN3 MOVE GSWSTR20,=X'00' COPY GSWSTR20,CBIN0,CBIN5,CPCKBUF,GSWBIN5 MOVE GSWBCD5,GSWSTR20 ADD GSWBCD5,GSWBCD6 MOVE GSWSTR20,GSWBCD5 COPY CPCKBUF,GSWBIN5,CBIN5,GSWSTR20,CBIN1 ADM0578 PERF SQWRIT,FD01,=D'1',CPCKBUF BOK ADM0550 ADM0568 PERF LAMPOF,=W'2047' SWITCH OFF LAMPS PERF LAMPON,=W'2' LAMP 10 ON B ADM0515 READ SOP ADM0570 PERF SQWRIT,FD01,=D'1',CPCKBUF WRITE SLUTD BNOK ADM0568 PERF WRITID,CBIN3,CBIN2 B ADM0513 LAMPS ON ADM0560 NOT OK PERF WRITID,CBIN4,CBIN2 PRINT FIRST PART OF LAST CORRECT RECORD SET SPPROMPT ATTFMT KONV4FMT PERF SPCLRA CONTINUE ? IB SPBINW2,A0561,A0561,A0562,A0563,A0561, C A0561,A0561,A0561,A0564 B ADM0560 A0561 MAK B ADM0560 * A0562 SLUT, CONTINUE READ AGAIN SUB CRECNR,CBIN1 CLEAR CERRORFL B ADM0550 * A0563 KRE, TRY NEXT SET CERRORFL B ADM0550 * A0564 KVIT CLEAR CERRORFL B ADM0565 WRITE SLUTD * * ADM0565 END OF DATA MOVE GSWBCD3,CRECNR SUB GSWBCD3,=D'2' SET UP SLUTD PERF SLUTID,GSWBCD3 B ADM0570 * * * * 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 * * 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 SET TTSUPFLG MOVE TTSUPMRK,=C'S' 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 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 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 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 * SET TTSUPFLG MOVE TTSUPMRK,=C'S' CBNE GTUSED(CBIN6),CBIN0,SPG0880 CLEAR TTSUPFLG MOVE TTSUPMRK,=C' ' 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 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,=C' ' 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 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' 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' 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 TCONFW,TTASKNR MOVE GTTESTMK,=C'T' SET GTTESTFL B ADM21RET ADM2150 PERF WRITJT,=W'10' CLEAR GTTESTFL MOVE GTTESTMK,=C' ' 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 * EJECT * * * * END OF ADM FUNCTIONS * ADMRET RET PEND EJECT RGA300 PERF ADM,CBIN11 SPG B RGADM EJECT ************************************************** * * TR2GEN GENERATES A TRANSACTION 2 * **************************************************** TR2GEN PROC DBKR MOVE TTDKDEX,DBKR CBNE TTDKDEX,=W'0',TR2DBKR MOVE TTDKDEX,CBIN1 CBL GTDUPF(CBIN4),=D'0',TR2DBKR MOVE TTDKDEX,CBIN2 TR2DBKR PERFI TTDKDEX,SETKRE,SETDEB EDWRT SCREEN,CLFRM02 PERF SLUT RET PEND EJECT ******************************************************** * * WAHEAD - GRASP AND WRITE HEADLINE ON VOUCHER * ******************************************************** WAHEAD PROC VOXDEX EDWRT SCREEN,CLFRM03 PERF SPLIN8,CBIN5,CBIN2 PERF GRASPV DSC1 KVOUCH,POS,CVOUTOP PERF CLEAR8 PERF FRMXVO,VOXDEX EDWRT KVOUCH,GTSTRFMT RET PEND EJECT ********************************************************* * * WALINE WRITE ACCUMULATORLINE * ********************************************************** WALINE PROC LINDEX PERF FRMXVO,LINDEX EDWRT KVOUCH,GTSTRFMT SUB TTLINNR,=D'1' RET PEND * EJECT SKIFT PROC ************************* * * SKIFT - THIS PROCEDURE TAKES HAND OF SHIFT * OF DISKS, IS ACTIVATED AFTER * 12 ADM * ************************ SK00 TBF CPFLG,SK10 DISC OCCUPIED? DELAY CBIN2 YES DELAY 200 MS B SK00 SK10 SET CPFLG DIUSC FREE SET CSKIFTWN PERF SPLIN8,CBIN8,CBIN2 'DISKETTE SKIFT' TBF CWFLAG,SK15 SUB CRECBCD,=D'1' PERF SLUTID,CRECBCD WRITE 'SLUTD' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR SK15 PERF WRITID,CBIN2,CBIN2 PERF CLSVOL,CBIN2 PERF LAMPOF,=W'2047' ADD CVOLNO,=D'1' SK120 PERF LAMPON,=W'512' LAMP 2 PERF SOPRD CBNE GSWBIN2,CBIN9,SK120 PERF ASGVOL,CBIN2 BNOK SK120 PERF LAMPOF,=W'2047' MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'0' TBF CWFLAG,SK130 PERF STRTWR BNOK SK120 SK130 PERF CNFWRT REWRITE CONFDATA TBF CWFLAG,SK150 MOVE CRECBCD,=D'1' PERF WRITID,CBIN2,CBIN1 SK150 PERF CLEAR8 PERF WRITJT,=W'11' CLEAR CSKIFTFL CLEAR CSKIFTWN CLEAR CPFLG DISC FREE RET PEND EJECT * LAMPON PROC $NR PLIT $NR ************************************** * * LAMPON - FIRE LAMPS ON OPR. PANEL. * CALL - PERF LAMPON,<$NR> * * THE LAMPS ARE FIRED CORRESPONDING TO 1-BITS IN PARAM * ***************************************** MOVE GSWBIN2,$NR DSC1 DSSOPO,ON,GSWBIN2 RET PEND * LAMPOF PROC $NR PLIT $NR ***************************************** * * LAMPOF - EXTINGUISH LAMPS ON OPR. PANEL * CALL - PERF LAMPOF,<$NR> * * THE LAMPS ARE EXTINGHUISHED CORRESPONDING TO 1-BITS IN PARAM * ******************************************** MOVE GSWBIN2,$NR DSC1 DSSOPO,OFF,GSWBIN2 RET PEND * SOPRD PROC ********************************************* * * SOPRD - READ SYSTEMS OPERATOR PANEL * ********************************************* SOPR10 MOVE GSWBIN1,CBIN1 KI DSSOPI,SOPINP,DUMTAB,GSWBIN1,GSWBIN2 BNOK SOPR10 RET PEND * EJECT STRTWR PROC ********************* * * STRTWR - SET UP AND WRITE START RECORD * * *********************** PERF STRTID,CVOLNO PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR BNOK STRTNOK ADD CRECNR,CBIN1 PERF RADEL,DK02,CRECNR BNOK STRTNOK CMP CBIN0,CBIN0 OK RET STRTNOK CMP CBIN1,CBIN0 RET PEND EJECT STRTID PROC VOLID ******************** * * STRTID - SETS UP A START ID IN PACK BUFFER * * CALL - PERF STRTID,<VOLID> * ******************** SET CSWFLAG CBE CRECLGD,=W'128',STRT10 CLEAR CSWFLAG STRT10 MOVE GSWBIN6,CBIN2 EDIT CPCKBUF,PCKINIT EDIT CPCKBUF,STARTFR MOVE GSWBCD3,VOLID EDIT GSWSTR20,FRVOLID MOVE GSWBIN1,=W'40' COPY CPCKBUF,GSWBIN1,CBIN12,GSWSTR20,CBIN0 STRTRET RET PEND EJECT SLUTID PROC SLUTNO ******************** * * SLUTID - SETS UP A SLUTD IN CPCKBUF * * ******************** SET CSWFLAG CBE CRECLGD,=W'128',SLUT10 CLEAR CSWFLAG SLUT10 EDIT CPCKBUF,PCKINIT MOVE CRECBCD,SLUTNO EDIT CPCKBUF,SLUTFRM RET PEND EJECT BCKUP PROC $OPT PLIT $OPT ******************** * * THIS PROCEDURE TAKES CARE OF ADMINISTRATION * OB BACKUP * * CALL: PERF BCKUP,<=W'X'> * $OPT = 1 : WITHOUT BACKUP * $OPT = 2 : WITH BACKUP * * ******************** * MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'1' ADD CVOLNO,=D'1' NEXT VOLUME NO PERF CNFWRT REWRITE CONFIGURATION SUB CVOLNO,=D'1' CBE CBIN1,$OPT,BCK100 NO BACKUP * * * BACKUP * BCK000 PERF LAMPOF,=W'2047' LAMPS OFF BCK005 PERF LAMPON,=W'1024' LAMP 1 PERF LAMPON,=W'128' LAMP 4 PERF LAMPON,=W'16' LAMP 7 TBF CGLREGFL,BCK010 PERF LAMPON,=W'512' LAMP 2 BCK010 PERF SOPRD READ SOP LAMPS IB GSWBIN2, C BSOP10,BSOP09,BSOP08,BSOP07,BSOP06, C BSOP05,BSOP04,BSOP03,BSOP02,BSOP01 BSOP03 BSOP05 BSOP06 BSOP08 BSOP09 BSOP10 B BCK010 OTHER LAMPS * BSOP01 BACKUP FD999001 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'1024' LAMP 1 PERF BACKUP,DK01,=D'1',=W'32',CCONBUF0,=W'199' BNOK BCK050 ADD CVOLNO,=D'1' PERF WRITID,CBIN6,CBIN4 BACKUP OK SUB CVOLNO,=D'1' PERF CONRDX,CCONBUF0,CBIN1 RESTORE BUFFER AREA B BCK000 BCK050 PERF CONRDX,CCONBUF0,CBIN1 RESTORE BUFFER AREA B BCK005 * BSOP02 COPY FD999002 TO FD999005 TBF CGLREGFL,BCK010 ALLOWED? B BCK02 * ***** BCK02 COPY FD999002 TO FD999005 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'512' LAMP 2 SET CPFLG PERF ASGVOL,CBIN2 ASSIGN REGSET BNOK BCK0290 MOVE CGLRECNR,CBIN0 BCK0250 ADD CGLRECNR,CBIN1 MOVE GSWBIN1,=W'128' LENGTH OF RECORD PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,CGLRECNR BNOK BCK0270 ERROR CBE GTWBCD1,=D'4',BCK0280 NO DATA MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CPCKBUF,CBIN0,CBIN5 BE BCK0280 SLUTD PERF RAWRIT,DK05,=D'5',CPCKBUF,CGLRECNR BOK BCK0250 BCK0270 ERROR PERF LAMPON,=W'2' LAMP 10 BCK0280 FINISH MOVE TTGLREC,CGLRECNR PERF TCONFW,CBIN1 SAVE LAST RECORD NO. BCK0290 CLEAR CPFLG DSC0 DK02,CLOSE CLOSE VOLUME 2 B BCK02R * ***** BCK02R B BCK000 * BSOP04 BACKUP FD999004 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'128' LAMP 4 PERF BACKUP,DK04,=D'4',=W'30',CKTBUF,=W'128' BNOK BCK005 NOK B BCK000 OK * BSOP07 FINISH PERF LAMPOF,=W'2047' LAMPS OFF PERF ASGVOL,CBIN1 ASSIGN SYSTEM FILES BNOK BCKNOK BCK100 PERF ASGVOL,CBIN2 BNOK BCKNOK ADD CVOLNO,=D'1' PERF STRTWR BOK BCKOK SUB CVOLNO,=D'1' PERF LAMPON,=W'2' LAMP 10 B BCKNOK * BCKNOK CMP CBIN1,CBIN0 NOK RET * BCKOK PERF WRITID,CBIN2,CBIN1 CMP CBIN0,CBIN0 RET PEND EJECT * * ************************************************* * * FORMATS * ************************************************* DUMTAB KTAB EORKY1 * FMTFKI FRMT FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * PCKINIT FRMT FBT CSWFLAG,INIT10 FILLR ' ',40 FILLR ' ',40 FILLR X'00',48 FEXIT INIT10 FILLR ' ',40 FILLR ' ',40 FILLR ' ',48 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 * FRVOLID FRMT FMEL '999999',CMASKDAT FMEL 'B99999',GSWBCD3 FMEND * SLUTFRM FRMT FCOPY =C'SLUTD' FMEL '99999',CRECBCD FMEND * STARTFR FRMT FCOPY =C'Z300 ' FMEL '9999',CKMDNR KOMMUNE NR FILLR C'2',1 FCOPY CVOL(GSWBIN6) FMEL '999',CRELDAY DAG NR FILLR C'1',1 MIXED TRANS FILLR ' ',6 FMEND * ADFRM01 FRMT FSL FCOPY ='KLAR ' FCOPY ='ADM ' FKI 12,MINL=1,MAXL=2 FMEL 'ZZ',GSWBCD3 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 ' FILLR X'07',1 FLINK FMTFKI FMEND * CLFRM01 FRMT FSL FCOPY =C'KASSELUKNING' FILLR X'07',1 FLINK FMTFKI FMEND * CLFRM02 FRMT FILLR '1',2 FCOPY =C'KASSELUKNING' FNL FCOPY GSWSTR20 TEXT FMEL 'ZZ',GTWBCD1 COUNTER NR FILLR ' ',4 FCOPY GTDBKRC DEB-KRE FNL FCOPY =C'KONTONR' FILLR ' ',5 FLINK FBELOB FNL FMEL '99999999E-99',GTDUPF(CBIN1) FMEL 'BTTT.TTT.TTT.TT9.99-',GTDUPF(CBIN4) FMEND * CLFRM03 FRMT FILLR '1',2 FBT GTSPGFLG,CLF0301 FCOPY =C'KASSELUKNING' CLF0301 FNL FCOPY GSWSTR20 FMEND * CLFRM04 FRMT FSL FBT GTSPGFLG,CLF0401 FCOPY ='KASSELUKNING' CLF0401 FNL FCOPY ='BEHOLDNINGST[LLERE' FNL FNL FBT GTSPGFLG,CLF0402 FCOPY ='SLET PERIODE ' FTAB 15 FCOPY =' DEB' FNL FCOPY ='SLET SALDO ' FTAB 15 FCOPY =' KRE' CLF0402 FNL FCOPY ='SUBTOTAL ' FTAB 16 FCOPY ='KVIT' FNL FNL FNL FILLR ' ',1 FCOPY ='BILAG' 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