|
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: 11771 (0x2dfb)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »HUVBOK1«
└─⟦7bb65a061⟧ Bits:30008625 DDMQ1-0065_Reflex_MSAB_Bokf_system_diskett_1_2_Sid2_Alla_pgm_PL1_781120_side0
└─⟦this⟧ »HUVBOK1«
└─⟦cfd478037⟧ Bits:30008627 DDMQ1-0066_MSAB_ref_ex_Bokf_system_NFK_diskett_2_2_781120_side0
└─⟦this⟧ »HUVBOK1«
/*FÖRSTA RADEN*/
/*HUVBOK UTSKRIFT AV HUVUDBOK PER KONTO UNDER RESP ANGIVEN MÅNAD
GENERELLT PGM. KLART: 781104 PROGR:TD */
DCL 1 VER,2 KO FIXED(4),2 AVD CHAR(3),2 DAT FIXED(4),
2 VERNR FIXED(7),2 VTXT CHAR(20),2 BEL FIXED(11,2),2 KOD CHAR(1);
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 KONTO FIXED(4),3 Z CHAR(1),2 K CHAR(4),2 TEXT CHAR(34),
2 IB FIXED(13,2);
DCL 1 KBU,2 BSTR,3 XKONTO FIXED(4),3 XZ CHAR(1),2 XKAVD CHAR(3),
2 XBUD(12) FIXED(7);
DCL 1 DATREC,2 XDAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1);
DCL VERFIL FILE,DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),
IND FIXED(1),SAMFIL FILE,Q FIXED(1),NYREG FIXED(1),
XKO FIXED(4),XAVD CHAR(3),XDAT FIXED(4),
AD FIXED(13,2),AK FIXED(13,2),KD FIXED(13,2),KK FIXED(13,2),
TD FIXED(13,2),TK FIXED(13,2),REG FIXED(1),DEL FIXED(1),RECNR BINARY,
JUMP FIXED(1),C CHAR(19)INIT('--------------9V.99'),
CC CHAR(19)INIT('-----------9V.99***'),
CCC CHAR(19)INIT('-------------9V.99*'),
DAG CHAR(6),KIB FIXED(13,2),MS FIXED(13,2),US FIXED(13,2),P BINARY;
CALL KFILE(VERFIL);
OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;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))('*** HUVUDBOK ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
TAB:PUT FILE(D)SKIP EDIT('VILKEN TYP AV KÖRNING?')(A(37))
('1 - ENDAST LISTA,MED TOTALER/KONTO')(A(37))
('2 - ----"---- ,MEN MED DELSUMMOR PER AVDELNING')(A(74))
('3 - KOMBINERAD LISTA OCH REGISTRERING FÖR RESULTAT- OCH BALANSRÄKNING')
(A(74))('4 - REGISTRERING UTAN LISTA')(A(35));
GET SKIP LIST(S);IF VERIFY(S,'1234')=0 THEN GO TO TAB;
IF S='1' THEN DO;P=1;REG=0;DEL=0;END;IF S='2' THEN DO;P=1;REG=0;DEL=1;END;
IF S='3' THEN DO;P=1;REG=1;DEL=0;END;IF S='4' THEN DO;P=0;REG=1;DEL=0;END;
IF P=1 THEN PUT FILE(D)SKIP EDIT('')(A(42))('*** UTSKRIFT PÅGÅR ***')(A(32));
IF P=0 THEN PUT FILE(D)SKIP EDIT('')(A(42))('*** REGISTRERING PÅGÅR ***')
(A(32));
OK:
IF REG=1 THEN DO;
JJJ=SUBSTR(DAG,3,2);JJJ=JJJ+6;IF JJJ>12 THEN JJJ=JJJ-12;
IF JJJ=MNR&MNR<12 THEN DO;
PUT FILE(D)SKIP EDIT(' ')(A(37))('FEL! REGISTRERING FÅR ENDAST SKE')(A(37))
('EFTER UTGÅNGEN AV AKTUELL MÅNAD')(A(37))
('TRYCK RETURN')(A(37));
DO JJ=1 TO 5;CALL OUTPUT(1,6);DO JJJ=1 TO 200;END;END;
GET SKIP LIST(S);GO TO SLUTT;
END;END;
IF REG=1 THEN DO;
SK(13)=' ';REWRITE FILE(DATFIL)FROM(DATREC);
END;
JUMP=0;RAD=5;SIDA=0;IND=1;AD=0;AK=0;KD=0;KK=0;TD=0;TK=0;KIB=0;Q=0;
RECNR=0;
ON ENDFILE GO TO SLUTT;READ FILE(VERFIL)INTO(VER);
XAVD=AVD;XKO=KO;XDAT=DAT;
RUB:SIDA=SIDA+1;
IF P=1 THEN PUT SKIP(RAD)EDIT('HUVUDBOK FÖR MÅNAD ')(A)(MON)(A(4));
IF DEL=1&P=1 THEN PUT EDIT('UPPDELAD PER AVD.')(A);
IF REG=1&P=1 THEN PUT EDIT('MED REG. FÖR BALANS- OCH RESULTAT.')(A);
IF P THEN PUT EDIT(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('KONTO')(A(10))('AVD.')(A(6))('BOKF.DAT')(A(10))('VER.NR')(A(8))('TEXT')
(A(35))('DEBET')(A(17))('KREDIT')(A(15))('MÅN.SALDO')(A(21))
('UTG.SALDO')(A)SKIP;
RAD=45;
IF JUMP=0 THEN GO TO NY;IF JUMP=1 THEN GO TO PRT;
IF JUMP=3 THEN GO TO NYAVD;IF JUMP=4 THEN GO TO NYKO;
NY:UNSPEC(SAMFIL)=RECNR;KIB=0;IB=0;
KONTO=KO;Z='A';TEXT='*** SAKNAS I KONTOPLANEN ***';
ON ERROR GO TO X0;READ KEY(KSTR)FILE(KTOTX)INTO(KTX);
X0:KIB=IB;KONTO=KO;
ON ERROR GO TO PRT;
READ KEY(KONTO)FILE(SAMFIL)INTO(SAM);
RECNR=UNSPEC(SAMFIL);
TEST:IF SKO¬=KONTO THEN GO TO PRT;
DO J=1 TO MNR-1;KIB=KIB+SAD(J)-SAK(J);END;
ON ENDFILE GO TO PRT;
READ FILE(SAMFIL)INTO(SAM);
GO TO TEST;
PRT:JUMP=1;IF RAD<12&P=1 THEN GO TO RUB;
IF P=0 THEN GOTO PRTKLAR;
IF IND=1öKO¬=XKO THEN PUT SKIP EDIT(KO)(A(10));ELSE PUT SKIP EDIT(' ')(A(10));
RAD=RAD-1;
IF IND=1öXAVD¬=AVDöXKO¬=KO THEN PUT EDIT(AVD)(A(8));
ELSE PUT EDIT('')(A(8));
IF IND=1öDAT¬=XDATöXKO¬=KO THEN PUT EDIT(DAT)(P'Z99.99',X(2));
ELSE PUT EDIT('')(A(8));
PUT EDIT(VERNR)(A(8))(VTXT)(A(22));
IF KOD='K' THEN PUT EDIT(' ')(A(18));
PUT EDIT(BEL)(PC);
PRTKLAR:IND=0;
XDAT=DAT;XAVD=AVD;XKO=KO;
IF KOD='D' THEN AD=AD+BEL;ELSE AK=AK+BEL;
ON ENDFILE GO TO SISTA;
READ FILE(VERFIL)INTO(VER);
TEST2:IF IND=-1öKO¬=XKOöAVD¬=XAVD THEN GO TO NYAVD;
GO TO PRT;
NYAVD:JUMP=3;IF RAD<12&P=1 THEN GO TO RUB;
IF XKO=KO&XAVD¬=AVD THEN Q=1;
IF DEL=1&Q=1 THEN DO;MS=AD-AK;IF XKO>2999 THEN MS=-MS;
PUT SKIP EDIT(' TOTALT AVD')(A(16))(XAVD)
(A(41))(AD)(PCCC)(AK)(PCCC)(MS)(PCCC)SKIP;RAD=RAD-2;END;
IF XKO>2999®=1 THEN DO;
SKO=XKO;SAVD=XAVD;
ON ERROR GO TO WRA;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
SAD(MNR)=AD;SAK(MNR)=AK;
REWRITE FILE(SAMFIL)FROM(SAM);
GO TO AKLAR;
WRA:UNSPEC(SAMFIL)=0;CALL SEOF(SAMFIL);
DO J=1 TO 12;SAD(J)=0;SAK(J)=0;END;
SAD(MNR)=AD;SAK(MNR)=AK;
WRITE FILE(SAMFIL)FROM(SAM);CLOSE SAMFIL;OPEN SAMFIL;END;
AKLAR:KD=KD+AD;KK=KK+AK;AD=0;AK=0;
IF IND=-1öKO¬=XKO THEN GO TO NYKO;
GO TO PRT;
NYKO:JUMP=4;IF RAD<12&P=1 THEN GO TO RUB;
IF XKO<3000®=1 THEN DO;
SKO=XKO;SAVD=' ';
ON ERROR GO TO WRK;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
SAD(MNR)=KD;SAK(MNR)=KK;
REWRITE FILE(SAMFIL)FROM(SAM);GO TO KKLAR;
WRK:UNSPEC(SAMFIL)=0;CALL SEOF(SAMFIL);
DO J=1 TO 12;SAD(J)=0;SAK(J)=0;END;
SAD(MNR)=KD;SAK(MNR)=KK;
WRITE FILE(SAMFIL)FROM(SAM);CLOSE SAMFIL;OPEN SAMFIL;END;
KKLAR:MS=KD-KK;US=KIB+KD-KK;IF XKO>2999 THEN DO;MS=-MS;US=-US;END;
KOPRT:IF P=1 THEN DO;
PUT SKIP EDIT(XKO)(A(6))(TEXT)(A(53))(KD)(PCC)(KK)(PCC)(MS)(PCC)
(US)(PC)SKIP;RAD=RAD-2;END;
TD=TD+KD;TK=TK+KK;KD=0;KK=0;Q=0;
IF IND=-1 THEN GO TO UT;
GO TO NY;
SISTA:IND=-1;GO TO TEST2;
UT:IF P=1 THEN DO;
PUT SKIP(2)EDIT('**** TOTALT UNDER MÅNADEN:')(A(56))(TD)(PC)(TK)(PC)
SKIP(RAD-7);END;
IF P=0 THEN PUT SKIP EDIT('HUVUDBOK REGISTRERAD FÖR MÅNAD:')(A)(MON)(A)SKIP;
SLUTT:CALL LOAD('BOKRUT',6);END;