`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$J $PfNICOTINECHECKFORLOADDATESELECTOPGREETINGAVERAGE READNUM JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDECXUDRESULTS.TEXTDC91K DATEINFO.DATAH NICOTINE.CODET& BPENTRY.CODET&2 WEIGHT.CODET?KWEIGHT.CODETKmNICOTINE.TEXTTmBPENTRY.TEXTT}IDINFO.TEXTT蠋IDINFO.CODET&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`& H+צ #4:SMOKEREC"ˡצNo data are presently on file.Press  SPACE BARצ to move on.(H+llegal filenamenT?PNAׯc Í0צERROR. Please try again: ??웾0ERROR. Please try again: ??2HC>94/*% צ& The user will need to know the nico-צ#tine content in milligrams for each'brand of cigarette smoked. These valuesצ$are periodically updated by the U.S.צ goverment.š9ݩ++š܆P ^ $be used for tracking daily nicotine צ$intake as part of a nicotine fading/צsmoking cessation program.צ& The user will need to know the nico-צ#tine content in milligrams for each'brand of cigarette smoked. These valuesצ$are periodically updated by the U.S.צ goverment.   CHARTING צ& This charting system is intended to צ$be used for tracking daily nicotine צ$intake as part of a nicotine fading/צsmoking cessation program.צ& The user will need to know the nico-צ#tine content in milligrams for each'brand of cigarette smoked. These valuesצ$are periodically updated by the U.S.צ goverment.צ NICOTINE CHARTING צ& This charting system is intended to צ$be used for tracking daily nicotine צ$intake as part of a nicotine fading/צsmoking cessation program.  TABLE OF DATA M MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.( oצ"Please try agian. Press one of theצ"letters above to make a selection.(61,'ET  /ء"  TABLE OF DATA M MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.( צSELECT OPTION:צ Eצ ENTER DATA G GRAPH OF DATA Tȡۤˡ áڢڢˍ? P ˡآڤ á Cá>آآ*Í k vޢƁ-$#5:DATEINFO.DATAبآ  HPress  SPACE BARצ to move on.(H+llegal filenamenTȡۤˡ áڢڢˍ? P ˡآڤ á Cá>آآ*Í k vޢ 099630-*'$!۹* %d ' %"ُ}š:#ERROR. Value too large. Try again: ??Í? 8$|  U.S.צ goverment.: : B J9 R1 8  b j r z  š$  á cFZ܊ 8++צThe last entry was for 7  8  : צ Do you want to continue? [Y/N]: Nˡ78:   P@@P@Q@ 8צJUN 8JULׯ 8צAUG 8SEPׯ  8צOCT  8NOVׯ  8צDEC  88 9:á 6 +áššȡ78:cɍ dń+cȡ+++++A +++7+c:+JANׯ 8צFEB 8MARׯ 8צAPR 8MAYׯe you wish to begin chart- ing with:  DAY [1..31]:  ɍ ń+  צMONTH [JAN,FEB,...DEC]: +  YEAR [70,...82,83]:    to צ are on file.  j nu4%ERROR. Try again: . +צ #4:SMOKERECצNew data file created.צ'Enter the dat+   7 : צ 8 צ    At present,   entryšsצ dating from Eצ!nter more data Menu MÝÍ78:GEáGGEˡFF+ +  cˡצ$Enter nicotine factor for this brandצ and press צRETURNצ: +"á/cצERROR. Please try again: &áGFfor 7  8  :  צ%Enter number of cigarettes smoked andpress RETURN: + +er Name and Press RETURN: צ____________________ ٢ צIs this correct? [Y/N]: YáGGData entry e, press$"Y" in response to the prompt below.$If you wish to stay with the presentname, press "N".Change this name? [Y/N]: YáءEnt]: Ná'If the wrong Patient Record Disk is in צ(Drive #1, remove it, replace it with theצ$correct disk, and restart the Apple.צ%If you wish to change the nam @Ɓ. #4:IDRECORD;٢ á"Data will be saved under the name: ٢ צIs this correct? [Y/NǴšǴ978:8ˡ 8š++ǴšǴ+ɡ"M š  78:8ˡ8P(á; DAILY NICOTINE INTAKEצ(DATE FACTOR CIGS/DAY NICOTINE+7+c:9 87> :< @@>@צ @8 @צ @< @ ɡ@@@@@@@ƀ ƀd@++݊Ímצ  צ 93-'ET  1ء"  צ #4:BPRECORDS"ˡF0c  צ #4:BPRECORDS   ۥ  צ #4:BPRECORDS"ˡersצabove to make your selection.(. oצ"Please try again. Press one of theצ"letters above to make a selection.( GRAPH OF DATA T TABLE OF DATA M MASTER MENUצ$Press one of the highlighted lett צ BLOOD PRESSURE CHART SELECT OPTION: צ Eצ ENTER DATA G צ Readings have been entered.צThe most recent was:  --  Systolic:   Diastolic: DBPENTRY  +á9H1+ #4:SMOKEREC  +&áONE MOMENT PLEASE... צ#4:MMENU+,0bj2Xt 08V :c8  +EÍ ,+W  á:+ #4:SMOKEREC"ˡ +++á6H.+צ #4:SMOKEREC +á9H1+ #4:SMOKEREC  +&áONE MOMENT PLEASE... צ#4:MMENU+,0b7c: 87 :c8  +EÍ ,+W  á:+ #4:SMOKEREC"ˡ +++á6H.+צ #4:SMOKEREC+ǴFǶDAILY NICOTINE INTAKE +7+c:9 87 :c8 878:8ˡ 8+áɡš<ۆ  1 * I7E)> ؏ áǸǰMG#ǰ  MG  ábZMG!Z  MG 00 MG*Ǵ*)Z+Z)Ǵ MG5 MISSING DATA78:+ÍצPress צ SPACE BAR to move on.(&+á#No blood pressure readings have yetצ been entered.Press  SPACE BAR.-š  ץӨ 6A   %Enter date of reading, press RETURN: צ Day [1..31]: P۶ Month [JAN]: צ Year [85]: Pc޶CORRECT? [Y/N]: éצSTARTING WEIGHT:  GOAL WEIGHT:   צ! entries have been made. The most recent was:  -- WEIGHT #4:BPRECORDS á/š& #4:BPRECORDS &áצONE MOMENT PLEASE...  #4:MMENU.CODE[ ,>10mxRX\X ` & Eצ"nter a reading Mצenu EáMÝÍ á>š5 צ #4:BPRECORDS á/š& #4:BPRECORDS &áצONE MOMENT PLEASE...  #4:MMENU.CODE[ ,á צ #4:BPRECORDSEצ"nter a reading Mצenu EáMÝÍ á>š5 צ}P   צ /  צPress צ SPACE BAR to move on.( h^@ [ 6LÍsצPress צ SPACE BAR to continue listing.(  SP SɡS}}צ }SQ}P*P }}} }ST}, 19X}*Ǩؕ٥<ؕ <ؕ̀ʀȡ&܂ڥߩ<ؕ5\ PATIENT NAME: H||ȡ򩂥éÍ.Í=ÍPצ110<צ90(70צ50nn<<̀ʀȡ(܂٥<ؕ<ؕ̀ʀȡ&܂ڥ<<ߩ<E V   Ǫ ޕނǶBLOOD PRESSURE - njǶH ǴáǪצ200njצ170nצ140PצCORRECT? [Y/N]: ÍNNˡ    j [ #4:IDRECORD=[[2ȡ;  ōNPɩcōNNˡۨSystolic reading, press RETURN: P Diastolic reading, press צRETURNצ:  of   lbs.>צ WEIGHT CHART SELECT OPTION: צ Eצ ENTER DATA G GRAPH OF DATA T TABLE OF DATA C CHANGE GOAL ީũǛɄJP ީǛɩńJP ީ̀@??  l   Ǫ ޕނǶצ WEIGHT - njǶFǑǑ<ݥ<ɡ @ġ @2ġ ?dġ ?ȡ;  <Ǒ ɡǑP @צIs this correct? [Y/N]: áNNˡ)     $ j Y #4:IDRECORD;YY2       4 @צChange the GOAL? [Y/N]: Yá  $Please enter the new weight goal andpress RETURN: P$Please enter the weight you wish to obtain and press צRETURNצ: PצIs this correct? [Y/N]: áNNˡ weight readings that you enter willצ#be plotted on a graph to aid you intracking your progress.צ&To construct this graph, you are askedצ#to select a weight level as a goal.Eצ"nter a weight Mצenu MÝÍEáEˡ&HJ.6'TheEnter weight and press צRETURNצ: PCORRECT? [Y/N]: áNNˡ       Day [1..31]: P Month [JAN]: צ Year [82]: PcCORRECT? [Y/N]: éōNPɩcōNNˡentered.Press  SPACE BAR.-š     6A   %Enter date of reading, press RETURN: צ0c #4:WTRECORDS  Y         輸>  צ #4:WTRECORDS"ˡ No weight readings have yet beenצ"Please try again. Press one of theצ"letters above to make a selection.(C=71+CT$)' ! ";ء"  צ #4:WTRECORDS"ˡOM MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.(t oʀȡ(܂٥< <̀ʀȡ"܂ڥ<1 tX PATIENT NAME: F||ȡ򩂭éÍ.Í=ÍLÍsצPress צ SPACE BAR to continue listing.(  SP SɡS}}צ }SQ}P*P }}} }ST}, 1Pצ110<צ90(70צ50nn<<̀ʀȡ(܂٥<ؕ<ؕ̀ʀȡ&܂ڥ<<ߩ<E V   Ǫ ޕނǶBLOOD PRESSURE - njǶH ǴáǪצ200njצ170nצ140PצCORRECT? [Y/N]: ÍNNˡ    j [ #4:IDRECORD=[[2ȡ;  ōNPɩcōNNˡۨSystolic reading, press RETURN: P Diastolic reading, press צRETURNצ: , press RETURN: צ Day [1..31]: P۶ Month [JAN]: צ Year [85]: Pc޶CORRECT? [Y/N]: é#No blood pressure readings have yetצ been entered.Press  SPACE BAR.-š  ץӨ 6A   %Enter date of reading93-'ET  1ء"  צ #4:BPRECORDS"ˡF0c  צ #4:BPRECORDS   ۥ  צ #4:BPRECORDS"ˡersצabove to make your selection.(. oצ"Please try again. Press one of theצ"letters above to make a selection.( GRAPH OF DATA T TABLE OF DATA M MASTER MENUצ$Press one of the highlighted lett צ BLOOD PRESSURE CHART SELECT OPTION: צ Eצ ENTER DATA G צ Readings have been entered.צThe most recent was:  --  Systolic:   Diastolic: ONE MOMENT PLEASE...  #4:MMENU.CODEY ,1vn   hV8 Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& צ #4:WTRECORDS 4 צ #4:WTRECORDS a2áצ9X}*Ǩ}P   צ lbs.צPress צ SPACE BAR to move on.( hV8 Y 5ؕ٥<ؕ <ؕ̀ʀȡ&܂ڥߩ<ؕ5\ PATIENT NAME: H||ȡ򩂥éÍ.Í=ÍLÍnצPress צ SPACE BAR to continue listing.  SP SɡS}} }SQ}P*P }}}צ }ST}צ, 19X}*Ǩ}Pentered.Press  SPACE BAR.-š     6A   %Enter date of reading, press RETURN: צ0c #4:WTRECORDS  Y         輸>  צ #4:WTRECORDS"ˡ No weight readings have yet beenצ"Please try again. Press one of theצ"letters above to make a selection.(C=71+CT$)' ! ";ء"  צ #4:WTRECORDS"ˡOM MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.(t oG GRAPH OF DATA T TABLE OF DATA C CHANGE GOAL Ͷ of   lbs.>צ WEIGHT CHART SELECT OPTION: צ Eצ ENTER DATA צSTARTING WEIGHT:  GOAL WEIGHT:   צ! entries have been made. The most recent was:  -- WEIGHT BPRECORDS á/š& #4:BPRECORDS &áצONE MOMENT PLEASE...  #4:MMENU.CODE[ ,>10mxRXXT \ " Eצ"nter a reading Mצenu EáMÝÍ á>š5 צ #4:BPRECORDS á/š& #4:BPRECORDS &áצONE MOMENT PLEASE...  #4:MMENU.CODE[ ,á צ #4:BPRECORDSEצ"nter a reading Mצenu EáMÝÍ á>š5 צ #4: צ   /  Press  SPACE BARצ to move on.( i_< [ 6 Day [1..31]: P Month [JAN]: צ Year [82]: PcCORRECT? [Y/N]: éōNPɩcōNNˡEnter weight and press צRETURNצ: PCORRECT? [Y/N]: áNNˡ      DBPENTRY ENT PLEASE...  #4:MMENU.CODEY ,1vf | hV0 Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& צ #4:WTRECORDS 4 צ #4:WTRECORDS a2áצONE MOM*Ǩ}P   צ lbs.צPress צ SPACE BAR to move on.( hV0 Y 5Í.Í=ÍLÍkצPress צ SPACE BAR to continue.(  SP SɡS}}צ }SQ}P*P }}} }ST}, 19X}ʀȡ(܂٥< <̀ʀȡ"܂ڥ<1 tX PATIENT NAME: F||ȡ򩂭éީũǛɄJP ީǛɩńJP ީ̀@??  l   Ǫ ޕނǶצ WEIGHT - njǶFǑǑ<ݥ<ɡ @ġ @2ġ ?dġ ?ȡ;  <Ǒ ɡǑP @צIs this correct? [Y/N]: áNNˡ)     $ j Y #4:IDRECORD;YY2       4 @צChange the GOAL? [Y/N]: Yá  $Please enter the new weight goal andpress RETURN: P$Please enter the weight you wish to obtain and press צRETURNצ: PצIs this correct? [Y/N]: áNNˡ weight readings that you enter willצ#be plotted on a graph to aid you intracking your progress.צ&To construct this graph, you are askedצ#to select a weight level as a goal.Eצ"nter a weight Mצenu MÝÍEáEˡ&HJ.6'The צ Readings have been entered.צThe most recent was:  --  Systolic:   Diastolic: á צ #4:BPRECORDSEצ"nter a reading Mצenu EáMÝÍ á>š5 צ}P   צ /  צPress צ SPACE BAR to move on.( h^@ [ 6LÍsצPress צ SPACE BAR to continue listing.(  SP SɡS}}צ }SQ}P*P }}} }ST}, 19X}*Ǩؕ٥<ؕ <ؕ̀ʀȡ&܂ڥߩ<ؕ5\ PATIENT NAME: H||ȡ򩂥éÍ.Í=ÍPצ110<צ90(70צ50nn<<̀ʀȡ(܂٥<ؕ<ؕ̀ʀȡ&܂ڥ<<ߩ<E V   Ǫ ޕނǶBLOOD PRESSURE - njǶH ǴáǪצ200njצ170nצ140PצCORRECT? [Y/N]: ÍNNˡ    j [ #4:IDRECORD=[[2ȡ;  ōNPɩcōNNˡۨSystolic reading, press RETURN: P Diastolic reading, press צRETURNצ: , press RETURN: צ Day [1..31]: P۶ Month [JAN]: צ Year [85]: Pc޶CORRECT? [Y/N]: é#No blood pressure readings have yetצ been entered.Press  SPACE BAR.-š  ץӨ 6A   %Enter date of reading93-'ET  1ء"  צ #4:BPRECORDS"ˡF0c  צ #4:BPRECORDS   ۥ  צ #4:BPRECORDS"ˡersצabove to make your selection.(. oצ"Please try again. Press one of theצ"letters above to make a selection.( GRAPH OF DATA T TABLE OF DATA M MASTER MENUצ$Press one of the highlighted lett צ BLOOD PRESSURE CHART SELECT OPTION: צ Eצ ENTER DATA G #4:BPRECORDS á/š& #4:BPRECORDS &áצONE MOMENT PLEASE...  #4:MMENU.CODE[ ,>10mxRX\X ` & Eצ"nter a reading Mצenu EáMÝÍ á>š5 צ weight readings that you enter willצ#be plotted on a graph to aid you intracking your progress.צ&To construct this graph, you are askedצ#to select a weight level as a goal.Eצ"nter a weight Mצenu MÝÍEáEˡ&HJ.6'TheEnter weight and press צRETURNצ: PCORRECT? [Y/N]: áNNˡ       Day [1..31]: P Month [JAN]: צ Year [82]: PcCORRECT? [Y/N]: éōNPɩcōNNˡentered.Press  SPACE BAR.-š     6A   %Enter date of reading, press RETURN: צ0c #4:WTRECORDS  Y         輸>  צ #4:WTRECORDS"ˡ No weight readings have yet beenצ"Please try again. Press one of theצ"letters above to make a selection.(C=71+CT$)' ! ";ء"  צ #4:WTRECORDS"ˡOM MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.(t oG GRAPH OF DATA T TABLE OF DATA C CHANGE GOAL Ͷ of   lbs.>צ WEIGHT CHART SELECT OPTION: צ Eצ ENTER DATA צSTARTING WEIGHT:  GOAL WEIGHT:   צ! entries have been made. The most recent was:  -- WEIGHT #4:BPRECORDS á/š& #4:BPRECORDS &áצONE MOMENT PLEASE...  #4:MMENU.CODE[ ,$Please enter the weight you wish to obtain and press צRETURNצ: PצIs this correct? [Y/N]: áNNˡ  4 @צChange the GOAL? [Y/N]: Yá  $Please enter the new weight goal andpress RETURN: P"STR (DATA^.DATEID.YEAR,YEARSTR); "FIRST:=CONCAT (DAYSTR,' ',DATA^.DATEID.MONTH,' ',YEARSTR); "STR (DDAY,DAYSTR);STR (DYEAR,YEARSTR); "LAST:=CONCAT (DAYSTR,' ',MON[DMON],' ',YEARSTR); " "WRITELN; "WRITE('At present, ',X,' entry'); "IF X>1 THEN WRIT$ IF (KEY='M') OR (KEY=CHR(27)) THEN &BEGIN 'UPDATE(DDAY,DMON,DYEAR); 'OK:= TRUE; &END; %IF KEY='E' THEN OK:= TRUE; $UNTIL OK; $ERASE(2,23,2); $IF KEY<>'E' THEN DONE:= TRUE; "UNTIL DONE; " "X:=X-1; "STR (DATA^.DATEID.DAY,DAYSTR); EAR (1); (END; %UNTIL IO=0;{$I+} $END; $ $X:=X+1; $OK:= FALSE; $DONE:= FALSE; $GOTOXY(0,23); $WRITE(CHR(15),'E',CHR(14),'nter more data ', *CHR(15),'M',CHR(14),'enu '); $REPEAT %REPEAT UNTIL KEYPRESS; %READ(KEYBOARD,KEY); RITELN; %WRITELN('Enter nicotine factor for this brand'); %WRITE('and press ',CHR(15),'RETURN',CHR(14),': '); %{$I-} %REPEAT 'IO:=0; 'READLN (DATA^.FACTOR[X]); 'IF IORESULT =14 THEN (BEGIN )IO:=99; )WRITELN('ERROR. Please try again: '); )UNITCL#WRITELN('Data entry for ',DDAY,' ',MON[DMON],' ',DYEAR); #GOTOXY(0,10); #WRITELN; #WRITELN('Enter number of cigarettes smoked and'); #WRITE('press ',CHR(15),'RETURN',CHR(14),': '); #READNUM(DATA^.CIGS[X]); # #IF DATA^.CIGS[X]<>-99 THEN $BEGIN %WONE MOMENT PLEASE...  #4:MMENU.CODEY ,1vn   hV8 Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& צ #4:WTRECORDS 4 צ #4:WTRECORDS a2áצ9X}*Ǩ}P   צ lbs.צPress צ SPACE BAR to move on.( hV8 Y 5Í.Í=ÍLÍsצPress צ SPACE BAR to continue listing.(  SP SɡS}}צ }SQ}P*P }}} }ST}, 1ʀȡ(܂٥< <̀ʀȡ"܂ڥ<1 tX PATIENT NAME: F||ȡ򩂭éީũǛɄJP ީǛɩńJP ީ̀@??  l   Ǫ ޕނǶצ WEIGHT - njǶFǑǑ<ݥ<ɡ @ġ @2ġ ?dġ ?ȡ;  <Ǒ ɡǑP @צIs this correct? [Y/N]: áNNˡ)     $ j Y #4:IDRECORD;YY2     ELN('s') ELSE WRITELN; "WRITELN('dating from ',FIRST,' to ', LAST); "WRITELN('are on file.');  END;  {************************************}   PROCEDURE OPEN;  VAR TEMP:INTEGER; ${----------------------} $PROCEDURE ERROR; $BEGIN %WRITELN; %WRITE('ERROR. Try again: '); $END; ${---------------------}  BEGIN "REWRITE (DATA,'#4:SMOKEREC'); " "ERASE(2,23,5); "WRITELN('New data file created.'); "WRITELN; "WRITELN('Enter the date you wish to begin chart-'); "WRITELN('ing with:'); "GOTOXY(0,1&MOVETO(21,90); &WSTRING('MG'); %END %ELSE %BEGIN &MOVETO(0,90); &WSTRING(CONCAT (STRG,' MG')); %END; #MOVETO(0,0); WSTRING ('00 MG'); #MOVETO(42,180);PENCOLOR (WHITE); #MOVETO(42,0); PENCOLOR (NONE); #MOVETO(41,90); PENCOLOR (WHITE); #MOVETO(THEN $BEGIN %MOVETO(7,184); %WSTRING(STRG); %MOVETO(21,176); %WSTRING('MG'); $END $ELSE $BEGIN %MOVETO(0,176); %WSTRING(CONCAT (STRG,' MG')); $END; #STR(A,STRG); #IF LENGTH(STRG) =3 THEN %BEGIN &MOVETO(7,98); &WSTRING(STRG); OTOXY(40,0); &REPEAT UNTIL KEYPRESS; &UNITCLEAR(1); &ERASE(6,23,6); #UNTIL DATA^.CIGS[J]=-1;  END;  {********************}   PROCEDURE HEADER (A:INTEGER); "VAR STRG:STRING[10]; %  BEGIN "PENCOLOR(NONE); "STR((2*A),STRG); "IF LENGTH(STRG)=3 :2,' ',T:3:1,' MG') *ELSE WRITELN(D,' MISSING DATA'); (UPDATE(DDAY,DMON,DYEAR); (J:=J+1; (COUNTER:=COUNTER+1; &UNTIL (DATA^.CIGS[J]=-1) OR (COUNTER=15); & &GOTOXY(0,23); &WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); &G(STR(DYEAR,YEARSTR); (D:=CONCAT(DSTR,' ',MON[DMON],' ',YEARSTR); (IF LENGTH(D)<9 THEN D:=CONCAT(SPACE,D); (D:=CONCAT(D,COPY(BLANK,1,(12-LENGTH(D)))); (F:=DATA^.FACTOR[J]; (C:=DATA^.CIGS[J]; (T:=F*C; (IF(C>0) OR (C=0) THEN WRITELN(D,F:3:2,' ',COTINE INTAKE'); "WRITELN; "WRITELN('DATE FACTOR CIGS/DAY NICOTINE'); "WRITELN; "WRITELN; "DDAY:=DATA^.DATEID.DAY; "DYEAR:=DATA^.DATEID.YEAR; "DMON:=FIRSTMON; "J:=1; $REPEAT &GOTOXY (0,6); &COUNTER:= 0; &REPEAT (STR(DDAY,DSTR); &SPACE: STRING[1]; &BLANK: STRING; &DSTR,YEARSTR:STRING[3];  BEGIN "{$R UPDATE} "SPACE:=' '; "BLANK:= SPACE; "REPEAT BLANK:=CONCAT(BLANK,SPACE) UNTIL LENGTH(BLANK)=40; " "ERASE(0,23,0); "CENTER(PTNAME); "WRITELN; "WRITELN(' DAILY NICcontinue? [Y/N]: '); %WAITFOR(RESPONSE); %IF RESPONSE<>'N' THEN 'BEGIN (UPDATE(DDAY,DMON,DYEAR); (DOITEMS(J);; 'END; $END $ELSE $DOITEMS(J);  END;  {********************}   PROCEDURE TABLE; "VAR T,F:REAL; &C,COUNTER:INTEGER; &D:STRING[20];"J:=0; "REPEAT J:=J+1 UNTIL (DATA^.CIGS[J]=-1); "IF J>1 THEN $BEGIN %IF J>3 THEN FOR K:=3 TO J DO UPDATE(DDAY,DMON,DYEAR); %GOTOXY(0,5); %WRITELN('The last entry was for ',DDAY,' ',MON[DMON],' ',DYEAR); %WRITELN; %WRITELN; %WRITE('Do you want to THEN DMON:=9; "IF T='OCT' THEN DMON:=10; "IF T='NOV' THEN DMON:=11; "IF T='DEC' THEN DMON:=12; "FIRSTMON:=DMON; "IF ((DYEAR MOD 4)=0) THEN MAX[2]:=29;{LEAP YEAR}  END;  {**********************************}   PROCEDURE GIVE_ENTRY_OPTION;  BEGIN ; "T:=DATA^.DATEID.MONTH; "IF T='JAN' THEN DMON:=1; "IF T='FEB' THEN DMON:=2; "IF T='MAR' THEN DMON:=3; "IF T='APR' THEN DMON:=4; "IF T='MAY' THEN DMON:=5; "IF T='JUN' THEN DMON:=6; "IF T='JUL' THEN DMON:=7; "IF T='AUG' THEN DMON:=8; "IF T='SEP' IN %DATA^.FACTOR[J]:=0; %DATA^.CIGS[J]:=-1; $END; "SEEK(DATA,0); "PUT (DATA);  END;  {*****************************} #  PROCEDURE GETINFO;  VAR T:STRING[3];  BEGIN "SEEK(DATA,0); "GET(DATA); "DDAY:=DATA^.DATEID.DAY; "DYEAR:=DATA^.DATEID.YEAR" "ERASE(10,23,10); "WRITE('YEAR [70,...82,83]: '); "REPEAT $GOTOXY (0,12); $READNUM (TEMP); $WRITELN; $IF (TEMP>99) OR (TEMP<1) THEN ERROR; "UNTIL (TEMP<100) AND (TEMP>0); "DATA^.DATEID.YEAR:=TEMP; " "ERASE(0,23,0); "FOR J:=1 TO 500 DO #BEG0); "WRITE('DAY [1..31]: '); "REPEAT $READNUM(TEMP); $WRITELN; $IF (TEMP>31) OR (TEMP<1) THEN ERROR; "UNTIL (TEMP<32) AND (TEMP>0); "DATA^.DATEID.DAY:=TEMP; " "ERASE(10,23,10); "WRITE('MONTH [JAN,FEB,...DEC]: '); "READLN(DATA^.DATEID.MONTH); 43,90); PENCOLOR (NONE); #MOVETO(41,180); PENCOLOR (WHITE); #MOVETO(43,180); PENCOLOR (NONE); #MOVETO(70,182); #WSTRING('DAILY NICOTINE INTAKE');  END;  {**************************}   PROCEDURE GRAPH;  "VAR LASTMON,INIT,QUAN,MONTHS,SPACES,SUM:INTEGER; &VERT,HORIZ,INDEX,AVG:INTEGER; &CH:CHAR; &SDAY:0..31; &SMON:1..12; &SYEAR:0..99; '  BEGIN "INITTURTLE; "DDAY:=DATA^.DATEID.DAY; "DYEAR:=DATA^.DATEID.YEAR; "DMON:=FIRSTMON; "SDAY:=DDAY; "SYEAR:=DYEAR; "SMON:=DMON; "INIT:=1; "LASTMON:{$S+} { SERIES 9 }   PROGRAM BPENTRY; { UPDATED 12/7/85 }   USES CHAINSTUFF,APPLESTUFF,MINSTUFF,SHORTGRAPHICS,EXSTUFF,ADDRESS,CODECHECK;  CONST MAX= 60;   TYPE DATE= RECORD .DAY: 0..31; .MONTH: STRING[3]; .YEAR: 0..99; ,END;  &IDINFO= N^T '); "SETCHAIN('#4:MMENU');  END. %CHECK_FOR_DATA; %IF DATAFOUND THEN &BEGIN 'RESET(DATA,'#4:SMOKEREC'); 'CHECKID; 'GETINFO; 'ERASE(0,23,0); 'TABLE; 'ERASE(0,23,0); 'CLOSE(DATA); &END; $END; # UNITCLEAR(1); "UNTIL OPTION=4; # "ERASE(0,23,23); "WRITE('ONE MOMENT PLEASE... A,LOCK); $END; $ #IF OPTION=2 THEN $BEGIN %CHECK_FOR_DATA; %IF DATAFOUND THEN 'BEGIN (RESET(DATA,'#4:SMOKEREC'); (CHECKID; (GETINFO; (GRAPH; (ERASE(2,23,23); (TEXTMODE; (CLOSE(DATA); 'END; %END; ( #IF OPTION=3 THEN $BEGIN TECT; " "GREETING; " "REPEAT #SELECT_OPTION; # #LOAD_DATEINFO; # #IF OPTION=1 THEN $BEGIN %CHECKID; %{$I-} %RESET(DATA,'#4:SMOKEREC'); %IF IORESULT<>0 THEN OPEN; %{$I+} %GETINFO; %GIVE_ENTRY_OPTION; %SEEK(DATA,0); %PUT(DATA); %CLOSE(DATYEAR; DMON:=SMON; %TIMESTRG (HORIZ); %PLOT (INIT,QUAN,SPACES,AVG); %SDAY:=DDAY; SYEAR:=DYEAR; SMON:=DMON; %READ (CH); %INITTURTLE; #UNTIL (DATA^.CIGS[INIT + 1]=-1) OR (CH='E'); !END;  {***********************************************}  BEGIN "PRO$IF SUM < 2 THEN EXIT (GRAPH); $IF ((SUM*3)+(MONTHS*7))>200 THEN 'BEGIN )SPACES:=3; )QUAN:=60; 'END 'ELSE 'BEGIN )QUAN:=(SUM); )SPACES:=(220-(MONTHS*7))DIV QUAN 'END; %AVG:=AVERAGE (INIT,QUAN); %HEADER(AVG); %HORIZ:=49; %DDAY:=SDAY; DYEAR:=S=DMON; "REPEAT $SUM:=0; $MONTHS:=0; $INDEX:=INIT; $REPEAT &UPDATE(DDAY,DMON,DYEAR); &IF DMON<>LASTMON THEN (BEGIN *MONTHS:=MONTHS+1; *LASTMON:=DMON; )END; 'SUM:=SUM+1; 'INDEX:=INDEX+1; $UNTIL DATA^.CIGS[INDEX]=-1; RECORD 0NAME,THERAPIST: STRING[20]; 0BIRTH: DATE; 0SSNUMBER: INTEGER[9]; .END; % &BPINFO= RECORD & DATEID: DATE; 0SYSTOLIC,DIASTOLIC,ENTRYCOUNT: INTEGER; .END; .  VAR BPBUFF: BPINFO; $BPFILE: FILE OF BPINFO; $IDBUFF: IDINFO; $IDFILE: FILE OF IDINFO; $ $OPTION,RECORDCOUNT,I: INTEGER; $KEY2: CHAR; $OK: BOOLEAN; $NEWVAR: STRING; $ $LASTDATE,START,STOP: DATE; $S,D: ARRAY[1..MAX] OF INTEGER;  {**************************************}   PROCEDURE SHOWBPBUFF;  BEGIN !GOTOXY(0,2)"REPEAT #ERASE(18,23,18); #WRITE('Systolic reading, press ',CHR(15),'RETURN',CHR(14),': '); #READLN(NEWVAR); #BPBUFF.SYSTOLIC:= MAKEINT(NEWVAR); #WRITE('Diastolic reading, press ',CHR(15),'RETURN',CHR(14),': '); #READLN(NEWVAR); #BPBUFF.DIASTOLIC:=; $WRITELN; $WRITE('CORRECT? [Y/N]: '); $WAITFOR(RESPONSE); $IF (LASTDATE.DAY=0) OR (LASTDATE.DAY>31) THEN RESPONSE:= 'N'; $IF (LASTDATE.YEAR<80) OR (LASTDATE.YEAR>99) THEN RESPONSE:= 'N'; "UNTIL RESPONSE<>'N'; " "BPBUFF.DATEID:=LASTDATE; " TELN('Enter date of reading, press RETURN: '); $WRITELN; $WRITE(' Day [1..31]: ');READLN(NEWVAR);LASTDATE.DAY:= MAKEINT(NEWVAR); $WRITE(' Month [JAN]: ');READLN(LASTDATE.MONTH); $WRITE(' Year [85]: ');READLN(NEWVAR);LASTDATE.YEAR:= MAKEINT(NEWVAR)RDCOUNT>0 THEN (BEGIN *SEEK(BPFILE,1); *GET(BPFILE); *START:=BPFILE^.DATEID; (END 'ELSE START:=STOP; $END; #CLOSE(BPFILE); "{$I+}  END;  {**************************************}   PROCEDURE PROMPTENTRY;  BEGIN "REPEAT $ERASE(9,23,9); $WRI%WRITELN('No blood pressure readings have yet'); %WRITELN('been entered.'); %WRITELN; %WRITELN('Press ',CHR(15),'SPACE BAR',CHR(14),'.'); %REPEAT UNTIL KEYPRESS; #END "ELSE $BEGIN &RECORDCOUNT:=BPFILE^.ENTRYCOUNT; &STOP:=BPFILE^.DATEID; &IF RECOE:=BPBUFF.DATEID; "CLOSE(BPFILE,LOCK); "{$I+}  END;  {****************************************}   PROCEDURE CHECK_FOR_DATA;  BEGIN !{$I-} !RESET(BPFILE,'#4:BPRECORDS'); !IF IORESULT<>0 THEN #BEGIN %ERASE(1,23,8); =0; )DIASTOLIC:=0; )ENTRYCOUNT:=0; 'END; %REWRITE(BPFILE,'#4:BPRECORDS'); %BPFILE^:=BPBUFF; %SEEK(BPFILE,0); %PUT(BPFILE); #END "ELSE $BEGIN &BPBUFF:=BPFILE^; &RECORDCOUNT:=BPBUFF.ENTRYCOUNT; {LAST RECORD NUMBER STORED HERE} $END;  "LASTDAT********************************}   PROCEDURE CHECKRECORDSTATUS;  BEGIN !{$I-} !RESET(BPFILE,'#4:BPRECORDS'); !IF IORESULT<>0 THEN #BEGIN %RECORDCOUNT:=0; %WITH BPBUFF DO 'BEGIN )DATEID.DAY:=0; )DATEID.MONTH:='0'; )DATEID.YEAR:=0; )SYSTOLIC:$WRITELN('Please try again. Press one of the'); $WRITE('letters above to make a selection.'); $GOTOXY(40,0); #END; "CASE KEY OF #'E':OPTION:=1; #'G':OPTION:=2; #'T':OPTION:=3; #'M':OPTION:=4; "END; !UNTIL OK; !ERASE(1,23,0);  END;  {*********ND; "{----------------------------------}  BEGIN !MENU_TEXT; ! !OK:= FALSE; !OPTIONLIST:= ['E','G','T','M']; !REPEAT "REPEAT UNTIL KEYPRESS; "READ(KEYBOARD,KEY); "IF KEY IN OPTIONLIST THEN OK:= TRUE #ELSE #BEGIN $ERASE(22,23,22); TELN; #WRITELN(' ',CHR(15),'T',CHR(14),' TABLE OF DATA'); #WRITELN; #WRITELN(' ',CHR(15),'M',CHR(14),' MASTER MENU'); #GOTOXY(0,22); #WRITELN('Press one of the highlighted letters'); #WRITE('above to make your selection.'); #GOTOXY(40,0); ! E0); #CENTERINV(' BLOOD PRESSURE CHART '); #SHOWBPBUFF; #WRITELN; #WRITELN; #WRITELN('SELECT OPTION: '); #WRITELN; #WRITELN; #WRITELN(' ',CHR(15),'E',CHR(14),' ENTER DATA'); #WRITELN; #WRITELN(' ',CHR(15),'G',CHR(14),' GRAPH OF DATA'); #WRI!WRITELN(' Diastolic: ',BPBUFF.DIASTOLIC:4);  END;  {****************************************}   PROCEDURE SELECT_OPTION; !VAR OK: BOOLEAN; %OPTIONLIST: SET OF CHAR; "{-----------------------------} "PROCEDURE MENU_TEXT; "BEGIN #ERASE(0,23,; !WRITELN(RECORDCOUNT,' Readings have been entered.'); !WRITELN; !WRITELN('The most recent was: ', )LASTDATE.DAY,'-',LASTDATE.MONTH,'-',LASTDATE.YEAR); !WRITELN; !WRITELN(' Systolic: ',BPBUFF.SYSTOLIC:4); MAKEINT(NEWVAR); #WRITELN; #WRITE('CORRECT? [Y/N]: '); #WAITFOR(RESPONSE); #IF (BPBUFF.SYSTOLIC=0) OR (BPBUFF.DIASTOLIC=0) THEN RESPONSE:= 'N'; "UNTIL RESPONSE<>'N'; " "RECORDCOUNT:=RECORDCOUNT+1; "SEEK(BPFILE,RECORDCOUNT); {OPEN SPACE FOR NEW FILE} "BPFILE^:=BPBUFF; "PUT(BPFILE); "SEEK(BPFILE,0); {UPDATE RECORDCOUNT AND LASTDATE} "BPBUFF.ENTRYCOUNT:=RECORDCOUNT; "BPFILE^:=BPBUFF; "PUT(BPFILE);  END;  {**************************************}   PROCEDURE GETIDINFO;  BEGIN "R BEGIN !PROTECT; ! !CHECKRECORDSTATUS; { GET RECORDCOUNT AND LASTDATE }  !REPEAT "SELECT_OPTION; ! "IF OPTION=1 THEN #BEGIN $RESET(BPFILE,'#4:BPRECORDS'); $REPEAT &ERASE(1,23,8); &SHOWBPBUFF; & &OK:= FALSE; &GOTOXY(0,23); &WRITE(CHR(15)S1,', 19',S2); (WRITELN(I:2,' ',S3,SYSTOLIC:8,' / ',DIASTOLIC:3); 'END; $END; #GOTOXY(0,23); #WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); #GOTOXY(40,0); #REPEAT UNTIL KEYPRESS;  END;  {*****************************************} "WRITELN; "WRITELN; "FOR I:= 1 TO RECORDCOUNT DO $BEGIN &SEEK(BPFILE,I); &GET(BPFILE); &BPBUFF:=BPFILE^; &WITH BPBUFF DO & BEGIN (STR(DATEID.DAY,S1); (IF LENGTH(S1)<2 THEN S1:=CONCAT(' ',S1); (STR(DATEID.YEAR,S2); (S3:= CONCAT(DATEID.MONTH,' ',INT+SPACING; &MOVETO(NEWPOINT,D[I]-A); &OLDPOINT:= NEWPOINT; $END; "PENCOLOR(NONE);  END;  {****************************************}   PROCEDURE MAKETABLE; !VAR S1,S2,S3:STRING;  BEGIN "ERASE(1,23,2); "WRITELN('PATIENT NAME: ',IDBUFF.NAME); &NEWPOINT:= OLDPOINT+SPACING; &MOVETO(NEWPOINT,S[I]-A); &OLDPOINT:= NEWPOINT; $END; "PENCOLOR(NONE); " "MOVETO(START,D[1]-A); "PENCOLOR(BLUE); "MOVETO(START+1,D[1]-A); "OLDPOINT:= START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:= OLDPOPENCOLOR(WHITE1); &MOVETO(NEWPOINT,GRAPHBASE-4); &PENCOLOR(NONE); &OLDPOINT:= NEWPOINT; $END; " "MOVETO(START,S[1]-A); "PENCOLOR(VIOLET); "MOVETO(START+1,S[1]-A); "OLDPOINT:= START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN HTBOUNDRY,60); "PENCOLOR(NONE); " "MOVETO(START,GRAPHBASE-1); "PENCOLOR(WHITE1); "MOVETO(START,GRAPHBASE-4); "PENCOLOR(NONE); "OLDPOINT:=START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:=OLDPOINT+SPACING; &MOVETO(NEWPOINT,GRAPHBASE-1); &ING('110'); "MOVETO(8,60);WSTRING('90'); "MOVETO(8,40);WSTRING('70'); "MOVETO(8,20);WSTRING('50'); " "MOVETO(LEFTBOUNDRY,110); "PENCOLOR(WHITE1); "MOVETO(RIGHTBOUNDRY,110); "PENCOLOR(NONE); "MOVETO(LEFTBOUNDRY,60); "PENCOLOR(WHITE1); "MOVETO(RIG"I:= 20; "REPEAT $MOVETO(LEFTBOUNDRY-4,I); $PENCOLOR(WHITE1); $MOVETO(LEFTBOUNDRY+4,I); $PENCOLOR(NONE); $I:= I+10; "UNTIL I=180; " "MOVETO(0,170);WSTRING('200'); "MOVETO(0,140);WSTRING('170'); "MOVETO(0,110);WSTRING('140'); "MOVETO(0,80);WSTR,'-',STOP.MONTH,'-',STOP.YEAR); "MOVETO(10,0);WSTRING(D1); "MOVETO(150,0);WSTRING(D2);} " "PENCOLOR(NONE); "MOVETO(RIGHTBOUNDRY,GRAPHBASE); "PENCOLOR(WHITE1); "MOVETO(LEFTBOUNDRY,GRAPHBASE); "MOVETO(LEFTBOUNDRY,GRAPHMAX); "PENCOLOR(NONE); " PACING:= HRANGE DIV NUMBEROFPOINTS; "START:= (SPACING DIV 2)+LEFTBOUNDRY; "A:= 30; " "MOVETO(0,182);WSTRING('BLOOD PRESSURE - '); "MOVETO(140,182);WSTRING(IDBUFF.NAME); "{D1:= CONCAT(START.DAY,'-',START.MONTH,'-',START.YEAR); "D2:= CONCAT(STOP.DAYPTNAME,D1,D2: STRING;   BEGIN  INITTURTLE; "NUMBEROFPOINTS:= RECORDCOUNT; "GRAPHBASE:= 20; "GRAPHMAX:= 170; "LEFTBOUNDRY:= 30; "RIGHTBOUNDRY:= 270; "HRANGE:= RIGHTBOUNDRY-LEFTBOUNDRY; "S&D[I]:=BPFILE^.DIASTOLIC; $END;  END;  {*******************************************}   PROCEDURE MAKEGRAPH;   VAR NUMBEROFPOINTS,GRAPHBASE,GRAPHMAX, %VRANGE,HRANGE,LEFTBOUNDRY,RIGHTBOUNDRY, %SPACING,OLDPOINT,NEWPOINT, %START,A: INTEGER;  %ESET(IDFILE,'#4:IDRECORD'); "IDBUFF:= IDFILE^; "CLOSE(IDFILE,LOCK);  END;  {*********************************}   PROCEDURE SETARRAYS;  BEGIN "FOR I:= 1 TO RECORDCOUNT DO $BEGIN &SEEK(BPFILE,I); &GET(BPFILE); &S[I]:=BPFILE^.SYSTOLIC; ,'E',CHR(14),'nter a reading ', ,CHR(15),'M',CHR(14),'enu '); &REPEAT UNTIL KEYPRESS; &READ(KEYBOARD,KEY); &IF KEY='E' THEN PROMPTENTRY; &IF (KEY='M') OR (KEY=CHR(27)) THEN OK:= TRUE; $UNTIL OK; $CLOSE(BPFILE); #END; # "IF OPTION=2 THEN "BEGIN #CHECK_FOR_DATA; #IF RECORDCOUNT>0 THEN %BEGIN 'RESET(BPFILE,'#4:BPRECORDS'); 'GETIDINFO; 'SETARRAYS; 'MAKEGRAPH; 'CLOSE(BPFILE); 'WAITFOR(RESPONSE); 'ERASE(2,23,0); 'TEXTMODE; %END; "END; " "IF OPTION=3 THEN "BEGIN #CHצ#be plotted on a graph to aid you intracking your progress.צ&To construct this graph, you are askedצ#to select a weight level as a goal.$Please enter the we"nter a weight Menu MÝÍEáEˡGI'The weight readings that you enter willצRETURNצ: PCORRECT? [Y/N]: Nˡ      E Day [1..31]: P Month [JAN]: צ Year [82]: PcCORRECT? [Y/N]: NˡEnter weight and press entered.Press  SPACE BAR.-š     6A   %Enter date of reading, press RETURN: צ0c #4:WTRECORDS  Y         輸>  צ #4:WTRECORDS"ˡ No weight readings have yet beenצ"Please try again. Press one of theצ"letters above to make a selection.(C=71+CT$)' ! ";ء"  צ #4:WTRECORDS"ˡOM MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.(t oG GRAPH OF DATA T TABLE OF DATA C CHANGE GOAL !SETCHAIN('#4:MMENU.CODE');  END. ECK_FOR_DATA; #IF RECORDCOUNT>0 THEN $BEGIN %RESET(BPFILE,'#4:BPRECORDS'); %GETIDINFO; %SETARRAYS; %MAKETABLE; %CLOSE(BPFILE); $END; "END; " "UNITCLEAR(1); !UNTIL OPTION=4; ! !ERASE(0,23,23); !WRITE('ONE MOMENT PLEASE... '); ight you wish to obtain and press צRETURNצ: PצIs this correct? [Y/N]: Nˡ  (4צChange the GOAL? [Y/N]: Yá  $Please enter the new weight goal andpress RETURN: PצIs this correct? [Y/N{$S+} { SERIES 9 }   PROGRAM WEIGHT; { UPDATED 12/7/85 }   USES CHAINSTUFF,APPLESTUFF,MINSTUFF,SHORTGRAPHICS,EXSTUFF,ADDRESS,CODECHECK;  CONST MAX= 60;   TYPE DATE= RECORD .DAY: 0..31; .MONTH: STRING[3]; .YEAR: 0..99; ,END;  &IDINFO= RN^T Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& צ #4:WTRECORDS 4 צ #4:WTRECORDS a2áצONE MOMENT PLEASE...  #4:MMENU.CODEY ,1v|L" 00. hO  Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& צ #4:WTRECORDS 4 צ #4:WTRECORDS }}} }ST}, 19X}*Ǩ}P   צ lbs.צPress צ SPACE BAR to move on.( hO <̀ʀȡ"܂ڥ<1 tX PATIENT NAME: F||ȡ  SP SɡS}}צ }SQ}P*P ͂P ީǛɩńJP ީ̀ʀȡ(܂٥<   Ǫ ޕނǶצ WEIGHT - njǶFǑǑ<ݥ<ީũǛɄJ?ȡ;  <Ǒ ɡǑP @@??  l ]: Nˡ)     ^ Y #4:IDRECORD;YY2     ɡ @ġ @2ġ ?dġ ECORD 0NAME,THERAPIST: STRING[20]; 0BIRTH: DATE; 0SSNUMBER: INTEGER[9]; .END; . &WEIGHTINFO= RECORD & DATEID: DATE; 0WEIGHT,ENTRYCOUNT: INTEGER; .END; .  VAR WEIGHTBUFF: WEIGHTINFO; $WEIGHTFILE: FILE OF WEIGHTINFO; $IDBUFF: IDINFO; $IDFILE: FILE OF IDINFO; $ $OPTION,RECORDCOUNT,I,GOAL,STARTWT,WTRANGE,PLOTSTART,INK,PLOT,PWT, $WTINK,SWT,LASTWT: INTEGER; $KEY2: CHAR; $OK,DONE: BOOLEAN; $FACTOR: REAL; $PLOTSTRING,NEWVAR: STRING; $ $LASTDATE,START,STOP: DATE; $W: ARRAY[0..MAX] OF$END; #CLOSE(WEIGHTFILE); "{$I+}  END;  {**************************************}   PROCEDURE PROMPTENTRY;  BEGIN "REPEAT #REPEAT %ERASE(10,23,10); %WRITELN('Enter date of reading, press RETURN: '); %WRITELN; %WRITE(' Day [1..31]: ');READLN(),'.'); %REPEAT UNTIL KEYPRESS; #END "ELSE $BEGIN &RECORDCOUNT:=WEIGHTFILE^.ENTRYCOUNT; &STOP:=WEIGHTFILE^.DATEID; &IF RECORDCOUNT>0 THEN (BEGIN *SEEK(WEIGHTFILE,1); *GET(WEIGHTFILE); *START:=WEIGHTFILE^.DATEID; (END 'ELSE START:=STOP;   PROCEDURE CHECK_FOR_DATA;  BEGIN !{$I-} !RESET(WEIGHTFILE,'#4:WTRECORDS'); !IF IORESULT<>0 THEN #BEGIN %ERASE(1,23,8); %WRITELN('No weight readings have yet been'); %WRITELN('entered.'); %WRITELN; %WRITELN('Press ',CHR(15),'SPACE BAR',CHR(14 "CLOSE(WEIGHTFILE,LOCK); "{$I+}  "WITH WEIGHTBUFF DO { data in record 0 } #BEGIN $LASTDATE:= DATEID; $RECORDCOUNT:= ENTRYCOUNT; {LAST RECORD NUMBER STORED HERE} $GOAL:= WEIGHT; #END;  END;  {****************************************} %STARTWT:= WEIGHTFILE^.WEIGHT; $END; #SEEK(WEIGHTFILE,0); #GET(WEIGHTFILE); #WEIGHTBUFF:=WEIGHTFILE^; # #I:=0; #WHILE NOT EOF(WEIGHTFILE) DO $BEGIN %SEEK(WEIGHTFILE,I); %GET(WEIGHTFILE); %LASTWT:= WEIGHTFILE^.WEIGHT; %I:= I+1; $END; "END; "UNT:=0; 'END; ' %REWRITE(WEIGHTFILE,'#4:WTRECORDS'); %WEIGHTFILE^:=WEIGHTBUFF; %SEEK(WEIGHTFILE,0); %PUT(WEIGHTFILE); #END "ELSE "BEGIN " SEEK(WEIGHTFILE,1); #IF EOF(WEIGHTFILE) THEN STARTWT:=0 ELSE $BEGIN %GET(WEIGHTFILE); IN !{$I-} !RESET(WEIGHTFILE,'#4:WTRECORDS'); !IF IORESULT<>0 THEN #BEGIN %RECORDCOUNT:=0; %GOAL:= 0; %STARTWT:= 0; %LASTWT:= 0; %WITH WEIGHTBUFF DO 'BEGIN )DATEID.DAY:=0; )DATEID.MONTH:='0'; )DATEID.YEAR:=0; )WEIGHT:=0; )ENTRYCOn.'); $GOTOXY(40,0); #END; "CASE KEY OF #'E':OPTION:=1; #'G':OPTION:=2; #'T':OPTION:=3; #'C':OPTION:=4; #'M':OPTION:=5; "END; !UNTIL OK; !ERASE(1,23,0);  END;  {*****************************************}   PROCEDURE CHECKRECORDSTATUS;  BEG!OPTIONLIST:= ['E','G','T','C','M']; !REPEAT "REPEAT UNTIL KEYPRESS; "READ(KEYBOARD,KEY); "IF KEY IN OPTIONLIST THEN OK:= TRUE #ELSE #BEGIN $ERASE(22,23,22); $WRITELN('Please try again. Press one of the'); $WRITE('letters above to make a selectioCHR(15),'M',CHR(14),' MASTER MENU'); #GOTOXY(0,22); #WRITELN('Press one of the highlighted letters'); #WRITE('above to make your selection.'); #GOTOXY(40,0); ! END; "{----------------------------------}  BEGIN !MENU_TEXT; ! !OK:= FALSE; ,'E',CHR(14),' ENTER DATA'); #WRITELN; #WRITELN(' ',CHR(15),'G',CHR(14),' GRAPH OF DATA'); #WRITELN; #WRITELN(' ',CHR(15),'T',CHR(14),' TABLE OF DATA'); #WRITELN; #WRITELN(' ',CHR(15),'C',CHR(14),' CHANGE GOAL'); #WRITELN; #WRITELN(' ', BOOLEAN; %OPTIONLIST: SET OF CHAR; "{-----------------------------} "PROCEDURE MENU_TEXT; "BEGIN #ERASE(0,23,0); #CENTERINV(' WEIGHT CHART '); #SHOW_WEIGHTBUFF; #WRITELN; #WRITELN; #WRITELN('SELECT OPTION: '); #WRITELN; #WRITELN(' ',CHR(15)!WRITELN(RECORDCOUNT,' entries have been made. The most'); !WRITELN('recent was: ', )LASTDATE.DAY,'-',LASTDATE.MONTH,'-',LASTDATE.YEAR, )' of ',LASTWT,' lbs.');  END;  {****************************************}   PROCEDURE SELECT_OPTION; !VAR OK: INTEGER;  {**************************************}   PROCEDURE SHOW_WEIGHTBUFF;  BEGIN !GOTOXY(0,2); !WRITELN('STARTING WEIGHT: ',STARTWT); !WRITELN('GOAL WEIGHT: ',GOAL); !WRITELN; NEWVAR);LASTDATE.DAY:= MAKEINT(NEWVAR); %WRITE(' Month [JAN]: ');READLN(LASTDATE.MONTH); %WRITE(' Year [82]: ');READLN(NEWVAR);LASTDATE.YEAR:= MAKEINT(NEWVAR); %WRITELN; %WRITE('CORRECT? [Y/N]: '); %WAITFOR(RESPONSE); %IF (LASTDATE.DAY=0) OR (LASTDATE.DAY>31) THEN RESPONSE:='N'; %IF (LASTDATE.YEAR<80) OR (LASTDATE.YEAR>99) THEN RESPONSE:='N'; #UNTIL RESPONSE<>'N'; #WEIGHTBUFF.DATEID:=LASTDATE; & #REPEAT $ERASE(18,23,18); $WRITE('Enter weight and press ',CHR(15),'RETURN',CHR(14),': '); $REA"PLOTSTART:= ROUND(145 - ((STARTWT - PWT) * FACTOR)); "STR(PWT,PLOTSTRING); " "IF FACTOR= 4.0 THEN WTINK:= 4; "IF FACTOR= 2.0 THEN WTINK:= 8; "IF FACTOR= 1.0 THEN WTINK:=16; "IF FACTOR= 0.5 THEN WTINK:=32;  END;  {*********************************IGHTFILE,I); &GET(WEIGHTFILE); &W[I]:= ROUND(145 - ((STARTWT - WEIGHTFILE^.WEIGHT) * FACTOR)); $END; $ "PWT:= 510; "OK:= FALSE; "REPEAT " PWT:= PWT-10; $IF PWT=25 THEN FACTOR:= 2.0; "IF WTRANGE>=50 THEN FACTOR:= 1.0; "IF WTRANGE>=100 THEN FACTOR:= 0.5; " "FOR I:= 0 TO RECORDCOUNT DO $BEGIN &SEEK(WE,'#4:IDRECORD'); "IDBUFF:= IDFILE^; "CLOSE(IDFILE,LOCK);  END;  {*********************************}   PROCEDURE SETARRAYS;  BEGIN "SEEK(WEIGHTFILE,0); "GET(WEIGHTFILE); "GOAL:= WEIGHTFILE^.WEIGHT; "SEEK(WEIGHTFILE,1); "GET(WEIGHTFILE); "START&OK:= TRUE; &SEEK(WEIGHTFILE,0); &GET(WEIGHTFILE); &WEIGHTFILE^.WEIGHT:= GOAL; &SEEK(WEIGHTFILE,0); &PUT(WEIGHTFILE); %END; #UNTIL OK; "ERASE(2,23,23);  END;  {**************************************}  PROCEDURE GETIDINFO;  BEGIN "RESET(IDFILE new weight goal and'); $WRITE('press ',CHR(15),'RETURN',CHR(14),': '); $READLN(NEWVAR); $GOAL:= MAKEINT(NEWVAR); $WRITELN; $WRITE('Is this correct? [Y/N]: '); $WAITFOR(RESPONSE); $IF GOAL=0 THEN RESPONSE:='N'; $IF RESPONSE<>'N' THEN %BEGIN ***************}   PROCEDURE CHANGE;  BEGIN  ERASE(2,23,2); "SHOW_WEIGHTBUFF; " "GOTOXY(0,23); "WRITE('Change the GOAL? [Y/N]: '); "WAITFOR(RESPONSE); "IF RESPONSE='Y' THEN #REPEAT $OK:= FALSE; # ERASE(10,23,10); $WRITELN('Please enter the? [Y/N]: '); #WAITFOR(RESPONSE); #IF GOAL=0 THEN RESPONSE:='N'; #IF RESPONSE<>'N' THEN OK:= TRUE; "UNTIL OK; " "WEIGHTBUFF.WEIGHT:= GOAL; "SEEK(WEIGHTFILE,0); "WEIGHTFILE^:= WEIGHTBUFF; "PUT(WEIGHTFILE); " "PROMPTENTRY;  END;  {***************#WRITELN('to select a weight level as a goal.'); #WRITELN; #WRITELN('Please enter the weight you wish to '); #WRITE('obtain and press ',CHR(15),'RETURN',CHR(14),': '); #READLN(NEWVAR); #GOAL:= MAKEINT(NEWVAR); #GOTOXY(0,23); #WRITE('Is this correctE; "REPEAT #ERASE(2,23,4); #WRITELN('The weight readings that you enter will'); #WRITELN('be plotted on a graph to aid you in'); #WRITELN('tracking your progress.'); #WRITELN; #WRITELN('To construct this graph, you are asked'); ESS; %READ(KEYBOARD,KEY); %IF (KEY='M') OR (KEY=CHR(27)) THEN OK:= TRUE; %IF KEY='E' THEN OK:= TRUE; #UNTIL OK; #IF KEY<>'E' THEN DONE:= TRUE; "UNTIL DONE;  END;  {**************************************}   PROCEDURE GET_GOAL;  BEGIN "OK:= FALS#SEEK(WEIGHTFILE,0); #PUT(WEIGHTFILE); # #ERASE(2,23,2); #SHOW_WEIGHTBUFF; # #OK:= FALSE; #DONE:= FALSE; #GOTOXY(0,23); #WRITE(CHR(15),'E',CHR(14),'nter a weight ', )CHR(15),'M',CHR(14),'enu '); #REPEAT %REPEAT UNTIL KEYPR#SEEK(WEIGHTFILE,RECORDCOUNT); {OPEN SPACE FOR NEW FILE} #WEIGHTFILE^:=WEIGHTBUFF; #PUT(WEIGHTFILE); # #SEEK(WEIGHTFILE,0); #GET(WEIGHTFILE); #WEIGHTFILE^.ENTRYCOUNT:= RECORDCOUNT; {UPDATE LASTDATE AND RECORDCOUNT} #WEIGHTFILE^.DATEID:= LASTDATE; DLN(NEWVAR); $LASTWT:= MAKEINT(NEWVAR); $WRITELN; $WRITE('CORRECT? [Y/N]: '); $WAITFOR(RESPONSE); $IF LASTWT=0 THEN RESPONSE:='N'; #UNTIL RESPONSE<>'N'; # #WEIGHTBUFF.WEIGHT:= LASTWT; # #RECORDCOUNT:=RECORDCOUNT+1; **********}   PROCEDURE MAKEGRAPH;   VAR NUMBEROFPOINTS,GRAPHBASE,GRAPHMAX, %VRANGE,HRANGE,LEFT,RIGHT, %SPACING,OLDPOINT,NEWPOINT, %START,A: INTEGER;  %PTNAME,D1,D2: STRING;   BEGIN  INITTURTLE; "NUMBEROFPOINTS:= RECORDCOUNT; "GRAPHBASE:= 20; "GRAPHMAX:= 170; "LEFT:= 30; "RIGHT:= 270; "HRANGE:= RIGHT-LEFT; "SPACING:= HRANGE DIV NUMBEROFPOINTS; "START:= (SPACING DIV 2)+LEFT; " "MOVETO(0,182);WSTRING('WEIGHT - '); "MOVETO6WEIGHT !ERASE(0,23,23); !WRITE('ONE MOMENT PLEASE... '); !SETCHAIN('#4:MMENU.CODE');  END. % &IF RECORDCOUNT>0 THEN (BEGIN *RESET(WEIGHTFILE,'#4:WTRECORDS'); *GETIDINFO; *SETARRAYS; *MAKETABLE; *CLOSE(WEIGHTFILE); (END; &END; $4:BEGIN 'RESET(WEIGHTFILE,'#4:WTRECORDS'); 'CHANGE; 'CLOSE(WEIGHTFILE); &END; $END; !UNTIL OPTION=5; !  %END; #2:BEGIN &CHECK_FOR_DATA; &IF RECORDCOUNT>0 THEN (BEGIN *RESET(WEIGHTFILE,'#4:WTRECORDS'); *GETIDINFO; *SETARRAYS; *MAKEGRAPH; *WAITFOR(RESPONSE); *ERASE(1,23,23); *TEXTMODE; *CLOSE(WEIGHTFILE); (END; &END; #3:BEGIN &CHECK_FOR_DATA;!CHECKRECORDSTATUS; { GET RECORDCOUNT AND LASTDATE }  !REPEAT "SELECT_OPTION; ! "CASE OPTION OF " 1:BEGIN &RESET(WEIGHTFILE,'#4:WTRECORDS'); &IF RECORDCOUNT=0 THEN GET_GOAL; &ERASE(2,23,2); &SHOW_WEIGHTBUFF; &PROMPTENTRY; &CLOSE(WEIGHTFILE);S2); (WRITELN(I:2,' ',S3,WEIGHT:10,' lbs.'); 'END; $END; #GOTOXY(0,23); #WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); #GOTOXY(40,0); #REPEAT UNTIL KEYPRESS;  END;  {*****************************************}  BEGIN !PROTECT; ! 1 TO RECORDCOUNT DO $BEGIN &SEEK(WEIGHTFILE,I); &GET(WEIGHTFILE); &WEIGHTBUFF:=WEIGHTFILE^; &WITH WEIGHTBUFF DO & BEGIN (STR(DATEID.DAY,S1); (IF LENGTH(S1)<2 THEN S1:=CONCAT(' ',S1); (STR(DATEID.YEAR,S2); (S3:= CONCAT(DATEID.MONTH,' ',S1,', 19',NT,W[I]); &OLDPOINT:= NEWPOINT; $END; "PENCOLOR(NONE);  END;  {****************************************}   PROCEDURE MAKETABLE; !VAR S1,S2,S3:STRING;  BEGIN "ERASE(1,23,2); "WRITELN('PATIENT NAME: ',IDBUFF.NAME); "WRITELN; "WRITELN; "FOR I:=&MOVETO(NEWPOINT,GRAPHBASE-4); &PENCOLOR(NONE); &OLDPOINT:= NEWPOINT; $END; " "MOVETO(START,W[1]); "PENCOLOR(ORANGE); "MOVETO(START+1,W[1]); "OLDPOINT:= START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:= OLDPOINT+SPACING; &MOVETO(NEWPOI); #END; " "MOVETO(START,GRAPHBASE-1); "PENCOLOR(WHITE1); "MOVETO(START,GRAPHBASE-4); "PENCOLOR(NONE); "OLDPOINT:=START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:=OLDPOINT+SPACING; &MOVETO(NEWPOINT,GRAPHBASE-1); &PENCOLOR(WHITE1); PLOT:= PLOTSTART; "SWT:= PWT; "WHILE (PLOT<155) AND (PLOT>30) DO #BEGIN $PLOT:= PLOT-INK; $SWT:= SWT-WTINK; $STR(SWT,PLOTSTRING); $MOVETO(0,PLOT); $WSTRING(PLOTSTRING); $MOVETO(LEFT-4,PLOT); $PENCOLOR(WHITE1); $MOVETO(LEFT,PLOT); $PENCOLOR(NONE; "SWT:= PWT; "WHILE (PLOT>30) AND (PLOT<155) DO #BEGIN $PLOT:= PLOT+INK; $SWT:= SWT+WTINK; $STR(SWT,PLOTSTRING); $MOVETO(0,PLOT); $WSTRING(PLOTSTRING); $MOVETO(LEFT-4,PLOT); $PENCOLOR(WHITE1); $MOVETO(LEFT,PLOT); $PENCOLOR(NONE); #END; " ""MOVETO(LEFT+2,W[0]); "PENCOLOR(GREEN); "MOVETO(RIGHT,W[0]); "PENCOLOR(NONE); " "MOVETO(0,PLOTSTART); "WSTRING(PLOTSTRING); "MOVETO(LEFT-4,PLOTSTART); "PENCOLOR(WHITE1); "MOVETO(LEFT,PLOTSTART); "PENCOLOR(NONE); " "INK:= 16; "PLOT:= PLOTSTART(140,182);WSTRING(IDBUFF.NAME); " "PENCOLOR(NONE); "MOVETO(RIGHT,GRAPHBASE); "PENCOLOR(WHITE1); "MOVETO(LEFT,GRAPHBASE); "MOVETO(LEFT,GRAPHMAX); "PENCOLOR(NONE); " "MOVETO(LEFT+2,145); "PENCOLOR(VIOLET); "MOVETO(RIGHT,145); "PENCOLOR(NONE); צSTARTING WEIGHT:  GOAL WEIGHT:   צ! entries have been made. The most recent was:  -- ɡ @ġ @2ġ ?dġ ?ȡ;  <Ǒ ɡǑP @צIs this correct? [Y/N]: áNNˡ)     $ j Y #4:IDRECORD;YY2       4 @צChange the GOAL? [Y/N]: Yá  $Please enter the new weight goal andpress RETURN: P$Please enter the weight you wish to obtain and press צRETURNצ: PצIs this correct? [Y/N]: áNNˡ weight readings that you enter willצ#be plotted on a graph to aid you intracking your progress.צ&To construct this graph, you are askedצ#to select a weight level as a goal.Eצ"nter a weight Mצenu MÝÍEáEˡ&HJ.6'TheEnter weight and press צRETURNצ: PCORRECT? [Y/N]: áNNˡ       Day [1..31]: P Month [JAN]: צ Year [82]: PcCORRECT? [Y/N]: éōNPɩcōNNˡentered.Press  SPACE BAR.-š     6A   %Enter date of reading, press RETURN: צ0c #4:WTRECORDS  Y         輸>  צ #4:WTRECORDS"ˡ No weight readings have yet beenצ"Please try again. Press one of theצ"letters above to make a selection.(C=71+CT$)' ! ";ء"  צ #4:WTRECORDS"ˡOM MASTER MENUצ$Press one of the highlighted lettersצabove to make your selection.(t oG GRAPH OF DATA T TABLE OF DATA C CHANGE GOAL Ͷ of   lbs.>צ WEIGHT CHART SELECT OPTION: צ Eצ ENTER DATA @??  l   Ǫ ޕނǶצ WEIGHT - njǶFǑǑ<ݥ<ީũǛɄJP ީǛɩńJP ީ̀ {**************************************}   SEGMENT PROCEDURE LOAD_DATEINFO; "VAR DATEINFO: FILE OF RECORD 1MONTHS: ARRAY[1..12] OF STRING[3]; 1NOFDAYS: ARRAY[1..12] OF 28..31; 0END;  BEGIN #RESET(DATEINFO,'#5:DATEINFO.DATA'); #MON:= DATEINFO^.M"IF IORESULT<>0 THEN #BEGIN $ERASE(2,23,5); $WRITELN('No data are presently on file.'); $GOTOXY(0,23); $WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); $GOTOXY(40,0); #END ELSE DATAFOUND:= TRUE; "CLOSE(DATA);  END; $DDAY:0..31; $FIRSTMON,DMON:1..12; $DYEAR:0..99; $PTNAME:STRING[20]; $DATAFOUND,OK,DONE: BOOLEAN;  {**********************************} !  SEGMENT PROCEDURE CHECK_FOR_DATA;  BEGIN "DATAFOUND:= FALSE; "{$I-} "RESET(DATA,'#4:SMOKEREC'); "{$I+} 99; %MONTHS=1..13; $  VAR I,J,K,OPTION: INTEGER; $MON:ARRAY [1..12] OF STRING[3]; $MAX:ARRAY [1..12] OF 28..31; $ $DATA:FILE OF PACKED RECORD *DATEID:DATE; *FACTOR:PACKED ARRAY [1..500] OF REAL ; *CIGS :PACKED ARRAY [1..500] OF INTEGER; )END;{$S+}{L CONSOLE:} { SERIES 9 }   PROGRAM NICOTINE; { UPDATED 12/7/85 }   USES APPLESTUFF,SHORTGRAPHICS,CHAINSTUFF,MINSTUFF,ADDRESS,CODECHECK,EXSTUFF;   TYPE DATE=RECORD +DAY:0..31; +MONTH:STRING[3]; +YEAR:0..99; *END; %DAYS=0..32; %YEARS=0..DI1 DI2 N^Ǥ1v|L: vvtb hO  Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& צ #4:WTRECORDS 4 צ #4:WTRECORDS a2áצONE MOMENT PLEASE...  #4:MMENU.CODEY , BAR to move on.( hO  Y 5 צ #4:WTRECORDSá š5 צ #4:WTRECORDS  eš& SP SɡS}}צ }SQ}P*P }}} }ST}, 19X}*Ǩ}P   צ lbs.צPress צ SPACEʀȡ(܂٥< <̀ʀȡ"܂ڥ<1 tX PATIENT NAME: F||ȡ ONTHS; #MAX:= DATEINFO^.NOFDAYS; #CLOSE(DATEINFO);  END;  {**********************************} )  SEGMENT PROCEDURE SELECT_OPTION;  VAR OK: BOOLEAN; &OPTIONLIST: SET OF CHAR; "{--------------------------} "PROCEDURE MENU_TEXT; "BEGIN $GOTOXY(0,12); $WRITELN('SELECT OPTION:'); $WRITELN; $WRITELN(' ',CHR(15),'E',CHR(14),' ENTER DATA'); $WRITELN; $WRITELN(' ',CHR(15),'G',CHR(14),' GRAPH OF DATA'); $WRITELN; $WRITELN(' ',CHR(15),'T',CHR(14),' TABLE OF DATA'); $WRITELN; $WRITELN(' END;  {***************************} 0  PROCEDURE UPDATE (VAR NDAY:DAYS ; 2VAR NMON:MONTHS; 2VAR NYEAR:YEARS);  BEGIN "NDAY:=NDAY+1; "IF NDAY>MAX[NMON] THEN $BEGIN %NDAY:=1; %NMON:=NMON+1; %IF NMON=13 THEN 'BEGIN (NMON:=1; (NYEAR:=NYEAR+1;G); "MOVETO (HOR,58);WCHAR(STRG[2]); "MOVETO (HOR,66);WCHAR(STRG[1]); "MOVETO (HOR,74);WCHAR('9'); "MOVETO (HOR,82);WCHAR('1'); "STRG:=MON[DMON]; "MOVETO (HOR,98);WCHAR(STRG[3]); "MOVETO (HOR,106);WCHAR(STRG[2]); "MOVETO (HOR,114);WCHAR(STRG[1]); IF} *END; {IF} *J:=J-1; {GET NEXT CHAR. TO LEFT} *COUNTER:=COUNTER + 1; (UNTIL (FLAG=TRUE) OR (J=0); &END; $UNTIL FLAG=FALSE  END;  {***************************} 0  PROCEDURE TIMESTRG(HOR:INTEGER); "VAR STRG:STRING[10];  BEGIN "STR (DYEAR,STRND; {CASE} ,CASE COUNTER OF /1: MULT:=1; /2: MULT:=10; /3: MULT:=100; /4: MULT:=1000; /5: MULT:=10000 ,END; {CASE} ,VALUE := VALUE + (INT * MULT); ,IF VALUE>32000 THEN /BEGIN 1WRITELN ('ERROR. Value too large. Try again: '); 1FLAG:=TRUE /END;{.WRITELN ('ERROR. Please try again: '); .FLAG:=TRUE; ,END; *IF FLAG=FALSE THEN +BEGIN ,CASE CH OF .'0': INT:=0; .'1': INT:=1; .'2': INT:=2; .'3': INT:=3; .'4': INT:=4; .'5': INT:=5; .'6': INT:=6; .'7': INT:=7; .'8': INT:=8; .'9': INT:=9 ,E; $IF (J>5) OR (J=0) THEN (BEGIN *WRITELN ('ERROR. Please try again: '); *FLAG:=TRUE; (END; $IF FLAG=FALSE THEN (BEGIN )VALUE:=0; )COUNTER:=1; {DIGITS} )REPEAT *CH:=THESE[J]; *IF NOT (CH IN NUMCH ) THEN ,BEGIN ER; &NUMCH:NUMBERS; &CH:CHAR; &THESE:STRING; &FLAG:BOOLEAN;  BEGIN "NUMCH :=['0','1','2','3','4','5','6','7','8','9']; "REPEAT $FLAG:=FALSE; $READLN (THESE); $IF THESE='NA' THEN &BEGIN (VALUE:= -99; (EXIT (READNUM); &END; $J:=LENGTH (THESE)1; &CASES:=CASES-1; &NUM :=NUM+1; $END; "IF NUM>0 THEN $AVERAGE:=SIGMA DIV NUM $ELSE $AVERAGE:=0;  END;  {*****************************} ) SEGMENT PROCEDURE READNUM(VAR VALUE:INTEGER); 9 "TYPE NUMBERS =SET OF CHAR; "VAR COUNTER,INT,MULT:INTEG {**********************************}   SEGMENT FUNCTION AVERAGE (BEGI,CASES:INTEGER):INTEGER; &VAR SIGMA,NUM:INTEGER;  BEGIN "NUM:=0; "SIGMA:=0; "WHILE CASES>0 DO $BEGIN &SIGMA :=SIGMA + ROUND(DATA^.FACTOR[BEGI]*DATA^.CIGS[BEGI]); &BEGI:=BEGI+will need to know the nico-'); "WRITELN('tine content in milligrams for each'); "WRITELN('brand of cigarette smoked. These values'); "WRITELN('are periodically updated by the U.S.'); "WRITELN('goverment.');  END; NV(' NICOTINE CHARTING '); "WRITELN; "WRITELN(' This charting system is intended to '); "WRITELN('be used for tracking daily nicotine '); "WRITELN('intake as part of a nicotine fading/'); "WRITELN('smoking cessation program.'); "WRITELN(' The user ; %GOTOXY(40,0); $END; #CASE KEY OF $'E':OPTION:=1; $'G':OPTION:=2; $'T':OPTION:=3; $'M':OPTION:=4; #END; "UNTIL OK; "ERASE(1,23,0);  END;  {********************************} )  SEGMENT PROCEDURE GREETING;  BEGIN  ERASE(0,23,0); "CENTERI"OPTIONLIST:= ['E','G','T','M']; "REPEAT #REPEAT UNTIL KEYPRESS; #READ(KEYBOARD,KEY); #IF KEY IN OPTIONLIST THEN OK:= TRUE $ELSE $BEGIN %ERASE(22,23,22); %WRITELN('Please try agian. Press one of the'); %WRITE('letters above to make a selection.') ',CHR(15),'M',CHR(14),' MASTER MENU'); $GOTOXY(0,22); $WRITELN('Press one of the highlighted letters'); $WRITE('above to make your selection.'); $GOTOXY(40,0); "END; "{-------------------------}  BEGIN  MENU_TEXT; " "OK:= FALSE; 'END; #END;  END;  {******************************} $  PROCEDURE PLOT(VAR INI,QUAN,SPA,AV:INTEGER); "VAR V,H,LASTMON:INTEGER; "{-------------------------} "FUNCTION VERTICAL(AVERG:INTEGER;NICO:REAL):INTEGER; "BEGIN $VERTICAL:=ROUND((90*NICO)/AVERG) "END; "{-------------------------}  BEGIN "LASTMON:=DMON; "V:=VERTICAL (AV,(DATA^.FACTOR[INI]*DATA^.CIGS[INI])); "IF V>180 THEN V:=180; "H:=57; "MOVETO (H,V); "INI:=INI+1; "QUAN:=QUAN-1; "UPDATE (DDAY,DMON,DYEAR); "H:=H+SPA; "IF DMON<>LAS"STR (DATA^.DATEID.YEAR,YEARSTR); "FIRST:=CONCAT (DAYSTR,' ',DATA^.DATEID.MONTH,' ',YEARSTR); "STR (DDAY,DAYSTR);STR (DYEAR,YEARSTR); "LAST:=CONCAT (DAYSTR,' ',MON[DMON],' ',YEARSTR); " "WRITELN; "WRITE('At present, ',X,' entry'); "IF X>1 THEN WRIT$ IF (KEY='M') OR (KEY=CHR(27)) THEN &BEGIN 'UPDATE(DDAY,DMON,DYEAR); 'OK:= TRUE; &END; %IF KEY='E' THEN OK:= TRUE; $UNTIL OK; $ERASE(2,23,2); $IF KEY<>'E' THEN DONE:= TRUE; "UNTIL DONE; " "X:=X-1; "STR (DATA^.DATEID.DAY,DAYSTR); EAR (1); (END; %UNTIL IO=0;{$I+} $END; $ $X:=X+1; $OK:= FALSE; $DONE:= FALSE; $GOTOXY(0,23); $WRITE(CHR(15),'E',CHR(14),'nter more data ', *CHR(15),'M',CHR(14),'enu '); $REPEAT %REPEAT UNTIL KEYPRESS; %READ(KEYBOARD,KEY); RITELN; %WRITELN('Enter nicotine factor for this brand'); %WRITE('and press ',CHR(15),'RETURN',CHR(14),': '); %{$I-} %REPEAT 'IO:=0; 'READLN (DATA^.FACTOR[X]); 'IF IORESULT =14 THEN (BEGIN )IO:=99; )WRITELN('ERROR. Please try again: '); )UNITCL#WRITELN('Data entry for ',DDAY,' ',MON[DMON],' ',DYEAR); #GOTOXY(0,10); #WRITELN; #WRITELN('Enter number of cigarettes smoked and'); #WRITE('press ',CHR(15),'RETURN',CHR(14),': '); #READNUM(DATA^.CIGS[X]); # #IF DATA^.CIGS[X]<>-99 THEN $BEGIN %WND;  {**************************************}   PROCEDURE DOITEMS(X:INTEGER);  VAR DAYSTR,YEARSTR:STRING[4]; 'LAST,FIRST:STRING[10]; 'IO:INTEGER;  BEGIN "{$R UPDATE} "{$R READNUM} "REPEAT #ERASE(2,23,5); _'); 'GOTOXY(0,12); 'READLN(IDFILE^.NAME); 'GOTOXY(0,23); 'WRITE('Is this correct? [Y/N]: '); 'WAITFOR(RESPONSE); 'IF RESPONSE='Y' THEN OK:= TRUE; &UNTIL OK; &SEEK(IDFILE,0); &PUT(IDFILE); %END; " END; "CLOSE(IDFILE,LOCK); "ERASE(2,23,2);  E; &WRITELN; &WRITE('Change this name? [Y/N]: '); &WAITFOR(RESPONSE); &IF RESPONSE='Y' THEN CHANGE:= TRUE; %END; $ $IF CHANGE THEN %BEGIN &REPEAT 'ERASE(2,23,5); 'WRITELN('Enter Name and Press RETURN: '); 'WRITELN; 'WRITELN('___________________&WRITELN('correct disk, and restart the Apple.'); &WRITELN; &WRITELN('If you wish to change the name, press'); &WRITELN('"Y" in response to the prompt below.'); &WRITELN; &WRITELN('If you wish to stay with the present'); &WRITELN('name, press "N".')E,CHR(14)); $WRITELN; $WRITE('Is this correct? [Y/N]: '); $WAITFOR(RESPONSE); $ $IF RESPONSE='N' THEN %BEGIN &WRITELN; &WRITELN; &WRITELN('If the wrong Patient Record Disk is in '); &WRITELN('Drive #1, remove it, replace it with the'); LE: FILE OF IDINFO;  BEGIN "RESET(IDFILE,'#4:IDRECORD'); "PTNAME:= IDFILE^.NAME; " "IF OPTION=1 THEN #BEGIN $CHANGE:= FALSE; $ERASE(2,23,5); $WRITELN('Data will be saved under the name:'); $WRITELN; $WRITELN(' ',CHR(15),IDFILE^.NAM=H+8; *MOVETO (H,V); *PENCOLOR (WHITE); (END; &H:=H+SPA; #END;  END;  {***********************}  PROCEDURE CHECKID;  "TYPE IDINFO= RECORD 0NAME,THERAPIST:STRING[20]; 0BIRTH:DATE; 0SSNUMBER:INTEGER[9]; /END;  VAR CHANGE: BOOLEAN; &IDFI*WCHAR ('M'); *IF SPA>7 THEN ,MOVETO (H,TURTLEY); *PENCOLOR (WHITE); *H:=H+7; (END (ELSE (MOVETO (H,V); &INI:=INI+1; &QUAN:=QUAN-1; &UPDATE (DDAY,DMON,DYEAR); &IF DMON<>LASTMON THEN (BEGIN *PENCOLOR(NONE); *LASTMON:=DMON; *TIMESTRG(H); *H:TMON THEN $BEGIN &LASTMON:=DMON; &TIMESTRG(H); &H:=H+8; $END; "PENCOLOR(WHITE); "WHILE QUAN>0 DO $BEGIN &V:=VERTICAL (AV,(DATA^.FACTOR[INI]*DATA^.CIGS[INI])); &IF V>180 THEN V:=180; &IF DATA^.CIGS[INI]<0 THEN (BEGIN *PENCOLOR (NONE); ELN('s') ELSE WRITELN; "WRITELN('dating from ',FIRST,' to ', LAST); "WRITELN('are on file.');  END;  {************************************}   PROCEDURE OPEN;  VAR TEMP:INTEGER; ${----------------------} $PROCEDURE ERROR; $BEGIN %WRITELN; %WRITE('ERROR. Try again: '); $END; ${---------------------}  BEGIN "REWRITE (DATA,'#4:SMOKEREC'); " "ERASE(2,23,5); "WRITELN('New data file created.'); "WRITELN; "WRITELN('Enter the date you wish to begin chart-'); "WRITELN('ing with:'); "GOTOXY(0,1&MOVETO(21,90); &WSTRING('MG'); %END %ELSE %BEGIN &MOVETO(0,90); &WSTRING(CONCAT (STRG,' MG')); %END; #MOVETO(0,0); WSTRING ('00 MG'); #MOVETO(42,180);PENCOLOR (WHITE); #MOVETO(42,0); PENCOLOR (NONE); #MOVETO(41,90); PENCOLOR (WHITE); #MOVETO(THEN $BEGIN %MOVETO(7,184); %WSTRING(STRG); %MOVETO(21,176); %WSTRING('MG'); $END $ELSE $BEGIN %MOVETO(0,176); %WSTRING(CONCAT (STRG,' MG')); $END; #STR(A,STRG); #IF LENGTH(STRG) =3 THEN %BEGIN &MOVETO(7,98); &WSTRING(STRG); OTOXY(40,0); &REPEAT UNTIL KEYPRESS; &UNITCLEAR(1); &ERASE(6,23,6); #UNTIL DATA^.CIGS[J]=-1;  END;  {********************}   PROCEDURE HEADER (A:INTEGER); "VAR STRG:STRING[10]; %  BEGIN "PENCOLOR(NONE); "STR((2*A),STRG); "IF LENGTH(STRG)=3 :2,' ',T:3:1,' MG') *ELSE WRITELN(D,' MISSING DATA'); (UPDATE(DDAY,DMON,DYEAR); (J:=J+1; (COUNTER:=COUNTER+1; &UNTIL (DATA^.CIGS[J]=-1) OR (COUNTER=15); & &GOTOXY(0,23); &WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); &G(STR(DYEAR,YEARSTR); (D:=CONCAT(DSTR,' ',MON[DMON],' ',YEARSTR); (IF LENGTH(D)<9 THEN D:=CONCAT(SPACE,D); (D:=CONCAT(D,COPY(BLANK,1,(12-LENGTH(D)))); (F:=DATA^.FACTOR[J]; (C:=DATA^.CIGS[J]; (T:=F*C; (IF(C>0) OR (C=0) THEN WRITELN(D,F:3:2,' ',COTINE INTAKE'); "WRITELN; "WRITELN('DATE FACTOR CIGS/DAY NICOTINE'); "WRITELN; "WRITELN; "DDAY:=DATA^.DATEID.DAY; "DYEAR:=DATA^.DATEID.YEAR; "DMON:=FIRSTMON; "J:=1; $REPEAT &GOTOXY (0,6); &COUNTER:= 0; &REPEAT (STR(DDAY,DSTR); &SPACE: STRING[1]; &BLANK: STRING; &DSTR,YEARSTR:STRING[3];  BEGIN "{$R UPDATE} "SPACE:=' '; "BLANK:= SPACE; "REPEAT BLANK:=CONCAT(BLANK,SPACE) UNTIL LENGTH(BLANK)=40; " "ERASE(0,23,0); "CENTER(PTNAME); "WRITELN; "WRITELN(' DAILY NICcontinue? [Y/N]: '); %WAITFOR(RESPONSE); %IF RESPONSE<>'N' THEN 'BEGIN (UPDATE(DDAY,DMON,DYEAR); (DOITEMS(J);; 'END; $END $ELSE $DOITEMS(J);  END;  {********************}   PROCEDURE TABLE; "VAR T,F:REAL; &C,COUNTER:INTEGER; &D:STRING[20];"J:=0; "REPEAT J:=J+1 UNTIL (DATA^.CIGS[J]=-1); "IF J>1 THEN $BEGIN %IF J>3 THEN FOR K:=3 TO J DO UPDATE(DDAY,DMON,DYEAR); %GOTOXY(0,5); %WRITELN('The last entry was for ',DDAY,' ',MON[DMON],' ',DYEAR); %WRITELN; %WRITELN; %WRITE('Do you want to THEN DMON:=9; "IF T='OCT' THEN DMON:=10; "IF T='NOV' THEN DMON:=11; "IF T='DEC' THEN DMON:=12; "FIRSTMON:=DMON; "IF ((DYEAR MOD 4)=0) THEN MAX[2]:=29;{LEAP YEAR}  END;  {**********************************}   PROCEDURE GIVE_ENTRY_OPTION;  BEGIN ; "T:=DATA^.DATEID.MONTH; "IF T='JAN' THEN DMON:=1; "IF T='FEB' THEN DMON:=2; "IF T='MAR' THEN DMON:=3; "IF T='APR' THEN DMON:=4; "IF T='MAY' THEN DMON:=5; "IF T='JUN' THEN DMON:=6; "IF T='JUL' THEN DMON:=7; "IF T='AUG' THEN DMON:=8; "IF T='SEP' IN %DATA^.FACTOR[J]:=0; %DATA^.CIGS[J]:=-1; $END; "SEEK(DATA,0); "PUT (DATA);  END;  {*****************************} #  PROCEDURE GETINFO;  VAR T:STRING[3];  BEGIN "SEEK(DATA,0); "GET(DATA); "DDAY:=DATA^.DATEID.DAY; "DYEAR:=DATA^.DATEID.YEAR" "ERASE(10,23,10); "WRITE('YEAR [70,...82,83]: '); "REPEAT $GOTOXY (0,12); $READNUM (TEMP); $WRITELN; $IF (TEMP>99) OR (TEMP<1) THEN ERROR; "UNTIL (TEMP<100) AND (TEMP>0); "DATA^.DATEID.YEAR:=TEMP; " "ERASE(0,23,0); "FOR J:=1 TO 500 DO #BEG0); "WRITE('DAY [1..31]: '); "REPEAT $READNUM(TEMP); $WRITELN; $IF (TEMP>31) OR (TEMP<1) THEN ERROR; "UNTIL (TEMP<32) AND (TEMP>0); "DATA^.DATEID.DAY:=TEMP; " "ERASE(10,23,10); "WRITE('MONTH [JAN,FEB,...DEC]: '); "READLN(DATA^.DATEID.MONTH); 43,90); PENCOLOR (NONE); #MOVETO(41,180); PENCOLOR (WHITE); #MOVETO(43,180); PENCOLOR (NONE); #MOVETO(70,182); #WSTRING('DAILY NICOTINE INTAKE');  END;  {**************************}   PROCEDURE GRAPH;  "VAR LASTMON,INIT,QUAN,MONTHS,SPACES,SUM:INTEGER; &VERT,HORIZ,INDEX,AVG:INTEGER; &CH:CHAR; &SDAY:0..31; &SMON:1..12; &SYEAR:0..99; '  BEGIN "INITTURTLE; "DDAY:=DATA^.DATEID.DAY; "DYEAR:=DATA^.DATEID.YEAR; "DMON:=FIRSTMON; "SDAY:=DDAY; "SYEAR:=DYEAR; "SMON:=DMON; "INIT:=1; "LASTMON:{$S+} { SERIES 9 }   PROGRAM BPENTRY; { UPDATED 12/7/85 }   USES CHAINSTUFF,APPLESTUFF,MINSTUFF,SHORTGRAPHICS,EXSTUFF,ADDRESS,CODECHECK;  CONST MAX= 60;   TYPE DATE= RECORD .DAY: 0..31; .MONTH: STRING[3]; .YEAR: 0..99; ,END;  &IDINFO= N^T '); "SETCHAIN('#4:MMENU');  END. %CHECK_FOR_DATA; %IF DATAFOUND THEN &BEGIN 'RESET(DATA,'#4:SMOKEREC'); 'CHECKID; 'GETINFO; 'ERASE(0,23,0); 'TABLE; 'ERASE(0,23,0); 'CLOSE(DATA); &END; $END; # UNITCLEAR(1); "UNTIL OPTION=4; # "ERASE(0,23,23); "WRITE('ONE MOMENT PLEASE... A,LOCK); $END; $ #IF OPTION=2 THEN $BEGIN %CHECK_FOR_DATA; %IF DATAFOUND THEN 'BEGIN (RESET(DATA,'#4:SMOKEREC'); (CHECKID; (GETINFO; (GRAPH; (ERASE(2,23,23); (TEXTMODE; (CLOSE(DATA); 'END; %END; ( #IF OPTION=3 THEN $BEGIN TECT; " "GREETING; " "REPEAT #SELECT_OPTION; # #LOAD_DATEINFO; # #IF OPTION=1 THEN $BEGIN %CHECKID; %{$I-} %RESET(DATA,'#4:SMOKEREC'); %IF IORESULT<>0 THEN OPEN; %{$I+} %GETINFO; %GIVE_ENTRY_OPTION; %SEEK(DATA,0); %PUT(DATA); %CLOSE(DATYEAR; DMON:=SMON; %TIMESTRG (HORIZ); %PLOT (INIT,QUAN,SPACES,AVG); %SDAY:=DDAY; SYEAR:=DYEAR; SMON:=DMON; %READ (CH); %INITTURTLE; #UNTIL (DATA^.CIGS[INIT + 1]=-1) OR (CH='E'); !END;  {***********************************************}  BEGIN "PRO$IF SUM < 2 THEN EXIT (GRAPH); $IF ((SUM*3)+(MONTHS*7))>200 THEN 'BEGIN )SPACES:=3; )QUAN:=60; 'END 'ELSE 'BEGIN )QUAN:=(SUM); )SPACES:=(220-(MONTHS*7))DIV QUAN 'END; %AVG:=AVERAGE (INIT,QUAN); %HEADER(AVG); %HORIZ:=49; %DDAY:=SDAY; DYEAR:=S=DMON; "REPEAT $SUM:=0; $MONTHS:=0; $INDEX:=INIT; $REPEAT &UPDATE(DDAY,DMON,DYEAR); &IF DMON<>LASTMON THEN (BEGIN *MONTHS:=MONTHS+1; *LASTMON:=DMON; )END; 'SUM:=SUM+1; 'INDEX:=INDEX+1; $UNTIL DATA^.CIGS[INDEX]=-1; RECORD 0NAME,THERAPIST: STRING[20]; 0BIRTH: DATE; 0SSNUMBER: INTEGER[9]; .END; % &BPINFO= RECORD & DATEID: DATE; 0SYSTOLIC,DIASTOLIC,ENTRYCOUNT: INTEGER; .END; .  VAR BPBUFF: BPINFO; $BPFILE: FILE OF BPINFO; $IDBUFF: IDINFO; $IDFILE: FILE OF IDINFO; $ $OPTION,RECORDCOUNT,I: INTEGER; $KEY2: CHAR; $OK: BOOLEAN; $NEWVAR: STRING; $ $LASTDATE,START,STOP: DATE; $S,D: ARRAY[1..MAX] OF INTEGER;  {**************************************}   PROCEDURE SHOWBPBUFF;  BEGIN !GOTOXY(0,2)"REPEAT #ERASE(18,23,18); #WRITE('Systolic reading, press ',CHR(15),'RETURN',CHR(14),': '); #READLN(NEWVAR); #BPBUFF.SYSTOLIC:= MAKEINT(NEWVAR); #WRITE('Diastolic reading, press ',CHR(15),'RETURN',CHR(14),': '); #READLN(NEWVAR); #BPBUFF.DIASTOLIC:=; $WRITELN; $WRITE('CORRECT? [Y/N]: '); $WAITFOR(RESPONSE); $IF (LASTDATE.DAY=0) OR (LASTDATE.DAY>31) THEN RESPONSE:= 'N'; $IF (LASTDATE.YEAR<80) OR (LASTDATE.YEAR>99) THEN RESPONSE:= 'N'; "UNTIL RESPONSE<>'N'; " "BPBUFF.DATEID:=LASTDATE; " TELN('Enter date of reading, press RETURN: '); $WRITELN; $WRITE(' Day [1..31]: ');READLN(NEWVAR);LASTDATE.DAY:= MAKEINT(NEWVAR); $WRITE(' Month [JAN]: ');READLN(LASTDATE.MONTH); $WRITE(' Year [85]: ');READLN(NEWVAR);LASTDATE.YEAR:= MAKEINT(NEWVAR)RDCOUNT>0 THEN (BEGIN *SEEK(BPFILE,1); *GET(BPFILE); *START:=BPFILE^.DATEID; (END 'ELSE START:=STOP; $END; #CLOSE(BPFILE); "{$I+}  END;  {**************************************}   PROCEDURE PROMPTENTRY;  BEGIN "REPEAT $ERASE(9,23,9); $WRI%WRITELN('No blood pressure readings have yet'); %WRITELN('been entered.'); %WRITELN; %WRITELN('Press ',CHR(15),'SPACE BAR',CHR(14),'.'); %REPEAT UNTIL KEYPRESS; #END "ELSE $BEGIN &RECORDCOUNT:=BPFILE^.ENTRYCOUNT; &STOP:=BPFILE^.DATEID; &IF RECOE:=BPBUFF.DATEID; "CLOSE(BPFILE,LOCK); "{$I+}  END;  {****************************************}   PROCEDURE CHECK_FOR_DATA;  BEGIN !{$I-} !RESET(BPFILE,'#4:BPRECORDS'); !IF IORESULT<>0 THEN #BEGIN %ERASE(1,23,8); =0; )DIASTOLIC:=0; )ENTRYCOUNT:=0; 'END; %REWRITE(BPFILE,'#4:BPRECORDS'); %BPFILE^:=BPBUFF; %SEEK(BPFILE,0); %PUT(BPFILE); #END "ELSE $BEGIN &BPBUFF:=BPFILE^; &RECORDCOUNT:=BPBUFF.ENTRYCOUNT; {LAST RECORD NUMBER STORED HERE} $END;  "LASTDAT********************************}   PROCEDURE CHECKRECORDSTATUS;  BEGIN !{$I-} !RESET(BPFILE,'#4:BPRECORDS'); !IF IORESULT<>0 THEN #BEGIN %RECORDCOUNT:=0; %WITH BPBUFF DO 'BEGIN )DATEID.DAY:=0; )DATEID.MONTH:='0'; )DATEID.YEAR:=0; )SYSTOLIC:$WRITELN('Please try again. Press one of the'); $WRITE('letters above to make a selection.'); $GOTOXY(40,0); #END; "CASE KEY OF #'E':OPTION:=1; #'G':OPTION:=2; #'T':OPTION:=3; #'M':OPTION:=4; "END; !UNTIL OK; !ERASE(1,23,0);  END;  {*********ND; "{----------------------------------}  BEGIN !MENU_TEXT; ! !OK:= FALSE; !OPTIONLIST:= ['E','G','T','M']; !REPEAT "REPEAT UNTIL KEYPRESS; "READ(KEYBOARD,KEY); "IF KEY IN OPTIONLIST THEN OK:= TRUE #ELSE #BEGIN $ERASE(22,23,22); TELN; #WRITELN(' ',CHR(15),'T',CHR(14),' TABLE OF DATA'); #WRITELN; #WRITELN(' ',CHR(15),'M',CHR(14),' MASTER MENU'); #GOTOXY(0,22); #WRITELN('Press one of the highlighted letters'); #WRITE('above to make your selection.'); #GOTOXY(40,0); ! E0); #CENTERINV(' BLOOD PRESSURE CHART '); #SHOWBPBUFF; #WRITELN; #WRITELN; #WRITELN('SELECT OPTION: '); #WRITELN; #WRITELN; #WRITELN(' ',CHR(15),'E',CHR(14),' ENTER DATA'); #WRITELN; #WRITELN(' ',CHR(15),'G',CHR(14),' GRAPH OF DATA'); #WRI!WRITELN(' Diastolic: ',BPBUFF.DIASTOLIC:4);  END;  {****************************************}   PROCEDURE SELECT_OPTION; !VAR OK: BOOLEAN; %OPTIONLIST: SET OF CHAR; "{-----------------------------} "PROCEDURE MENU_TEXT; "BEGIN #ERASE(0,23,; !WRITELN(RECORDCOUNT,' Readings have been entered.'); !WRITELN; !WRITELN('The most recent was: ', )LASTDATE.DAY,'-',LASTDATE.MONTH,'-',LASTDATE.YEAR); !WRITELN; !WRITELN(' Systolic: ',BPBUFF.SYSTOLIC:4); MAKEINT(NEWVAR); #WRITELN; #WRITE('CORRECT? [Y/N]: '); #WAITFOR(RESPONSE); #IF (BPBUFF.SYSTOLIC=0) OR (BPBUFF.DIASTOLIC=0) THEN RESPONSE:= 'N'; "UNTIL RESPONSE<>'N'; " "RECORDCOUNT:=RECORDCOUNT+1; "SEEK(BPFILE,RECORDCOUNT); {OPEN SPACE FOR NEW FILE} "BPFILE^:=BPBUFF; "PUT(BPFILE); "SEEK(BPFILE,0); {UPDATE RECORDCOUNT AND LASTDATE} "BPBUFF.ENTRYCOUNT:=RECORDCOUNT; "BPFILE^:=BPBUFF; "PUT(BPFILE);  END;  {**************************************}   PROCEDURE GETIDINFO;  BEGIN "R BEGIN !PROTECT; ! !CHECKRECORDSTATUS; { GET RECORDCOUNT AND LASTDATE }  !REPEAT "SELECT_OPTION; ! "IF OPTION=1 THEN #BEGIN $RESET(BPFILE,'#4:BPRECORDS'); $REPEAT &ERASE(1,23,8); &SHOWBPBUFF; & &OK:= FALSE; &GOTOXY(0,23); &WRITE(CHR(15)S1,', 19',S2); (WRITELN(I:2,' ',S3,SYSTOLIC:8,' / ',DIASTOLIC:3); 'END; $END; #GOTOXY(0,23); #WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); #GOTOXY(40,0); #REPEAT UNTIL KEYPRESS;  END;  {*****************************************} "WRITELN; "WRITELN; "FOR I:= 1 TO RECORDCOUNT DO $BEGIN &SEEK(BPFILE,I); &GET(BPFILE); &BPBUFF:=BPFILE^; &WITH BPBUFF DO & BEGIN (STR(DATEID.DAY,S1); (IF LENGTH(S1)<2 THEN S1:=CONCAT(' ',S1); (STR(DATEID.YEAR,S2); (S3:= CONCAT(DATEID.MONTH,' ',INT+SPACING; &MOVETO(NEWPOINT,D[I]-A); &OLDPOINT:= NEWPOINT; $END; "PENCOLOR(NONE);  END;  {****************************************}   PROCEDURE MAKETABLE; !VAR S1,S2,S3:STRING;  BEGIN "ERASE(1,23,2); "WRITELN('PATIENT NAME: ',IDBUFF.NAME); &NEWPOINT:= OLDPOINT+SPACING; &MOVETO(NEWPOINT,S[I]-A); &OLDPOINT:= NEWPOINT; $END; "PENCOLOR(NONE); " "MOVETO(START,D[1]-A); "PENCOLOR(BLUE); "MOVETO(START+1,D[1]-A); "OLDPOINT:= START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:= OLDPOPENCOLOR(WHITE1); &MOVETO(NEWPOINT,GRAPHBASE-4); &PENCOLOR(NONE); &OLDPOINT:= NEWPOINT; $END; " "MOVETO(START,S[1]-A); "PENCOLOR(VIOLET); "MOVETO(START+1,S[1]-A); "OLDPOINT:= START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN HTBOUNDRY,60); "PENCOLOR(NONE); " "MOVETO(START,GRAPHBASE-1); "PENCOLOR(WHITE1); "MOVETO(START,GRAPHBASE-4); "PENCOLOR(NONE); "OLDPOINT:=START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:=OLDPOINT+SPACING; &MOVETO(NEWPOINT,GRAPHBASE-1); &ING('110'); "MOVETO(8,60);WSTRING('90'); "MOVETO(8,40);WSTRING('70'); "MOVETO(8,20);WSTRING('50'); " "MOVETO(LEFTBOUNDRY,110); "PENCOLOR(WHITE1); "MOVETO(RIGHTBOUNDRY,110); "PENCOLOR(NONE); "MOVETO(LEFTBOUNDRY,60); "PENCOLOR(WHITE1); "MOVETO(RIG"I:= 20; "REPEAT $MOVETO(LEFTBOUNDRY-4,I); $PENCOLOR(WHITE1); $MOVETO(LEFTBOUNDRY+4,I); $PENCOLOR(NONE); $I:= I+10; "UNTIL I=180; " "MOVETO(0,170);WSTRING('200'); "MOVETO(0,140);WSTRING('170'); "MOVETO(0,110);WSTRING('140'); "MOVETO(0,80);WSTR,'-',STOP.MONTH,'-',STOP.YEAR); "MOVETO(10,0);WSTRING(D1); "MOVETO(150,0);WSTRING(D2);} " "PENCOLOR(NONE); "MOVETO(RIGHTBOUNDRY,GRAPHBASE); "PENCOLOR(WHITE1); "MOVETO(LEFTBOUNDRY,GRAPHBASE); "MOVETO(LEFTBOUNDRY,GRAPHMAX); "PENCOLOR(NONE); " PACING:= HRANGE DIV NUMBEROFPOINTS; "START:= (SPACING DIV 2)+LEFTBOUNDRY; "A:= 30; " "MOVETO(0,182);WSTRING('BLOOD PRESSURE - '); "MOVETO(140,182);WSTRING(IDBUFF.NAME); "{D1:= CONCAT(START.DAY,'-',START.MONTH,'-',START.YEAR); "D2:= CONCAT(STOP.DAYPTNAME,D1,D2: STRING;   BEGIN  INITTURTLE; "NUMBEROFPOINTS:= RECORDCOUNT; "GRAPHBASE:= 20; "GRAPHMAX:= 170; "LEFTBOUNDRY:= 30; "RIGHTBOUNDRY:= 270; "HRANGE:= RIGHTBOUNDRY-LEFTBOUNDRY; "S&D[I]:=BPFILE^.DIASTOLIC; $END;  END;  {*******************************************}   PROCEDURE MAKEGRAPH;   VAR NUMBEROFPOINTS,GRAPHBASE,GRAPHMAX, %VRANGE,HRANGE,LEFTBOUNDRY,RIGHTBOUNDRY, %SPACING,OLDPOINT,NEWPOINT, %START,A: INTEGER;  %ESET(IDFILE,'#4:IDRECORD'); "IDBUFF:= IDFILE^; "CLOSE(IDFILE,LOCK);  END;  {*********************************}   PROCEDURE SETARRAYS;  BEGIN "FOR I:= 1 TO RECORDCOUNT DO $BEGIN &SEEK(BPFILE,I); &GET(BPFILE); &S[I]:=BPFILE^.SYSTOLIC; ,'E',CHR(14),'nter a reading ', ,CHR(15),'M',CHR(14),'enu '); &REPEAT UNTIL KEYPRESS; &READ(KEYBOARD,KEY); &IF KEY='E' THEN PROMPTENTRY; &IF (KEY='M') OR (KEY=CHR(27)) THEN OK:= TRUE; $UNTIL OK; $CLOSE(BPFILE); #END; # "IF OPTION=2 THEN "BEGIN #CHECK_FOR_DATA; #IF RECORDCOUNT>0 THEN %BEGIN 'RESET(BPFILE,'#4:BPRECORDS'); 'GETIDINFO; 'SETARRAYS; 'MAKEGRAPH; 'CLOSE(BPFILE); 'WAITFOR(RESPONSE); 'ERASE(2,23,0); 'TEXTMODE; %END; "END; " "IF OPTION=3 THEN "BEGIN #CHD;  {*****************************************}  BEGIN !PROTECT; ! !CHECKRECORDSTATUS; { GET RECORDCOUNT AND LASTDATE }  !REPEAT "SELECT_OPTION; ! "CASE OPTION OF " 1:BEGIN &RESET(WEIGHTFILE,'#4:WTRECORDS'); &IF RECORDCOUNT=0 THEN GET_GOAL; ',S1); (STR(DATEID.YEAR,S2); (S3:= CONCAT(DATEID.MONTH,' ',S1,', 19',S2); (WRITELN(I:2,' ',S3,WEIGHT:10,' lbs.'); 'END; $END; #GOTOXY(0,23); #WRITE('Press ',CHR(15),'SPACE BAR',CHR(14),' to move on.'); #GOTOXY(40,0); #REPEAT UNTIL KEYPRESS;  EN"WRITELN('PATIENT NAME: ',IDBUFF.NAME); "WRITELN; "WRITELN; "FOR I:= 1 TO RECORDCOUNT DO $BEGIN &SEEK(WEIGHTFILE,I); &GET(WEIGHTFILE); &WEIGHTBUFF:=WEIGHTFILE^; &WITH WEIGHTBUFF DO & BEGIN (STR(DATEID.DAY,S1); (IF LENGTH(S1)<2 THEN S1:=CONCAT('&NEWPOINT:= OLDPOINT+SPACING; &MOVETO(NEWPOINT,W[I]); &OLDPOINT:= NEWPOINT; $END; "PENCOLOR(NONE);  END;  {****************************************}   PROCEDURE MAKETABLE; !VAR S1,S2,S3:STRING;  BEGIN "ERASE(1,23,2); TO(NEWPOINT,GRAPHBASE-1); &PENCOLOR(WHITE1); &MOVETO(NEWPOINT,GRAPHBASE-4); &PENCOLOR(NONE); &OLDPOINT:= NEWPOINT; $END; " "MOVETO(START,W[1]); "PENCOLOR(ORANGE); "MOVETO(START+1,W[1]); "OLDPOINT:= START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN COLOR(WHITE1); $MOVETO(LEFT,PLOT); $PENCOLOR(NONE); #END; " "MOVETO(START,GRAPHBASE-1); "PENCOLOR(WHITE1); "MOVETO(START,GRAPHBASE-4); "PENCOLOR(NONE); "OLDPOINT:=START; "FOR I:= 2 TO NUMBEROFPOINTS DO $BEGIN &NEWPOINT:=OLDPOINT+SPACING; &MOVE$MOVETO(LEFT,PLOT); $PENCOLOR(NONE); #END; " "PLOT:= PLOTSTART; "SWT:= PWT; "WHILE (PLOT<155) AND (PLOT>30) DO #BEGIN $PLOT:= PLOT-INK; $SWT:= SWT-WTINK; $STR(SWT,PLOTSTRING); $MOVETO(0,PLOT); $WSTRING(PLOTSTRING); $MOVETO(LEFT-4,PLOT); $PENONE); " "INK:= 16; "PLOT:= PLOTSTART; "SWT:= PWT; "WHILE (PLOT>30) AND (PLOT<155) DO #BEGIN $PLOT:= PLOT+INK; $SWT:= SWT+WTINK; $STR(SWT,PLOTSTRING); $MOVETO(0,PLOT); $WSTRING(PLOTSTRING); $MOVETO(LEFT-4,PLOT); $PENCOLOR(WHITE1); "MOVETO(RIGHT,145); "PENCOLOR(NONE); "MOVETO(LEFT+2,W[0]); "PENCOLOR(GREEN); "MOVETO(RIGHT,W[0]); "PENCOLOR(NONE); " "MOVETO(0,PLOTSTART); "WSTRING(PLOTSTRING); "MOVETO(LEFT-4,PLOTSTART); "PENCOLOR(WHITE1); "MOVETO(LEFT,PLOTSTART); "PENCOLOR(N!SETCHAIN('#4:MMENU.CODE');  END. ECK_FOR_DATA; #IF RECORDCOUNT>0 THEN $BEGIN %RESET(BPFILE,'#4:BPRECORDS'); %GETIDINFO; %SETARRAYS; %MAKETABLE; %CLOSE(BPFILE); $END; "END; " "UNITCLEAR(1); !UNTIL OPTION=4; ! !ERASE(0,23,23); !WRITE('ONE MOMENT PLEASE... '); &ERASE(2,23,2); &SHOW_WEIGHTBUFF; &PROMPTENTRY; &CLOSE(WEIGHTFILE); %END; #2:BEGIN &CHECK_FOR_DATA; &IF RECORDCOUNT>0 THEN (BEGIN *RESET(WEIGHTFILE,'#4:WTRECORDS'); *GETIDINFO; *SETARRAYS; *MAKEGRAPH; *WAITFOR(RESPONSE); *ERASE(1,23,23); *TEXTMODE; *CLOSE(WEIGHTFILE); (END; &END; #3:BEGIN &CHECK_FOR_DATA; &IF RECORDCOUNT>0 THEN (BEGIN *RESET(WEIGHTFILE,'#4:WTRECORDS'); *GETIDINFO; *SETARRAYS; *MAKETABLE; *CLOSE(WEIGHTFILE); (END; &END; $4:BEGIN 'RESET(WEIGHTFILE,'#4:WTRECORDS'); 'CHANGE; 'CLOSE(WEIGHTFILE); &END; $END; !UNTIL OPTION=5; ! !ERASE(0,23,23); !WRITE('ONE MOMENT PLEASE... '); !SETCHAIN('#4:MMENU.CODE');  END. %