|
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: 11692 (0x2dac)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »HUVBOK1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »HUVBOK1«
/*FÖRSTA RADEN*/
/*HUVBOK1 UTSKRIFT AV HUVUDBOK PER KONTO UNDER RESP ANGIVEN MÅNAD
KLART XXXXXX PROGR:TD */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 VER,2 KO FIXED(4),2 AVD FIXED(2),2 PROJ FIXED(4),2 DAT FIXED(4),
2 TYP CHAR(1),2 VERNR FIXED(6),2 BEL FIXED(11,2),2 KOD CHAR(1);
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD FIXED(2),3 SPROJ FIXED(4),3 SSTR2,
4 SMNR FIXED(2),4 BUD CHAR(1),
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);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(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),
XPROJ FIXED(4),XKO FIXED(4),XAVD FIXED(2),XDAT FIXED(4),PD FIXED(12,2),
PK FIXED(12,2),AD FIXED(12,2),AK FIXED(12,2),KD FIXED(12,2),KK FIXED(12,2),
TD FIXED(12,2),TK FIXED(12,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(12,2);
/* H U V U D - P R O G R A M */
OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO UT;
DO I=1 TO 14;XSK(I)=SK(I);END;
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));GET SKIP LIST(S);IF VERIFY(S,'123')=0 THEN GO TO TAB;
PUT FILE(D)SKIP;
IF S='3' THEN XSK(13)=' ';REWRITE FILE(DATFIL)FROM(XDATREC);
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;
NYREG=1;
IF REG=1 THEN DO;SMNR=MNR;BUD=' ';
ON ERROR GO TO OK;READ KEY(SSTR2)FILE(SAMFIL)INTO(SAM)KEYTO(SSTR2);
NYREG=0;
OK: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);
XPROJ=PROJ;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 AVD.')(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(10))('AVD.')(A(6))('BOKF.DAT')(A(10))('TYP')(A(5))('VER.NR')(A(23))
('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=2 THEN GO TO NYPROJ;
IF JUMP=3 THEN GO TO NYAVD;IF JUMP=4 THEN GO TO NYKO;
NY:UNSPEC(SAMFIL)=RECNR;KIB=0;
ON ERROR GO TO PRT;
READ KEY(KO)FILE(SAMFIL)INTO(SAM);
RECNR=UNSPEC(SAMFIL);
TEST:IF SKO¬=KO THEN GO TO PRT;
IF SMNR<MNR&BUD=' ' 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(9));ELSE PUT SKIP EDIT(' ')(A(9));
RAD=RAD-1;
IF IND=1öXAVD¬=AVDöXKO¬=KO THEN PUT EDIT(AVD)(P'ZZZ9 ');
ELSE PUT EDIT(' ')(A(7));
IF IND=1öDAT¬=XDATöXKO¬=KO THEN PUT EDIT(DAT)(P'ZZZ99.99',X(4));
ELSE PUT EDIT(' ')(A(12));
PUT EDIT(TYP)(A(2))(VERNR)(P'ZZZZZZ9',X(4));
IF KOD='K' THEN PUT EDIT(' ')(A(18));
PUT EDIT(BEL)(PC);
IND=0;
XDAT=DAT;XPROJ=PROJ;XAVD=AVD;XKO=KO;
IF KOD='D' THEN PD=PD+BEL;ELSE PK=PK+BEL;
ON ENDFILE GO TO SISTA;
READ FILE(VERFIL)INTO(VER);
TEST2:IF IND=-1öKO¬=XKOöAVD¬=XAVDöPROJ¬=XPROJ THEN GO TO NYPROJ;
GO TO PRT;
NYPROJ:JUMP=2;IF RAD<12 THEN GO TO RUB;
IF XKO>2999®=1 THEN DO;
SKO=XKO;SAVD=XAVD;SPROJ=XPROJ;SMNR=MNR;BUD=' ';
IF NYREG=1 THEN GO TO WRP;
ON ERROR GO TO WRP;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
SAD=PD;SAK=PK;HJKOD=' ';
REWRITE FILE(SAMFIL)FROM(SAM);
GO TO PKLAR;
WRP:UNSPEC(SAMFIL)=0;CALL SEOF(SAMFIL);
SAD=PD;SAK=PK;HJKOD=' ';
WRITE FILE(SAMFIL)FROM(SAM);CLOSE SAMFIL;OPEN SAMFIL;END;
PKLAR:AD=AD+PD;AK=AK+PK;PD=0;PK=0;
IF IND=-1öKO¬=XKOö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 AVD')(A(16))(XAVD)
(P'ZZ9',X(23))(AD)(PCCC)(AK)(PCCC)(AD-AK)(PCCC)SKIP;RAD=RAD-2;END;
IF XKO=1210®=1 THEN DO;
SKO=XKO;SAVD=XAVD;SPROJ=XPROJ;SMNR=MNR;BUD=' ';
IF NYREG=1 THEN GO TO WRA;
ON ERROR GO TO WRA;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
SAD=AD;SAK=AK;HJKOD=' ';
REWRITE FILE(SAMFIL)FROM(SAM);
GO TO AKLAR;
WRA:UNSPEC(SAMFIL)=0;CALL SEOF(SAMFIL);
SAD=AD;SAK=AK;HJKOD=' ';
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 THEN GO TO RUB;
IF XKO¬=1210&XKO<3000®=1 THEN DO;
SKO=XKO;SAVD=0;SPROJ=0;SMNR=MNR;BUD=' ';
IF NYREG=1 THEN GO TO WRK;
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;END;
KKLAR:ON ERROR GO TO EJTXT;READ KEY(XKO)FILE(KTOTX)INTO(KTO);GO TO KOPRT;
EJTXT:TEXT='*** KONTOT SAKNAS I KONTOPLANEN ';
KOPRT:PUT SKIP EDIT(XKO)(A(9))(TEXT)(A(35))(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(41))(TD)(PC)(TK)(PC)
SKIP(RAD-7);
SLUTT:CALL TYPIST('BOKRUT┣0d┫',7);END;