| 1 | IBDFDE3 ;ALB/AAS - AICS Manual Data Entry, process handprint fields ; 24-FEB-96
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | % G ^IBDFDE
|
|---|
| 5 | ;
|
|---|
| 6 | HNDPR(RESULT,IBDF) ; -- Procedure
|
|---|
| 7 | ; -- Manual Data entry routine for Hand Print Fields
|
|---|
| 8 | ; Input : Result := call by reference, used to output results
|
|---|
| 9 | ; IBDF("IEN") := pointer to hand print file (359.94)
|
|---|
| 10 | ; IBDF("PI") := pointer to input package interface
|
|---|
| 11 | ; IBDF("DFN") := pointer to patient
|
|---|
| 12 | ; IBDF("CLINIC") := pointer to hospital location
|
|---|
| 13 | ;
|
|---|
| 14 | ; output: Result(n) $p1 := pointer to package interface
|
|---|
| 15 | ; $p2 := input value (validated user input)
|
|---|
| 16 | ; $p3 := null
|
|---|
| 17 | ; $p4 := null
|
|---|
| 18 | ; $p5 := null
|
|---|
| 19 | ; $p6 := measurement type for vitals
|
|---|
| 20 | ; $p7 := ien in handprint file
|
|---|
| 21 | ; $p8 := vital type (name from 359.1)
|
|---|
| 22 | ; $P9 := Units (for Vitals)
|
|---|
| 23 | ; ibdpi(package interface, qlfr or n) := result(n)
|
|---|
| 24 | ; $P13 := number of the selection
|
|---|
| 25 | ;
|
|---|
| 26 | N I,J,X,Y,ANS,DISPTXT,HDR,DIR,DIRUT,DUOUT,DTOUT,IBDX,QLFR,CHOICE,OVER,IBDPRE
|
|---|
| 27 | S (IBQUIT,OVER)=0,(ANS,QLFR)=""
|
|---|
| 28 | D OBJLST^IBDFRPC1(.CHOICE,.IBDF)
|
|---|
| 29 | I +CHOICE(0)<1 G HPQ
|
|---|
| 30 | S IBDASK=$P(CHOICE(1),"^")_" "
|
|---|
| 31 | I '$D(^TMP("IBD-ASK",$J,IBDFMIEN,IBDASK)) S ^TMP("IBD-ASK",$J,IBDFMIEN,$$UP^XLFSTR(IBDASK),IBDF("IBDF"))=""
|
|---|
| 32 | I $P($G(^IBE(357.6,+IBDF("PI"),0)),"^")["INPUT VITALS" S QLFR=$P(CHOICE(1),"^",5)
|
|---|
| 33 | ;
|
|---|
| 34 | OVER ;
|
|---|
| 35 | K X,Y,DIR,DIRUT,DUOUT,DTOUT
|
|---|
| 36 | S OVER=0
|
|---|
| 37 | S DIR("?")="Enter the value on the form, or enter Return if there is no value"
|
|---|
| 38 | S DIR(0)="FOA^2:"_$P(CHOICE(1),"^",3)
|
|---|
| 39 | I $G(QLFR)'="",$P($G(IBDPI(IBDF("PI"),QLFR)),"^",2)'="" S DIR("B")=$P($G(IBDPI(IBDF("PI"),QLFR)),"^",2)
|
|---|
| 40 | S DIR("A")=$P(CHOICE(1),"^")_" "
|
|---|
| 41 | I $D(IBDF("ASKDATE")) S Y=$$ASKDT^IBDFDE0(DIR("A"),$S($D(DIR("B")):DIR("B"),1:$G(IBDF("DEFLT"))),"",IBDF("APPT")) G REV
|
|---|
| 42 | D ^DIR
|
|---|
| 43 | REV I $G(IBDREDIT),$G(DIR("B"))'="" S IBDPRE=DIR("B") G:Y=$G(DIR("B")) HPQ
|
|---|
| 44 | S ANS=$$UP^XLFSTR(Y)
|
|---|
| 45 | K DIR
|
|---|
| 46 | I $G(IBDREDIT),$G(IBDPRE)'="",ANS="" D DELETE W " Deleted!" G HPQ
|
|---|
| 47 | I ANS="" G HPQ
|
|---|
| 48 | I ANS["^",ANS'="^" D G HPOVER
|
|---|
| 49 | .S GOTO=$$UP^XLFSTR($P(ANS,"^",2))
|
|---|
| 50 | .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
|
|---|
| 51 | .S X=$O(^TMP("IBD-ASK",$J,IBDFMIEN,GOTO))
|
|---|
| 52 | .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
|
|---|
| 53 | .S IBQUIT=1
|
|---|
| 54 | I $D(DIRUT) S IBQUIT=1 G HPQ
|
|---|
| 55 | ;
|
|---|
| 56 | VITALS ; -- if vitals, validate input
|
|---|
| 57 | S OVER=0
|
|---|
| 58 | I $G(QLFR)'="" D I OVER G HPOVER
|
|---|
| 59 | .I $L($T(RATECHK^GMRVPCE0)) D Q
|
|---|
| 60 | ..S OVER='$$RATECHK^GMRVPCE0(QLFR,ANS,$P(CHOICE(1),"^",6))
|
|---|
| 61 | ..Q:'OVER
|
|---|
| 62 | ..D HELP^GMRVPCE0(QLFR,"HELP")
|
|---|
| 63 | ..W ! S IBDX="" F S IBDX=$O(HELP(IBDX)) Q:IBDX="" W !,HELP(IBDX)
|
|---|
| 64 | ..W ! K ANS,HELP
|
|---|
| 65 | .I $L($T(@(QLFR))) D @QLFR Q
|
|---|
| 66 | ;
|
|---|
| 67 | ; -- delete old answer
|
|---|
| 68 | I $G(IBDREDIT),$G(IBDPRE)'="",$G(IBDPRE)'=ANS D DELETE
|
|---|
| 69 | ;
|
|---|
| 70 | I ANS'="" D
|
|---|
| 71 | .S RESULT(0)=$G(RESULT(0))+1
|
|---|
| 72 | .S RESULT(RESULT(0))=+IBDF("PI")_"^"_ANS_"^^^^"_QLFR_"^"_$G(IBDF("IEN"))_"^"_$G(IBDF("VITAL"))_"^"_$P(CHOICE(1),"^",4)
|
|---|
| 73 | .S IBDPI(IBDF("PI"),$S($G(QLFR)'="":QLFR,1:RESULT(0)))=IBDSEL(RESULT(0))
|
|---|
| 74 | .S $P(IBDPI(IBDF("PI"),$S($G(QLFR)'="":QLFR,1:RESULT(0))),"^",13)=RESULT(0)
|
|---|
| 75 | ;
|
|---|
| 76 | HPOVER G:OVER OVER
|
|---|
| 77 | HPQ Q
|
|---|
| 78 | ;
|
|---|
| 79 | DELETE ; -- delete old answer if changed
|
|---|
| 80 | Q:'$G(IBDREDIT)!(ANS=$G(IBDPRE))
|
|---|
| 81 | S SEL=+$P($G(IBDPI(IBDF("PI"),QLFR)),"^",13) Q:'SEL
|
|---|
| 82 | K IBDPI(IBDF("PI"),QLFR),RESULT(SEL)
|
|---|
| 83 | I $G(RESULT(0))=1 S RESULT(0)=0
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | BP ; -- validate blood pressure
|
|---|
| 87 | N D,S
|
|---|
| 88 | I ANS'?2.3N1"/"2.3N S OVER=1 K ANS G BPQ
|
|---|
| 89 | S S=$P(ANS,"/"),D=$P(ANS,"/",2)
|
|---|
| 90 | I D<20!(D>200)!(S<20)!(S>275) K ANS S OVER=1
|
|---|
| 91 | I S'>D K ANS S OVER=1
|
|---|
| 92 | 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.",!
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | WT ; -- validate body weight
|
|---|
| 96 | I ANS'?1.3N.1".".1N!(ANS<2)!(ANS>750)!(+ANS'=ANS) K ANS S OVER=1
|
|---|
| 97 | WTQ I OVER W !,"Enter a body weight, 1 decimal place allowed, between 2 and 750 lbs.",!
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | HT ; --validate body height
|
|---|
| 101 | I ANS'?2N.1".".1N!(ANS<10)!(ANS>80) K ANS S OVER=1
|
|---|
| 102 | I OVER W !,"Enter the body height in inches, 1 decimal place allowed, between 10 and 80.",!
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | AG ; -- validate adominal girth
|
|---|
| 106 | I +ANS'=ANS!(ANS?.E1"."1N.N)!(ANS<10)!(ANS>750) K ANS S OVER=1
|
|---|
| 107 | I OVER W !,"Enter the abdominal girth in inches, no decimal places, between 10 and 750.",!
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | AUD ; -- validate audiometry
|
|---|
| 111 | N %AUI,%AUX
|
|---|
| 112 | I $L(ANS,"/")'=17 K ANS S OVER=1
|
|---|
| 113 | F %AUI=1:1:16 S %AUX=$P(X,"/",%AUI) I %AUX'="" I %AUX'?1.3N!(+%AUX>110) K ANS S OVER=1
|
|---|
| 114 | 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/",!
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | TMP ; -- validate temperature
|
|---|
| 118 | I ANS'?2.3N.1".".1N!(ANS<94)!(ANS>109.9)!(+ANS'=ANS) K ANS S OVER=1
|
|---|
| 119 | I OVER W !,"Enter the body temperature in degrees fahrenheit, must be between 94 and 109.9.",!
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | FT ; -- validate fetal heart tones
|
|---|
| 123 | I ANS'=+ANS!(ANS<50)!(ANS>250)!(ANS?.E1"."1N.N) K ANS S OVER=1
|
|---|
| 124 | I OVER W !,"Enter Fetal Heart Tone. Must be in the range 50 -250.",!
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | FH ; -- validate fundal height
|
|---|
| 128 | I ANS'=+ANS!(ANS<10)!(ANS>250)!(ANS?.E1"."1N.N) K ANS S OVER=1
|
|---|
| 129 | I OVER W !,"Enter a fundal Height. Must be in the range 10 - 50",!
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | HC ; -- validate head circumference
|
|---|
| 133 | I ANS'=+ANS!(ANS<10)!(ANS>30)!(ANS?.E1"."3N.N) K ANS S OVER=1
|
|---|
| 134 | 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)",!
|
|---|
| 135 | Q
|
|---|
| 136 | ;
|
|---|
| 137 | HE ; -- validate hearing
|
|---|
| 138 | S ANS=$$UP^XLFSTR($E(ANS))
|
|---|
| 139 | I "AN"'[ANS K ANS S OVER=1
|
|---|
| 140 | I OVER W !,"Enter 'A' for abnormal, or 'N' for Normal.",!
|
|---|
| 141 | Q
|
|---|
| 142 | ;
|
|---|
| 143 | PU ; -- validate pulse
|
|---|
| 144 | I ANS'?1.3N!(ANS<30)!(ANS>250) K ANS S OVER=1
|
|---|
| 145 | I OVER W !,"Enter the patients 1 minute pulse, enter a number between 30 and 250.",!
|
|---|
| 146 | Q
|
|---|
| 147 | ;
|
|---|
| 148 | RS ; -- validate respirations
|
|---|
| 149 | I ANS'?1.2N!(ANS<8)!(ANS>90) K ANS S OVER=1
|
|---|
| 150 | I OVER W !,"Enter the patients 1 minute number of resperations, enter a number between 8 and 90.",!
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | TON ; -- validate tonometry
|
|---|
| 154 | N AUTONR,AUTONL
|
|---|
| 155 | 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
|
|---|
| 156 | S AUTONR=$P(ANS,"/",1) S:AUTONR?1"R".N AUTONR=$E(AUTONR,2,10)
|
|---|
| 157 | S AUTONL=$P(ANS,"/",2) S:AUTONL?1"L".N AUTONL=$E(AUTONL,2,10)
|
|---|
| 158 | I AUTONR'="" I AUTONR<0!(AUTONR>80) K ANS S OVER=1
|
|---|
| 159 | I AUTONL'="" I AUTONL<0!(AUTONL>80) K ANS S OVER=1
|
|---|
| 160 | 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"
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | VC ; -- validate vision corrected
|
|---|
| 164 | ; same input as uncorrected
|
|---|
| 165 | VU ; -- validate vision uncorrected
|
|---|
| 166 | I $L(ANS)>7!($L(ANS)<2)!'((ANS?2.3N)!(ANS?1"/"2.3N)!(ANS?2.3N1"/"2.3N)) K ANS S OVER=1
|
|---|
| 167 | I $P(ANS,"/",1)'="" I $P(ANS,"/",1)<10!($P(ANS,"/",1)>999) K ANS S OVER=1
|
|---|
| 168 | I $P(ANS,"/",2)'="" I $P(ANS,"/",2)<10!($P(ANS,"/",2)>999) K ANS S OVER=1
|
|---|
| 169 | 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."
|
|---|
| 170 | Q
|
|---|
