|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/36 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/36 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 4608 (0x1200)
Notes: MEMBER_S, Member_Text
Names: »BOG970 «
└─⟦2142406c2⟧ Bits:30009842 APAR ÅÅBOG ØLIBRARY - Seebach Data Aps
└─⟦1fc10e824⟧
└─⟦this⟧ ».BOG970 «
H 18 D.J 1 BOG970
F****************************************************************
F* *
F* PROGRAM B O G 9 7 0 - FORESP@RGSEL P$ BILAG *
F* ----------- *
F* *
F* FORESP@RGSEL P$ ENKELTE BILAG MED MULIGHED FOR AT SE DE *
F* ENKELTE POSTERINGER. *
F* *
F* FORM$LET KAN V#RE SLETNING AF BILAGET *
F* *
F****************************************************************
FSK#RM CD F 100 WORKSTN
F KSLN VLN
F KID WS
F KINFDS EXERDS
F KINFSR EXER
FPOS1 IF 234 78L14AI EXTK DISK
IPOS1 NS 20 1 CT
I 2 2 STAKOD
I 3 100KTOKEY
I 11 120POSTPR
I 13 180BILDAT
I 19 48 TEKST
I 49 582BEL@B
I 59 640BILAG
I NS 01 1 CX
ISK#RM NS 40 1 C0
I* FORMAT- BOG97000
I 2 70XBILAG
I NS 41 1 C1
I* FORMAT- BOG97002
I NS
I DS
I 1 60DATO
I 1 20$R
I 3 40MD
I 5 60DG
IEXERDS DS
I *STATUS STATUS
I UDS
I 1 7 LOCAL
I 8 130XBILAG
I 8 21 KEY
I 52 52 SIS$R
C* I N D I K A T O R O V E R S I G T
C*
C* 40 - INPUT AF BILAGSNUMMER
C* 41 - INPUT AF CMD-KEY
C* 49 - EXEPTION/ERROR CONDITION I SK#RM-FILE
C* 50 - OUTPUT AF SK#RMBILLEDE FOR INPUT AF KONTONUMMER
C* 52 - OUTPUT AF SK#RMBILLEDE MED INPUT AF CMD EL. PERIODE
C* 54 - OUTPUT AF POSTERINGER MED VLN
C* 59 - DEBET STEMMER MED KREDIT
C* 60 - IKKE FLERE POSTERINGER P$ DENNE KONTO
C* 61 - DER ER POSTER P$ DETTE BILAGSNR.
C* 65 - POSTERINGSBEL@B ER KREDIT
C* 76 - END OF FILE POST
C* 77 - BLADRE FREM
C* 78 - POSTPERIODE ANDET END 12
C SETON 9098
C U8 SETOF 98
C READ TAG
C SETOF 404149
C SETOF 50 52
C SETOF 5475
C SETOF 8083KC
C READ SK#RM 4980
C 80 SETON LR
C 80 GOTO END
C*
C MOVE 'FORTRYD' LOCAL
C KL 59 DEBET COMP 0 80
C KL 59N80 MOVE 'SLET ' LOCAL
C KL 59N80SIS$R IFEQ 'S' .IF
C 78 MOVE 'IKKE ' LOCAL
C END .END
C KL GOTO END
C KE MOVE 'RET ' LOCAL
C KE GOTO END
C KG GOTO END
C*
C 49 EXSR EXER EXCPT/ERROR
C 49 GOTO STARTX
C* TEST OM 'STOP SYSTEM' @NSKET
C*
C 40 GOTO REC0
C 41 GOTO START0
C*
C TIME TMS 60
C*
C START0 TAG
C SETOF 60
C SETON 50
C*
C STARTX TAG
C EXCPT
C GOTO READ
C*
C******************************************************
C* BEHANDLING AF SK#RMBILLEDE 0 - FORMAT BOG97000 *
C* BILSGSNUMMER *
C******************************************************
C REC0 TAG
C*
C SETON 59
PS C SETOF 61
C Z-ADD0 DEBET 112
C Z-ADD0 KREDIT 112
C SETON 5253
C EXSR POSTER
C GOTO STARTX
C*
C END TAG
PS C N61 MOVE 'INGEN ' LOCAL
C*
C******************************************************
C* S U B R U T I N E R *
C* ------------------- *
C****************************************************** E X E R
C* - - - -
C* BEHANDLING AF EXEPTION/ERROR FRA SK#RM
C*
C EXER BEGSR
C STATUS COMP 01122 80
C 80 GOTO ROLUP ROLL UP
C STATUS COMP 01123 80
C 80 GOTO ROLDWN ROLL DOWN
C GOTO EXER98
C ROLUP TAG
C N60 SETON 77
C N60 GOTO EXER97
C***
C ROLDWN TAG
C Z-ADD0 DEBET 112
C Z-ADD0 KREDIT 112
C*
C EXER97 TAG
C SETON 5253
C EXSR POSTER
C EXER98 TAG
C ENDSR
C****************************************************** P O S T E R
C* - - - - - -
C* DISPLAY DE ENKELTE POSTERINGER MED VLN
C*
C POSTER BEGSR
C SETOF 7660
C Z-ADD0 VLN
C N77 KEY SETLLPOS1
C SETOF 77
C POST01 TAG
C ADD 1 VLN
C VLN COMP 14 80
C 80 GOTO POST98
C READ POS1 76
C N76 BILAG COMP XBILAG 7676
C 76 SETON 60
C 76 GOTO POST98
C N78 POSTPR COMP 12 78
C Z-ADDBEL@B BEL@B 65
C N65 ADD BEL@B DEBET
C 65 SUB BEL@B KREDIT
C Z-ADDBILDAT DATO
C MOVELDG BILDAT
C MOVE $R BILDAT
PS C SETON 54 61
C EXCPT
C SETOF 525354
C GOTO POST01
C POST98 TAG
C DEBET COMP KREDIT 59
C SETON 52
C ENDSR
OSK#RM E 50
O K8 'BOG97000'
O WS 2
O UDATE Y 10
O E 53
O K8 'BOG97003'
O E 54
O K8 'BOG97004'
O BILAG Z 6
O KTOKEY 14
O BILDATY 22
O TEKST 52
O N65 BEL@B 1 62
O 65 BEL@B 1 75
O E 60N83
O K8 'BOG97005'
O KREDIT2 27
O DEBET 2 14
O E 52
O K8 'BOG97002'