|
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: 14615 (0x3917)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BOKRUT1«
└─⟦aeb45b905⟧ Bits:30008623 DDMQ1-0063__LMC_Original_Generella_pgm_for_bokforing_Sid1_PL1_Sid2_kompil_781105_side1
└─⟦this⟧ »BOKRUT1«
└─⟦f4c608b16⟧ Bits:30008624 DDMQ1-0064_LMC_Kopia_Generall_pgm_for_bokforing_Endast_PL1-vers_781105_B
└─⟦this⟧ »BOKRUT1«
/*FÖRSTA RADEN*/
/*BOKRUT TABLÅPROGRAM FÖR NYA VERS AV BOKFÖRINGSRUTINER. GENERELL.
REV 781104 PROGR:TD */
/*FÖLJANDE DATAFILER BEHÖVS:
MON:AKTUELL VERFIL
VERSORT:ATT KOPIERA MON I
SAMFIL,
KTOTX,
SAMSORT:ATT KOPIERA SAMFIL OCH KTOTX I
DATFIL:SORTERINGSDATA,DATUM OSV
SORTERINGSDATA: 1-12 GÄLLER VERFILERNA 1-12 (T.EX JAN-DEC),
K=KONTONR.ORDN,V=VER.NR ORDN.
13 GÄLLER SAMFIL. K=KONTONUMMERORDN,A=AVDELN.ORDN,P=PROJEKTORDN (ANV.EJ HÄR)
14 GÄLLER KTOTX. K=KONTONR.ORDN NUMERISK,k=NUMMERORDN 1,10,101,1010,11,110 OSV.
*/
DCL DATFIL FILE,S CHAR(2),ANT BINARY,SUB CHAR(90),INFO(5) CHAR(128),
LB(24) LABEL INIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16,
A17,A18,A19,A20,A21,A22,A23,A24),SAMFIL FILE,INF CHAR(128),KTOTX FILE;
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SORTKOD(14) CHAR(1),
2 CO FIXED(1);
DCL M_STR CHAR(50) INIT(' JAN,FEB,MAR,APR,MAJ,JUN,JUL,AUG,SEP,OKT,NOV,DEC');
OPEN DATFIL;READ FILE(DATFIL)INTO(DATREC);
L0:
PUT FILE(D) SKIP EDIT (' ******* VAD VILL DU GÖRA? *******')
(A(37))(' (TRYCK RETURN FÖR NY TABLÅ)')(A(37))
(' 1 - AVSLUTA PROGRAMKÖRNINGEN')(A(37))
(' 2 - MAN. REGISTRERING AV VERIF.')(A(37))
(' 3 - VERIFIKATIONSLISTA')(A(37))
(' 4 - AKTUELLT SALDO,VISSA KONTON')(A(37))
(' 5 - UTSKRIFT AV KONTOPLANEN')(A(37))
(' 6 - HUVUDBOK')(A(35));
GET SKIP LIST(S);PUT FILE(D) SKIP;
IF S='1 ' THEN GO TO A1;
IF S='2 'öS='3 'öS='4 'öS='5 'öS='6 ' THEN GO TO PER;
L1:PUT FILE(D) SKIP EDIT('')(A(42))('(TRYCK RETURN FÖR NY TABLÅ)')(A(32))
(' 7 - RES.RÄKN. (TOT ELLER PER AVD)')(A(37))
(' 8 - BAL.RÄKN.')(A(37))
(' 9 - RÅBALANS FÖR BOKSLUT')(A(37))
(' 10 - UTSKRIFT AV INGÅENDE BALANSER')(A(37))
(' 11 - UTSKRIFT AV BUDGET')(A(34));GET SKIP LIST(S);PUT FILE(D)SKIP;
IF S='7 'öS='8 'öS='9 'öS='10'öS='11' THEN GO TO PER;
L2:PUT FILE(D)EDIT('')(A(42))('(TRYCK RETURN FÖR NY TABLÅ)')(A(32))
(' 12 - UPPLÄGGNING AV NYA KONTON')(A(37))
(' 13 - ÄNDRINGAR I KONTOPLANEN')(A(37))
(' 14 - INMATNING AV INGÅENDE BALANSER')(A(37))
(' 15 - INMATNING AV BUDGET')(A(37))
(' 16 - RUTIN FÖR NYTT BOKFÖRINGSÅR')(A(34));
GET SKIP LIST(S);PUT FILE(D)SKIP;
IF S='12'öS='13'öS='14'öS='15' THEN GO TO PER;
IF S='16' THEN GO TO A16;
GO TO L0;
PER:MON=' ';MNR=0;PUT FILE(D)SKIP;
IF S='2 ' THEN PUT FILE(D)EDIT(' BOKF.')(A);
ELSE PUT FILE(D)SKIP EDIT(' ANGE ')(A);
PUT FILE(D)EDIT('DAGENS DATUM (ÅÅMMDD):')(A(25));
GET SKIP LIST(DAG);PUT FILE(D) SKIP;
IF S='6 'ö
S='7 'öS='2 'öS='3 'öS='4 'öS='8 ' THEN GO TO MONIN;GO TO VX;
MONIN:PUT FILE(D) SKIP EDIT('VILKEN MÅNAD SKA AVSES?')(A(37))
('SVARA "JAN" "APR" ELLER LIKN')(A(37))('ANGE ALLTID TRE BOKSTÄVER:')(A(34));
GET SKIP LIST(MON);PUT FILE(D) SKIP;
MNR=0;
MNR=INDEX(M_STR,MON)/4;
IF MNR=0 THEN GO TO MONIN;
MNR=MNR-8;
/* HÄR LÄGGER MAN TILL DET ANTAL MÅNADERS "OFFSET" SOM
BOKFÖRINGSÅRET HAR I DET AKTUELLA FALLET. OM FÖRSTA MÅNADEN T.EX ÄR JULI
SUBTRAHERAS EN SEXA (6) */
IF MNR<1 THEN MNR=MNR+12;
VX:II=S;IF II¬=0 THEN GO TO LB(II);
GO TO L0;
A2:INF='VERIFIN ' CAT MON;
REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,11);GO TO UT;
A3:ANT=0;
INFO(1)='';IF SORTKOD(MNR)¬='V' THEN DO;
INFO(1)='SORT,O ' CAT MON CAT ' VERSORT 9 ';ANT=21;END;
SORTKOD(MNR)='V';REWRITE FILE(DATFIL)FROM(DATREC);
INFO(2)='VERIFUT ' CAT MON;ANT=ANT+11;
INF=INFO(1) CAT INFO(2);
CALL LOAD(INF,ANT);GO TO UT;
A6:OPEN SAMFIL;CALL SEOF(SAMFIL);
IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;INFO(1)='';INFO(2)='';
IF SORTKOD(MNR)¬='K' THEN DO;
INFO(1)='SORT ' CAT MON CAT ' VERSORT ';ANT=17;END;
IF SORTKOD(13)¬='K' THEN DO;INFO(2)='SORT SAMFIL '
CAT 'SAMSORT ';ANT=ANT+20;END;
SORTKOD(MNR)='K';SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC);
INF=INFO(1) CAT INFO(2) CAT 'HUVBOK ' CAT MON;ANT=ANT+10;
CALL LOAD(INF,ANT);
GO TO UT;
A7:PUT FILE(D)SKIP EDIT('1 - PER AVDELNING')(A(37))
('2 - TOTALT ALLA AVD.')(A(35));
GET SKIP LIST(S);
IF VERIFY(SUBSTR(S,1,1),'12')=0 THEN GO TO A7;
PUT FILE(D)SKIP;
INFO(1)='';INFO(2)='';
IF S='1 ' THEN DO;
OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='A' THEN DO;INFO(1)='ALTA ' CAT
'SORT SAMFIL SAMSORT ALTB ';ANT=30;SORTKOD(13)='A';END;
IF SORTKOD(14)¬='A' THEN DO;INFO(2)='ALTE SORT KTOTX SAMSORT ALTF ';
ANT=ANT+29;SORTKOD(14)='A';END;
INFO(3)='AVDRES';ANT=ANT+6;END;
IF S='2 ' THEN DO;
OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT ' CAT
'SAMFIL SAMSORT ';ANT=20;SORTKOD(13)='K';END;
IF SORTKOD(14)¬='K' THEN DO;INFO(2)='SORT KTOTX ' CAT
'SAMSORT ';SORTKOD(14)='K';ANT=ANT+19;END;
INFO(3)='RESRÄKN';ANT=ANT+7;END;
INF=INFO(1) CAT INFO(2) CAT INFO(3);
REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A8:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;INFO(1)='';INFO(2)='';
IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT SAMFIL SAMSORT ';ANT=20;END;
IF SORTKOD(14)¬='K' THEN DO;INFO(2)='SORT KTOTX ' CAT
'SAMSORT ';ANT=ANT+19;END;
INF=INFO(1) CAT INFO(2) CAT 'BALRÄKN';ANT=ANT+7;
SORTKOD(13)='K';SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A12:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('KOUPP',5);GO TO UT;
A14:ANT=0;INFO(1)='';IF SORTKOD(14)¬='K' THEN DO;
INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
INF=INFO(1) CAT 'IBALIN';ANT=ANT+6;
CALL LOAD(INF,ANT);GO TO UT;
A13:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('KOALT',5);GO TO UT;
A5:ANT=0;INFO(1)='';IF SORTKOD(14)¬='k' THEN DO;
INFO(1)='SORT,O KTOTX SAMSORT 4 ';ANT=23;END;
INF=INFO(1) CAT 'KOUT';ANT=ANT+4;
SORTKOD(14)='k';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A10:ANT=0;INFO(1)='';IF SORTKOD(14)¬='K' THEN DO;
INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END;
INF=INFO(1) CAT 'IBALUT';ANT=ANT+6;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A15:REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD('BUDGIN',6);GO TO UT;
A11:ANT=0;INFO(1)='';IF SORTKOD(14)¬='K' THEN DO;
INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END;
INF=INFO(1) CAT 'BUDGUT';ANT=ANT+6;
SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A9:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0;
ANT=0;INFO(1)='';INFO(2)='';
IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT SAMFIL SAMSORT ';ANT=20;END;
IF SORTKOD(14)¬='K' THEN DO;INFO(2)='SORT KTOTX ' CAT
'SAMSORT ';ANT=ANT+19;END;
INF=INFO(1) CAT INFO(2) CAT 'BOKSLUT';ANT=ANT+7;
SORTKOD(13)='K';SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A1:GO TO UT;
A4:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K';
ANT=0;INFO(1)='';INFO(2)='';
IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT SAMFIL SAMSORT ';ANT=20;END;
IF SORTKOD(MNR)¬='K' THEN DO;
INFO(2)='SORT ' CAT MON CAT ' VERSORT ';ANT=ANT+17;END;
INF=INFO(1) CAT INFO(2) CAT 'AKTSAL ' CAT MON;ANT=ANT+10;
SORTKOD(13)='K';SORTKOD(MNR)='K';REWRITE FILE(DATFIL)FROM(DATREC);
CALL LOAD(INF,ANT);GO TO UT;
A16:DAG='YYYYYY';REWRITE FILE(DATFIL)FROM(DATREC);
PUT FILE(D) SKIP EDIT
('SÄTT IN EN DISKETT MED EN FIL')(A(37))
('SOM HETER NYKTOTX,MED RECORDLÄNGD=55')(A(37))
('OCH MINST LIKA STOR SOM KTOTX.')(A(37))
('VERIFIKATIONSDISKETTEN BEHÖVS EJ')(A(37))
('FILEN SAMSORT FÅR EJ TAS BORT')(A(37))
('ÄR DU KLAR?')(A(74))
('SVARA "J" ELLER "N":')(A(36));GET SKIP LIST(S);
IF S¬='J ' THEN GO TO L0;
PUT FILE(D)SKIP;
ANT=0;INFO(1)='';INFO(2)='';INFO(3)='';IF SORTKOD(14)¬='K' THEN DO;
INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END;
INFO(2)='DISK C KTOTX NYKTOTX ';ANT=ANT+21;
IF SORTKOD(13)¬='K' THEN DO;INFO(3)='SORT SAMFIL SAMSORT ';ANT=ANT+20;END;
SORTKOD(13)='K';
INF=INFO(1) CAT INFO(3) CAT INFO(2) CAT 'NYÅR';ANT=ANT+4;
CALL LOAD(INF,ANT);GO TO UT;
UT:END;