DataMuseum.dk

top - metrics - download

    Length: 17302 (0x4396)
    Notes: pts_type(SC)
    Names: »RGSUB1.SC«

└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
    └─⟦this⟧ »REMIT2/RGSUB1.SC« 

PTS(SC)

 IDENT RGSUB1 820924 NJ 
         DDUM    KMD08
         PDIV 
	ENTRY	SLUT 
 ENTRY UPDAKK 
 ENTRY FLDIN
 ENTRY FLDTST 
	EXT	PACKST 
         EXT     WRITFD 
         EXT     WRITVO 
         EXT     WRITJT 
	EXT	FRMTJT 
	EXT	FRMXTA 
	EXT	WTALLY 
	EXT	FRMTVO 
 EXT KTPLAN 
 EXT SPERR
	EXT	SPINF8 
 EXT KFWRIT 
 EXT KFREAD 
	INCLUDE	EQUATE 
 EJECT
SLUT     PROC 
** SLUT - PACKS THE BUFFER
** WRITES TO DISK 
** WRITE JOURNAL
** WRITE VOUCHER
** UPDATE ACCUMULATE=ORS
* 
	TBT	TTINVFLG,SLUT30	IF IN MODPOST
*          FIND CORRECT ARKIV KONTO NR
 MOVE TTDBKRM,=C'K' IF KREDIT 
 CBE TTDKDEX,CBIN1,SLUT10 
 MOVE TTDBKRM,=C'D' IF DEBET
SLUT10
	TBF	GTCYFLG,SLUT30 
	TBT	TTCY2FLG,SLUT30
 CBE GTREGDEX,CBIN3,SLUT30 IF TRANS 3 
 CBE GTREGDEX,CBIN4,SLUT30 IF TRANS 4 
	MOVE	GTDUPF(CBIN9),TTARKSAV
	MOVE	GTUSED(CBIN9),CBIN13
	CBNE	TTARKSAV,=D'0',SLUT30	NO ARKIV? 
	MOVE	TTARKSAV,GTDUPF(CBIN1)
	MOVE	GTDUPF(CBIN9),TTARKSAV
SLUT30
* INSET REGNSKABS]R IF
* TRANSTYPES  1,2,5,6,7,8,9,10,18,19,28,29
* INDEX       1,2,5,6,7,8,9,10,12,13,14,15
 CBG GTREGDEX,CBIN15,SLUT50 > TR 29 
 CBE GTREGDEX,CBIN11,SLUT50 = TR 12 
 CBE GTREGDEX,CBIN3,SLUT50 = TR3
 CBE GTREGDEX,CBIN4,SLUT50 = TR 4 
* TYPES 1,2,5-10,18,29
	MOVE	GTDUPF(CBIN6),GTDATO	GET DATE 
 CBE GTREGDEX,CBIN10,SLUT37 TRANS10, ALWAYS SUPL YEAR 
 TBT TTSUPFLG,SLUT35
 MOVE TTSUPMRK,=' ' 
 B SLUT40 
SLUT35
 CBE TTSUPMRK,=C'N',SLUT36
 CBE TTSUPMRK,=C'G',SLUT37
 B SLUT40 
SLUT36
 ADD GTDUPF(CBIN6),=D'1' FORSUPPLEMENT
 B SLUT40 
SLUT37
	SUB	GTDUPF(CBIN6),=D'1'	SUB 1 FROM YEAR
SLUT40
	MOVE	TSWBCD2,GTDUPF(CBIN6)	ISOLATE LAST DIGIT
	MOVE	GTDUPF(CBIN6),TSWBCD2 
	MOVE	GTUSED(CBIN6),CBIN10	 SET FIELD NO
SLUT50
* 
	ADD	TTLBNR,=D'1'	EKSP. LB. NR
         PERF  WRITFD 
	BNOK	SLUTNOK 
	PERF	SUMWRT	WRITE SUM OR RESTSUM 
	TBF	GTKASSE,SLUT60	 ON JOURNAL?
	PERF	FRMTJT
	PERF	WRITJT,=W'0'
SLUT60
	PERF	FRMTVO
         PERF  WRITVO 
* TEST IF IN LISTE
	TBF	TTLSTFLG,SLUT80
	PERF	FRMXTA,CBIN4
	PERF	WTALLY
SLUT80
         PERF  UPDAKK 
 SET GTKORTFL 
 MOVE GSWBIN1,GTKTTYP 
 IB GSWBIN1,		C 
		SLUT90,SLUT95,SLUT95,SLUT95,SLUT90
SLUT90
 CLEAR GTKORTFL 
SLUT95
	SET	TTEORFLG 
 CLEAR SPME READY FOR FUNCTIONS 
	CLEAR	GTREGFLG 
	CMP	CBIN0,CBIN0	OK, SETCR=0
	RET
SLUTNOK 
	SUB	TTLBNR,=D'1'	CHANGE LB. NR. AFTER
			DISK ERROR 
	MOVE	SPBINW4,CBIN17
	CMP	CBIN1,CBIN0
         RET
         PEND 
	EJECT
SUMWRT	PROC 
********************
* 
**          SUMWRT - CALCULATE AND WRITE SUM/RESTSUM
* 
********************
	TBF	TTSUMFLG,SUMRET	ONLY IF SUM
	TBF	GTCYFLG,SUMADD	
	TBT	TTCY2FLG,SUMADD
	SUB	GTSUM,GTDUPF(CBIN4)	CALCULATE NEW RESTSUM
	ADD	TTCYKTOT,GTDUPF(CBIN4) 
	B	SUMOUT 
SUMADD
	ADD	GTSUM,GTDUPF(CBIN4)	CALCULATE NEW SUM
	ADD	TTCYKTOT,GTDUPF(CBIN4) 
SUMOUT
	PERF	SPINF8
SUMRET
	ADD	GTSUMCNT,GTDUPF(CBIN4)	ALWAYS ADD TO SUMFUNCTION 
	RET
	PEND 
         EJECT
UPDAKK   PROC 
********************
* 
*        UPDAKK 
*         ROUTINE FOR UPDATING ACCUMULATORS 
* 
*        TR1-TR10  UPDATES TTACC(IDX1,IDX2) 
*                IDX1 = TRNR
*               IDX2 = DEB/KRE
*        TR12  UPDATES TTACC12(IDX1,IDX2) 
*                IDX1 = TAELLER NR
*                IDX2 = DEB/KRE 
* 
*        ALL TRANSACTIONS UPDATE  TTTOTDK(IDX2) 
*        AND IF INVERT               TTKORDK(IDX2)
* 
********************
         CBNE    GTREGNR,='12',UPD20
         PERF    UPDA12                    TAELLER 12 
         B       UPDRET 
UPD20 
	CBG	GTREGNR,=D'30',UPDRET	NO ACCUMULATION FOR
			CERTAIN TRANSACTIONS 
 CBNE GTUSED(CBIN6),CBIN10,UPD30 REGNSKABSAAR 
 MOVE TSWBCD2,GTDATO GET CURRENT YEAR 
 SUB TSWBCD2,GTDUPF(CBIN6) SUB REGNSKABSAAR 
 BZ UPD30 SAME YEAR 
UPD25 
	ADD	TTACC(CBIN8,TTDKDEX),GTDUPF(CBIN4) 
			UPDATE SUPL COUNTER
UPD30 
 TBT GTTESTFL,UPD38 
*     ACCUMULATE 'BEHOLDNINGSTAELLERE'
 MOVE GSWBIN1,CBIN1 
UPD35 
 CBE CBACC(GSWBIN1,CBIN1),GTDUPF(CBIN3),UPD350 BKO? 
 CBNE CBACC(GSWBIN1,CBIN1),GTDUPF(CBIN1),UPD36 FOUND? 
UPD350
 ADD CBACC(GSWBIN1,CBIN2),GTDUPF(CBIN4) 
 ADD CBACC(GSWBIN1,CBIN3),GTDUPF(CBIN4) 
UPD36 
 ADD GSWBIN1,CBIN1 LOOK AT NEXT COUNTER 
 CBNG GSWBIN1,=W'60',UPD35
UPD38 
	MOVE	GSWBIN1,CCNTDEX(GTREGDEX)	GET INDEX 
         ADD     TTACC(GSWBIN1,TTDKDEX),GTDUPF(CBIN4) 
                                           UPDATE ACCUMULATOR 
 IB TTDKDEX,UPDKR,UPDDB SEE IF INVERT 
UPDDB 
         CBNL    GTDUPF(CBIN4),='0',UPD50  IF NEGATIVE DEBET
	ADD	TTACC(CBIN7,TTDKDEX),GTDUPF(CBIN4)	CORRECTION
 B UPD50
UPDKR 
	CBNG	GTDUPF(CBIN4),=D'0',UPD50	IF POSITIVE KREDIT, 
	ADD	TTACC(CBIN7,TTDKDEX),GTDUPF(CBIN4)	CORRECTION
UPD50 
	CBG	GSWBIN1,CBIN4,UPDRET	IF COUNTER 5,6
         TBT     GTTFLG,UPDRET             WHEN CLOSE, NO UPDATE
 TBT CWFLAG,UPD56 
 CBE TTCASHAC,GTDUPF(CBIN1),UPD54 IF KASSEKONTO,NO UPDATE 
 CBE TVERSUR,GTDUPF(CBIN1),UPD54 IF VERSUR, NO UPDATE 
 B UPD55
UPD54 
 ADD TTCYKTOT,GTDUPF(CBIN4) 
 B UPD56
UPD55 
 MOVE TTCYKTOT,=D'0'
UPD56 
 SUB TTCASH,GTDUPF(CBIN4) UPDATE CASH 
 TBF GTBDTFLG,UPD60 
* UPDATE FOR TRANS 28,29 VERSUR KONTO 
 MOVE GSWBIN3,CBIN3 
 SUB GSWBIN3,TTDKDEX
 MOVE GSWBIN7,GTLEVBFO
 CBL GSWBIN7,CBIN5,UPD57
 SUB GSWBIN7,CBIN5
UPD57 
 PERF KFREAD,CBIN3,GSWBIN3,GSWBIN7,GTKFVAL
 SUB GTKFVAL,GTDUPF(CBIN4)
 PERF KFWRIT,CBIN3,GSWBIN3,GSWBIN7,GTKFVAL
 B UPDRET 
UPD60 
 TBF GTSTRFLG,UPDRET
* UPDATE FOR TRANS 18/19, PENGE KONTO - ST
 PERF KFREAD,CBIN2,CBIN1,CBIN0,GTKFVAL
 SUB GTKFVAL,GTDUPF(CBIN4)
 PERF KFWRIT,CBIN2,CBIN1,CBIN0,GTKFVAL
 B UPDRET 
UPDRET
	RET
         PEND 
         EJECT
UPDA12   PROC 
********************
* 
*        UPDA12 - UPDATE FOR TR12 
* 
********************
         MOVE    GSWBIN1,TTCNTNR           TAELLER NR 
 SUB GSWBIN1,=W'100' GET INDEX
 ADD GSWBIN1,CTR12(TTASKNR,CBIN1) 
         ADD     C12ACC(GSWBIN1,TTDKDEX),GTDUPF(CBIN4)
 ADD TTEJEDB,GTDUPF(CBIN4)
 MOVE GSWBCD1,CTR12NR(GSWBIN1) GET TR 12 ACCOUNT
 MOVE GSWBIN7,GSWBIN1 
 PERF KTPLAN,GSWBCD1,GTKTTYP SEE IF KORT NEEDED 
 MOVE GTKFVAL,C12ACC(GSWBIN7,TTDKDEX) 
 PERF KFWRIT,CBIN1,TTDKDEX,GSWBIN7,GTKFVAL
         RET
         PEND 
         EJECT
FLDTST   PROC 
********************
* 
*        FLDTST - TEST IF FIELDS ARE ENTERED CORRECT
*        FELT AFHAENGIGHEDS TEST
* 
********************
	PERF	PACKST,CBINMAX	CLEAR UNUSED FIELDS
         IB      GTREGDEX,		C 
		FLDTOK,FLDTOK,FLDT03,FLDT04,FLDTOK,		C
		FLDTOK,FLDTOK,FLDT08,FLDT09,FLDT10,		C
		FLDTOK,FLDT18,FLDT19,FLDT28,FLDT29,		C
		FLDTOK,FLDTOK,FLDTOK,FLDT45,		C 
                 FLDT45,FLDT45,FLDTOK,FLDTOK,FLDT50,		C 
                 FLDT50,FLDT52,FLDT53,FLDT54
FLDT03
 CBE GTUSED(CBIN12),CBIN0,FLDT035 FIELD 16? 
*     YES, RTE/GEB, INSERT TEXT IN TT16TXT
 MOVE GSWBCD3,GTDUPF(CBIN12) GET FIELD
 CBNE GSWBCD3,=D'0',FLDT031 
 MOVE TT16TXT,=C'RAT' IF = 0
 B FLDT035
FLDT031 
 CBNE GSWBCD3,=D'1',FLDT032 
 MOVE TT16TXT,=C'RTE' IF = 1
 B FLDT035
FLDT032 
 CBNE GSWBCD3,=D'2',FLDT035 
 MOVE TT16TXT,=C'GEB' IF = 2
FLDT035 
 TEST CFLT48
 BZ FLDTOK BRANCH IF FALSE
 CMP GTUSED(CBIN15),=W'0' 
 BNE FLDTOK FIELD 48 USED 
 TBT C221FLG,FLDT036
 TBT C167FLG,FLDT038
 CMP GTDUPF(CBIN3),=D'21' 
 BL FLDT037 
 CMP GTDUPF(CBIN3),=D'26' 
 BL FLDTOK BKO =  21-25 
FLDT037 
 CMP GTDUPF(CBIN3),=D'46' 
 BE FLDTOK BKO=46 
 CMP GTDUPF(CBIN3),=D'56' 
 BE FLDTOK BKO=56 
 B FLDT039 END ODENSE 
FLDT036			HUNDESTED 
 TEST BCPR CPRNR? 
 BZ FLDTOK NO 
 CBE GTDUPF(CBIN3),=D'41',FLDT039 
 CBE GTDUPF(CBIN3),=D'46',FLDT039 BKO 30,41,46? 
 B FLDTOK 
FLDT038			HVIDOVRE
 CMP GTDUPF(CBIN3),=D'46' 
 BNE FLDTOK BKO <> 46 
FLDT039 
 MOVE GTUSED(CBIN15),=W'48' SET FIELD 48 USED 
 MOVE GTDUPF(CBIN15),=D'1' SET FIELD 48 = 1 
 B FLDTOK 
* 
FLDT04
         TBT     BCPR,FLDT041              CIR
 CMP GTUSED(CBIN10),=W'0' 
 BE FLDTOK FIELD 17 (INDEX 10)
         B       FLDTNOK
FLDT041                                    CPR
         PERF    FLDIN,CBIN11,CBIN12,CBIN13,CBIN0 FIELD 18,19,20
 CMP GSWBIN1,=W'0'
 BNE FLDTNOK
 CMP GTUSED(CBIN10),=W'0' 
 BNE FLDTOK 
         B       FLDTNOK
* 
FLDT08
 TBT C221FLG,FLDT09 
 TEST CFLT46
 BZ FLDTOK
 CMP GTUSED(CBIN17),=W'0' 
 BNE FLDTOK FIELD 46 USED 
 MOVE GTUSED(CBIN17),=W'46' ELSE SET FIELD 46 USED
 MOVE GTDUPF(CBIN17),=D'1' SET FIELD 46 = 1 
 B FLDTOK 
FLDT09			HUNDESTED
 TBF C221FLG,FLDT09X
 TBF BCPR,FLDT09X 
 CBNE GTUSED(CBIN8),CBIN0,FLDT09X 
 MOVE GTUSED(CBIN8),CBIN12
 MOVE GTDUPF(CBIN8),=D'6' 
FLDT09X 
 B FLDTOK 
* 
FLDT10
 MOVE GSWBIN1,GTKTTYP 
 IB GSWBIN1,		C 
		FLDT105,FLDT105,FLDT102,FLDT108,FLDT108 
FLDT102 
 B FLDTOK 
FLDT105 
 CMP GTUSED(CBIN2),=W'0'
 BNE FLDTOK 
 B FLDTNOK
FLDT108 
 CMP GTUSED(CBIN2),=W'0'
 BNE FLDTOK 
 MOVE SPBINW4,=W'26'
 PERF SPERR 
 CMP SPBINW2,CBIN2
 BE FLDTOK KOR-KEY
 MOVE SPBINW4,=W'0' 
 B FLDTNOK NOT KOR-KEY
FLDT28
FLDT29
 CBNE GTUSED(CBIN7),CBIN0,FLDT18
 MOVE GTDUPF(CBIN7),GTDATO
 MOVE GTUSED(CBIN7),CBIN11
FLDT18
FLDT19
 MOVE GTUSED(CBIN3),CBIN7 SET BKO=91
 MOVE GTDUPF(CBIN3),=D'91'
* FOLLOWING FIELDS ARE ONLY USED LOCALLY (NOT TO KMD) 
 MOVE GTUSED(CBIN13),CBIN0 NR-1 
 MOVE GTUSED(CBIN14),CBIN0 NR-2 
 MOVE GTUSED(CBIN15),CBIN0 TXT
 MOVE GTUSED(CBIN18),CBIN0 DATO-1 
 MOVE GTUSED(CBIN19),CBIN0 DATO-2 
 B FLDTOK 
* 
FLDT45
 MOVE GSWBCD1,CMASKDAT DDMMYY 
 MOVE GSWBCD2,CMASKDAT
 DIV GSWBCD2,=D'100' 	  DDMM
 MUL GSWBCD2,=D'100' DDMM00 
 SUB GSWBCD1,GSWBCD2 	    YY
 MOVE GSWBCD2,GTREGF(CBIN16) (YY-1,YY,YY+1) 
 ADD GSWBCD2,=D'3' ADJUST FOR FLTDEX
 SUB GSWBCD2,GSWBCD1
 MOVE GSWBIN1,GSWBCD2 
 MOVE GTREGF(GSWBIN1),GTREGF(CBIN17) MOVE AMOUNT
 MOVE GTUSED(GSWBIN1),CBIN1 
 MOVE GTUSED(CBIN15),CBIN0
 MOVE GTUSED(CBIN16),CBIN0
 MOVE GTUSED(CBIN17),CBIN0
 MOVE GTUSED(CBIN18),CBIN0
 MOVE GTUSED(CBIN19),CBIN0
 MOVE GTUSED(CBIN20),CBIN0
 MOVE GTUSED(CBIN21),CBIN0
 B FLDTOK 
* 
FLDT50
         PERF    FLDIN,CBIN2,CBIN1,CBIN0,CBIN0  FIELD 6,28
	CBE	GSWBIN1,=W'1',FLDTOK 
         B       FLDTNOK
* 
FLDT52
         PERF    FLDIN,CBIN2,CBIN1,CBIN0,CBIN0 FIELD 6,28 
         CBNE    GSWBIN1,=W'1',FLDTNOK
         PERF    FLDIN,CBIN12,CBIN7,CBIN0,CBIN0 FIELD 33,40 
         CBE     GSWBIN1,=W'2',FLDT525
	PERF	FLDIN,CBIN14,CBIN20,CBIN21,CBIN22	FIELD 42,43,44,45 
         CBNE    GSWBIN1,=W'0',FLDTNOK
FLDT525 
         CBNE    GTDUPF(CBIN17),=D'1',FLDT527 FIELD 46
         CBE     GTUSED(CBIN20),=W'0',FLDTNOK FIELD 43
FLDT527 
         CBE     GTUSED(CBIN1),=W'0',FLDTOK FIELD 28
         CBNE    GTUSED(CBIN15),=W'0',FLDTNOK FIELD 48
         B       FLDTOK 
* 
FLDT53
         CBNE    GTUSED(CBIN12),=W'0',FLDT535 FIELD 47
         PERF    FLDIN,CBIN20,CBIN21,CBIN22,CBIN0 FIELD 43,44,45
         CBNE    GSWBIN1,=W'0',FLDTNOK
FLDT535 
         CBNE    GTUSED(CBIN7),=W'0',FLDT537 FIELD 40 
         CBNE    GTUSED(CBIN12),=W'0',FLDTNOK FIELD 47
FLDT537 
         CBE     GTUSED(CBIN1),=W'0',FLDTOK FIELD 28
         CBNE    GTUSED(CBIN15),=W'0',FLDTNOK FIELD 48
         B       FLDTOK 
* 
FLDT54
         CBE     GTUSED(CBIN1),=W'0',FLDTOK FIELD 28
         CBNE    GTUSED(CBIN15),=W'0',FLDTNOK FIELD 48
         B       FLDTOK 
* 
FLDTOK
         CMP     CBIN0,CBIN0               SET CR=0 OK
         RET
* 
FLDTNOK 
         CMP     CBIN0,CBIN1               SET CR <> 0  NOT OK
         RET
         PEND 
         EJECT
FLDIN    PROC    FML1,FML2,FML3,FML4
********************
* 
*        FLDIN- TESTS HOW MANY OF THE GIVEN FIELDS
*        (GIVEN BY INDEX) ARE PRESENT 
*        OUTPUT IN GSWBIN1
* 
********************
         MOVE    GSWBIN1,=W'0'
         CBE     FML1,=W'0',FLD5
	CBE	GTUSED(FML1),=W'0',FLD1
         ADD     GSWBIN1,=W'1'
FLD1
         CBE     FML2,=W'0',FLD5
         CBE     GTUSED(FML2),=W'0',FLD2
         ADD     GSWBIN1,=W'1'
FLD2
         CBE     FML3,=W'0',FLD5
         CBE     GTUSED(FML3),=W'0',FLD3
         ADD     GSWBIN1,=W'1'
FLD3
         CBE     FML4,=W'0',FLD5
         CBE     GTUSED(FML4),=W'0',FLD5
         ADD     GSWBIN1,=W'1'
FLD5
         RET
	PEND 
* 
* 
         END