|
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: 12245 (0x2fd5)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V91«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V91«
/* V91 SKRIVER UT EN AVSTÄMNINGSLIST ÖVER SAMTLIGA VERIFIKATIONER
I TRANSFIL
DVS SUMMERAR SAMMAN KONTERINGAR MED SAMMA ANDRASIFFRA I KONTONUMMMRET
SAMT ETT TOTALT SALDO LISTAN OMFATTAR ÄVEN UPPGIFT OM OM INGÅENDE VERNR
VERSION 1:3. Grupptotaler från 0 TILL 9 inlagda
PRG JÅ 780915 */
DCL AREAP POINTER,
1 VERSTR BASED(AREAP),
2 KONTO FIXED(11),
2 VERNR FIXED(5),
2 BOKDAG FIXED(5),
2 PERDAG FIXED(5),
2 BELOPP FIXED(11),
2 TEXT CHAR(13),
TRANSL BINARY INIT(34);
/* 34 BYTES */
DCL 1 AREA,
2 CH(100) CHAR(100);
/* 10 000 BYTES */
DCL NR BINARY,
T11 CHAR(11),
SALDO FIXED(11) INIT(0),
MAX BINARY,
RCODE BINARY,
TRANSFIL FILE,
SUMMA(0:9) FIXED(11) INIT((10)0),
T40 CHAR(40) INIT('AVSTÄMNINGSLISTA,VERIFIKATIONER'),
FELTAB(10) CHAR(47) INIT(
'SEKTOR HEADER NOT FOUND',
'READ ERROR',
'WRITE ERROR',
'KEY NOT FOUND',
'NÅGON DISKETT HAR FLYTTATS',
'EN AV FILERNA ÄR FÖR LITEN',
'EN AV FILERNA ÄR SKRIVSKYDDAD'),
T14 CHAR(14),
M BINARY INIT(0),
NAMN(2) CHAR(10) INIT('KVV/KWAROS','AROS'),
P POINTER,
D BASED(P) CHAR(6),
DATUM CHAR(6),
PP POINTER,
1 STRX BASED(PP),
2 X CHAR(2),
2 Y CHAR(2),
2 FIRMA CHAR(1),
2 OP_KOD BINARY,
2 RADANT BINARY,
VERSION CHAR(47) INIT(' V9 Version 1.3 800701');
FILOPEN:PROC;
OPEN TRANSFIL;
CALL SEOF(TRANSFIL);
MAX=UNSPEC(TRANSFIL);
UNSPEC(TRANSFIL)=0;
INPOSTER=0;
RETURN;
END;
POST:PROC;
IF INPOSTER=0 THEN DO;
IF MAX=0 THEN DO;
RCODE=10;
RETURN;
END;
J=255;
IF J>MAX THEN J=MAX;
MAX=MAX-J;
CALL RD(TRANSFIL,AREA,J,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I TRANSFIL',RCODE);
INPOSTER=J-1;
AREAP=ADDR(AREA);
END;
ELSE DO;
INPOSTER=INPOSTER-1;
UNSPEC(AREAP)=UNSPEC(AREAP)+TRANSL;
END;
RETURN;
END;
SKRIV:PROC;
PUT SKIP(3) EDIT(NAMN(FIRMA-7))(A(20));
IF Y='3 ' THEN PUT EDIT('PRELIMINÄR')(A(11));
PUT EDIT(T40)(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))('1')(A) SKIP(3) EDIT(' ')(A(20))('Ver.nr')(A(8))
(NR)(A)(' - ')(A)(VERNR)(A) SKIP(3) EDIT(' ')(A(20))
('KONTO +/- BELOPP')(A) SKIP;
DO I = 0 TO 9;
PUT SKIP EDIT(' ')(A(20))(FIRMA)(A)(I)(A)('xxx')(A(7));
IF SUMMA(I)>0 THEN PUT EDIT('+')(A);
IF SUMMA(I)<0 THEN PUT EDIT('-')(A);
IF SUMMA(I)=0 THEN PUT EDIT(' ')(A);
SALDO=SALDO+SUMMA(I);
IF SUMMA(I)<0 THEN SUMMA(I)=-SUMMA(I);
CALL BELRED(SUMMA(I),T14);
PUT EDIT(T14)(A);
END;
CALL BELRED(SALDO,T14);
PUT SKIP(2) EDIT(' ')(A(20))('SALDO')(A(10))(T14)(A) SKIP(RADANT - 21);
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: CALL DATCHECK(DATUM);
IF DATUM='0 ' THEN GO TO SLUT;
UNSPEC(P)=16570;
UNSPEC(PP)=16616;
D='0';
PUT FILE(D) SKIP EDIT(VERSION)(A(96))
('UTSKRIFT AV AVSTÄMNINGSLISTA')(A(45));
CALL CORED(0);
CALL FILOPEN;
IF MAX=0 THEN GO TO SLUT;
L1: CALL POST;
IF RCODE¬=0 THEN GO TO FEL;
IF M=0 THEN DO;
NR=VERNR;
M=1;
END;
T11=KONTO;
IF SUBSTR(T11,1,1)¬=FIRMA THEN DO;
PUT SKIP(5) EDIT(T40)(A) SKIP(5)
EDIT('FRÄMANDE POSTER I TRANSFILEN ******')(A) SKIP(38);
CALL OUTPUT(1,6);
D=DATUM;
CALL PLOAD('Q ');
END;
K=SUBSTR(T11,2,1);
SUMMA(K)=SUMMA(K)+BELOPP;
GO TO L1;
FEL: IF RCODE=10 THEN DO;
CALL SKRIV;
GO TO SLUT;
END;
PUT SKIP(3) LIST('LÄSFEL I TRANSFIL',FELTAB(RCODE)) SKIP(45);
SLUT: D=DATUM;
IF Y¬='3 ' & SALDO=0 THEN CALL PLOAD('V6 ');
CALL PLOAD('Q ');
END;