|
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: 9796 (0x2644)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »HUVBOK1«
└─⟦1f3202981⟧ Bits:30008731 DDMQ1-0173_MSAB_Bokföring_Alla_Program_i_PL1_ref_ex_780428
└─⟦this⟧ »HUVBOK1«
/*FÖRSTA RADEN*/
/*HUVBOK UTSKRIFT AV HUVUDBOK PER KONTO UNDER RESP ANGIVEN MÅNAD
KLART: 780428 FÖR MSAB PROGR:TD */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 VER,2 KO CHAR(4),2 AVD CHAR(2),2 DAT CHAR(4),
2 VERNR FIXED(5),2 VTX CHAR(20),2 BEL FIXED(11,2),2 KOD CHAR(1);
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),
3 SMNR FIXED(2),
2 SAD FIXED(11,2),2 SAK FIXED(11,2),2 HJKOD CHAR(1);
DCL 1 KTO,2 KONTO FIXED(4),2 TEXT CHAR(34);
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(1),2 XCO FIXED(1);
XDAG='XXXXXX ';XMNR=0;
DCL 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 CHAR(4),XAVD CHAR(2),XDAT CHAR(4),PD FIXED(13,2),
PK FIXED(13,2),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(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
KIB FIXED(13,2);
OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO SLUTT;
DO I=1 TO 14;XSK(I)=SK(I);END;XCO=CO;
REWRITE FILE(DATFIL)FROM(XDATREC);
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 ANSTÄLLD')(A(74))
('"3"=KOMBINERAD LISTA OCH REGISTRERING FÖR RESULTAT- OCH BALANSRÄKNING')
(A(74));GET SKIP LIST(S);IF VERIFY(S,'123')=0 THEN GO TO TAB;
PUT FILE(D)SKIP;
PUT FILE(D) EDIT(' ')(A(42))('*** UTSKRIFT PÅGÅR ***')(A(69));
IF S='1' THEN DO;REG=0;DEL=0;END;IF S='2' THEN DO;REG=0;DEL=1;END;
IF S='3' THEN DO;REG=1;DEL=0;END;
IF REG=1 THEN DO;
JJJ=SUBSTR(DAG,3,2);
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 100;END;END;
GET SKIP LIST(S);GO TO SLUTT;
END;END;
IF REG=1 THEN DO;XSK(13)=' ';REWRITE FILE(DATFIL)FROM(XDATREC);END;
JUMP=0;RAD=5;SIDA=0;IND=1;PD=0;PK=0;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;PUT SKIP(RAD)EDIT('HUVUDBOK FÖR MÅNAD ')(A)(MON)(A(4));
IF DEL=1 THEN PUT EDIT('UPPDELAD PER ANST. ')(A);
IF REG=1 THEN PUT EDIT('MED REG. FÖR BALANS- OCH RESULTAT.')(A);
PUT EDIT(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('KONTO')(A(6))('ANST')(A(10))('DAT')(A(6))('VER.NR')(A(8))('TEXT')(A(34))
('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;SKO=KO;
ON ERROR GO TO PRT;
READ KEY(SKO)FILE(SAMFIL)INTO(SAM);
RECNR=UNSPEC(SAMFIL);
TEST:IF SKO¬=KO THEN GO TO PRT;
IF SMNR<MNR THEN KIB=KIB+SAD-SAK;
ON ENDFILE GO TO PRT;
READ FILE(SAMFIL)INTO(SAM);
GO TO TEST;
PRT:JUMP=1;IF RAD<12 THEN GO TO RUB;
IF IND=1öKO¬=XKO THEN PUT SKIP EDIT(KO)(A(7));ELSE PUT SKIP EDIT(' ')(A(7));
RAD=RAD-1;
IF IND=1öXAVD¬=AVDöXKO¬=KO THEN PUT EDIT(AVD)(A(4));
ELSE PUT EDIT(' ')(A(4));
IF IND=1öDAT¬=XDATöXKO¬=KO THEN PUT EDIT(DAT)(P'ZZZ99.99',X(2));
ELSE PUT EDIT(' ')(A(10));
PUT EDIT(VERNR)(P'ZZZZZZ9',X(2))(VTX)(A(21));
IF KOD='K' THEN PUT EDIT(' ')(A(18));
PUT EDIT(BEL)(PC);
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öXKO¬=KOöAVD¬=XAVD THEN GO TO NYAVD;
GO TO PRT;
NYAVD:JUMP=3;IF RAD<12 THEN GO TO RUB;
IF XKO=KO&XAVD¬=AVD THEN Q=1;
IF DEL=1&Q=1 THEN DO;PUT SKIP EDIT(' TOTALT FÖR')(A(16))(XAVD)
(A(36))(AD)(PCCC)(AK)(PCCC)(AD-AK)(PCCC)SKIP;RAD=RAD-2;END;
AKLAR:KD=KD+AD;KK=KK+AK;AD=0;AK=0;
IF IND=-1öXKO¬=KO THEN GO TO NYKO;
GO TO PRT;
NYKO:JUMP=4;IF RAD<12 THEN GO TO RUB;
SKO=XKO;SMNR=MNR;
ON ERROR GO TO WRK;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
SAD=KD;SAK=KK;HJKOD=' ';
REWRITE FILE(SAMFIL)FROM(SAM);GO TO KKLAR;
WRK:UNSPEC(SAMFIL)=0;CALL SEOF(SAMFIL);
SAD=KD;SAK=KK;HJKOD=' ';
WRITE FILE(SAMFIL)FROM(SAM);CLOSE SAMFIL;OPEN SAMFIL;
KKLAR:ON ERROR GO TO EJTXT;READ KEY(SKO)FILE(KTOTX)INTO(KTO);GO TO KOPRT;
EJTXT:TEXT='*** KONTOT SAKNAS I KONTOPLANEN ';
KOPRT:PUT SKIP EDIT(XKO)(A(9))(TEXT)(A(45))(KD)(PCC)(KK)(PCC)(KD-KK)(PCC)
(KIB+KD-KK)(PC)SKIP;RAD=RAD-2;
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:PUT SKIP(2)EDIT('**** TOTALT UNDER MÅNADEN:')(A(51))(TD)(PC)(TK)(PC)
SKIP(RAD-7);
SLUTT:CALL LOAD('BOKRUT',6);END;