|
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: 9401 (0x24b9)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BOKSLUT1«
└─⟦7bb65a061⟧ Bits:30008625 DDMQ1-0065_Reflex_MSAB_Bokf_system_diskett_1_2_Sid2_Alla_pgm_PL1_781120_side0
└─⟦this⟧ »BOKSLUT1«
└─⟦aeb45b905⟧ Bits:30008623 DDMQ1-0063__LMC_Original_Generella_pgm_for_bokforing_Sid1_PL1_Sid2_kompil_781105_side1
└─⟦this⟧ »BOKSLUT1«
└─⟦cfd478037⟧ Bits:30008627 DDMQ1-0066_MSAB_ref_ex_Bokf_system_NFK_diskett_2_2_781120_side0
└─⟦this⟧ »BOKSLUT1«
└─⟦d1c33ffd3⟧ Bits:30008583 DDMQ1-0017_Bokforingssystem_kallkod_Msab_790411
└─⟦this⟧ »BOKSLUT1«
└─⟦d4a65d31f⟧ Bits:30008722 DDMQ1-0163_MSAB_Bokf_pgm_i_PL1_781112_TD
└─⟦this⟧ »BOKSLUT1«
└─⟦f4c608b16⟧ Bits:30008624 DDMQ1-0064_LMC_Kopia_Generall_pgm_for_bokforing_Endast_PL1-vers_781105_B
└─⟦this⟧ »BOKSLUT1«
/*FÖRSTA RADEN*/
/*BOKSLUT RÅBALANS T.O.M SENASTE REG. HUVUDBOK GENERELLT PGM.
KLART: 781104 PROGR:TD*/
DCL 1 DUM,2 DUM1 CHAR(3),2 BUDKOD CHAR(1),2 DUM2 CHAR(51);
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD CHAR(3),
2 SAD(12) FIXED(11,2),2 SAK(12) FIXED(11,2);
DCL 1 KTX,2 KSTR,3 TKO FIXED(4),3 TKOD CHAR(1),2 TKO2 CHAR(4),2 TEXT CHAR(34),
2 IB FIXED(13,2);
DCL 1 DATREC,2 XDAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 KOD FIXED(1);
DCL DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
DAG CHAR(6),SAMFIL FILE,
D4 FIXED(13,2),K4 FIXED(13,2),KIB FIXED(13,2),US FIXED(13,2),
TI FIXED(13,2),TD FIXED(13,2),TK FIXED(13,2),
XSKO FIXED(4),TXT CHAR(34),RECNR BINARY,SAMSLUT BINARY,
KTOSLUT BINARY,C CHAR(17)INIT('------------9V.99'),
CC CHAR(17)INIT('-----------9V.99*'),
CCC CHAR(16)INIT('-----9V.99% '),CCCC CHAR(15)INIT('----9V.99% '),
D CHAR(4)INIT('ZZZ9'),E CHAR(12)INIT('-------9V.9 '),
EE CHAR(12)INIT('-------9V.9*'),J FIXED(4),K FIXED(4),L FIXED(4);
ABORT:PROC(ABTX);
DCL ABTX CHAR(15);
PUT SKIP EDIT('FEL! ')(A)(ABTX)(A)SKIP(RAD-4);GOTO SLUTT;
RETURN;
END;
RUB:PROC;
SIDA=SIDA+1;PUT SKIP(RAD)EDIT('RÅBALANS FÖR BOKSLUTSTRANSAKTIONER')(A)
(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A(30))('** BOKSLUTSTABLÅ **')
(A)SKIP EDIT('')(A(90))('(BOKFÖRINGSORDER)')(A)SKIP(2)EDIT
('KTO')(A(13))('ING. SALDO')(A(18))('ACK. DEB')(A(16))('ACK. KRE')(A(14))
('UTG. SALDO')(A(29))('KONTO')(A(11))('DEB')(A(10))('KRE')(A)SKIP EDIT
('')(A(9))('(VID ÅRETS BÖRJAN)')(A)SKIP;RAD=43;
RETURN;END;
SUBA:PROC(SUBKO);
DCL SUBKO FIXED(4);
IF RAD<12 THEN CALL RUB;
IF SUBKO=9999 THEN GOTO TOTUT;
IF KIB¬=0öD4¬=0öK4¬=0 THEN DO;
US=KIB+D4-K4;
IF SUBKO>2999 THEN DO;KIB=-KIB;US=-US;END;
PUT SKIP(2) EDIT(SUBKO)(A(7))(KIB)(PC)(D4)(PC)(K4)(PC)(US)(PC);
RAD=RAD-2;XKTO=SUBKO;END;
TI=TI+KIB;TD=TD+D4;TK=TK+K4;KIB=0;D4=0;K4=0;
RETURN;
TOTUT:IF RAD<14 THEN CALL RUB;
PUT SKIP(3)EDIT('TOTALT')(A(7))(TI)(PC)(TD)(PC)(TK)(PC)(TI+TD-TK)(PC)
SKIP(RAD-8);
GO TO SLUTT;
RETURN;
END;
PROCB:PROC; /*UPPREPAR ACKUMULERING AV SALDON OCH LÄSNING I SAMFIL
TILLS ETT RECORD MED ANNAT KONTONUMMER HITTAS,ELLER FILEN TAR SLUT*/
KIB=IB;
SAMIN:XSKO=SKO;
DO I=1 TO 12;D4=D4+SAD(I);K4=K4+SAK(I);END;
ON ENDFILE GOTO SAMUT;READ FILE(SAMFIL)INTO(SAM);
GOTO SAMOK;
SAMUT:SAMSLUT=1;
SAMOK:IF SAMSLUT=0 & XSKO=SKO THEN GOTO SAMIN;
RETURN;END;
PROCC:PROC; /*UPPREPAR LÄSNING I KTOTX,OCH HOPPAR ÖVER BUDGET,TILLS ETT
RECORD MED ANNAT KONTONUMMER HITTAS, ELLER FILEN TAR SLUT*/
UNSPEC(KTOTX)=RECNR;
KTOIN:ON ENDFILE GOTO KTOUT;READ FILE(KTOTX)INTO(DUM);
RECNR=UNSPEC(KTOTX);GOTO KTOOK;
KTOUT:KTOSLUT=1;GOTO KTOKLAR;
KTOOK:IF BUDKOD='A' THEN GOTO KTOKLAR;
GOTO KTOIN;
KTOKLAR:CALL SUBA(TKO);
KTX=DUM;
RETURN;END;
OPEN KTOTX;OPEN DATFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF XDAG='XXXXXX' THEN GO TO SLUTT;
DAG=XDAG;XDAG='XXXXXX';
REWRITE FILE(DATFIL)FROM(DATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** RÅBALANS FÖR BOKSLUT ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
PUT FILE(D)SKIP EDIT(' ')(A(43))('*** UTSKRIFT PÅGÅR ***')(A(67));
DEL=0;RECNR=0;RAD=5;SIDA=0;IND=1;SAMSLUT=0;KTOSLUT=0;
KIB=0;D4=0;K4=0;TI=0;TD=0;TK=0;
/*START AV SJÄLVA PROGRAMMET!*/
START:SAMSLUT=1;
ON ENDFILE GOTO A0000;READ FILE(SAMFIL)INTO(SAM);SAMSLUT=0;
A0000:UNSPEC(KTOTX)=UNSPEC(KTOTX)+10;
ON ENDFILE GOTO A0X;READ FILE(KTOTX)INTO(KTX);
IF TKO<1000 THEN GOTO A0000;
A0X:UNSPEC(KTOTX)=UNSPEC(KTOTX)-11;
IF UNSPEC(KTOTX)<0 THEN UNSPEC(KTOTX)=0;
A0:ON ENDFILE GO TO KTOUT2;READ FILE(KTOTX)INTO(KTX);
IF TKO<1000 THEN GO TO A0;GOTO KTOOK2;
KTOUT2:KTOSLUT=1;
KTOOK2:RECNR=UNSPEC(KTOTX);
NY:
IF KTOSLUT=1 & SAMSLUT=1 THEN GO TO AVSLUTA;
IF TKOD¬='A' THEN CALL ABORT('TKOD EJ "A"');
IF(SAMSLUT=0 & SKO<TKO) ö (KTOSLUT=1)THEN CALL ABORT('');
IF SAMSLUT=0 & KTOSLUT=0 & SKO=TKO THEN GO TO BOTH;
ONE:KIB=IB;
CALL PROCC;
GOTO NY;
BOTH:
CALL PROCB;
CALL PROCC;
GOTO NY;
AVSLUTA:SKO=9999;CALL SUBA(SKO);
GOTO SLUT;
SLUT:PUT SKIP(RAD-6);
SLUTT:CALL LOAD('BOKRUT',6);END;