IBDFDE3 ;ALB/AAS - AICS Manual Data Entry, process handprint fields ; 24-FEB-96
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
% G ^IBDFDE
;
HNDPR(RESULT,IBDF) ; -- Procedure
; -- Manual Data entry routine for Hand Print Fields
; Input : Result := call by reference, used to output results
; IBDF("IEN") := pointer to hand print file (359.94)
; IBDF("PI") := pointer to input package interface
; IBDF("DFN") := pointer to patient
; IBDF("CLINIC") := pointer to hospital location
;
; output: Result(n) $p1 := pointer to package interface
; $p2 := input value (validated user input)
; $p3 := null
; $p4 := null
; $p5 := null
; $p6 := measurement type for vitals
; $p7 := ien in handprint file
; $p8 := vital type (name from 359.1)
; $P9 := Units (for Vitals)
; ibdpi(package interface, qlfr or n) := result(n)
; $P13 := number of the selection
;
N I,J,X,Y,ANS,DISPTXT,HDR,DIR,DIRUT,DUOUT,DTOUT,IBDX,QLFR,CHOICE,OVER,IBDPRE
S (IBQUIT,OVER)=0,(ANS,QLFR)=""
D OBJLST^IBDFRPC1(.CHOICE,.IBDF)
I +CHOICE(0)<1 G HPQ
S IBDASK=$P(CHOICE(1),"^")_" "
I '$D(^TMP("IBD-ASK",$J,IBDFMIEN,IBDASK)) S ^TMP("IBD-ASK",$J,IBDFMIEN,$$UP^XLFSTR(IBDASK),IBDF("IBDF"))=""
I $P($G(^IBE(357.6,+IBDF("PI"),0)),"^")["INPUT VITALS" S QLFR=$P(CHOICE(1),"^",5)
;
OVER ;
K X,Y,DIR,DIRUT,DUOUT,DTOUT
S OVER=0
S DIR("?")="Enter the value on the form, or enter Return if there is no value"
S DIR(0)="FOA^2:"_$P(CHOICE(1),"^",3)
I $G(QLFR)'="",$P($G(IBDPI(IBDF("PI"),QLFR)),"^",2)'="" S DIR("B")=$P($G(IBDPI(IBDF("PI"),QLFR)),"^",2)
S DIR("A")=$P(CHOICE(1),"^")_" "
I $D(IBDF("ASKDATE")) S Y=$$ASKDT^IBDFDE0(DIR("A"),$S($D(DIR("B")):DIR("B"),1:$G(IBDF("DEFLT"))),"",IBDF("APPT")) G REV
D ^DIR
REV I $G(IBDREDIT),$G(DIR("B"))'="" S IBDPRE=DIR("B") G:Y=$G(DIR("B")) HPQ
S ANS=$$UP^XLFSTR(Y)
K DIR
I $G(IBDREDIT),$G(IBDPRE)'="",ANS="" D DELETE W " Deleted!" G HPQ
I ANS="" G HPQ
I ANS["^",ANS'="^" D G HPOVER
.S GOTO=$$UP^XLFSTR($P(ANS,"^",2))
.I "????"[GOTO X "W !!,""Valid Blocks to Jump to: "" S IBDX=0 F S IBDX=$O(^TMP(""IBD-ASK"",$J,IBDFMIEN,IBDX)) Q:IBDX="""" W !,?6,IBDX" S OVER=1 Q
.S X=$O(^TMP("IBD-ASK",$J,IBDFMIEN,GOTO))
.I X'="",X[GOTO W $E(X,$L(GOTO)+1,$L(X)) S IBDF("GOTO")=+$O(^TMP("IBD-ASK",$J,IBDFMIEN,X,""))-1,IBDREDIT=1 Q
.S IBQUIT=1
I $D(DIRUT) S IBQUIT=1 G HPQ
;
VITALS ; -- if vitals, validate input
S OVER=0
I $G(QLFR)'="" D I OVER G HPOVER
.I $L($T(RATECHK^GMRVPCE0)) D Q
..S OVER='$$RATECHK^GMRVPCE0(QLFR,ANS,$P(CHOICE(1),"^",6))
..Q:'OVER
..D HELP^GMRVPCE0(QLFR,"HELP")
..W ! S IBDX="" F S IBDX=$O(HELP(IBDX)) Q:IBDX="" W !,HELP(IBDX)
..W ! K ANS,HELP
.I $L($T(@(QLFR))) D @QLFR Q
;
; -- delete old answer
I $G(IBDREDIT),$G(IBDPRE)'="",$G(IBDPRE)'=ANS D DELETE
;
I ANS'="" D
.S RESULT(0)=$G(RESULT(0))+1
.S RESULT(RESULT(0))=+IBDF("PI")_"^"_ANS_"^^^^"_QLFR_"^"_$G(IBDF("IEN"))_"^"_$G(IBDF("VITAL"))_"^"_$P(CHOICE(1),"^",4)
.S IBDPI(IBDF("PI"),$S($G(QLFR)'="":QLFR,1:RESULT(0)))=IBDSEL(RESULT(0))
.S $P(IBDPI(IBDF("PI"),$S($G(QLFR)'="":QLFR,1:RESULT(0))),"^",13)=RESULT(0)
;
HPOVER G:OVER OVER
HPQ Q
;
DELETE ; -- delete old answer if changed
Q:'$G(IBDREDIT)!(ANS=$G(IBDPRE))
S SEL=+$P($G(IBDPI(IBDF("PI"),QLFR)),"^",13) Q:'SEL
K IBDPI(IBDF("PI"),QLFR),RESULT(SEL)
I $G(RESULT(0))=1 S RESULT(0)=0
Q
;
BP ; -- validate blood pressure
N D,S
I ANS'?2.3N1"/"2.3N S OVER=1 K ANS G BPQ
S S=$P(ANS,"/"),D=$P(ANS,"/",2)
I D<20!(D>200)!(S<20)!(S>275) K ANS S OVER=1
I S'>D K ANS S OVER=1
BPQ I OVER W !,"Invalid format. Enter as SYSTOLIC/DIASTOLIC (120/80). SYSTOLIC must be",!,"between 20 and 275. DIASTOLIC must be between 20 and 200. SYSTOLIC must be",!,"greater than DIASTOLIC.",!
Q
;
WT ; -- validate body weight
I ANS'?1.3N.1".".1N!(ANS<2)!(ANS>750)!(+ANS'=ANS) K ANS S OVER=1
WTQ I OVER W !,"Enter a body weight, 1 decimal place allowed, between 2 and 750 lbs.",!
Q
;
HT ; --validate body height
I ANS'?2N.1".".1N!(ANS<10)!(ANS>80) K ANS S OVER=1
I OVER W !,"Enter the body height in inches, 1 decimal place allowed, between 10 and 80.",!
Q
;
AG ; -- validate adominal girth
I +ANS'=ANS!(ANS?.E1"."1N.N)!(ANS<10)!(ANS>750) K ANS S OVER=1
I OVER W !,"Enter the abdominal girth in inches, no decimal places, between 10 and 750.",!
Q
;
AUD ; -- validate audiometry
N %AUI,%AUX
I $L(ANS,"/")'=17 K ANS S OVER=1
F %AUI=1:1:16 S %AUX=$P(X,"/",%AUI) I %AUX'="" I %AUX'?1.3N!(+%AUX>110) K ANS S OVER=1
I OVER W !,"Enter 8 readings for right ear followed by 8 readings for left ear,",!,"all followed by slashes (/). Values must be between 0 and 110.",!,"EXAMPLE: 100/100/100/95/90/90/85/80/105/105/105/105/100/100/95/90/",!
Q
;
TMP ; -- validate temperature
I ANS'?2.3N.1".".1N!(ANS<94)!(ANS>109.9)!(+ANS'=ANS) K ANS S OVER=1
I OVER W !,"Enter the body temperature in degrees fahrenheit, must be between 94 and 109.9.",!
Q
;
FT ; -- validate fetal heart tones
I ANS'=+ANS!(ANS<50)!(ANS>250)!(ANS?.E1"."1N.N) K ANS S OVER=1
I OVER W !,"Enter Fetal Heart Tone. Must be in the range 50 -250.",!
Q
;
FH ; -- validate fundal height
I ANS'=+ANS!(ANS<10)!(ANS>250)!(ANS?.E1"."1N.N) K ANS S OVER=1
I OVER W !,"Enter a fundal Height. Must be in the range 10 - 50",!
Q
;
HC ; -- validate head circumference
I ANS'=+ANS!(ANS<10)!(ANS>30)!(ANS?.E1"."3N.N) K ANS S OVER=1
I OVER W !,"To enter head circumference in inches, enter the inches",!,"and decimal. Must be 10 - 30 inches and the fractional decimal part must",!,"be a multiple of 1/8 (.125)",!
Q
;
HE ; -- validate hearing
S ANS=$$UP^XLFSTR($E(ANS))
I "AN"'[ANS K ANS S OVER=1
I OVER W !,"Enter 'A' for abnormal, or 'N' for Normal.",!
Q
;
PU ; -- validate pulse
I ANS'?1.3N!(ANS<30)!(ANS>250) K ANS S OVER=1
I OVER W !,"Enter the patients 1 minute pulse, enter a number between 30 and 250.",!
Q
;
RS ; -- validate respirations
I ANS'?1.2N!(ANS<8)!(ANS>90) K ANS S OVER=1
I OVER W !,"Enter the patients 1 minute number of resperations, enter a number between 8 and 90.",!
Q
;
TON ; -- validate tonometry
N AUTONR,AUTONL
I $L(ANS)>7!($L(ANS)<2)!'((ANS?.1"R"1.2N1"/")!(ANS?1"/".1"L"1.2N)!(ANS?.1"R"1.2N1"/".1"L"1.2N)) K ANS S OVER=1
S AUTONR=$P(ANS,"/",1) S:AUTONR?1"R".N AUTONR=$E(AUTONR,2,10)
S AUTONL=$P(ANS,"/",2) S:AUTONL?1"L".N AUTONL=$E(AUTONL,2,10)
I AUTONR'="" I AUTONR<0!(AUTONR>80) K ANS S OVER=1
I AUTONL'="" I AUTONL<0!(AUTONL>80) K ANS S OVER=1
TONX I OVER W !,"Enter a reading for the RIGHT eye, followed by a SLASH, followed",!,"by the reading for the LEFT eye. The SLASH is required. Readings can be",!,"between 0 and 80. Examples: 18/18, /20, 18/, 10/13"
Q
;
VC ; -- validate vision corrected
; same input as uncorrected
VU ; -- validate vision uncorrected
I $L(ANS)>7!($L(ANS)<2)!'((ANS?2.3N)!(ANS?1"/"2.3N)!(ANS?2.3N1"/"2.3N)) K ANS S OVER=1
I $P(ANS,"/",1)'="" I $P(ANS,"/",1)<10!($P(ANS,"/",1)>999) K ANS S OVER=1
I $P(ANS,"/",2)'="" I $P(ANS,"/",2)<10!($P(ANS,"/",2)>999) K ANS S OVER=1
I OVER W !,"Enter denominators only. The 20/ is assumed. Enter right eye",!,"/ left eye in form n/n (20/20). If right eye only enter n (20).",!,"If left eye only enter /n (/20). Must be between 10 and 999."
Q
IBDFDE3 ;ALB/AAS - AICS Manual Data Entry, process handprint fields ; 24-FEB-96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
% GOTO ^IBDFDE
+1 ;
HNDPR(RESULT,IBDF) ; -- Procedure
+1 ; -- Manual Data entry routine for Hand Print Fields
+2 ; Input : Result := call by reference, used to output results
+3 ; IBDF("IEN") := pointer to hand print file (359.94)
+4 ; IBDF("PI") := pointer to input package interface
+5 ; IBDF("DFN") := pointer to patient
+6 ; IBDF("CLINIC") := pointer to hospital location
+7 ;
+8 ; output: Result(n) $p1 := pointer to package interface
+9 ; $p2 := input value (validated user input)
+10 ; $p3 := null
+11 ; $p4 := null
+12 ; $p5 := null
+13 ; $p6 := measurement type for vitals
+14 ; $p7 := ien in handprint file
+15 ; $p8 := vital type (name from 359.1)
+16 ; $P9 := Units (for Vitals)
+17 ; ibdpi(package interface, qlfr or n) := result(n)
+18 ; $P13 := number of the selection
+19 ;
+20 NEW I,J,X,Y,ANS,DISPTXT,HDR,DIR,DIRUT,DUOUT,DTOUT,IBDX,QLFR,CHOICE,OVER,IBDPRE
+21 SET (IBQUIT,OVER)=0
SET (ANS,QLFR)=""
+22 DO OBJLST^IBDFRPC1(.CHOICE,.IBDF)
+23 IF +CHOICE(0)<1
GOTO HPQ
+24 SET IBDASK=$PIECE(CHOICE(1),"^")_" "
+25 IF '$DATA(^TMP("IBD-ASK",$JOB,IBDFMIEN,IBDASK))
SET ^TMP("IBD-ASK",$JOB,IBDFMIEN,$$UP^XLFSTR(IBDASK),IBDF("IBDF"))=""
+26 IF $PIECE($GET(^IBE(357.6,+IBDF("PI"),0)),"^")["INPUT VITALS"
SET QLFR=$PIECE(CHOICE(1),"^",5)
+27 ;
OVER ;
+1 KILL X,Y,DIR,DIRUT,DUOUT,DTOUT
+2 SET OVER=0
+3 SET DIR("?")="Enter the value on the form, or enter Return if there is no value"
+4 SET DIR(0)="FOA^2:"_$PIECE(CHOICE(1),"^",3)
+5 IF $GET(QLFR)'=""
IF $PIECE($GET(IBDPI(IBDF("PI"),QLFR)),"^",2)'=""
SET DIR("B")=$PIECE($GET(IBDPI(IBDF("PI"),QLFR)),"^",2)
+6 SET DIR("A")=$PIECE(CHOICE(1),"^")_" "
+7 IF $DATA(IBDF("ASKDATE"))
SET Y=$$ASKDT^IBDFDE0(DIR("A"),$SELECT($DATA(DIR("B")):DIR("B"),1:$GET(IBDF("DEFLT"))),"",IBDF("APPT"))
GOTO REV
+8 DO ^DIR
REV IF $GET(IBDREDIT)
IF $GET(DIR("B"))'=""
SET IBDPRE=DIR("B")
IF Y=$GET(DIR("B"))
GOTO HPQ
+1 SET ANS=$$UP^XLFSTR(Y)
+2 KILL DIR
+3 IF $GET(IBDREDIT)
IF $GET(IBDPRE)'=""
IF ANS=""
DO DELETE
WRITE " Deleted!"
GOTO HPQ
+4 IF ANS=""
GOTO HPQ
+5 IF ANS["^"
IF ANS'="^"
Begin DoDot:1
+6 SET GOTO=$$UP^XLFSTR($PIECE(ANS,"^",2))
+7 IF "????"[GOTO
XECUTE "W !!,""Valid Blocks to Jump to: "" S IBDX=0 F S IBDX=$O(^TMP(""IBD-ASK"",$J,IBDFMIEN,IBDX)) Q:IBDX="""" W !,?6,IBDX"
SET OVER=1
QUIT
+8 SET X=$ORDER(^TMP("IBD-ASK",$JOB,IBDFMIEN,GOTO))
+9 IF X'=""
IF X[GOTO
WRITE $EXTRACT(X,$LENGTH(GOTO)+1,$LENGTH(X))
SET IBDF("GOTO")=+$ORDER(^TMP("IBD-ASK",$JOB,IBDFMIEN,X,""))-1
SET IBDREDIT=1
QUIT
+10 SET IBQUIT=1
End DoDot:1
GOTO HPOVER
+11 IF $DATA(DIRUT)
SET IBQUIT=1
GOTO HPQ
+12 ;
VITALS ; -- if vitals, validate input
+1 SET OVER=0
+2 IF $GET(QLFR)'=""
Begin DoDot:1
+3 IF $LENGTH($TEXT(RATECHK^GMRVPCE0))
Begin DoDot:2
+4 SET OVER='$$RATECHK^GMRVPCE0(QLFR,ANS,$PIECE(CHOICE(1),"^",6))
+5 IF 'OVER
QUIT
+6 DO HELP^GMRVPCE0(QLFR,"HELP")
+7 WRITE !
SET IBDX=""
FOR
SET IBDX=$ORDER(HELP(IBDX))
IF IBDX=""
QUIT
WRITE !,HELP(IBDX)
+8 WRITE !
KILL ANS,HELP
End DoDot:2
QUIT
+9 IF $LENGTH($TEXT(@(QLFR)))
DO @QLFR
QUIT
End DoDot:1
IF OVER
GOTO HPOVER
+10 ;
+11 ; -- delete old answer
+12 IF $GET(IBDREDIT)
IF $GET(IBDPRE)'=""
IF $GET(IBDPRE)'=ANS
DO DELETE
+13 ;
+14 IF ANS'=""
Begin DoDot:1
+15 SET RESULT(0)=$GET(RESULT(0))+1
+16 SET RESULT(RESULT(0))=+IBDF("PI")_"^"_ANS_"^^^^"_QLFR_"^"_$GET(IBDF("IEN"))_"^"_$GET(IBDF("VITAL"))_"^"_$PIECE(CHOICE(1),"^",4)
+17 SET IBDPI(IBDF("PI"),$SELECT($GET(QLFR)'="":QLFR,1:RESULT(0)))=IBDSEL(RESULT(0))
+18 SET $PIECE(IBDPI(IBDF("PI"),$SELECT($GET(QLFR)'="":QLFR,1:RESULT(0))),"^",13)=RESULT(0)
End DoDot:1
+19 ;
HPOVER IF OVER
GOTO OVER
HPQ QUIT
+1 ;
DELETE ; -- delete old answer if changed
+1 IF '$GET(IBDREDIT)!(ANS=$GET(IBDPRE))
QUIT
+2 SET SEL=+$PIECE($GET(IBDPI(IBDF("PI"),QLFR)),"^",13)
IF 'SEL
QUIT
+3 KILL IBDPI(IBDF("PI"),QLFR),RESULT(SEL)
+4 IF $GET(RESULT(0))=1
SET RESULT(0)=0
+5 QUIT
+6 ;
BP ; -- validate blood pressure
+1 NEW D,S
+2 IF ANS'?2.3N1"/"2.3N
SET OVER=1
KILL ANS
GOTO BPQ
+3 SET S=$PIECE(ANS,"/")
SET D=$PIECE(ANS,"/",2)
+4 IF D<20!(D>200)!(S<20)!(S>275)
KILL ANS
SET OVER=1
+5 IF S'>D
KILL ANS
SET OVER=1
BPQ IF OVER
WRITE !,"Invalid format. Enter as SYSTOLIC/DIASTOLIC (120/80). SYSTOLIC must be",!,"between 20 and 275. DIASTOLIC must be between 20 and 200. SYSTOLIC must be",!,"greater than DIASTOLIC.",!
+1 QUIT
+2 ;
WT ; -- validate body weight
+1 IF ANS'?1.3N.1".".1N!(ANS<2)!(ANS>750)!(+ANS'=ANS)
KILL ANS
SET OVER=1
WTQ IF OVER
WRITE !,"Enter a body weight, 1 decimal place allowed, between 2 and 750 lbs.",!
+1 QUIT
+2 ;
HT ; --validate body height
+1 IF ANS'?2N.1".".1N!(ANS<10)!(ANS>80)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter the body height in inches, 1 decimal place allowed, between 10 and 80.",!
+3 QUIT
+4 ;
AG ; -- validate adominal girth
+1 IF +ANS'=ANS!(ANS?.E1"."1N.N)!(ANS<10)!(ANS>750)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter the abdominal girth in inches, no decimal places, between 10 and 750.",!
+3 QUIT
+4 ;
AUD ; -- validate audiometry
+1 NEW %AUI,%AUX
+2 IF $LENGTH(ANS,"/")'=17
KILL ANS
SET OVER=1
+3 FOR %AUI=1:1:16
SET %AUX=$PIECE(X,"/",%AUI)
IF %AUX'=""
IF %AUX'?1.3N!(+%AUX>110)
KILL ANS
SET OVER=1
+4 IF OVER
WRITE !,"Enter 8 readings for right ear followed by 8 readings for left ear,",!,"all followed by slashes (/). Values must be between 0 and 110.",!,"EXAMPLE: 100/100/100/95/90/90/85/80/105/105/105/105/100/100/95/90/",!
+5 QUIT
+6 ;
TMP ; -- validate temperature
+1 IF ANS'?2.3N.1".".1N!(ANS<94)!(ANS>109.9)!(+ANS'=ANS)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter the body temperature in degrees fahrenheit, must be between 94 and 109.9.",!
+3 QUIT
+4 ;
FT ; -- validate fetal heart tones
+1 IF ANS'=+ANS!(ANS<50)!(ANS>250)!(ANS?.E1"."1N.N)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter Fetal Heart Tone. Must be in the range 50 -250.",!
+3 QUIT
+4 ;
FH ; -- validate fundal height
+1 IF ANS'=+ANS!(ANS<10)!(ANS>250)!(ANS?.E1"."1N.N)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter a fundal Height. Must be in the range 10 - 50",!
+3 QUIT
+4 ;
HC ; -- validate head circumference
+1 IF ANS'=+ANS!(ANS<10)!(ANS>30)!(ANS?.E1"."3N.N)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"To enter head circumference in inches, enter the inches",!,"and decimal. Must be 10 - 30 inches and the fractional decimal part must",!,"be a multiple of 1/8 (.125)",!
+3 QUIT
+4 ;
HE ; -- validate hearing
+1 SET ANS=$$UP^XLFSTR($EXTRACT(ANS))
+2 IF "AN"'[ANS
KILL ANS
SET OVER=1
+3 IF OVER
WRITE !,"Enter 'A' for abnormal, or 'N' for Normal.",!
+4 QUIT
+5 ;
PU ; -- validate pulse
+1 IF ANS'?1.3N!(ANS<30)!(ANS>250)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter the patients 1 minute pulse, enter a number between 30 and 250.",!
+3 QUIT
+4 ;
RS ; -- validate respirations
+1 IF ANS'?1.2N!(ANS<8)!(ANS>90)
KILL ANS
SET OVER=1
+2 IF OVER
WRITE !,"Enter the patients 1 minute number of resperations, enter a number between 8 and 90.",!
+3 QUIT
+4 ;
TON ; -- validate tonometry
+1 NEW AUTONR,AUTONL
+2 IF $LENGTH(ANS)>7!($LENGTH(ANS)<2)!'((ANS?.1"R"1.2N1"/")!(ANS?1"/".1"L"1.2N)!(ANS?.1"R"1.2N1"/".1"L"1.2N))
KILL ANS
SET OVER=1
+3 SET AUTONR=$PIECE(ANS,"/",1)
IF AUTONR?1"R".N
SET AUTONR=$EXTRACT(AUTONR,2,10)
+4 SET AUTONL=$PIECE(ANS,"/",2)
IF AUTONL?1"L".N
SET AUTONL=$EXTRACT(AUTONL,2,10)
+5 IF AUTONR'=""
IF AUTONR<0!(AUTONR>80)
KILL ANS
SET OVER=1
+6 IF AUTONL'=""
IF AUTONL<0!(AUTONL>80)
KILL ANS
SET OVER=1
TONX IF OVER
WRITE !,"Enter a reading for the RIGHT eye, followed by a SLASH, followed",!,"by the reading for the LEFT eye. The SLASH is required. Readings can be",!,"between 0 and 80. Examples: 18/18, /20, 18/, 10/13"
+1 QUIT
+2 ;
VC ; -- validate vision corrected
+1 ; same input as uncorrected
VU ; -- validate vision uncorrected
+1 IF $LENGTH(ANS)>7!($LENGTH(ANS)<2)!'((ANS?2.3N)!(ANS?1"/"2.3N)!(ANS?2.3N1"/"2.3N))
KILL ANS
SET OVER=1
+2 IF $PIECE(ANS,"/",1)'=""
IF $PIECE(ANS,"/",1)<10!($PIECE(ANS,"/",1)>999)
KILL ANS
SET OVER=1
+3 IF $PIECE(ANS,"/",2)'=""
IF $PIECE(ANS,"/",2)<10!($PIECE(ANS,"/",2)>999)
KILL ANS
SET OVER=1
+4 IF OVER
WRITE !,"Enter denominators only. The 20/ is assumed. Enter right eye",!,"/ left eye in form n/n (20/20). If right eye only enter n (20).",!,"If left eye only enter /n (/20). Must be between 10 and 999."
+5 QUIT
