`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$Jâ DAILYLEDGERgDAILYBUFF.TEXTg DAYLED.TEXTvg DAYLED.CODEvgLEDGE.DOC.TEXT{PSCAL12PAYROLLr=g* FD.PART3.TEXTvg*1 FD.INTRO.CODEvg1M FD.PART1.TEXTvgzMi FD.PART2.TEXTvgi FILEDEMO.TEXTvg FILEDEMO.CODEvg FD.INTRO.TEXTvg README.TEXTvg&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&N N1 N2 N3 R1 R2 Q RN^١  IF SELECTION = 'T' THEN TWELVEMO; "END(*IF*);  END(*LISTONE*); &  PROCEDURE MENU2;  BEGIN "WRITELN(HOME,ERASE); "PROMPTAT(4,' LIST'); "PROMPTAT(5,' ********'); "PROMPTAT(7,' A(LL RECORDS'); "PROMPTAT(9,' O(NE RECORD'); "PROMPTAT(11ENDING UPON 'SELECTION', EITHER *)  (* UP TO TWELVE MONTHS OF PAY HISTORY *)  (* IS LISTED OR THE PROCEDURE IS *)  (* TERMINATED. *)  (* *)  (***************************************) $PROMPTAT(17,' N(EXT EMPLOYEE'); $PROMPTAT(19,' Q(UIT LIST'); $PROMPTAT(22,' ***** SELECT ONE *****'); $SELECTION:= GETCHAR(['N','T','Q']); $  (***************************************)  (* *)  (* DEP *)  (***************************************)   BEGIN  PRINTPAGE;  IF NOT EOF(PAYROLL) THEN "BEGIN $POST; $WITH PAYROLL^ DO &BEGIN (PROMPTAT(12,REMARKS); &END; $PROMPTAT(15,' T(WELVE MONTH PAY HISTORY'); *)  (* *)  (* DEPENDING ON THE ANSWER TO N(EXT, *)  (* T(WELVE MONTH PAY OR Q(UIT THE *)  (* PROCEDURE MAY OR MAY NOT CALL *)  (* TWELVEMO. *)  (* (*TWELVEMO*); "  PROCEDURE LISTONE;   (***************************************)  (* *)  (* LISTS ONE INDIVIDUAL RECORD BY 1ST *)  (* PRINTING THE PAGE FORMAT (PRINT- *)  (* PAGE) THEN THE INDIVIDUAL'S DATA.&BEGIN (**LISTS ONE MONTH'S PAY 5HISTORY**) (WRITELN(I:2,' ',PAY:9:2,' ',SOCSEC:8:2,' ', 6DEDUCTIONS:9:2,' ',WORKHOURS:4); &END(*WITH*); $END(*IF*); "END(*FOR*); "PROMPTAT(23,'ENTER C(ONTINUE WHEN READY'); "SELECTION := GETCHAR(['C']);  ENDEGIN $IF PAYROLL^.YEARSPAY[I].WORKHOURS <> 0 THEN '(** IF THE INDEXED MONTH'S WORK- )HOURS IS = TO 0 THEN THAT MONTH )WAS NOT ENTERED AND THE FOLLOW- )ING MONTHS ARE ALSO NOT ENTERED.**) ) $BEGIN &WITH PAYROLL^.YEARSPAY[I] DO ;  BEGIN "WRITELN(HOME,ERASE); "PROMPTAT(2,' TWELVE MONTH PAY HISTORY FOR '); "GOTOXY(12,4);WRITE(PAYROLL^.HISTORY.NAME); "PROMPTAT(6,'MO PAY SOCSEC DEDUCTIONS HRS'); "PROMPTAT(7,BORDER); "GOTOXY(0,9); "FOR I := 1 TO MONTHS DO "B LISTS UP TO TWELVE MONTHS*)  (* OF PAYDATA FOR EACH INDIVIDUAL *)  (* ONLY IF REQUESTED BY USER. *)  (* *)  (***************************************)   PROCEDURE TWELVEMO;  VAR MO,I,WRKHRS: INTEGER PROCEDURE LIST;   (***************************************)  (* *)  (* LISTS ALL RECORDS ALPHABETICALLY *)  (* BY NAME OR BY SPECIFIC RECORD. *)  (* *)  (* TWELVEMO:,' Q(UIT'); "PROMPTAT(15,' ****SELECT ONE**** ');  SELECTION:= GETCHAR(['A','O','Q']);  END(*MENU2*);   PROCEDURE LISTALL;   (***************************************)  (* *)  (* LISTS ONE RECORD'S GENERAL DATA *)  (* *)  (* THEN ASK IF USER WANTS TWELVE *)  (* *)  (* MONTHS OF PAYROLL DATA HISTORY *)  (*  (* IF THE USER ONLY KNOWS THE EMPLOYEE*)  (* NAME AND NOT THE RECORD NUMBER, HE *)  (* CAN FIND THE RECORD NUMBER BY USING*)  (* THE N(AME CASE OF SELECTION AND *)  (* ENTERING THE COMPLETE NAME WHEN *)  (* ASKED: MPTAT(23,'ENTER C(ONTINUE OR E(XIT LIST'); +SELECTION := GETCHAR(['C','E']); +IF SELECTION = 'E' THEN EXIT(LIST); +UNTIL EOF(PAYROLL); +END(*'H'*); $'N': BEGIN +  (***************************************)  (* *) 5C(ONTINUE. **) + -GOTOXY(0,3);WRITELN(ERASEOS); -FOR I := 1 TO 15 DO -BEGIN /IF NOT EOF(PAYROLL) THEN /BEGIN 1WRITELN(RECNUM,' ',PAYROLL^.HISTORY.NAME); 1RECNUM:= RECNUM+1; 1GET(PAYROLL); /END(*IF*); -END(*FOR*); +PROMPTAT(22,BORDER); +PRO *)  (***************************************)  +PAGE(OUTPUT); +PROMPTAT(1,'REC NAME'); +GET(PAYROLL); +RECNUM:= 1; +REPEAT (**PRINTS A PAGE OF 15 5NAMES AT ONE TIME 5THEN ASKS IF USER 5WANTS TO E(XIT OR *******************)  (* *)  (* IF USER SELECTS H(ELP, THIS CASE *)  (* OF SELECTION WILL LIST THE NAMES *)  (* OF ALL EMPLOYEES ON THE FILE IN *)  (* ALPHABETICAL ORDER. *)  (* (* IF REC WAS 0 THEN USER 0DID NOT KNOW THE RECORD 0NUMBER AND HAD TO EXIT 0TO 'SEARCH' OR 'HELP' OF 0'LIST','ONE'. **) 0 +SEEK(PAYROLL,REC); +GET(PAYROLL); +LISTONE; +READ(CH); +EXIT(ONEREC); )END(*'I'*); $'H': BEGIN +  (******************** (* I( KNOW THE RECORD NUMBER *)  (* *)  (***************************************)   GOTOXY(0,18); +WRITE('ENTER THE RECORD NUMBER NOW: '); +REC := GETINT(30,18,5); +IF REC = 0 THEN EXIT(ONEREC); . .ECORD NUMBER *)  (* THIS CASE OF SELECTION WILL LIST *)  (* THAT ONE RECORD AND THE TWELVE *)  (* MONTH PAYROLL HISTORY IF DESIRED. *)  (* SELECTED BY PRESSING: *)  (* *) ','H','N','Q']);  END(*SONEREC*); $  BEGIN(*ONEREC*)  REPEAT "SONEREC; (*PUTS MENU ABOVE ON SCREEN*) "CASE SELECTION OF $'I': BEGIN +  (***************************************)  (* *)  (* IF USER KNOWS THE RCH RECORD NUMBER'); "PROMPTAT(10,' H(ELP ME FIND THE RECORD NUMBER'); "PROMPTAT(12,' N(AME KNOWN'); "PROMPTAT(14,' Q(UIT'); "PROMPTAT(16,' E(XIT PROGRAM'); "PROMPTAT(18,' ***** SELECT ONE *****'); "SELECTION:=GETCHAR(['I','E PROCEDURE SONEREC; (*PUTS MENU ON SCREEN*)  BEGIN (*FOR 'ONEREC' BELOW*)  RESET(PAYROLL); "WRITELN(HOME,ERASE); "PROMPTAT(5,' MENU FOR LIST ONE RECORD'); "PROMPTAT(6,' ****************************'); "PROMPTAT(8,' I( KNOW WHIE RECORD WHEN GIVEN THE *)  (* RECORD NUMBER. *)  (* *)  (***************************************)   VAR RECNUM,REC,I:INTEGER;  S:STRING[NAMELEN]; $ ROCEDURE ONEREC;   (***************************************)  (* *)  (* EITHER SEARCHES FOR A RECORD BY *)  (* EMPLOYEE NAME, LISTS ALL *)  (* NAMES ALPHABETICALLY OR LISTS *)  (* A SINGL *)  (***************************************)   BEGIN "RESET(PAYROLL); "GET(PAYROLL); "REPEAT $LISTONE; $CASE SELECTION OF &'Q': EXIT(LISTALL); &'T': TWELVEMO; $END(*CASE*); $GET(PAYROLL);  UNTIL EOF(PAYROLL);  END(*LISTALL*);  &  P *)  (* *)  (* SMITH, JOHNATHAN S. *)  (* -------------------- *)  (* *)  (***************************************)   WRITELN(HOME,ERASE); +PROMPTAT(1,'ENTER THE NAME: '); +GOTOXY(4,6); +WRITELN('YOU HAVE ',NAMELEN,' SPACES AS SHOWN: '); +GOTOXY(10,11); +WRITELN('--------------------'); +GOTOXY(10,10); +READLN(S); (* UNDERLINING WAS 6PUT ON SCREEN 6FIRST THEN CURSOR 6MOVED OVER FIRIN PAYROLL. THE NEXT LINE CREATES *)  (* REC-1 RECORD SPACES IN THE NEW *)  (* PAYROLL FILE SINCE ONE HAS BEEN *)  (* DELETED. *)  (* *)  (****************************************) "RESET(PAYBUF); "GET(PAYBUF); "REWRITE(PAYROLL,'PAYROLL:PAYROLL.DATA'); &(***CREATES A NEW PAYROLL FILE***)   (***************************************)  (* *)  (* REC IS NOW THE NUMBER OF RECORDS *)  (* $(* IF YOU HAVE READ AND WRITTEN UP 'TO THE RECORD TO BE DELETED THIS 'STATEMENT SIMPLY READS ANOTHER 'RECORD WITHOUT PUTTING IT TO ''PAYBUF' THUS EFFECTIVELY 'DELTEING IT*) "UNTIL EOF(PAYROLL); "CLOSE(PAYROLL,PURGE); (***DESTROYS 9FILE PAYROLL** AND REWRITE BOTH PUT 'RECORDS IN THE WINDOW. STMT ABOVE 'SETS THE FIRST RECORD OF PAYBUF 'EQUAL TO THE FIRST RECORD OF 'PAYROLL. *) $PUT(PAYBUF); $REC := REC + 1; $GET(PAYROLL); $IF REC = RECNUM THEN GET(PAYROLL); *)  (* *)  (***************************************)   RESET(PAYROLL); "REWRITE(PAYBUF,'PAY.DATA'); (*CREATES " 'PAYBUF'*) "REPEAT $PAYBUF^ := PAYROLL^; $(* RESET *)  (* NOW KNOWING THE RECORD NUMBER THE *)  (* PROCEDURE CREATES A TEMPORARY FILE *)  (* 'PAYBUF' AND WRITES ALL THE RECORDS*)  (* EXCEPT THE DELETED RECORD TO IT. *)  (* 'PAYBUF' IS THEN RESET AND WRITTEN *)  (* TO 'PAYROLL'. "PROMPTAT(23,' USE THE L(IST FUNCTION TO FIND IT'); "GOTOXY(12,12); "WAIT(4000); "WRITE('RECORD #: '); "RECNUM := GETINT(22,12,5); "IF RECNUM = 0 THEN EXIT(DELETE); "REC:=0; "  (***************************************)  (* ITELN(HOME,ERASE); "PROMPTAT(2,' ENTER THE RECORD NUMBER TO BE DELETED'); "PROMPTAT(3,BORDER); "PROMPTAT(20,BORDER); "PROMPTAT(21,'IF YOU DO NOT KNOW THE RECORD NUMBER'); "PROMPTAT(22,' ENTER 0 FOR THE RECORD NUMBER AND'); LE BY ONE RECORD. *)  (* *)  (* RCD# 0 WILL EXIT THE PROCEDURE. *)  (* *)  (***************************************)   VAR REC,RECNUM:INTEGER;  BEGIN "FILESTATUS; "WR (******************)  PROCEDURE DELETE;   (***************************************)  (* *)  (* GIVEN A RECORD NUMBER WILL SEARCH *)  (* FOR AND DELETE THAT RECORD AND *)  (* CRUNCH THE FI"CASE SELECTION OF (******************) $'Q': EXIT(LIST); (* *) $'A': LISTALL; (* EXITS, LISTS *) $'O': ONEREC; (* ALL RCDS, OR *)  END(*SELECT*); (* JUST ONE RCD. *)  END(*LIST*); (* *)  "END(*CASE*); (* PROGRAM!!!*)  UNTIL FALSE; $ $(* IMPORTANT!!- 'FALSE' WILL NEVER ,BE TRUE. THE ONLY WAY TO ,GET OUT IS TO ENTER A 'Q' ,OR 'E' AND 'EXIT'. **) ,  END(*ONEREC*); & &  BEGIN(*LIST*) "FILESTATUS; "MENU2; FOR '); 1WRITELN(' ',S,' IS: ',REC,ERASEOL); /END(*ELSE*); /PROMPTAT(22,BORDER); /PROMPTAT(23,'ENTER C(ONTINUE WHEN READY '); /SELECTION := GETCHAR(['C']); )END(*'N'*); %'Q': EXIT(ONEREC);(* GOES TO LIST*) %'E': THATSALL; (*EXITS THE ENTIRE*) ST 6'-' FOR ENTRY. **) + +REC:=0; +REPEAT -GET(PAYROLL); -REC:= REC + 1; +UNTIL (PAYROLL^.HISTORY.NAME = S) OR EOF(PAYROLL); +GOTOXY(4,10); +IF EOF(PAYROLL) THEN -WRITELN('RECORD FOR ',S,' NOT FOUND') /ELSE /BEGIN 1WRITELN('THE RECORD NUMBER )   SEEK(PAYROLL,REC-1); "PUT(PAYROLL); "RESET(PAYROLL);   (***************************************)  (* *)  (* NOW WE SIMPLY READ FROM 'PAYBUF' *)  (* AND WRITE(PUT) TO 'PAYROLL'. NOTE *)  (* THAT PUT GOES FIRST BECAUSE THE *)  (* INITIAL RESET(PAYBUF) PLACED THE *)  (* FIRST RECORD IN THE WINDOW AND IT *)  (* MUST BE WRITTEN TO 'PAYROLL' BEFORE*)  (* THE FIRST GET. *)  (* OLL FILE DEMONSTRATION'); "PROMPTAT(3,' I(NSTRUCTIONS'); "PROMPTAT(5,' E(NTER'); "PROMPTAT(7,' U(PDATE'); "PROMPTAT(9,' L(IST'); "PROMPTAT(11,' D(ELETE'); "PROMPTAT(13,' S(EARCH'); "PROMPTAT(15,' P(ROCESS'); "PROMPTAT(17,' QOT RETURN UNTIL *)  (* ON OF THE APPROPRIATE KEYS IS *)  (* PRESSED. *)  (* *)  (***************************************)   BEGIN "WRITELN(HOME,ERASE); "PROMPTAT(1,' PAYR"CLOSE(PAYROLL,PURGE); "CLOSE(PAYROLL,LOCK); "THATSALL;  END(*PURGEIT*);   PROCEDURE MENU;   (***************************************)  (* *)  (* PUTS MENU TO SELECT FROM ON THE *)  (* SCREEN AND WILL N*****)  (* *)  (* DESTROYS FILE 'PAYROLL' AND IF *)  (* ACCESSED AGAIN IT WILL BE EMPTY. *)  (* *)  (***************************************)   BEGIN AT(16,' DISK HANDLING');  PROMPTAT(22,BORDER);  PROMPTAT(23,'ENTER C(ONTINUE OR E(XIT PROGRAM');  SELECTION := GETCHAR(['C','E']);  IF SELECTION = 'E' THEN THATSALL;  END(*PROCESS*);   PROCEDURE PURGEIT;   (**********************************) )(* *) )(*****************************) )  WRITELN(HOME,ERASE);  PROMPTAT(10,'YOUR PROCESS WOULD GO HERE;');  PROMPTAT(12,' HOWEVER, THE PURPOSE OF THIS');  PROMPTAT(14,' PROGRAM IS ONLY TO DEMONSTRATE');  PROMPT PROMPTAT(23,'ENTER C(ONTINUE TO EXIT');  SELECTION := GETCHAR(['C']);  END(*SEARCH*);   PROCEDURE PROCESS;  BEGIN )(*****************************) )(* *) )(* YOUR PROCESSING OF THE *) )(* DATA WOULD OCCUR HERE *F(PAYROLL) THEN "BEGIN $GOTOXY(0,14); $WRITELN('RECORD IS NOT IN FILE'); "END(*IF*)  ELSE "BEGIN $PROMPTAT(14,'THE RECORD NUMBER FOR EMPLOYEE'); $GOTOXY(5,16); $WRITELN(FULLNAME,' IS: ',REC); "END(*ELSE*);  PROMPTAT(22,BORDER); SINCE MOST (NAMES ARE OVER TWO CHARACTERS (THIS PROTECTS AGAINST THE (PROBLEM. LET ME KNOW IF YOU (FIGURE OUT WHY!!!! ***) (  REC:= 0;  REPEAT "REC:= REC + 1; "GET(PAYROLL);  UNTIL EOF(PAYROLL) OR (FULLNAME = PAYROLL^.HISTORY.NAME);  IF EOOXY(10,10); "READLN(FULLNAME);  UNTIL LENGTH(FULLNAME) > 2;  $(***FOR SOME REASON THIS WAS NECESSARY (BECAUSE A CHARACTER WAS OFTEN (PASSED TO THIS ROUTINE FROM (SOMEWHERE, CAUSING 'READLN(FULL- (NAME) TO PRESS ON WITHOUT THE (NAME BEING ENTERED. PAGE(OUTPUT);  PROMPTAT(2,' WHAT IS THE INDIVIDUAL''S NAME?');  PROMPTAT(4,' ENTER: LAST, FIRST MIDDLE INITIAL');  GOTOXY(4,6);  WRITELN('YOU HAVE ',NAMELEN,' SPACES AS SHOWN: ');  GOTOXY(10,11);  WRITELN('--------------------');  REPEAT "GOT *)  (* STARTED AT ZERO AND WHEN A MATCH *)  (* IS FOUND PRINTED OUT AS THE RECORD *)  (* NUMBER. *)  (* *)  (***************************************)   BEGIN  FILESTATUS; **************************************)  (* *)  (* ASKS FOR THE FULLNAME OF THE *)  (* EMPLOYEE TO BE FOUND AND THEN *)  (* SEARCHES THE FILE SEQUENTIALLY *)  (* UNTIL A MATCH IS FOUND. REC IS *)  (***************************************)  "REPEAT $PAYROLL^ := PAYBUF^; $PUT(PAYROLL); $GET(PAYBUF); "UNTIL EOF(PAYBUF); "CLOSE(PAYBUF,PURGE);  END(*DELETE*);   PROCEDURE SEARCH;  VAR REC:INTEGER; $FULLNAME:STRING[NAMELEN];   (*(UIT'); "PROMPTAT(19,' R(EMOVE >>ENTIRE<< FILE'); "PROMPTAT(21,'***** SELECT BY FIRST LETTER *****'); "PROMPTAT(23,' WHICH ONE?:'); "SELECTION:= GETCHAR(['I','E','L','U','D','S','P','Q','R']);  END(*MENU*);   BEGIN(*MAIN PROGRAM*) #  (***************************************)  (* *)  (* GOES TO THE APPROPRIATE PROCEDURE *)  (* DEPENDING UPON THE SELECTION FROM *)  (* THE MENU ABOVE. *)  (* AND COMMENTS(****************************************(THE PROGRAM FILEDEMO IS VERY LARGE AND & HAD TO BE BROKEN DOWN INTO THREE ' PARTS BEFORE COMMENTS COULD BE ADDADDITIONAL RECORDS AREצ( ENTERED ALPHABETICALLY BY LAST NAME)*****************************************צPRESS ANY KEY TO CONTINUEb  REMARKSצ& PROMPT C(ONTINUE MEANS TO ENTER Aצ 'C' IF YOU WISH TO CONTINUE.t'A CORRECTION PROCEDURE WAS DEVELOPED TOצ% HANDLE INCORRECT INTEGER OR REAL% ENTRIES. PAYROLL.DATA FILE MUST ALWAYS BEצ' THE LAST FILE ON THE DISK OR ADDED' RECORDS MIGHT OVER WRITE FOLLOWINGצ FILES.%ALL ENTRIES ARE DONE WITH MENUS. THEAL.#THIS SPECIAL DISK TITLED: 'PAYROLL'צ& HAS THE FILEDEMO.TEXT FILE FIRST,צ' THEN THE FILEDEMO.CODE, AND THEN A$ SAMPLE FILE: PAYROLL.DATA. THE%   INSTRUCTIONS)*****************************************צ(THIS PROGRAM IS MEANT TO DEMONSTRATE THEצ% FILE HANDLING CHARACTERISTICS OF PASCצ% TO 'PAYROLL:PAYROLL.DATA')*****************************************צNOW EX(ECUTE 'PAYROLL:FILEDEMO'צPRESS ANY KEY WHEN READYצDISK NAMED 'PAYROLL:' FILEDEMO.CODEצ FILEDEMO.TEXT SAMPLE.DATAצ$THEN T(RANSFER 'PAYROLL:SAMPLE.DATA' #THE PROGRAM FILEDEMO IS DESIGNED TOצ#RUN ON A DISKETTE CALLED 'PAYROLL:')*****************************************צ"LOAD THE FOLLOWING PROGRAMS ONTO A" FDINSTRU ASE SELECTION OF ''I': INSTRUCTIONS; ''E': ENTER; ''U': ENTER; ''L': LIST; ''R': PURGEIT; ''D': DELETE; ''S': SEARCH; ''P': PROCESS; ''Q': STOP := TRUE; %END(*CASE*); #UNTIL STOP; #CLOSE(PAYROLL,LOCK); #THATSALL;  END. *)  (* *)  (***************************************)  #ERASEOL:=CHR(16);ERASEOS:=CHR(11); #ERASE:=CHR(12);HOME:=CHR(25); #ENTERING := FALSE; #STOP := FALSE; #ONCETHRU := FALSE; #REPEAT; %MENU; %C *)  (* ERASE TO END OF LINE (ERASEOL), *)  (* ERASE TO END OF SCREEN (ERASEOS), *)  (* CLEARSCREEN (ERASE) AND HOME ARE *)  (* INITIALIZED BELOW. BOOLEANS STOP, *)  (* ENTERING AND ONCETHRU ARE SET TO *)  (* FALSE. EDצ#TO SEE EXTENSIVE REMARKS WITHIN THE% PROGRAM PLACE THE FOLLOWING THREE צ% TEXT FILES INTO 'SYSTEM.WRK.TEXT',# THEN LIST THEM WITH THE E(DITOR.צ FD.PART1.TEXTצ FD.PART2.TEXT FD.PART3.TEXT!THESE PROGRAMS CANNOT BE COMPILED-REMARKS: STRING; %END(*PAYDATA*); %  VAR  PAYROLL,PAYBUF: FILE OF PAYDATA; *P: INTERACTIVE; (*P WILL REPRESENT EITHER CONSOLE: OR PRINTER:*) )CH: CHAR; 'STOP: BOOLEAN; #ENTERING: BOOLEAN; #ONCETHRU: BOOLEAN; "ERASEOL,ERASEOS,HOME,ERASE:CHAR; THE *)  (* APPROPRIATE CLASS.' *)  (* *)  (***************************************)   PAYDATA = PACKED RECORD -HISTORY: PERSONALDATA; ,YEARSPAY: PACKED ARRAY [1..MONTHS] OF PAYYEARHISTORY; )  (* BOTH OF THESE RECORDS CONTAIN *)  (* STRING, INTEGER AND REAL DATA WHICH *)  (* CAN BE MIXED IN ANY WAY. THE *)  (* RECORD MUST BE DEFINED AS A FILE IN *)  (* THE VARIABLE SECTION OR YOU WILL *)  (* GET THE ERROR MESSAGE 'NOT OFTEGER; %END(*PAYYEARHISTORY*); + #  (***************************************)  (* *)  (* NOTE THAT PAY DATA IS A RECORD *)  (* WHICH CONTAINS BOTH THE RECORD *)  (* PAYYEARHISTORY AND PERSONALDATA. */STATE: STRING[STATELEN]; 1ZIP: STRING[5]; *DEPENDENTS: INTEGER; )YEARSWITHUS: INTEGER; ,PAYGRADE: INTEGER; *ALLOTMENTS: REAL; %END(*PERSONALDATA*); * #PAYYEARHISTORY = PACKED RECORD 1PAY: REAL; .SOCSEC: REAL; *DEDUCTIONS: REAL; +WORKHOURS: IN#STATELEN = 2; #MONTHS = 12; #MAXINT = 300; #MININT = 0; #MAXREAL = 9999.99; #MINREAL = 0.0; $  TYPE $ #SETOFCHAR = SET OF CHAR; #PERSONALDATA = PACKED RECORD 0NAME: STRING[NAMELEN]; .STREET: STRING[STREETLEN]; 0CITY: STRING[CITYLEN]; YOUR APPLICATION. *)  (* *)  (***************************************)   CONST #BORDER = '****************************************'; #NULL = ''; #NAMELEN = 20; #STREETLEN = 25; #CITYLEN = 17; , EDITING OF INPUT, AND *)  (* RECORDS WITHIN RECORDS. HOPEFULLY *)  (* THE EXTENSIVE REMARKS INCLUDED IN *)  (* FD.REM1.TEXT, FD.REM2.TEXT AND *)  (* FD.REM3.TEXT SHOULD PROVIDE SOME *)  (* GUIDE TO USING PASCAL FILES FOR *)  (*  PROGRAM FILEDEMO;   (***************************************)  (* *)  (* THIS PROGRAM DEMONSTRATES METHODS*)  (* OF HANDLING FILES IN PASCAL TO *)  (* INCLUDE: FILE CREATION, INSERTION, *)  (* DELETIONN N1 N2 N3 R1 R2 000000N^١zצ(****************************************צ PRESS ANY KEY TO C(ONTINUE   0 TEXT',# THEN LIST THEM WITH THE E(DITOR."SELECTION: CHAR; " I: INTEGER; % PRINT: STRING[10]; * *  PROCEDURE OPENFILE;   (***************************************)  (* *)  (* THIS PROCEDURE ATTEMPTS TO OPEN *)  (* THE FILE 'PAYROLL'. IT THE FILE IS *)  (* ALREADY OPEN THE FILE IS CREATED. *)  (* THE COMPILER INSTRUCTION (*$I-*) *)  (* TURNS OFF AUTOMATIC ERROR CHECHING *)  (* AND ALLOWS THE USER TO CHECK THE *)  (* ERRORS WHILE PROCESSING CONTINUES. *)  (* ALSO INITIATES TH&GOTOXY(30,5);WRITE(STATE:2); &GOTOXY(34,5);WRITE(ZIP:5); &GOTOXY(13,8);WRITE(PAYGRADE); &GOTOXY(32,8);WRITE(ALLOTMENTS:6:2); &GOTOXY(13,10);WRITE(DEPENDENTS); &GOTOXY(31,10);WRITE(YEARSWITHUS); % END(*WITH*);  END(*POST*); $  PROCEDURE GOOFED(VA*)  (* *)  (***************************************)   BEGIN  WITH PAYROLL^.HISTORY DO &BEGIN &GOTOXY(18,1);WRITE(NAME); &GOTOXY(11,3);WRITE(STREET); &GOTOXY(11,5);WRITE(CITY:17); PROCEDURE WRITES THE INDIVIDUAL'S *)  (* DATA TO THE OUTLINE PREVIOUSLY *)  (* PLACED ON THE SCREEN BY PRINTPAGE. *)  (* EACH WRITE IS PRECEEDED BY A *)  (* GOTOXY(X,Y) TO THE EXACT POSITION *)  (* AT WHICH THE DATA IS TO BE WRITTEN. N OKSET; $IF NOT GOOD THEN WRITE(CHR(7),CHR(7)) 'ELSE IF CH IN [' '..'Z'] THEN WRITE(CH); "UNTIL GOOD; "GETCHAR:=CH;  END(*GETCHAR*);   PROCEDURE POST;   (***************************************)  (* *)  (*  (* CORRECT CHAR IS INPUT. *)  (* *)  (***************************************)   VAR CH: CHAR; $GOOD:BOOLEAN;  BEGIN "REPEAT $READ(KEYBOARD,CH); $IF EOLN(KEYBOARD) THEN CH:=CHR(13); $GOOD:= CH IE BOOLEAN GETCHAR*)  (* IS RETURNED. THE PROCEDURE LOOPS *)  (* UNTIL ONE OF THE CHARACTERS IN THE *)  (* OKSET IS SELECTED. IF AN INCORRECT *)  (* CHARACTER IS SELECTED THE BELL WILL*)  (* RING TWICE. ECHOS CHAR ONLY WHEN *) ): CHAR;   (***************************************)  (* *)  (* EXCELLENT ROUTINE FROM APPLE3: *)  (* DISKIO. THE CHARACTERS FROM WHICH *)  (* THE USER IS TO SELECT IS SENT TO *)  (* THIS ROUTINE AND THTOP *)  (* OF THE SCREEN. *)  (* *)  (***************************************)   BEGIN #GOTOXY(0,J); #WRITE(S); #WRITELN(ERASEOL);  END(*PROMPTAT*); *  FUNCTION GETCHAR (OKSET: SETOFCHAR (* AND THE MESSAGE TO BE PRINTED (S) *)  (* ARE PASSED TO THIS ROUTINE. FOR *)  (* EXAMPLE: PROMPTAT(5,' HELLO'); *)  (* THIS PRINTS TWO SPACES AND THE *)  (* MESSAGE 'HELLO' ON LINE 5. LINES *)  (* ARE NUMBERED 0 TO 23, FROM THE ING);   (***************************************)  (* *)  (* VERY IMPORTANT PROCEDURE. USED *)  (* TO PRINT ANY WHERE ON THE SCREEN. *)  (* THE LINE NUMBER ON THE SCREEN (J) *) 'END; 'PAYROLL^.REMARKS := NULL; 'PUT(PAYROLL); $END(*REWRITE*);  (*$I+*)  ONCETHRU := TRUE;  END(*OPEN FILE*); ,  PROCEDURE WAIT(TIME:INTEGER);  VAR DELAY:INTEGER;  BEGIN "FOR DELAY:=1 TO TIME DO;  END; "  PROCEDURE PROMPTAT(J:INTEGER; S:STR1STATE:= NULL; 3ZIP:= NULL; ,DEPENDENTS:=0; +YEARSWITHUS:=0; .PAYGRADE:=0; ,ALLOTMENTS:= 0.0; 'END; 'FOR I:= 1 TO MONTHS DO 'BEGIN )WITH PAYROLL^.YEARSPAY[I] DO )BEGIN 2PAY := 0.0; /SOCSEC := 0.0; +DEDUCTIONS := 0.0; ,WORKHOURS := 0; )END; $RESET(PAYROLL,'PAYROLL:PAYROLL.DATA'); $IF IORESULT <> 0 THEN $BEGIN 'REWRITE(PAYROLL,'PAYROLL:PAYROLL.DATA'); '(*$I+*) 'WITH PAYROLL^.HISTORY DO 'BEGIN 2NAME:= NULL;(* NULL DEFINED*) 0STREET:= NULL;(* AS '' UNDER*) 2CITY:= NULL;(* CONSTANTS*) E 0 RECORD TO A *)  (* NIL RECORD. *)  (* *)  (***************************************)   BEGIN $PRINT:='CONSOLE:'; $RESET(P,PRINT); $STOP:=FALSE; $(*$I-*) $CLOSE(PAYROLL,LOCK); R H:INTEGER);   (***************************************)  (* *)  (* PROCEDURE INVOKED WHEN EITHER *)  (* GETINT OR GETREAL DETECT AN ERROR *)  (* IN THE NUMERICAL INPUT. MERELY *)  (* WAITS UNTIL THE USER ACKNOWLEDGES *)  (* THAT HE PROBABLY MADE A MISTAKE BY *)  (* PRESSING 'G'. *)  (* *)  (***************************************)   BEGIN #GOTOXY(0,19); #WRITELN('YOU PROBABLY MADE&POST; &GOTOXY(X,Y); &WRITE(' ':A); $END(*ELSE*); $GOTOXY(X,Y); $READITI(INUM); "UNTIL GOODNUM;  GETINT := INUM;  END(*GETINT *); $  PROCEDURE PRINTPAGE;   (***************************************)  (* *) )GOOFED(H); &END(*IF*); "X:=Y; "IF H = 0 THEN GOODNUM := TRUE &ELSE GOODNUM := FALSE;  END(*READITI*); *  BEGIN(*GETINT *) "GOODNUM := FALSE; "REPEAT $IF NOT ENTERING THEN $BEGIN &GOTOXY(X,Y); &WRITELN(ERASEOS); $END(*IF*) $ELSE $BEGIN *******************************)   VAR GOODNUM:BOOLEAN; 'INUM:INTEGER; $ "  PROCEDURE READITI(VAR X:INTEGER);   VAR Y,H:INTEGER;   BEGIN $(*$I-*) $READ(Y); $(*$I+*) $H:=IORESULT; $IF (H <> 0) OR (Y < MININT) OR (Y > MAXINT) THEN &BEGINY,A:INTEGER):INTEGER;   (***************************************)  (* *)  (* PROCEDURE ALMOST IDENTICAL TO *)  (* GETREAL EXCEPT THAT RANGE IS 0 TO *)  (* 32767. *)  (********$IF NOT ENTERING THEN $BEGIN &GOTOXY(X,Y); &WRITELN(ERASEOS); $END(*IF*) $ELSE $BEGIN &POST; &GOTOXY(X,Y); &WRITE(' ':A); &END(*ELSE*); $GOTOXY(X,Y); $READITR(RNUM); "UNTIL GOODNUM;  GETREAL := RNUM;  END(*GETREAL*); $  FUNCTION GETINT(X,EAL) OR (Y > MAXREAL) THEN $BEGIN (* IF LOOKS FOR ERROR OR OUT*) &GOOFED(H); (*OF RANGE VARIABLE*) $END(*IF*); "IF H = 0 THEN GOODNUM := TRUE &ELSE GOODNUM := FALSE;  X:=Y;  END(*READITR*); $  BEGIN(*GETREAL*) "GOODNUM := FALSE; "REPEAT *)  (***************************************)   VAR Y: REAL; $H: INTEGER;  BEGIN $(*$I-*) (*STOPS COMPILER I/O ERROR*) $READ(Y);(* CHECKING AND READS THE*) $(*$I+*) (* INPUT VARIABLE *) $H:=IORESULT; $IF (H<>0) OR (Y < MINRNPUT.*)  (* IF IT IS NOT IMPORTANT TO RETAIN *)  (* THE SCREEN DISPLAY THE CURSOR GOES *)  (* TO THE X,Y POSITION AND ERASES THE *)  (* REST OF THE LINE BEFORE AWAITING *)  (* THE CORRECT INPUT. *)  (*  (* IF IT IS IMPORTANT TO RETAIN THE *)  (* INTEGRETITY OF THE SCREEN DISPLAY, *)  (* THE CURSOR MOVES TO THE APPROPRIATE *)  (* X,Y POSITION THEN ERASES 'A' SPACES.*)  (* CURSOR THEN RETURNS TO THE X,Y *)  (* POSITION TO RECEOVE A CORRECT I *)  (* PROCEDURE FIRST CHECKS FOR AN *)  (* I/O ERROR, THEN CHECKS FOR A VALUE *)  (* RANGE. IN THIS CASE THE RANGE IS *)  (* 0 TO 9999.99. IF AN ERROR IS MADE *)  (* THE GOOFED PROCEDURE IS INVOKED. *) *)  (* *)  (***************************************)   VAR GOODNUM:BOOLEAN; $RNUM:REAL;    PROCEDURE READITR(VAR X:REAL);   (***************************************)  (* *)  (* *)  (* *)  (* *)  (* *)  (* *)  (*  (***************************************)  (* *)  (* PROCEDURE INSURES AN INPUT OF *)  (* A REAL VARIALBLE AT SCREEN POSITION *)  (* X,Y OF CHARACTER LENGTH A. *)  (* AN I/O ERROR'); #WRITELN(ERASEOS); #WRITELN(' G(OOFED WILL ASK FOR ANOTHER ENTRY'); #SELECTION := GETCHAR(['G']); #READ(CH); #H:=14; #GOTOXY(0,19); #WRITELN(ERASEOS);  END(*GOOFED*);   FUNCTION GETREAL(X,Y,A:INTEGER):REAL;   (* PROCEDURE PRINTS A PAGE FORMAT *)  (* WHICH IS LATER FILLED IN BY *)  (* PROCEDURE POST ABOVE. WHEN THIS *)  (* PROCEDURE IS DONE ALL HEADINGS ARE *)  (* ON THE PAGE BUT NO DATA IS THERE. *)  (* *)  (***************************************)   BEGIN "PAGE(OUTPUT); "PROMPTAT(1,' PAYROLL FILE FOR'); "PROMPTAT(3,' ADDRESS:'); "PROMPTAT(5,' CITY'); "GOTOXY(28,5); "WRITELN(', ST ZIP'); "PROMPTAT(8,' PAYGRADE: '); "GOTOXY PROCEDURE ENTER;   (***************************************)  (* *)  (* PROCEDURES VARIES WHAT IT DOES *)  (* DEPENDING UPON WHETHER ADD, INSERT *)  (* OR UPDATE ARE REQUIRED. VARIABLES *)  (* ARE ACCEPN N1 N2 N3 R1 R2 111 1N^١GETCHAR(['E','C']); #IF SELECTION = 'E' THEN THATSALL;  END(*INSTRUCTIONS*);  #PROMPTAT(8,'FOR INSTRUCTION EX(ECUTE THE PROGRAM:'); #PROMPTAT(10,' LIB1:FD.INTRO '); #PROMPTAT(12,' OR PAYROLL:FD.INTRO '); #GOTOXY(0,22); #WRITELN(BORDER); #WRITE('ENTER E(XIT TO INFO OR C(ONTINUE'); #SELECTION := *********)   BEGIN "PAGE(OUTPUT); "PROMPTAT(12,' .....THAT''S ALL FOLKS'); "EXIT(PROGRAM);  END(*THATSALL*);   PROCEDURE INSTRUCTIONS;  BEGIN #PAGE(OUTPUT); #WRITELN(' INSTRUCTIONS'); #WRITELN(BORDER);   (***************************************)  (* *)  (* PRINTS A CLOSING MESSAGE AND *)  (* EXITS THE PROGRAM. *)  (* *)  (******************************ESS- *)  (* ING. *)  (* *)  (***************************************)   BEGIN #IF ONCETHRU = FALSE THEN OPENFILE &ELSE RESET(PAYROLL);  END(*FILESTATUS*); "  PROCEDURE THATSALL;  (* IF ANY OTHER PROCEDURE HAS *)  (* BEEN RUN THEN 'ONCETHRU' WILL BE *)  (* TRUE AND THE FILE PAYROLL WILL BE *)  (* RESET. IT THIS IS THE FIRST TIME *)  (* ONCETHRU WILL BE FALSE AND THE FILE *)  (* WILL HAVE TO BE OPENED FOR PROC(19,8); "WRITELN('ALLOTMENTS: $'); "PROMPTAT(10,' DEPENDENTS:'); "GOTOXY(19,10); "WRITELN('IN SERVICE: YRS');  END(*PRINTPAGE*); "  PROCEDURE FILESTATUS;   (***************************************)  (* *) TED THROUGH THE EDITING *)  (* ROUTINES 'GETINT' AND 'GETREAL'. *)  (* *)  (***************************************)   VAR FULLNAME: STRING[20]; $REC,W,I,NUM:INTEGER; $SUCCESSFUL:BOOLEAN;   PROCEDURE INITTWELVE;   (***************************************)  (* *)  (* INITIALIZES TWELVE MONTHS OF *)  (* PAYROLL HISTROY TO ZERO(0). *)  (* *)  (********************* (* USING THE EDITING 'GETINT' AND *)  (* 'GETREAL' PROCEDURES. *)  (* *)  (***************************************)   ENTERING := FALSE; $WRITELN(HOME,ERASE); $PROMPTAT(1,'MO PAY SOCVES 0 TO 12 *)  (* MONTHS OF PAYROLL HISTORY. IF AN *)  (* ENTRY YEAR IS DESIRED USER IS *)  (* PROMPTED ONE AT A TIME FOR PAY, *)  (* SOCSEC DEDUCTION, ALLOTMENTS, AND *)  (* WORKHOURS. EACH VARIABLE IS INPUT *) (*** EXITS PROCEDURE IF *) 0(* ENTRY WAS IN ERROR *) +SUCCESSFUL := FALSE; +EXIT(ENTERIT); )END(*'E'*); "END(*CASE*);  END(*WITH*); $  (***************************************)  (* *)  (* NEXT LOOP RECEI,10,3); "READ(CH); "GOTOXY(0,12); "WRITE('ENTER REMARKS: '); "READLN(PAYROLL^.REMARKS); "GOTOXY(0,12); "WRITELN(PAYROLL^.REMARKS,ERASEOL); "PROMPTAT(23,' ENTER C(ORRECT OR E(RROR'); "SELECTION := GETCHAR(['C','E']); "CASE SELECTION OF $'E': BEGIN (* TO ACCEPTING ANOTHER INPUT. *)  (* *)  (***************************************)  "PAYGRADE := GETINT(13,8,3); "ALLOTMENTS:= GETREAL(32,8,8); "DEPENDENTS := GETINT(13,10,3); "YEARSWITHUS := GETINT(31ON THE PAGE *)  (* FROM WHICH THE VARIABLE SHOULD BE *)  (* TAKEN AND THE MAXIMUM SPACES *)  (* ALLOCATED TO THE VARIABLE. THE *)  (* SPACES ARE USED TO ERASE PREVIOUS *)  (* VARIABLE IF IT WAS INCORRECT PRIOR *) (ZIP); "  (***************************************)  (* *)  (* PROCEDURE 'GETINT' AND 'GETREAL'*)  (* USED BELOW EDITS THE INPUT REAL *)  (* OR INTEGER VARIABLE. PARAMETERS *)  (* ARE THE X,Y POSITION TH PAYROLL^.HISTORY DO  BEGIN "NAME:=FULLNAME; "GOTOXY(11,3); "READLN(STREET); "GOTOXY(11,5); "READ(CITY); "READLN; (* WAS REQUIRED BECAUSE CHAR *) *(* IS LEFT IN KEYBOARD BUFFER *) "GOTOXY(30,5); "READ(STATE); "READLN; "GOTOXY(34,5); "READLN (* *)  (***************************************)   BEGIN  PRINTPAGE; (* PUTS PAGE FORMAT ON SCREEN*)  GOTOXY(18,1);  WRITE(FULLNAME);  PROMPTAT(22,BORDER);  PROMPTAT(23,'ENTER ITEM ASKED FOR AT CURSOR ');  WICURS THE INCORRECT ENTRY IS *)  (* ERASED AND THE USER IS PROMPTED FOR *)  (* ANOTHER ENTRY. USE OF THE *)  (* PROCEDURE EXIT IS CONVENIENT WHEN *)  (* THE OBJECTIVES OF A PROCEDURE HAVE *)  (* BEEN MET AT USER'S DISCRETION. *) ,Y) FOLLOWED BY A *)  (* STRING READ LEAVES SOMETHING IN THE *)  (* INPUT BUFFER. A READ SOLVED IT BUT *)  (* REAL REASON AND BETTER SOLUTION IS *)  (* DESIREABLE. VARIABLES ARE READ *)  (* WITH EDITING PROCEDURES. IF AN *)  (* ERROR OC THE SCREEN,*)  (* THEN PROMPTS AT EACH APPROPRIATE *)  (* POSITION FOR THE STRING OR VARIABLE.*)  (* AFTER STRING INPUTS AN ADDITIONAL *)  (* READLN OR READ(CH) WAS REQUIRED. *)  (* REASON FOR THIS UNKNOWN, HOWEVER, *)  (* SUSPECT GOTOXY(X&WORKHOURS := 0; $END(*WITH*); "END(*FOR*);  END(*INITTWELVE*);   PROCEDURE ENTERIT;   (***************************************)  (* *)  (* ENTERS ONE EMPLOYEE RECORD. *)  (* FIRST PUTS BLANK PAGE ON******************)   VAR NUM: INTEGER;   BEGIN "FOR NUM := 1 TO MONTHS DO "BEGIN $WITH PAYROLL^.YEARSPAY[NUM] DO 4(* YEARSPAY[NUM] *) 4(* IS AN ARRAY 12 *) 4(* MONTHS LONG *) $BEGIN &PAY := 0.0; &SOCSEC := 0.0; &DEDUCTIONS := 0.0; SEC DEDUCTIONS HRS'); $PROMPTAT(22,BORDER); $PROMPTAT(23,'ENTER M(ONTH, Q(UIT'); $W := 3; (*** W IS LINE NUMBER FOR *) -(* GOTYXY(X,W) *) $INITTWELVE;  FOR NUM := 1 TO MONTHS DO  BEGIN(*FOR*) "WITH PAYROLL^.YEARSPAY[NUM] DO "BEGIN(*WITH*) $SELECTION := GETCHAR(['M','Q']); $CASE SELECTION OF &'M': BEGIN -PROMPTAT(22,BORDER); -PROMPTAT(23,'ENTER M(ONTH, Q(UIT'); -PROMPTAT(15,'ENTER PAY: '); -PAY := GETREAL(18,15,8); -PROMPTAT(15,' SOCSEC: '); -SOCSEC := GETREAL(1 PROCEDURE UPDATE(RECNUM:INTEGER);   (***************************************)  (* *)  (* UPDATES EMPLOYEE RECORD BY 1ST *)  (* PLACING A BLANK PAGE ON THE SCREEN *)  (* THEN OVERWRITING THE CURRENT INFO. EMP := TEMP2; -PUT(PAYROLL); -GET(PAYROLL); -REC := REC + 1; +END(*WHILE*); +PAYROLL^ := TEMP; +PUT(PAYROLL); +CLOSE(PAYROLL,LOCK); +RESET(PAYROLL,'PAYROLL:PAYROLL.DATA'); +END(*'I'*); &'Q': EXIT(INSERT); $END(*CASE*);  END(*INSERT*); $ NTIL *)  (* END OF FILE CONDITION. AT THAT TIME *)  (* THE LAST RECORD STILL HAS TO BE *)  (* WRITTEN BECAUSE THE FILE IS ONE *)  (* RECORD LONGER *)  -SEEK(PAYROLL,REC); -TEMP2 := PAYROLL^; -PAYROLL^ := TEMP; -T:= TRUE; +WHILE NOT EOF(PAYROLL) DO +BEGIN -IF FIRSTTIME THEN -BEGIN (* GOES TO NEXT *) 3(* RECORD IF INSERT *) 3(* HAPPENED *) - /SEEK(PAYROLL,REC); /GET(PAYROLL); /FIRSTTIME := FALSE; -END(*IF*);  (* READS AND WRITES RECORDS BELOW U+SEEK(PAYROLL,REC); +ENTERIT; ,(* USER INDICATES IN ENTERIT *) + (* IF THE ENTRY RECORD WAS *) ,(* CORRECT OR NOT AND WAS *) ,(* CORRECT IF SUCCESSFUL *) + +IF SUCCESSFUL THEN PUT(PAYROLL) .ELSE EXIT(INSERT); +REC := REC + 1; +FIRSTTIMECE TO CHANGE MIND*) "REC := 0; "SELECTION := GETCHAR(['I','Q']); "CASE SELECTION OF $'I': BEGIN +RESET(PAYROLL); +WHILE (PNAME > PAYROLL^.HISTORY.NAME) DO +BEGIN -GET(PAYROLL); -REC := REC + 1; +END(*WHILE*); +TEMP := PAYROLL^; "PAGE(OUTPUT); "GOTOXY(4,6); "WRITELN('THE INDIVIDUAL TO BE INSERTED IS '); "GOTOXY(10,11); "WRITELN('--------------------'); "GOTOXY(10,10); "WRITELN(PNAME); "PROMPTAT(22,BORDER); "PROMPTAT(23,'ENTER I(NSERT OR Q(UIT'); $(* GIVES USER CHANT IS *)  (* WRITTEN TO DISK THEN REOPENS IT. *)  (* *)  (***************************************)   VAR REC :INTEGER; $FIRSTTIME : BOOLEAN; $TEMP,TEMP2: PAYDATA;  BEGIN "FILESTATUS; (* OPENS FILE IF NEEDED*) (* THE PREVIOUS TEMP RECORD WRITTEN TO *)  (* THE FILE IN TRIANGULAR FASHION UNTIL*)  (* THE COMPLETE FILE HAS BEEN WRITTEN *)  (* LEAVING THE NEW RECORD INSERTED *)  (* ALPHABETICALLY. THEN CLOSES AND *)  (* LOCKS THE FILE TO ENSURE THAT IY STORE *)  (* THE RECORD THERE, USES THE PROCEDURE*)  (* 'ENTERIT' TO GET NEW RECORDS INPUT *)  (* DATA, AND WRITES THE NEW RECORD TO *)  (* THE INSERT POSITION. EACH RECORD *)  (* IS THEN READ INTO TEMP STORAGE AND *) *)  (* OPENS IF NOT YET OPEN. SHOWS THE *)  (* NAME OF EMPLOYEE TO BE INSERTED. *)  (* SEARCHES FILE UNTIL EMPLOYEES NAME *)  (* IS LESS THAN THE LAST NAME READ. *)  (* AT THIS POINT GOES TO THAT POSITION *)  (* IN THE FILE AND TEMPORARIL'*); $END(*CASE*); "END(*WITH*); !END(*FOR*); !SUCCESSFUL := TRUE;  END(*ENTERIT*);   PROCEDURE INSERT(PNAME:STRING);   (***************************************)  (* *)  (* CHECKS TO SEE IF FILE OPEN AND-W := W +1; -PROMPTAT(22,BORDER); -PROMPTAT(23,'ENTER M(ONTH, Q(UIT'); +END(*'M'*); &'Q': BEGIN (*** EXITS PROCEDURE *) 2(* WHEN USER HAS *) 2(* ENTERED ALL THE *) 2(* MONTHS DESIRED *) -SUCCESSFUL := TRUE; -EXIT(ENTERIT); +END(*'Q8,15,8); -PROMPTAT(15,' DEDUCTIONS: '); -DEDUCTIONS := GETREAL(18,15,8); -PROMPTAT(15,' WORKHOURS: '); -WORKHOURS := GETINT(18,15,3); -GOTOXY(0,W); -WRITELN(NUM:2,' ',PAY:9:2,' ',SOCSEC:8:2,' ', 5DEDUCTIONS:9:2,' ',WORKHOURS:4); *)  (* A MENU IS SHOWN AT THE BOTTOM OF *)  (* THE SCREEN AND THE USERS ASKED TO *)  (* SELECT THE ITEM TO BE CHANGED. THEN *)  (* DEPENDING UPON HIS SELECTION (CASE *)  (* STATEMENT BELOW) THE CURSOR IS *)  (* POSITIONED AND A STRING, INTEGER OR *)  (* REAL READ. INT AND REAL INPUT WITH *)  (* EDITING PROCEDURES 'GETREAL' AND *)  (* 'GETINT'. CONTINUES UPDATING UNTIL *)  (* USER INDICATES HE IS FINISHED AND *)  (* BOOLEAN 'DONE' IS SET TO TRUE. AT *)  (* THAT TIME A SEEK TO  UNTIL (EOF(PAYROLL)) OR (FULLNAME <= PAYROLL^.HISTORY.NAME);  IF EOF(PAYROLL) THEN #BEGIN %ENTERIT; %IF SUCCESSFUL THEN (BEGIN *PUT(PAYROLL); *EXIT(ENTER); ' END(*IF*); #END(*IF*);  IF FULLNAME < PAYROLL^.HISTORY.NAME THEN #BEGIN %INSERT(FULIAL');  GOTOXY(4,6);  WRITELN('YOU HAVE ',NAMELEN,' SPACES AS SHOWN: ');  GOTOXY(10,11);  WRITELN('--------------------');  GOTOXY(10,10);  READLN(FULLNAME);  REC:= 0;  REPEAT "REC:= REC + 1; "GET(PAYROLL); *)  (* *)  (***************************************)   ENTERING := TRUE;  FILESTATUS;  PAGE(OUTPUT);  PROMPTAT(2,' WHAT IS THE INDIVIDUAL''S NAME?');  PROMPTAT(4,' ENTER: LAST, FIRST MIDDLE INITTINUE*)  (* BY UPDATING THE EXISTING RECORD OR *)  (* QUIT. IN THE THIRD CASE THE NAME *)  (* IS FOUND TO FALL WITHIN THE EXIST- *)  (* ING FILE AND THE PROCEDURE INSERT *)  (* IS INVOKED IF THE USER WANTS TO *)  (* CONTINUE.  (* IF 'A' AND 'B' ARE THE CURRENT *)  (* FILE AND 'F' THE NEW RECORD IT *)  (* WOULD BE PLACED AT THE END GIVING *)  (* A NEW FILE 'A','B','F'. IF THAT *)  (* EMPLOYEE ALREADY EXISTS IT TELLS *)  (* YOU AND ASKS IF YOU WANT TO CONHE *)  (* SEQUENCE ALREADY IN BEING OR COULD *)  (* BE PLACED AT THE END OF THE EXIST- *)  (* ING FILE. IF THE LATTER PROCEDURE *)  (* ENTERIT IS INVOKED AND THE RECORD *)  (* PUT AT THE END OF THE FILE (EX: *)  (***************************************)  (* *)  (* ASKS USER FOR THE NAME OF *)  (* EMPLOYEE TO BE ENTERED. THEN *)  (* SEARCHES THE FILE TO SEE IF THEY *)  (* ALREADY EXIST, WOULD LIE IN TTH NEW DATA *) $END(*WITH*); $PROMPTAT(20,' D(ONE OR M(ORE'); $SELECTION := GETCHAR(['D','M']); $IF SELECTION = 'D' THEN DONE := TRUE (ELSE DONE := FALSE;  UNTIL DONE; "SEEK(PAYROLL,RECNUM); "PUT(PAYROLL);  END(*UPDATE*);   BEGIN(*ENTER*) ('5': BEGIN 1GOTOXY(34,5); 1READLN(ZIP); /END(*5*); ('6': PAYGRADE := GETINT(13,8,3); ('7': ALLOTMENTS := GETREAL(32,8,8); ('8': DEPENDENTS := GETINT(13,10,3); ('9': YEARSWITHUS := GETINT(31,10,3); &END(*CASE*);  POST; (* OVERWRITES WIE SELECTION OF ('1': BEGIN 1GOTOXY(18,1); 1READ(NAME); /END(*1*); ('2': BEGIN 1GOTOXY(11,3); 1READ(STREET); /END(*2*); ('3': BEGIN 1GOTOXY(11,5); 1READ(CITY); /END(*3*); ('4': BEGIN 1GOTOXY(30,5); 1READ(STATE); /END(*4*); ','4','5', :'6','7','8','9']); $READ(CH);(* CH USED BECAUSE PROCEDURE *) -(* GETCHAR WORKS ON CHAR *) -(* ONLY *) $ $GOTOXY(0,12); (* ERASES *) $WRITELN(ERASEOS); (* MENU *) $WITH PAYROLL^.HISTORY DO $BEGIN &CAS 4: STATE 7: ALLOTMENTS'); $PROMPTAT(16,'2: STREET 5: ZIP 8: DEPENDENTS'); $PROMPTAT(18,'3: CITY 6: PAYGRADE 9: YEARSWITHUS');  WRITELN; $WRITELN; $WRITE('WHICH ENTRY REQUIRES CHANGE: ',ERASEOS); $SELECTION := GETCHAR(['1','2','3"RESET(PAYROLL); "SEEK(PAYROLL,RECNUM); "GET(PAYROLL); "REPEAT $PRINTPAGE;(*FORMATTED PAGE DISPLAYED *) $POST;(*EMPLOYEE DATA OVERWRITTEN *) )(* MENU CREATED BELOW *) $ $PROMPTAT(12,'ENTER THE ITEM NUMBER TO CHANGE'); $PROMPTAT(14,'1: NAME THE RECORD IS *)  (* ACCOMPLISHED AND THE NEW (REVISED) *)  (* RECORD IS WRITTEN. *)  (* *)  (***************************************)   VAR DONE: BOOLEAN;  BEGIN "PAGE(OUTPUT); LNAME); %EXIT(ENTER); #END(*IF*);  IF FULLNAME = PAYROLL^.HISTORY.NAME THEN #BEGIN %PROMPTAT(12,' FILE FOR THIS INDIVIDUAL EXISTS'); %PROMPTAT(22,BORDER); %PROMPTAT(23,' ENTER U(PDATE OR Q(UIT'); %SELECTION := GETCHAR(['U','Q']); %CASE SELECTION OF ''U': UPDATE(REC); ''Q': EXIT(ENTER); %END(*CASE*); #END(*IF*);  ENTERING := FALSE;  END(*ENTER*);  #WRITELN(ERASEOL);  END(*PROMPTAT*); *  FUNCTION GETCHAR (OKSET: SETOFCHAR): CHAR;  VAR CH: CHAR; $GOOD:BOOLEAN;  BEGIN "REPEAT $READ(KEYBOARD,CH); $IF EOLN(KEYBOARD) THEN CH:=CHR(13); $GOOD:= CH IN OKSET; $IF NOT GOOD THEN WRITE(CHR(7),CHR(7))ITE*);  (*$I+*)  ONCETHRU := TRUE;  END(*OPEN FILE*); ,  PROCEDURE WAIT(TIME:INTEGER);  VAR DELAY:INTEGER;  BEGIN "FOR DELAY:=1 TO TIME DO;  END; "  PROCEDURE PROMPTAT(J:INTEGER; S:STRING);  BEGIN #GOTOXY(0,J); #WRITE(S); 0; .PAYGRADE:=0; ,ALLOTMENTS:= 0.0; 'END; 'FOR I:= 1 TO MONTHS DO 'BEGIN )WITH PAYROLL^.YEARSPAY[I] DO )BEGIN 2PAY := 0.0; /SOCSEC := 0.0; +DEDUCTIONS := 0.0; ,WORKHOURS := 0; )END; 'END; 'PAYROLL^.REMARKS := NULL; 'PUT(PAYROLL); $END(*REWRL,'PAYROLL:PAYROLL.DATA'); $IF IORESULT <> 0 THEN $BEGIN 'REWRITE(PAYROLL,'PAYROLL:PAYROLL.DATA'); '(*$I+*) 'WITH PAYROLL^.HISTORY DO 'BEGIN 2NAME:= NULL; 0STREET:= NULL; 2CITY:= NULL; 1STATE:= NULL; 3ZIP:= NULL; ,DEPENDENTS:=0; +YEARSWITHUS:=#ONCETHRU: BOOLEAN; "ERASEOL,ERASEOS,HOME,ERASE:CHAR; "SELECTION: CHAR; " I: INTEGER; % PRINT: STRING[10]; * *  PROCEDURE OPENFILE;  BEGIN $PRINT:='CONSOLE:'; $RESET(P,PRINT); $STOP:=FALSE; $(*$I-*) $CLOSE(PAYROLL,LOCK); $RESET(PAYROLNTHS] OF PAYYEARHISTORY; -REMARKS: STRING; %END(*PAYDATA*); %  VAR  PAYROLL,PAYBUF: FILE OF PAYDATA; *P: INTERACTIVE; (*P WILL REPRESENT EITHER CONSOLE: OR PRINTER:*) )CH: CHAR; 'STOP: BOOLEAN; %ADDING: BOOLEAN; #ENTERING: BOOLEAN; LOTMENTS: REAL; %END(*PERSONALDATA*); * #PAYYEARHISTORY = PACKED RECORD 1PAY: REAL; .SOCSEC: REAL; *DEDUCTIONS: REAL; +WORKHOURS: INTEGER; %END(*PAYYEARHISTORY*); + #PAYDATA = PACKED RECORD -HISTORY: PERSONALDATA; ,YEARSPAY: PACKED ARRAY [1..MO$ #SETOFCHAR = SET OF CHAR; #PERSONALDATA = PACKED RECORD 0NAME: STRING[NAMELEN]; .STREET: STRING[STREETLEN]; 0CITY: STRING[CITYLEN]; /STATE: STRING[STATELEN]; 1ZIP: STRING[5]; *DEPENDENTS: INTEGER; )YEARSWITHUS: INTEGER; ,PAYGRADE: INTEGER; *AL PROGRAM FILEDEMO;  CONST #BORDER = '****************************************'; #NULL = ''; #NAMELEN = 20; #STREETLEN = 25; #CITYLEN = 17; #STATELEN = 2; #MONTHS = 12; #MAXINT = 300; #MININT = 0; #MAXREAL = 9999.99; #MINREAL = 0.0; $  TYPE N N1 N2 N3 R1 R2 $2&:9|9N^١ 'ELSE IF CH IN [' '..'Z'] THEN WRITE(CH); "UNTIL GOOD; "GETCHAR:=CH;  END(*GETCHAR*);   PROCEDURE POST;  BEGIN  WITH PAYROLL^.HISTORY DO &BEGIN &GOTOXY(18,1);WRITE(NAME); &GOTOXY(11,3);WRITE(STREET); &GOTOXY(11,5);WRITE(CITY:17); &GOTOXY(30,5);WRITE(STATE:2); &GOTOXY(34,5);WRITE(ZIP:5); &GOTOXY(13,8);WRITE(PAYGRADE); &GOTOXY(32,8);WRITE(ALLOTMENTS:6:2); &GOTOXY(13,10);WRITE(DEPENDENTS); &GOTOXY(31,10);WRITE(YEARSWITHUS); % END(*WITH*);  END(*POST*); $  PROCEDURE GOOFED(VAR H:INTEGER) PROMPTAT(23,'ENTER ITEM ASKED FOR AT CURSOR ');  WITH PAYROLL^.HISTORY DO  BEGIN "NAME:=FULLNAME; "GOTOXY(11,3); "READLN(STREET); "GOTOXY(11,5); "READ(CITY); "READLN; "GOTOXY(30,5); "READ(STATE); "READLN; "GOTOXY(34,5); "READLN(ZIP); "PAYGR= 0.0; &SOCSEC := 0.0; &DEDUCTIONS := 0.0; &WORKHOURS := 0; $END(*WITH*); "END(*FOR*);  END(*INITTWELVE*);   PROCEDURE ENTERIT;  BEGIN  PRINTPAGE;  GOTOXY(18,1);  WRITE(FULLNAME);  PROMPTAT(22,BORDER); D(*INSTRUCTIONS*);   PROCEDURE ENTER;  VAR FULLNAME: STRING[20]; $REC,W,I,NUM:INTEGER; $SUCCESSFUL:BOOLEAN;   PROCEDURE INITTWELVE;  VAR NUM: INTEGER;   BEGIN "FOR NUM := 1 TO MONTHS DO "BEGIN $WITH PAYROLL^.YEARSPAY[NUM] DO $BEGIN &PAY :MPTAT(10,' LIB1:FD.INTRO '); #PROMPTAT(12,' OR PAYROLL:FD.INTRO '); #GOTOXY(0,22); #WRITELN(BORDER); #WRITE('ENTER E(XIT TO INFO OR C(ONTINUE'); #SELECTION := GETCHAR(['E','C']); #IF SELECTION = 'E' THEN THATSALL;  EN"PROMPTAT(12,' .....THAT''S ALL FOLKS'); "EXIT(PROGRAM);  END(*THATSALL*);   PROCEDURE INSTRUCTIONS;  BEGIN #PAGE(OUTPUT); #WRITELN(' INSTRUCTIONS'); #WRITELN(BORDER); #PROMPTAT(8,'FOR INSTRUCTION EX(ECUTE THE PROGRAM:'); #PRO DEPENDENTS:'); "GOTOXY(19,10); "WRITELN('IN SERVICE: YRS');  END(*PRINTPAGE*); "  PROCEDURE FILESTATUS;  BEGIN #IF ONCETHRU = FALSE THEN OPENFILE &ELSE RESET(PAYROLL);  END(*FILESTATUS*); "  PROCEDURE THATSALL;  BEGIN "PAGE(OUTPUT); GE;  BEGIN "PAGE(OUTPUT); "PROMPTAT(1,' PAYROLL FILE FOR'); "PROMPTAT(3,' ADDRESS:'); "PROMPTAT(5,' CITY'); "GOTOXY(28,5); "WRITELN(', ST ZIP'); "PROMPTAT(8,' PAYGRADE: '); "GOTOXY(19,8); "WRITELN('ALLOTMENTS: $'); "PROMPTAT(10,'(PAYROLL^.HISTORY.PAYGRADE:=0; (PAYROLL^.HISTORY.ALLOTMENTS:= 0.0; (ADDING := FALSE; &END; &POST; &GOTOXY(X,Y); &WRITE(' ':A); $END(*ELSE*); $GOTOXY(X,Y); $READITI(INUM); "UNTIL GOODNUM;  GETINT := INUM;  END(*GETINT *); $  PROCEDURE PRINTPA END(*READITI*); *  BEGIN(*GETINT *) "GOODNUM := FALSE; "REPEAT $IF NOT ENTERING THEN $BEGIN &GOTOXY(X,Y); &WRITELN(ERASEOS); $END(*IF*) $ELSE $BEGIN &IF ADDING THEN &BEGIN (PAYROLL^.HISTORY.DEPENDENTS:=0; (PAYROLL^.HISTORY.YEARSWITHUS:=0; NTEGER);   VAR Y,H:INTEGER;   BEGIN $(*$I-*) $READ(Y); $(*$I+*) $H:=IORESULT; $IF (H <> 0) OR (Y < MININT) OR (Y > MAXINT) THEN &BEGIN )GOOFED(H); &END(*IF*); "X:=Y; "IF H = 0 THEN GOODNUM := TRUE &ELSE GOODNUM := FALSE; &POST; &GOTOXY(X,Y); &WRITE(' ':A); &END(*ELSE*); $GOTOXY(X,Y); $READITR(RNUM); "UNTIL GOODNUM;  GETREAL := RNUM;  END(*GETREAL*); $  FUNCTION GETINT(X,Y,A:INTEGER):INTEGER;  VAR GOODNUM:BOOLEAN; 'INUM:INTEGER; $ "  PROCEDURE READITI(VAR X:IN &GOOFED(H); $END(*IF*); "IF H = 0 THEN GOODNUM := TRUE &ELSE GOODNUM := FALSE;  X:=Y;  END(*READITR*); $  BEGIN(*GETREAL*) "GOODNUM := FALSE; "REPEAT $IF NOT ENTERING THEN $BEGIN &GOTOXY(X,Y); &WRITELN(ERASEOS); $END(*IF*) $ELSE $BEGIN  FUNCTION GETREAL(X,Y,A:INTEGER):REAL;  VAR GOODNUM:BOOLEAN; $RNUM:REAL;    PROCEDURE READITR(VAR X:REAL);  VAR Y: REAL; $H: INTEGER;  BEGIN $(*$I-*) $READ(Y); $(*$I+*) $H:=IORESULT; $IF (H<>0) OR (Y < MINREAL) OR (Y > MAXREAL) THEN $BEGI;  BEGIN #GOTOXY(0,19); #WRITELN('YOU PROBABLY MADE AN I/O ERROR'); #WRITELN(ERASEOS); #WRITELN(' G(OOFED WILL ASK FOR ANOTHER ENTRY'); #SELECTION := GETCHAR(['G']); #READ(CH); #H:=14; #GOTOXY(0,19); #WRITELN(ERASEOS);  END(*GOOFED*);  ADE := GETINT(13,8,3); "ALLOTMENTS:= GETREAL(32,8,8); "DEPENDENTS := GETINT(13,10,3); "YEARSWITHUS := GETINT(31,10,3); "READ(CH); "GOTOXY(0,12); "WRITE('ENTER REMARKS: '); "READLN(PAYROLL^.REMARKS); "GOTOXY(0,12); "WRITELN(PAYROLL^.REMARKS,ERASEOL); "PROMPTAT(23,' ENTER C(ORRECT OR E(RROR'); "SELECTION := GETCHAR(['C','E']); "CASE SELECTION OF $'E': BEGIN +SUCCESSFUL := FALSE; +EXIT(ENTERIT); )END(*'E'*); "END(*CASE*);  END(*WITH*); $ENTERING := FALSE; $WRITELN(HOME,ERASE); $PROMPTAT(1,$PROMPTAT(20,' D(ONE OR M(ORE'); $SELECTION := GETCHAR(['D','M']); $IF SELECTION = 'D' THEN DONE := TRUE (ELSE DONE := FALSE;  UNTIL DONE; "SEEK(PAYROLL,RECNUM); "PUT(PAYROLL);  END(*UPDATE*);   BEGIN(*ENTER*)  ENTERING := TRUE;  FILESTATU5': BEGIN 1GOTOXY(34,5); 1READLN(ZIP); /END(*5*); ('6': PAYGRADE := GETINT(13,8,3); ('7': ALLOTMENTS := GETREAL(32,8,8); ('8': DEPENDENTS := GETINT(13,10,3); ('9': YEARSWITHUS := GETINT(31,10,3); &END(*CASE*); &POST; $END(*WITH*); N &CASE SELECTION OF ('1': BEGIN 1GOTOXY(18,1); 1READ(NAME); /END(*1*); ('2': BEGIN 1GOTOXY(11,3); 1READ(STREET); /END(*2*); ('3': BEGIN 1GOTOXY(11,5); 1READ(CITY); /END(*3*); ('4': BEGIN 1GOTOXY(30,5); 1READ(STATE); /END(*4*); (' 6: PAYGRADE 9: YEARSWITHUS');  WRITELN; $WRITELN; $WRITE('WHICH ENTRY REQUIRES CHANGE: ',ERASEOS); $SELECTION := GETCHAR(['1','2','3','4','5', :'6','7','8','9']); $READ(CH); $GOTOXY(0,12); $WRITELN(ERASEOS); $WITH PAYROLL^.HISTORY DO $BEGI"SEEK(PAYROLL,RECNUM); "GET(PAYROLL); "REPEAT $PRINTPAGE; $POST; $PROMPTAT(12,'ENTER THE ITEM NUMBER TO CHANGE'); $PROMPTAT(14,'1: NAME 4: STATE 7: ALLOTMENTS'); $PROMPTAT(16,'2: STREET 5: ZIP 8: DEPENDENTS'); $PROMPTAT(18,'3: CITY YROLL); +CLOSE(PAYROLL,LOCK); +RESET(PAYROLL,'PAYROLL:PAYROLL.DATA'); +END(*'I'*); &'Q': EXIT(INSERT); $END(*CASE*);  END(*INSERT*); $  PROCEDURE UPDATE(RECNUM:INTEGER);  VAR DONE: BOOLEAN;  BEGIN "PAGE(OUTPUT); "RESET(PAYROLL); EN -BEGIN /SEEK(PAYROLL,REC); /GET(PAYROLL); /FIRSTTIME := FALSE; -END(*IF*); -SEEK(PAYROLL,REC); -TEMP2 := PAYROLL^; -PAYROLL^ := TEMP; -TEMP := TEMP2; -PUT(PAYROLL); -GET(PAYROLL); -REC := REC + 1; +END(*WHILE*); +PAYROLL^ := TEMP; +PUT(PAREC + 1; +END(*WHILE*); +TEMP := PAYROLL^; +SEEK(PAYROLL,REC); +ADDING:=TRUE; +ENTERIT; +ADDING:=FALSE; +IF SUCCESSFUL THEN PUT(PAYROLL) .ELSE EXIT(INSERT); +REC := REC + 1; +FIRSTTIME:= TRUE; +WHILE NOT EOF(PAYROLL) DO +BEGIN -IF FIRSTTIME TH"WRITELN(PNAME); "PROMPTAT(22,BORDER); "PROMPTAT(23,'ENTER I(NSERT OR Q(UIT'); "REC := 0; "SELECTION := GETCHAR(['I','Q']); "CASE SELECTION OF $'I': BEGIN +RESET(PAYROLL); +WHILE (PNAME > PAYROLL^.HISTORY.NAME) DO +BEGIN -GET(PAYROLL); -REC := :STRING);  VAR REC :INTEGER; $FIRSTTIME : BOOLEAN; $TEMP,TEMP2: PAYDATA;  BEGIN "FILESTATUS; "PAGE(OUTPUT); "GOTOXY(4,6); "WRITELN('THE INDIVIDUAL TO BE INSERTED IS '); "GOTOXY(10,11); "WRITELN('--------------------'); "GOTOXY(10,10); +1; -PROMPTAT(22,BORDER); -PROMPTAT(23,'ENTER M(ONTH, Q(UIT'); +END(*'M'*); &'Q': BEGIN -SUCCESSFUL := TRUE; -EXIT(ENTERIT); +END(*'Q'*); $END(*CASE*); "END(*WITH*); !END(*FOR*); !SUCCESSFUL := TRUE;  END(*ENTERIT*);   PROCEDURE INSERT(PNAME; -PROMPTAT(15,' DEDUCTIONS: '); -DEDUCTIONS := GETREAL(18,15,8); -PROMPTAT(15,' WORKHOURS: '); -WORKHOURS := GETINT(18,15,3); -GOTOXY(0,W); -WRITELN(NUM:2,' ',PAY:9:2,' ',SOCSEC:8:2,' ', 5DEDUCTIONS:9:2,' ',WORKHOURS:4); -W := W $SELECTION := GETCHAR(['M','Q']); $CASE SELECTION OF &'M': BEGIN -PROMPTAT(22,BORDER); -PROMPTAT(23,'ENTER M(ONTH, Q(UIT'); -PROMPTAT(15,'ENTER PAY: '); -PAY := GETREAL(18,15,8); -PROMPTAT(15,' SOCSEC: '); -SOCSEC := GETREAL(18,15,8)'MO PAY SOCSEC DEDUCTIONS HRS'); $PROMPTAT(22,BORDER); $PROMPTAT(23,'ENTER M(ONTH, Q(UIT'); $W := 3; $INITTWELVE;  FOR NUM := 1 TO MONTHS DO  BEGIN(*FOR*) "WITH PAYROLL^.YEARSPAY[NUM] DO "BEGIN(*WITH*) S;  PAGE(OUTPUT);  PROMPTAT(2,' WHAT IS THE INDIVIDUAL''S NAME?');  PROMPTAT(4,' ENTER: LAST, FIRST MIDDLE INITIAL');  GOTOXY(4,6);  WRITELN('YOU HAVE ',NAMELEN,' SPACES AS SHOWN: ');  GOTOXY(10,11);  WRITELN('--------------------');  GOTOXY(10,10);  READLN(FULLNAME);  REC:= 0;  REPEAT "REC:= REC + 1; "GET(PAYROLL);  UNTIL (EOF(PAYROLL)) OR (FULLNAME <= PAYROLL^.HISTORY.NAME);  IF EOF(PAYROLL) THEN #BEGIN %ADDING:=TRUE; %ENTERIT; %ADDING:=FALSE; %IF SUCCESSFUL THEN PUT(PAYROLL); %E+PROMPTAT(23,'ENTER C(ONTINUE OR E(XIT LIST'); +SELECTION := GETCHAR(['C','E']); +IF SELECTION = 'E' THEN EXIT(LIST); +UNTIL EOF(PAYROLL); +END(*'H'*); $'N': BEGIN +WRITELN(HOME,ERASE); +PROMPTAT(1,'ENTER THE NAME: '); +GOTOXY(4,6); +WRITELN('YOUITELN(ERASEOS); -FOR I := 1 TO 15 DO -BEGIN /IF NOT EOF(PAYROLL) THEN /BEGIN 1WRITELN(RECNUM,' ',PAYROLL^.HISTORY.NAME); 1RECNUM:= RECNUM+1; 1GET(PAYROLL); /END(*IF*); -END(*FOR*); +PROMPTAT(22,BORDER); GETINT(30,18,5); +IF REC = 0 THEN EXIT(ONEREC); +SEEK(PAYROLL,REC); +GET(PAYROLL); +LISTONE; +READ(CH); +EXIT(ONEREC); )END(*'I'*); $'H': BEGIN +PAGE(OUTPUT); +PROMPTAT(1,'REC NAME'); +GET(PAYROLL); +RECNUM:= 1; +REPEAT -GOTOXY(0,3);WRGRAM'); "PROMPTAT(18,' ***** SELECT ONE *****'); "SELECTION:=GETCHAR(['I','E','H','N','Q']);  END(*SONEREC*); $  BEGIN(*ONEREC*)  REPEAT "SONEREC; "CASE SELECTION OF $'I': BEGIN +GOTOXY(0,18); +WRITE('ENTER THE RECORD NUMBER NOW: '); +REC := "PROMPTAT(6,' ****************************'); "PROMPTAT(8,' I( KNOW WHICH RECORD NUMBER'); "PROMPTAT(10,' H(ELP ME FIND THE RECORD NUMBER'); "PROMPTAT(12,' N(AME KNOWN'); "PROMPTAT(14,' Q(UIT'); "PROMPTAT(16,' E(XIT PROEND(*LISTALL*);  &  PROCEDURE ONEREC;  VAR RECNUM,REC,I:INTEGER;  S:STRING[NAMELEN]; $  PROCEDURE SONEREC;  BEGIN  RESET(PAYROLL); "WRITELN(HOME,ERASE); "PROMPTAT(5,' MENU FOR LIST ONE RECORD');  SELECTION:= GETCHAR(['A','O','Q']);  END(*MENU2*);   PROCEDURE LISTALL;  BEGIN "RESET(PAYROLL); "GET(PAYROLL); "REPEAT $LISTONE; $CASE SELECTION OF &'Q': EXIT(LISTALL); &'T': TWELVEMO; $END(*CASE*); $GET(PAYROLL);  UNTIL EOF(PAYROLL);  END(*LISTONE*); &  PROCEDURE MENU2;  BEGIN "WRITELN(HOME,ERASE); "PROMPTAT(4,' LIST'); "PROMPTAT(5,' ********'); "PROMPTAT(7,' A(LL RECORDS'); "PROMPTAT(9,' O(NE RECORD'); "PROMPTAT(11,' Q(UIT'); "PROMPTAT(15,' ****SELECT ONE**** '); $PROMPTAT(15,' T(WELVE MONTH PAY HISTORY'); $PROMPTAT(17,' N(EXT EMPLOYEE'); $PROMPTAT(19,' Q(UIT LIST'); $PROMPTAT(22,' ***** SELECT ONE *****'); $SELECTION:= GETCHAR(['N','T','Q']); $IF SELECTION = 'T' THEN TWELVEMO; "END(*IF*);  D(*FOR*); "PROMPTAT(23,'ENTER C(ONTINUE WHEN READY'); "SELECTION := GETCHAR(['C']);  END(*TWELVEMO*); "  PROCEDURE LISTONE;  BEGIN  PRINTPAGE;  IF NOT EOF(PAYROLL) THEN "BEGIN $POST; $WITH PAYROLL^ DO &BEGIN (PROMPTAT(12,REMARKS); &END; OTOXY(0,9); "FOR I := 1 TO MONTHS DO "BEGIN $IF PAYROLL^.YEARSPAY[I].WORKHOURS <> 0 THEN $BEGIN &WITH PAYROLL^.YEARSPAY[I] DO &BEGIN (WRITELN(I:2,' ',PAY:9:2,' ',SOCSEC:8:2,' ', 6DEDUCTIONS:9:2,' ',WORKHOURS:4); &END(*WITH*); $END(*IF*); "ENDURE TWELVEMO;  VAR MO,I,WRKHRS: INTEGER;  BEGIN "WRITELN(HOME,ERASE); "PROMPTAT(2,' TWELVE MONTH PAY HISTORY FOR '); "GOTOXY(12,4);WRITE(PAYROLL^.HISTORY.NAME); "PROMPTAT(6,'MO PAY SOCSEC DEDUCTIONS HRS'); "PROMPTAT(7,BORDER); "G%PROMPTAT(22,BORDER); %PROMPTAT(23,' ENTER U(PDATE OR Q(UIT'); %SELECTION := GETCHAR(['U','Q']); %CASE SELECTION OF ''U': UPDATE(REC); ''Q': EXIT(ENTER); %END(*CASE*); #END(*IF*);  ENTERING := FALSE;  END(*ENTER*);   PROCEDURE LIST;   PROCEXIT(ENTER); #END(*IF*);  IF FULLNAME < PAYROLL^.HISTORY.NAME THEN #BEGIN %INSERT(FULLNAME); %EXIT(ENTER); #END(*IF*);  IF FULLNAME = PAYROLL^.HISTORY.NAME THEN #BEGIN %PROMPTAT(12,' FILE FOR THIS INDIVIDUAL EXISTS'); HAVE ',NAMELEN,' SPACES AS SHOWN: '); +GOTOXY(10,11); +WRITELN('--------------------'); +GOTOXY(10,10); +READLN(S); +REC:=0; +REPEAT -GET(PAYROLL); -REC:= REC + 1; +UNTIL (PAYROLL^.HISTORY.NAME = S) OR EOF(PAYROLL); +GOTOXY(4,10); +IF EOF(PAYROLL) THEN -WRITELN('RECORD FOR ',S,' NOT FOUND') /ELSE /BEGIN 1WRITELN('THE RECORD NUMBER FOR '); 1WRITELN(' ',S,' IS: ',REC,ERASEOL); /END(*ELSE*); /PROMPTAT(22,BORDER); /PROMPTAT(23,'ENTER C(ONTINUE WHEN READY '); /SELECTION := GETCHAR(['C'])"SELECTION:= GETCHAR(['I','E','L','U','D','S','P','Q','R']);  END(*MENU*);   BEGIN(*MAIN PROGRAM*) #ERASEOL:=CHR(16);ERASEOS:=CHR(11); #ERASE:=CHR(12);HOME:=CHR(25); #ENTERING := FALSE; #STOP := FALSE; #ONCETHRU := FALSE; #REPEAT; %MENU; %CASEE'); "PROMPTAT(13,' S(EARCH'); "PROMPTAT(15,' P(ROCESS'); "PROMPTAT(17,' Q(UIT'); "PROMPTAT(19,' R(EMOVE >>ENTIRE<< FILE'); "PROMPTAT(21,'***** SELECT BY FIRST LETTER *****'); "PROMPTAT(23,' WHICH ONE?:'); RGEIT*);   PROCEDURE MENU;  BEGIN "WRITELN(HOME,ERASE); "PROMPTAT(1,' PAYROLL FILE DEMONSTRATION'); "PROMPTAT(3,' I(NSTRUCTIONS'); "PROMPTAT(5,' E(NTER'); "PROMPTAT(7,' U(PDATE'); "PROMPTAT(9,' L(IST'); "PROMPTAT(11,' D(ELETTAT(22,BORDER);  PROMPTAT(23,'ENTER C(ONTINUE OR E(XIT PROGRAM');  SELECTION := GETCHAR(['C','E']);  IF SELECTION = 'E' THEN THATSALL;  END(*PROCESS*);   PROCEDURE PURGEIT;  BEGIN "CLOSE(PAYROLL,PURGE); "CLOSE(PAYROLL,LOCK); "THATSALL;  END(*PU)(*****************************) )  WRITELN(HOME,ERASE);  PROMPTAT(10,'YOUR PROCESS WOULD GO HERE;');  PROMPTAT(12,' HOWEVER, THE PURPOSE OF THIS');  PROMPTAT(14,' PROGRAM IS ONLY TO DEMONSTRATE');  PROMPTAT(16,' DISK HANDLING');  PROMPC']);  END(*SEARCH*);   PROCEDURE PROCESS;  BEGIN )(*****************************) )(* *) )(* YOUR PROCESSING OF THE *) )(* DATA WOULD OCCUR HERE *) )(* *) RECORD IS NOT IN FILE'); "END(*IF*)  ELSE "BEGIN $PROMPTAT(14,'THE RECORD NUMBER FOR EMPLOYEE'); $GOTOXY(5,16); $WRITELN(FULLNAME,' IS: ',REC); "END(*ELSE*);  PROMPTAT(22,BORDER);  PROMPTAT(23,'ENTER C(ONTINUE TO EXIT');  SELECTION := GETCHAR(['----');  REPEAT "GOTOXY(10,10); "READLN(FULLNAME);  UNTIL LENGTH(FULLNAME) > 2;  REC:= 0;  REPEAT "REC:= REC + 1; "GET(PAYROLL);  UNTIL EOF(PAYROLL) OR (FULLNAME = PAYROLL^.HISTORY.NAME);  IF EOF(PAYROLL) THEN "BEGIN $GOTOXY(0,14); $WRITELN(' BEGIN  FILESTATUS;  PAGE(OUTPUT);  PROMPTAT(2,' WHAT IS THE INDIVIDUAL''S NAME?');  PROMPTAT(4,' ENTER: LAST, FIRST MIDDLE INITIAL');  GOTOXY(4,6);  WRITELN('YOU HAVE ',NAMELEN,' SPACES AS SHOWN: ');  GOTOXY(10,11);  WRITELN('----------------"SEEK(PAYROLL,REC-1); "PUT(PAYROLL); "RESET(PAYROLL); "REPEAT $PAYROLL^ := PAYBUF^; $PUT(PAYROLL); $GET(PAYBUF); "UNTIL EOF(PAYBUF); "CLOSE(PAYBUF,PURGE);  END(*DELETE*);   PROCEDURE SEARCH;  VAR REC:INTEGER; $FULLNAME:STRING[NAMELEN]; BUF,'PAY.DATA'); "REPEAT $PAYBUF^ := PAYROLL^; $PUT(PAYBUF); $REC := REC + 1; $GET(PAYROLL); $IF REC = RECNUM THEN GET(PAYROLL); "UNTIL EOF(PAYROLL); "CLOSE(PAYROLL,PURGE); "RESET(PAYBUF); "GET(PAYBUF); "REWRITE(PAYROLL,'PAYROLL:PAYROLL.DATA'); T(22,' ENTER 0 FOR THE RECORD NUMBER AND'); "PROMPTAT(23,' USE THE L(IST FUNCTION TO FIND IT'); "GOTOXY(12,12); "WAIT(8000); "WRITE('RECORD #: '); "RECNUM := GETINT(22,12,5); "IF RECNUM = 0 THEN EXIT(DELETE); "REC:=0; "RESET(PAYROLL); "REWRITE(PAY PROCEDURE DELETE;  VAR REC,RECNUM:INTEGER;  BEGIN "FILESTATUS; "WRITELN(HOME,ERASE); "PROMPTAT(2,' ENTER THE RECORD NUMBER TO BE DELETED'); "PROMPTAT(3,BORDER); "PROMPTAT(20,BORDER); "PROMPTAT(21,'IF YOU DO NOT KNOW THE RECORD NUMBER'); "PROMPTA; )END(*'N'*); %'Q': EXIT(ONEREC); %'E': THATSALL; "END(*CASE*);  UNTIL FALSE;  END(*ONEREC*); & &  BEGIN(*LIST*) "FILESTATUS; "MENU2; "CASE SELECTION OF $'Q': EXIT(LIST); $'A': LISTALL; $'O': ONEREC;  END(*SELECT*);  END(*LIST*);  SELECTION OF ''I': INSTRUCTIONS; ''E': ENTER; ''U': ENTER; ''L': LIST; ''R': PURGEIT; ''D': DELETE; ''S': SEARCH; ''P': PROCESS; ''Q': STOP := TRUE; %END(*CASE*); #UNTIL STOP; #CLOSE(PAYROLL,LOCK); #THATSALL;  END. (****************************************ENTER M(ONTH, Q(UIT  ȡע+   ᩄצ(****************************************צENTER M(ONTH, Q(UITENTER PAY: צ  ENTER REMARKS: עP ע ENTER C(ORRECT OR E(RRORU(ᩄ  EE۶(MO PAY SOCSEC DEDUCTIONS HRSצ(****************************************צENTER ITEM ASKED FOR AT CURSOR ز آ  آآ!"آ#آ(  آ) آ&  آ'  TRO (**************************************** ENTER E(XIT TO INFO OR C(ONTINUE(ᩄEá ȡ=ע+ ڳIڢڢڢDR  FOLKS8  INSTRUCTIONS(****************************************%FOR INSTRUCTION EX(ECUTE THE PROGRAM: צ" LIB1:FD.INTRO  צ" OR PAYROLL:FD.IN CITYצ , ST ZIP PAYGRADE:  ALLOTMENTS: $ צ DEPENDENTS: IN SERVICE: YRS     .....THAT'S ALLI T "ɍ,ōښá: ۓ=ڡ'ע&ע'ע(ע)  ݡo z   PAYROLL FILE FORצ ADDRESS: FOR ANOTHER ENTRY"L F?áP ۓ  ݡ آ  آآ!"آ# أ( آ) أ&  أ' צYOU PROBABLY MADE AN I/O ERRORצ% G(OOFED WILL ASKעצPܭEc $ȡتPR2   Tf$ nͥCONSOLE:ת ٥צPAYROLL:PAYROLL.DATA"ˡצPAYROLL:PAYROLL.DATAצآ צآצآ!צآ#צآ&آ'آ(آ)X ȡAע+ ٳ٢)٢(٢"* $ FILEDEMO SOCSEC: ٢ DEDUCTIONS: ٢צ WORKHOURS: ٢    ټ  ٢ ٢   צ(****************************************צENTER M(ONTH, Q(UIT;MQ   & nتP  &THE INDIVIDUAL TO BE INSERTED IS  צ--------------------     Bצ RECORD FOR צ NOT FOUNDtצTHE RECORD NUMBER FOR צ  IS:  ***********צENTER C(ONTINUE OR E(XIT LIST(ᩄEá צENTER THE NAME:  YOU HAVE  צ SPACES AS SHOWN:  --------------------ER NOW:  á צREC NAMEȡL :  צ(*****************************" I( KNOW WHICH RECORD NUMBER & H(ELP ME FIND THE RECORD NUMBER  N(AME KNOWN Q(UIT E(XIT PROGRAM ***** SELECT ONE ***** CFENTER THE RECORD NUMBצ ****SELECT ONE**** @ QT 4L MENU FOR LIST ONE RECORD ****************************HISTORY N(EXT EMPLOYEEצ Q(UIT LIST ***** SELECT ONE ******@ᩄTá*  LISTצ ******** A(LL RECORDS צ O(NE RECORD צ Q(UIT϶  ܼ צ ܢ ܢ   ENTER C(ONTINUE WHEN READY8C   آ T(WELVE MONTH PAY ۭ % TWELVE MONTH PAY HISTORY FOR  'MO PAY SOCSEC DEDUCTIONS HRSצ(****************************************  ȡע+ ˡע+  ״ ׵ׯ צ' FILE FOR THIS INDIVIDUAL EXISTS(**************************************** ENTER U(PDATE OR Q(UIT"ᩄ QU   ! WHAT IS THE INDIVIDUAL'S NAME?צ$ ENTER: LAST, FIRST MIDDLE INITIAL YOU HAVE  צ SPACES AS SHOWN:  --------------------   ڢ}ڢ!j"ڢ#Oڢ(  Bڢ) 4ڢ&  'ڢ'  19q`G<0% D(ONE OR M(ORE* ᩄDá١?Zv nENTSצ%2: STREET 5: ZIP 8: DEPENDENTS&3: CITY 6: PAYGRADE 9: YEARSWITHUSWHICH ENTRY REQUIRES CHANGE:   ڀƀ-++ƀըצPAYROLL:PAYROLL.DATAIQ  "   צENTER THE ITEM NUMBER TO CHANGE%1: NAME 4: STATE 7: ALLOTMצ(****************************************צENTER I(NSERT OR Q(UIT+ᩄױ++ƀթר+ڮڶ ++, T,+,+-רƀըצ(****************************************צENTER C(ONTINUE WHEN READY ,&"EQ C 7*,; 1-)AQ" ' 5H & ENTER THE RECORD NUMBER TO BE DELETED(****************************************(****************************************$IF YOU DO NOT KNOW THE RECORD NUMBER" ENTER 0 FOR THE RECORD NUMBER ANDPROGRAM FDINSTRUCTIONS;  VAR CH:CHAR;   PROCEDURE PAGEONE;  BEGIN #PAGE(OUTPUT); #WRITELN('THE PROGRAM FILEDEMO IS DESIGNED TO'); #WRITELN; #WRITELN('RUN ON A DISKETTE CALLED ''PAYROLL:'''); #WRITELN('*****************************************'); N^/ǨץǨ  &NJFB>:62ٹ,DU$, 82*(:4"H١ *6X J TV~L6&<  d!""""@ U(PDATE צ L(IST D(ELETE צ S(EARCH P(ROCESS Q(UITצ R(EMOVE >>ENTIRE<< FILE"***** SELECT BY FIRST LETTER ***** WHICH ONE?:/0V /ǨץǨ  &NJFB>:62ٹ,DU$, 82*(:4"H١ *6X J TV~L6&<  d!TER U(PDATE צ L(IST D(ELETE צ S(EARCH P(ROCESS Q(UITצ R(EMOVE >>ENTIRE<< FILE"***** SELECT BY FIRST LETTER ***** WHICH ONE?:/0V ***********************************צ ENTER C(ONTINUE OR E(XIT PROGRAM(ᩄEá0&! PAYROLL FILE DEMONSTRATIONצ I(NSTRUCTIONS E(N*********צENTER C(ONTINUE TO EXIT8  YOUR PROCESS WOULD GO HERE; צ! HOWEVER, THE PURPOSE OF THIS# PROGRAM IS ONLY TO DEMONSTRATEצ DISK HANDLINGצ(***** š ׯ 0צRECORD IS NOT IN FILEWTHE RECORD NUMBER FOR EMPLOYEE IS:  צ(*******************************ꨀ * .  ! WHAT IS THE INDIVIDUAL'S NAME?צ$ ENTER: LAST, FIRST MIDDLE INITIAL YOU HAVE  צ SPACES AS SHOWN:  --------------------" USE THE L(IST FUNCTION TO FIND IT @ RECORD #:   áPAY.DATAꩁרá צPAYROLL:PAYROLL.DATA#WRITELN; #WRITELN('LOAD THE FOLLOWING PROGRAMS ONTO A'); #WRITELN; #WRITELN('DISK NAMED ''PAYROLL:'''); #WRITELN; #WRITELN(' FILEDEMO.CODE'); #WRITELN(' FILEDEMO.TEXT'); #WRITELN(' SAMPLE.DATA'); #WRITELN; #WRITELN('THEN T(RANSFER ''PAYROLL:SAMPLE.DATA'''); #WRITELN(' TO ''PAYROLL:PAYROLL.DATA'''); #WRITELN; #WRITELN('*****************************************'); #WRITELN; #WRITELN('NOW EX(ECUTE ''PAYROLL:FILEDEMO'''); #GOTOXY(4,23); A^â#WRITE(' PRESS ANY KEY TO C(ONTINUE'); #READ(CH); #PAGE(OUTPUT);  END(*PAGETHREE*);   BEGIN #PAGEONE; #PAGETWO; #PAGETW2; #PAGETHREE;  END.  END(*THREE1*);   BEGIN(*PAGE3 *) #THREE1; #WRITELN(' FD.PART3.TEXT'); #WRITELN; #WRITELN('THESE PROGRAMS CANNOT BE COMPILED'); #WRITELN; #WRITELN; #WRITELN('****************************************'); M PLACE THE FOLLOWING THREE '); #WRITELN(' TEXT FILES INTO ''SYSTEM.WRK.TEXT'','); #WRITELN(' THEN LIST THEM WITH THE E(DITOR.'); #WRITELN; #WRITELN(' FD.PART1.TEXT'); #WRITELN; #WRITELN(' FD.PART2.TEXT'); #WRITELN;; #WRITELN; #WRITELN('THE PROGRAM FILEDEMO IS VERY LARGE AND '); #WRITELN(' HAD TO BE BROKEN DOWN INTO THREE '); #WRITELN(' PARTS BEFORE COMMENTS COULD BE ADDED'); #WRITELN; #WRITELN('TO SEE EXTENSIVE REMARKS WITHIN THE'); #WRITELN(' PROGRA#WRITE('PRESS ANY KEY TO CONTINUE'); #READ(CH);  END(*PAGETW2*);   PROCEDURE PAGETHREE;  VAR CH:CHAR;   PROCEDURE THREE1;  BEGIN #PAGE(OUTPUT); #WRITELN(' REMARKS AND COMMENTS'); #WRITELN('****************************************')WAS DEVELOPED TO'); #WRITELN(' HANDLE INCORRECT INTEGER OR REAL'); #WRITELN(' ENTRIES. ADDITIONAL RECORDS ARE'); #WRITELN(' ENTERED ALPHABETICALLY BY LAST NAME'); #GOTOXY(0,22); #WRITELN('*****************************************'); N(' FILES.'); #WRITELN('ALL ENTRIES ARE DONE WITH MENUS. THE'); #WRITELN(' PROMPT C(ONTINUE MEANS TO ENTER A'); #WRITELN(' ''C'' IF YOU WISH TO CONTINUE.');  END(*PAGETWO*);   PROCEDURE PAGETW2;  BEGIN #WRITELN('A CORRECTION PROCEDURE HEN THE FILEDEMO.CODE, AND THEN A'); #WRITELN(' SAMPLE FILE: PAYROLL.DATA. THE'); #WRITELN(' PAYROLL.DATA FILE MUST ALWAYS BE'); #WRITELN(' THE LAST FILE ON THE DISK OR ADDED'); #WRITELN(' RECORDS MIGHT OVER WRITE FOLLOWING'); #WRITEL#WRITELN('THIS PROGRAM IS MEANT TO DEMONSTRATE THE'); #WRITELN(' FILE HANDLING CHARACTERISTICS OF'); #WRITELN(' PASCAL.'); #WRITELN('THIS SPECIAL DISK TITLED: ''PAYROLL'''); #WRITELN(' HAS THE FILEDEMO.TEXT FILE FIRST,'); #WRITELN(' T#WRITE('PRESS ANY KEY WHEN READY'); #READ(CH);  END(*PAGEONE*); "  PROCEDURE PAGETWO;  BEGIN #PAGE(OUTPUT); #WRITELN(' INSTRUCTIONS'); #WRITELN('*****************************************'); #WRITELN; !THREE TEXT FILES INTO 'SYSTEM.WRK.TEXT', THEN LIST THEM WITH THE =E(DITOR. A :FD.PART1.TEXT :FD.PART2.TEXT :FD.PART3.TEXT A 0THESE PROGRAMS CANNOT BE COMPILED A -**************************************** A AND COMMENTS ,***************************************** A #THE PROGRAM FILEDEMO IS VERY LARGE AND HAD TO BE BROKEN DOWN )INTO THREE PARTS BEFORE COMMENTS COULD BE ADDED A !TO SEE EXTENSIVE REMARKS WITHIN THE PROGRAM PLACE THE FOLLOWING MEANS TO /ENTER A 'C' IF YOU WISH TO CONTINUE. A !A CORRECTION PROCEDURE WAS DEVELOPED TO HANDLE INCORRECT INTEGER !OR REAL ENTRIES. ADDITIONAL RECORDS ARE ENTERED ALPHABETICALLY ;BY LAST NAME A ,***************************************** 7REMARKSFILE &FIRST, THEN THE FILEDEMO.CODE, AND THEN A SAMPLE FILE: #PAYROLL.DATA. THE PAYROLL.DATA FILE MUST ALWAYS BE THE LAST #FILE ON THE DISK OR ADDED RECORDS MIGHT OVER WRITE FOLLOWING >FILES. A !ALL ENTRIES ARE DONE WITH MENUS. THE PROMPT C(ONTINUE,***************************************** ;INSTRUCTIONS ,***************************************** # &THIS PROGRAM IS MEANT TO DEMONSTRATE THE FILE HANDLING 4CHARACTERISTICS OF PASCAL. A !THIS SPECIAL DISK TITLED: 'PAYROLL' HAS THE FILEDEMO.TEXT %LOAD THE FOLLOWING PROGRAMS ONTO A DISK NAMED 'PAYROLL:' A :FILEDEMO.CODE :FILEDEMO.TEXT 0 THEN $REPEAT &CC:=CC+1; &RCH:=REPLY[CC]; &X:=10*X+(ORD(RCH)-ORD('0')); $UNTIL CC=LEN; "IF X<0 THEN INT:=0 "ELSE INT:=X;  END;   PROCEDURE CONVERTSTRGTOREAL(SN:STRING;VAR N:REAL);  (* TAKES STRING IN FORM STRING.CH CH OR STRING FOR CONVERTING TO REAL *)  V"END;(*PAGETOTALS*) " " "PROCEDURE INITPAGE; " "BEGIN $PAGEEND:=FALSE; $BUFF:='PP'; $BUFF[2]:=CHR(ORD('0')+PAGENUMBER); $FNAME:=' '; $FNAME:=CONCAT(FILENAME,BUFF,'.TEXT');(* FNAME NOW IS LEDGER/M-D-YP#.TEXT *) $REWRITE(PAGEFILE,FNAME); $LINENUOLB2'); $WRITE(OUTPUT,' COL C'); $WRITE(OUTPUT,' COL D'); $WRITE(OUTPUT,' CASH '); $WRITELN(OUTPUT,' CHECKS'); " WRITELN(OUTPUT,PAGEA:10:2,PAGEB1:10:2,PAGEB2:10:2,PAGEC:10:2,PAGED:10:2, ,PAGECASH:10:2,PAGECHECKS:10:2); 2 + PAGEB2; $DAYSC:=DAYSC + PAGEC; $DAYSD:=DAYSD + PAGED; $DAYSCASH:=DAYSCASH + PAGECASH; $DAYSCHECKS:=DAYSCHECKS + PAGECHECKS; " WRITELN(OUTPUT,'TOTALS THIS PAGE: '); $WRITE(OUTPUT,' COL A'); $WRITE(OUTPUT,' COLB1'); $WRITE(OUTPUT,' CRING; "PAGEFILE:TEXT; "DISCRIPTION:CHAR; "PAGEA,PAGEB1,PAGEB2,PAGEC,PAGED,PAGECASH,PAGECHECKS:REAL; "LINENUMBER:INTEGER; "NUM:ARRAY[1..8] OF REAL; " " "PROCEDURE PAGETOTALS; "BEGIN $DAYSA:=DAYSA + PAGEA; $DAYSB1:=DAYSB1 + PAGEB1; $DAYSB2:=DAYSB"RESET(F,'DAILYBUFF.TEXT'); "WRITELN(F,LASTMONTHSBALANCE,MONTHSA,MONTHSB1,MONTHSB2,MONTHSC,MONTHSD, *MONTHSCASH,MONTHSCHECKS); "CLOSE(F,LOCK);  END;(*MONTHTOTALS*) " (   PROCEDURE PROCESSPAGE;  VAR "PAGEEND,STATIS:BOOLEAN; "FNAME,BUFF,LINE:ST MONTH? Y/N '); " READ(INPUT,CH); "UNTIL CH IN ['Y','y','n','N']; "IF CH IN ['Y','y'] THEN $BEGIN &LASTMONTHSBALANCE:=MONTHSD; &MONTHSA :=0; &MONTHSB1:=0; &MONTHSB2:=0; &MONTHSC :=0; &MONTHSD :=0; &MONTHSCASH :=0; &MONTHSCHECKS :=0; $END; COL D'); "WRITE(OUTPUT,' CASH '); "WRITELN(OUTPUT,' CHECKS');  WRITELN(OUTPUT,MONTHSA:10:2,MONTHSB1:10:2,MONTHSB2:10:2,MONTHSC:10:2, *MONTHSD:10:2,MONTHSCASH:10:2,MONTHSCHECKS:10:2);  REPEAT $WRITELN(OUTPUT,'IS THIS THE LAST DAY OF THE:2);  END; (*DAYTOTALS*)  PROCEDURE MONTHTOTALS;  VAR "F:TEXT;  BEGIN "WRITELN(OUTPUT,'TOTALS THIS MONTH: '); "WRITE(OUTPUT,' COL A'); "WRITE(OUTPUT,' COLB1'); "WRITE(OUTPUT,' COLB2'); "WRITE(OUTPUT,' COL C'); "WRITE(OUTPUT,' "WRITE(OUTPUT,' COLB2'); "WRITE(OUTPUT,' COL C'); "WRITE(OUTPUT,' COL D'); "WRITE(OUTPUT,' CASH '); "WRITELN(OUTPUT,' CHECKS'); "WRITELN(OUTPUT,DAYSA:10:2,DAYSB1:10:2,DAYSB2:10:2,DAYSC:10:2,DAYSD:10:2, *DAYSCASH:10:2,DAYSCHECKS:10MONTHSC:=MONTHSC + DAYSC; "MONTHSD:=MONTHSD + DAYSD; "MONTHSCASH:=MONTHSCASH + DAYSCASH; "MONTHSCHECKS:=MONTHSCHECKS + DAYSCHECKS; "WRITELN(OUTPUT,'TOTALS THIS DAY: '); "WRITE(OUTPUT,' COL A'); "WRITE(OUTPUT,' COLB1'); RITELN(OUTPUT,'ENTER DATE M-D-Y '); "READLN(INPUT,DATE); "FILENAME:=CONCAT(FILENAME,DATE); "GETDAILYBUFFER;  END; (*INIT*)    PROCEDURE DAYTOTALS;  BEGIN "MONTHSA:=MONTHSA + DAYSA; "MONTHSB1:=MONTHSB1 + DAYSB1; "MONTHSB2:=MONTHSB2 + DAYSB2; "TDAILYBUFFER*) $RESET(F,'DAILYBUFF.TEXT'); $READLN(F,LASTMONTHSBALANCE,MONTHSA,MONTHSB1,MONTHSB2,MONTHSC,MONTHSD, +MONTHSCASH,MONTHSCHECKS); $CLOSE(F); "END; (* GETD-B-*)    BEGIN (*INIT*) "LASTPAGE:=FALSE; "FILENAME:='SHEET/'; "DATE:=' '; "W&DELETE(SN,POINT,3); $END; "NDOLLARS:=INT(SN); "N:=NDOLLARS+(NCENTS/100);  END;   PROCEDURE INIT;  VAR "(*GLOBAL VAR FILENAME:STRING; /LASTPAGE:BOOLEAN;*) "DATE:STRING;   PROCEDURE GETDAILYBUFFER;(*ALL GLOBAL*) "VAR $F:TEXT; "BEGIN (*GEAR "SCENTS:STRING; "NCENTS,NDOLLARS:REAL; "POINT:INTEGER;  BEGIN "NCENTS:=0; "NDOLLARS:=0; "SCENTS:=' '; "POINT:=POS('.',SN); "IF POINT <> 0 THEN (* 2 DIGITS FOR CENTS*) $BEGIN &SCENTS:=COPY(SN,POINT,2); &NCENTS:=INT(SCENTS); MBER:=1; "END; (*INITPAGE*)   PROCEDURE TESTLINE(VAR CHECK:BOOLEAN); "VAR $X,BLANKPOSITION:INTEGER; $STRINGNUMBER:STRING; $ "BEGIN (* TESTLINE *) $CHECK:=TRUE; $STRINGNUMBER:=' '; $FOR X:=1 TO 8 DO (* THERE ARE 8 NUMBERS IN A LINE *) &BEGIN (BLANKPOSITION:= POS(BLANK,BUFF); (STRINGNUMBER:= COPY(BUFF,1,BLANKPOSITION-1); (DELETE(BUFF,1,BLANKPOSITION); (CONVERTSTRGTOREAL(STRINGNUMBER,NUM[X]); &END; $IF (ABS((NUM[1]+NUM[5])-(NUM[2]+NUM[3]+NUM[4])) > EPSILON) THEN &CHECK:=FALSE $ELSE IF (AȥȼƥƼĥļ¥¼TOTALS THIS DAY:  COL A COLB1 COLB2 COL C COL D CASH  CHECKSZ ӥצSHEET/P PENTER DATE M-D-Y P**P*Ǡ*PtΥμ̥̼ʥʼڪP./-.š ---0 /00/-.á/ɡ/1ZP٪PWU, Pצ.YYˡ#,ZYZPW,YUUWdnƁ-צDAILYBUFF.TEXTB*b DAILYLED  INIT; "PAGENUMBER:=0; "REPEAT $PAGENUMBER:=PAGENUMBER+1; $PROCESSPAGE; "UNTIL LASTPAGE=TRUE; "DAYTOTALS; "MONTHTOTALS;  END.(*MAIN*)  EPEAT $WRITELN(OUTPUT,'WAS THIS THE LAST PAGE? Y/N '); $READ(INPUT,DISCRIPTION); "UNTIL DISCRIPTION IN ['Y','y','N','n']; "IF DISCRIPTION IN ['Y','y'] THEN LASTPAGE:=TRUE "ELSE LASTPAGE:=FALSE;  END; (* PROCESSPAGE *) $ (  BEGIN (*MAIN*) E; " LINENUMBER:=LINENUMBER+1; * IF LINENUMBER < 31 THEN WRITELN(OUTPUT,'ENTER LINE ',LINENUMBER); *END (ELSE WRITELN(OUTPUT,'ERROR-CHECK LINE AND REENTER') &END "UNTIL (PAGEEND OR (LINENUMBER=31)); "CLOSE(PAGEFILE,LOCK); "PAGETOTALS; "RR); "REPEAT $STATIS:=FALSE; $READLN(INPUT,LINE); $BUFF:=LINE; $DISCRIPTION:=BUFF[1]; $IF DISCRIPTION IN ['E','e'] THEN PAGEEND:=TRUE $ELSE DELETE(BUFF,1,2); $IF NOT PAGEEND THEN &BEGIN (TESTLINE(STATIS); $ IF STATIS THEN *BEGIN ,SAVESUMLIN" PAGEC:=PAGEC + NUM[4]; $PAGED:=PAGED + NUM[5]; $PAGECASH:=PAGECASH + NUM[7]; $PAGECHECKS:=PAGECHECKS + NUM[8]; $WRITELN(PAGEFILE,LINE); "END;(*SAVESUMLINE*) " "  BEGIN (* PROCESSPAGE *) "INITPAGE; "WRITELN(OUTPUT,'ENTER LINENUMBER ',LINENUMBEBS(NUM[2]-NUM[7]-NUM[8]) > EPSILON) THEN &CHECK:=FALSE $ELSE CHECK:=TRUE; "END; (*TESTLINE*) " " "PROCEDURE SAVESUMLINE; "(* PAGE TOTALS *) " "BEGIN $PAGEA:=PAGEA + NUM[1]; $PAGEB1:=PAGEB1 + NUM[2]; $PAGEB2:=PAGEB2 + NUM[3];        Ɓ-TOTALS THIS MONTH:  COL A COLB1 COLB2 COL C COL D CASH  CHECKSμ ̼ ʼ ȼ Ƽ ļ ¼ צ'IS THIS THE LAST DAY OF THE MONTH? Y/N THIS IS AN UN FINISHED PROGRAM FOR A  DAILY LEDGER.. MIFAX TYPE...   ONE IT DOESN'T SEEM TO WORK BUT I THINK  ITS ONLY AN INTILIALIZATION PROBLEM.   WRITE ME FOR UPDATED LISTING ...   TERRY PUNDIAK,M.D.  3321 SHERWOOD ROAD  EASTON,PA.18042 N^0צERROR-CHECK LINE AND REENTERʁÍ~ WAS THIS THE LAST PAGE? Y/N Ɓʁ@@ʁӹ~U[-YZҩ-Zb8(n\|$  ʁ P,P,́ʁ ,ٓu ء> ʁ́ʁɡ+ ENTER LINE ʁ 0צERROR-CHECK LINE AND REENTERʁÍ~ WAS THIS THE LAST PAGE? Y/N Ɓʁ@@ʁӹ~U[-YZ~~ ~Ɓ ENTER LINENUMBER ʁ P,P,́ʁ ,ٓu ء> ʁ́ʁɡ+ ENTER LINE ʁ o?:o P,0҂U PUP,Ǡצ.TEXTǥP~Uf  P--ȡ?צ ,,..P,: COLB2צ COL Cצ COL Dצ CASH צ CHECKS        ,PP¼QZצTOTALS THIS PAGE: צ COL Aצ COLB1צ @@;ХƼDAILYBUFF.TEXTмμ̼ʼȼƼļ  N3BDC   FORMAT FOR EACH LINE 1->30 IS   ONE LETTER FOR HOSPITAL,OFFICE,OR  END TO INDICATE NO MORE LINES ON THE  PAGE.   THEN THE FOLLOWING NUMBERS: "CHARGE "PAYMENT "ADJUSTMENTS "CURRENT BALANCE "PRIVIOUS BALANCE "RECEPT NUMBER "CASH RECIEVED "CHECKS RECIEVED  THEN THE NAME...  THEN A RETURN KEY (ONLY SPACES BETWEEN  NUMBERS)   A DAILYBUFF.TEXT IS USED TO TRANSFER  DATA FROM ONE DAY TO ANOTHER.   THE SHEET PAGE DATA SHOULD BE TRANSFERED  TO THE PRINTER AND REMOVED FROM DISK  FREQUENTLY TO PREVENT DISK OVER LOAD    ***