|
|
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: 7584 (0x1da0)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »ETIKNY1«
└─⟦72f0dadd8⟧ Bits:30008723 DDMQ1-0164_ETIKNY_MS_COPY_820511
└─⟦this⟧ »ETIKNY1«
DCL 1 KUND,
2 NR CHAR(5),
2 FNAMN CHAR(8),
2 NAMN CHAR(16)INIT(''),
2 CO CHAR(20)INIT(''),
2 AVD CHAR(15),
2 ADR CHAR(20)INIT(''),
2 BOX CHAR(10),
2 PAD CHAR(18)INIT(''),
2 TEL CHAR(11),
2 KOD(7) CHAR(2);
DCL SORTFIL FILE;
DCL ENR(4) CHAR(5), ENAMN(4) CHAR(24),EADR(4) CHAR(20),ECO(4) CHAR(20),
EAVD(4) CHAR(15),X FIXED(1),XX CHAR(25) INIT(' '),
EPAD(4) CHAR(18),SVAR CHAR(5),LETA FIXED(1);
LETA=0;
X=0;
DO I= 1 TO 4;
ENR(I)=XX;
ENAMN(I)=XX;
ECO(I)=XX;
EADR(I)=XX;
EPAD(I)=XX;
EAVD(I)=XX;
END;
ST:
OPEN SORTFIL;
PUT FILE(D) SKIP EDIT('VAR SKALL UTSKRIFTEN BÖRJA?')(A(37))
('OM FRÅN BÖRJAN, TRYCK RETURN')(A(37))('ANNARS ANGE FÖRSTA KUNDNR')(A(37));
GET SKIP LIST(SVAR);
IF SVAR¬=' ' THEN LETA=1;
ELSE LETA=0;
PUT FILE(D) SKIP EDIT(XX)(A(85))('UTSKRIFT PÅGÅR')(A(190));
START:
DO I=1 TO 4;
IF LETA=1 THEN DO;
ON ERROR GO TO ST;
READ KEY(SVAR) FILE(SORTFIL) INTO(KUND);
END;
IF LETA=0 THEN DO;
X=1;
ON ENDFILE GO TO PRT;
READ FILE(SORTFIL) INTO(KUND);
X=0;
END;
DO J=8 TO 1 BY -1;
IF SUBSTR(FNAMN,J,1)¬=' ' THEN GO TO CAT_ST;
END;
CAT_ST:
ENAMN(I)=FNAMN CAT XX;
IF J=0 THEN ENAMN(I)=NAMN;
ELSE SUBSTR(ENAMN(I),J+2,16)=NAMN;
ENR(I)=NR;
ECO(I)=CO;
EAVD(I)=AVD;
EADR(I)=ADR;
IF BOX¬=' ' THEN EADR(I)=BOX CAT XX;
EPAD(I)=PAD;
LETA=0;
END;
I=I-1;
PRT:
PUT SKIP;
DO J=1 TO I;
PUT EDIT(ENAMN(J))(A(36));
END;
PUT SKIP;
DO J=1 TO I;
PUT EDIT(ECO(J))(A(36));
END;
PUT SKIP;
DO J=1 TO I;
PUT EDIT(EAVD(J))(A(24))(ENR(J))(A(12));
END;
PUT SKIP;
DO J=1 TO I;
PUT EDIT(EADR(J))(A(36));
END;
PUT SKIP;
DO J=1 TO I;
PUT EDIT(EPAD(J))(A(36));
END;
PUT SKIP;
DO I = 1 TO 4;
ENR(I)=XX;
ENAMN(I)=XX;
EADR(I)=XX;
ECO(I)=XX;
EPAD(I)=XX;
END;
IF X=0 THEN GO TO START;
END;