|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 42976 (0xa7e0) Types: Q1_Text, reclen=79 Notes: q1file Names: »V101_1:2«
└─⟦60d3ae5fc⟧ Bits:30008760 50001599 └─⟦this⟧ »V101_1:2«
/* V10 SKRIVER UT KONTOUTDRAG & SALDOLISTOR LISTANS OMFATTNING BEGRÄNSAS AV 2 KONTONUMMER & 2 DATUM V 0:1 780927 JÅ */ DCL KONTO1 CHAR(11), KONTO2 CHAR(11), RKONTO1 CHAR(13) INIT('-----.---.---'), RKONTO2 CHAR(13) INIT('-----.---.---'), DATUM1 CHAR(6), DATUM2 CHAR(6), DAT1BIN BINARY, DAT2BIN BINARY, SPTYP BINARY, STAB(11) BINARY, S_MARK CHAR(13) INIT(' . . '); DCL 1 TSTR, 2 VERNRT FIXED(5), 2 DATUMT BINARY, 2 TEXT CHAR(13), 2 ANTVERP BINARY; DCL PK POINTER, 1 BSTR BASED(PK), 2 KONTONR CHAR(11); DCL PB POINTER, 1 BELSTR BASED(PB), 2 VERNR BINARY, 2 PDATUM BINARY, 2 BELOPP FIXED(11); DCL 1 AREA, 2 CH(255) CHAR(61); /* 15 555 BYTES */ DCL VERTEXT FILE, VERBELOP FILE, BSTRL BINARY INIT(61), MAX BINARY, BLOCKANT BINARY, JK BINARY, JJ BINARY, LISTTYP BINARY, RCODE BINARY, KONTOG CHAR(11), SIDA BINARY INIT(1), R BINARY INIT(0), RADANT BINARY INIT (0), NAMN(2) CHAR(10) INIT('KVV/KWAROS','AROS'), RTEXT(8) CHAR(22) INIT( 'KONTOUTDRAG', 'SALDOBESKED', 'PERDAG', 'BOKDAG', 'BOKDAG PERDAG VER.', '', 'TEXT', ''), RKONTO CHAR(13), KONTONRG CHAR(11), KONSTANT BINARY, BUFF CHAR(20), T1 CHAR(1), T61 CHAR(6), T62 CHAR(6), T11 CHAR(11), T13 CHAR(13), T14 CHAR(14), KT1 CHAR(1), KT2 CHAR(2), KT3 CHAR(3), KT4 CHAR(4), KT5 CHAR(5), KT6 CHAR(6), KT7 CHAR(7), KT8 CHAR(8), KT9 CHAR(9), KT10 CHAR(10), KT11 CHAR(11), FX6 FIXED(6), TYP1 BINARY INIT(0), TYP2 BINARY INIT(0), OFFSET BINARY INIT(1), LENGD BINARY INIT(0), SUMMA(11) FIXED(11) INIT((11)0), P POINTER, D CHAR(6) BASED(P), DATUM CHAR(6), PP POINTER, 1 STR BASED(PP), 2 X CHAR(2), 2 Y CHAR(2), 2 FIRMA CHAR(1), T4 CHAR(4), ANTAL_KONT BINARY INIT(0), TOT_ANTAL_KONT BINARY INIT(0), VERSION CHAR(47) INIT(' V10 Version 1.2 790323'); KONTORED:PROC; DCL KFLAGG BINARY INIT(0); KONTO2='-----------'; RKONTO='-----.---.---'; T1=SUBSTR(BUFF,1,1); IF T1¬='8' & T1¬='9' & Y='5 ' THEN DO; T1=SUBSTR(BUFF,7,1); I=6; J=7; TYP2=1; IF INDEX('0123456789',T1)¬=0 THEN GO TO K1; T1=SUBSTR(BUFF,11,1); I=9; J=11; TYP2=2; IF INDEX('0123456789',T1)=0 THEN GO TO KUT; K1: DO K=1 TO 3; SUBSTR(KONTO2,I,1)=T1; SUBSTR(RKONTO,J,1)=T1; T1=SUBSTR(BUFF,J+1,1); IF INDEX('0123456789',T1)=0 THEN GO TO KUT; J=J+1; I=I+1; END; GO TO KUT; END; J=0; TYP2=0; DO I=1 TO 11; IF I=6 ö I=9 THEN J=J+2; ELSE J=J+1; T1=SUBSTR(BUFF,J,1); IF INDEX('0123456789',T1)=0 & LENGD>0 THEN GO TO KUT; IF INDEX('0123456789',T1)¬=0 THEN DO; SUBSTR(KONTO2,I,1)=T1; SUBSTR(RKONTO,J,1)=T1; LENGD=LENGD+1; END; ELSE DO; OFFSET=OFFSET+1; SUBSTR(KONTO2,I,1)='-'; SUBSTR(RKONTO,J,1)='-'; END; END; KUT: IF KFLAGG=0 THEN DO; KONTO1=KONTO2; KFLAGG=1; TYP1=TYP2; END; RETURN; END; SRED:PROC; J=14; DO I=11 TO 1 BY -1; IF (I=5) ö (I=8) THEN J=J-2; ELSE J=J-1; IF SUBSTR(BUFF,J,1)='S' THEN DO; STAB(I)=1; SUBSTR(S_MARK,J,1)='S'; END; ELSE DO; STAB(I)=0; END; END; RETURN; END; RUB:PROC; I_R=LISTTYP; PUT SKIP(R+3) EDIT(NAMN(FIRMA-7))(A(20))(RTEXT(I_R))(A(35))('19')(A) (SUBSTR(DATUM,1,2))(A)('-')(A)(SUBSTR(DATUM,3,2))(A)('-')(A) (SUBSTR(DATUM,5,2))(A(5))('SID')(A(4))(SIDA)(A) SKIP EDIT ('Fr.o.m konto')(A(13))(RKONTO1)(A)(', till konto')(A(13))(RKONTO2) (A) SKIP EDIT(' ')(A(13))(S_MARK)(A) SKIP EDIT('Fr.o.m datum')(A(13)) (DATUM1)(A(7))('till datum')(A(11))(DATUM2)(A(7))('m.a.p')(A(6)) (RTEXT(SPTYP+2))(A) SKIP EDIT(' ')(A(12))('KONTO')(A(18))(RTEXT(I_R+4)) (A)(' ')(A(6))('BELOPP')(A(13))(RTEXT(I_R+6))(A) SKIP; SIDA=SIDA+1; R = RADANT - 8; RETURN; END; STYRDATA:PROC; PUT FILE(D) SKIP EDIT(VERSION)(A(49))(RTEXT(Y-3))(A(47)) ('Fr.o.m. KONTO')(A(47))('Till KONTO')(A(47))('SUMMERING')(A); J=128; CALL MOVEBUFF(J); CALL TYPIST(RKONTO1,13); CALL TYPIST('┣10┫',1); GET SKIP LIST(BUFF); CALL KONTORED; RKONTO1=RKONTO; PUT FILE(D) EDIT(RKONTO1)(A); J=175; CALL MOVEBUFF(J); IF OFFSET>1 THEN GO TO S15; CALL TYPIST(RKONTO2,13); CALL TYPIST('┣10┫',1); S1: GET SKIP LIST(BUFF); CALL KONTORED; S15: RKONTO2=RKONTO; IF (KONTO1>KONTO2) ö (TYP1¬=TYP2) THEN GO TO S1; PUT FILE(D) EDIT(RKONTO2)(A); J=222; CALL MOVEBUFF(J); IF OFFSET>1 THEN GO TO S17; CALL TYPIST(S_MARK,13); CALL TYPIST('┣10┫',1); GET SKIP LIST(BUFF); CALL SRED; S17: PUT FILE(D) EDIT(S_MARK)(A(15))('DATUMSPÄR')(A(47)) ('1 = PERDATUM')(A(47))('2 = BOKDATUM')(A(44)); S4: GET SKIP LIST(SPTYP); IF SPTYP<1 ö SPTYP>2 THEN GO TO S4; PUT FILE(D) EDIT(SPTYP)(A(3))('Fr.o.m DATUM')(A(47)) ('Till DATUM')(A); J=417; CALL MOVEBUFF(J); S3: GET SKIP LIST(D); CALL DATCHECK(DATUM1); IF DATUM1='0 ' THEN GO TO S3; PUT FILE(D) EDIT(DATUM1)(A); J=464; CALL MOVEBUFF(J); S2: GET SKIP LIST(D); CALL DATCHECK(DATUM2); IF DATUM1>=DATUM2 THEN GO TO S2; D='0'; PUT FILE(D) EDIT(DATUM2)(A); IF TYP1=1 THEN Y='6 '; IF TYP1=2 THEN Y='7 '; IF Y='4 ' THEN LISTTYP=1; ELSE LISTTYP=2; DAT1BIN=372*(SUBSTR(DATUM1,1,2)-78)+31*(SUBSTR(DATUM1,3,2)-1)+ SUBSTR(DATUM1,5,2)-1; DAT2BIN=372*(SUBSTR(DATUM2,1,2)-78)+31*(SUBSTR(DATUM2,3,2)-1)+ SUBSTR(DATUM2,5,2)-1; RETURN; END; STARTPOST:PROC; RCODE=0; PK=ADDR(AREA); OPEN VERBELOP; CALL SEOF(VERBELOP); MAX=UNSPEC(VERBELOP); UNSPEC(VERBELOP)=0; IF OFFSET>1 THEN DO; READ FILE(VERBELOP) INTO(BSTR); GO TO ST2; END; J=INDEX(KONTO1,'-')-1; IF J=1 THEN DO; KT1=KONTO1; ON ERROR GO TO ST1; READ KEY(KT1) FILE(VERBELOP) INTO(AREA); END; IF J=2 THEN DO; KT2=KONTO1; ON ERROR GO TO ST1; READ KEY(KT2) FILE(VERBELOP) INTO(AREA); END; IF J=3 THEN DO; KT3=KONTO1; ON ERROR GO TO ST1; READ KEY(KT3) FILE(VERBELOP) INTO(AREA); END; IF J=4 THEN DO; KT4=KONTO1; ON ERROR GO TO ST1; READ KEY(KT4) FILE(VERBELOP) INTO(AREA); END; IF J=5 THEN DO; KT5=KONTO1; ON ERROR GO TO ST1; READ KEY(KT5) FILE(VERBELOP) INTO(AREA); END; IF J=6 THEN DO; KT6= KONTO1; ON ERROR GO TO ST1; READ KEY(KT6) FILE(VERBELOP) INTO(AREA); END; IF J=7 THEN DO; KT7=KONTO1; ON ERROR GO TO ST1; READ KEY(KT7) FILE(VERBELOP) INTO(AREA); END; IF J=8 THEN DO; KT8=KONTO1; ON ERROR GO TO ST1; READ KEY(KT8) FILE(VERBELOP) INTO(AREA); END; IF J=9 THEN DO; KT9=KONTO1; ON ERROR GO TO ST1; READ KEY(KT9) FILE(VERBELOP) INTO(AREA); END; IF J=10 THEN DO; KT10=KONTO1; ON ERROR GO TO ST1; READ KEY(KT10) FILE(VERBELOP) INTO(AREA); END; IF J=-1 THEN DO; KT11=KONTO1; ON ERROR GO TO ST1; READ KEY(KT11) FILE(VERBELOP) INTO(AREA); END; GO TO ST2; ST1: IF ONCODE¬=4 THEN DO; PUT SKIP LIST('LÄSFEL I VERBELOP',RCODE); D=DATUM; CALL PLOAD('Q '); END; RCODE=1; RETURN; ST2: KONTONRG=KONTONR; UNSPEC(VERBELOP)=UNSPEC(VERBELOP)-1; BLOCKANT=MAX-UNSPEC(VERBELOP); JJ=5; JK=0; IF (LISTTYP=1) ö (SPTYP=2) THEN DO; OPEN VERTEXT; READ FILE(VERTEXT) INTO(TSTR); KONSTANT=VERNRT; END; RETURN; END; POST:PROC; P1: JJ=JJ+1; IF JJ>5 THEN DO; IF JK<1 THEN DO; IF BLOCKANT>0 THEN DO; JK=255; IF JK>BLOCKANT THEN JK=BLOCKANT; BLOCKANT=BLOCKANT-JK; CALL RD(VERBELOP,AREA,JK,RCODE); IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I VERBELOP',RCODE); PK=ADDR(AREA); END; ELSE DO; KONTONR='99999999999'; PDATUM=DAT1BIN; DATUMT=DAT1BIN; RETURN; END; END; ELSE DO; UNSPEC(PK)=UNSPEC(PK)+BSTRL; END; JK=JK-1; JJ=1; END; UNSPEC(PB)=UNSPEC(PK)+JJ*10+1; IF PDATUM=0 THEN GO TO P1; RETURN; END; DATTEST:PROC; RCODE=0; IF (SPTYP=2) & (PDATUM<0) THEN DO; IF VERNR¬=VERNRT THEN DO; UNSPEC(VERTEXT)=VERNR-KONSTANT; ON ERROR GO TO D1; ON ENDFILE GO TO D1; READ FILE(VERTEXT) INTO(TSTR); END; IF (DAT1BIN>DATUMT) ö (DAT2BIN<=DATUMT) THEN RCODE=1; END; ELSE DO; IF PDATUM<0 THEN PDATUM=-PDATUM; IF (DAT1BIN>PDATUM) ö (DAT2BIN<=PDATUM) THEN RCODE=1; END; RETURN; D1: PUT SKIP LIST('LÄSFEL I VERTEXT',ONCODE); R=R-1; RCODE=1; RETURN; END; KONTOTEST:PROC; RCODE=0; IF SUBSTR(KONTONR,OFFSET,LENGD)=SUBSTR(KONTO2,OFFSET,LENGD) THEN RETURN; IF KONTONR¬='99999999999' THEN RCODE=1; RETURN; END; SKRIV_SUMMA:PROC; T13=' '; T11=T13; DO I=2 TO 11; SUMMA(I)=SUMMA(I)+SUMMA(1); END; T4=ANTAL_KONT; TOT_ANTAL_KONT=TOT_ANTAL_KONT+ANTAL_KONT; DO I=1 TO 11; IF SUBSTR(KONTONRG,I,1)¬=SUBSTR(KONTONR,I,1) THEN GO TO SKR1; END; SKR1: DO N=11 TO 1 BY-1; IF SUBSTR(KONTONRG,N,1)¬='0' THEN GO TO SKR2; END; SKR2: IF R<8 THEN CALL RUB; K=11; SKR3: DO J=1 TO 12-I; IF STAB(12-J)=1 THEN DO; IF R<2 THEN CALL RUB; SUBSTR(T11,K,1)='*'; K=K-1; CALL BELRED(SUMMA(J),T14); M=0; T13=' '; DO L=1 TO 12-J; M=M+1; IF (L=6) ö (L=9) THEN DO; SUBSTR(T13,M,1)='.'; M=M+1; END; SUBSTR(T13,M,1)=SUBSTR(KONTONRG,L,1); END; IF LISTTYP=1 THEN M=28; ELSE M=2; PUT SKIP EDIT(T11)(A(12))(T13)(A)(' ')(A(M))(T14)(A(33))(T4)(A); T4=' '; R=R-1; END; SUMMA(J)=0; END; KONTONRG=KONTONR; SUMMA(1)=0; IF K¬=11 THEN DO; PUT SKIP; R=R-1; ANTAL_KONT=0; END; RETURN; END; POSTSKRIV:PROC; IF R<8 THEN CALL RUB; IF VERNR¬=VERNRT THEN DO; UNSPEC(VERTEXT)=VERNR-KONSTANT; ON ERROR GO TO P3; ON ENDFILE GO TO D1; READ FILE(VERTEXT) INTO(TSTR); GO TO P2; P3: TEXT='**** FINNS EJ'; DATUMT=PDATUM; P2: END; I=0; DO J=1 TO 11; IF (J=6) ö (J=9) THEN DO; I=I+1; SUBSTR(T13,I,1)='.'; END; I=I+1; SUBSTR(T13,I,1)=SUBSTR(KONTONR,J,1); END; IF PDATUM<0 THEN PDATUM=-PDATUM; IIII=DATUMT; CALL BINTOCH(IIII,T61); CALL BINTOCH(PDATUM,T62); CALL BELRED(BELOPP,T14); IF T61=T62 THEN T62=' '; PUT SKIP EDIT(' ')(A(12))(T13)(A(18))(T61)(A(8))(T62)(A(8)) (VERNR)(P'-----9',X(1))(T14)(A(18))(TEXT)(A); R=R-1; RETURN; END; /* H Ä R B Ö R J A R H U V U D P R O G R A M M E T */ START: PUT FILE (D) SKIP EDIT (' Hur många rader har blanketten? ') (A(45)); GET LIST (RADANT); IF RADANT < 30 ö RADANT > 80 THEN GO TO START; CALL DATCHECK(DATUM); IF DATUM='0 ' THEN CALL PLOAD('Q '); UNSPEC(P)=16570; D='0'; UNSPEC(PP)=16616; L0: CALL STYRDATA; IF Y='6 ' ö Y='7 ' THEN DO; D=DATUM; CALL PLOAD('V12 '); END; CALL STARTPOST; IF RCODE=1 THEN GO TO L0; L1: CALL POST; CALL DATTEST; IF RCODE¬=0 THEN GO TO L1; IF OFFSET>1 THEN DO; CALL KONTOTEST; IF RCODE¬=0 THEN GO TO L1; IF KONTONR='99999999999' THEN DO; IF R<3 THEN CALL RUB; CALL BELRED(SUMMA(1),T14); T4=ANTAL_KONT; TOT_ANTAL_KONT=ANTAL_KONT; PUT SKIP EDIT(RKONTO1)(X(12),A(41))(T14)(A(33))(T4)(A); R=R-1; END; END; ELSE DO; IF KONTONR>=KONTO2 THEN KONTONR='99999999999'; IF KONTONR¬=KONTONRG THEN CALL SKRIV_SUMMA; END; IF KONTONR='99999999999' THEN GO TO UT; IF LISTTYP=1 THEN CALL POSTSKRIV; SUMMA(1)=SUMMA(1)+BELOPP; ANTAL_KONT=ANTAL_KONT+1; GO TO L1; UT: IF TOT_ANTAL_KONT=0 THEN DO; CALL OUTPUT(1,6); PUT SKIP(2) EDIT('**** INGEN KONTERING INOM BEGÄRT OMRÅDE')(A); R=R-2; END; IF R¬=0 THEN PUT SKIP(R); D=DATUM; CALL PLOAD('Q '); END;