- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFDE3 7565 printed Feb 19, 2025@00:18:44 Page 2
- 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