FHASS1.m

FHASS1 ; GLRISC/REL - Nutritional Assessment Cont. ; 30-Jan-88  12:32 pm ; [ 06/07/90  12:32 PM ]

 ;;3.16;NUTRITION & DIETETICS;;*;;1NOV90

 S RTE=0,ACT="" D BEE,STR:TYP="Y",ACT:TYP'="Y",RAT:OPT'="M",PRO

 K IOP S %IS="MQ",%IS("A")="Select Report Device: ",%IS("B")="HOME" W ! D ^%ZIS K %IS,IOP G:POP KIL^FHASS

 I $D(IO("Q")) S FHPGM="^FHASS3",FHLST="NAM^SEX^AGE^WGT^IBW^FRM^HGT^UWGT^BEE^AMP^TYP^ACT^KCAL^RTE^OPT^PRO^NIT^EXT^X(^Y(" D EN2^FH G F1^FHASS

 U IO D ^FHASS3 U IO(0) X ^%ZIS("C") S IOP="" D ^%ZIS K %IS,IOP G F1^FHASS

RAT S RTE=0 W !!,"Select rate of ",$S(OPT="G":"gain",1:"loss")," in lbs./week (0-2.5): " R RTE:DTIME Q:"^"[RTE  I RTE'?.N.1".".N!(RTE<0)!(RTE>2.5) W *7," ??" G RAT

 S KCAL=$S(OPT="L":-RTE,1:RTE)*500+KCAL Q

ACT R !!,"Activity Level (Sedentary, Moderate, High): ",ACT:DTIME S:ACT="" ACT="M" I $P("SEDENTARY",ACT,1)'="",$P("MODERATE",ACT,1)'="",$P("HIGH",ACT,1)'="" W *7,"  Enter S, M or H" G ACT

 S ACT=$E(ACT,1),KCAL=$S(ACT="S":3,ACT="H":10,1:5)*WGT+BEE Q

PRO R !!,"Select Protein Level (0.5-3.5 g/kg): 0.8// ",PRO:DTIME S:PRO="" PRO=0.8

 I PRO'?.N.1".".N!(PRO<.5)!(PRO>3.5) W *7," Select value between .5 and 3.5" G PRO

 S PRO=$S(OPT="M":WGT,1:IBW)/2.2*PRO,NIT=PRO/6.25 Q

STR W !!,"Activity Factor (AF)",!?3,"1  Confined to Bed (1.2)",!?3,"2  Out of Bed (1.3)"

 R !!?3,"Level: ",AF:DTIME I AF'=1,AF'=2 W *7," Select 1 or 2" G STR

S1 W !!,"Stress/Injury Factor (IF)",!?3,"1.20 Minor Operation",!?3,"1.35 Skeletal Trauma"

 W !?3,"1.60 Major Sepsis",!?3,"2.10 Severe Burn"

 R !!?3,"Level (1.00-2.10): ",IF:DTIME S:'$T IF=1 I IF'?.N.1".".N!(IF<1)!(IF>2.1) W *7,"  select value between 1.00 and 2.10" G S1

S2 R !!,"Oral Temperature (deg F): ",FF:DTIME S:FF="" FF=98.6 I FF'?.N.1".".N!(FF<94)!(FF>107) W *7," Enter values in degrees F." G S2

 S KCAL=BEE*$S(AF=1:1.2,1:1.3)*IF

 S:FF>98.6 KCAL=KCAL+(FF-98.6*.07*BEE) Q

BEE I SEX="M" S BEE=66.47+(6.25*WGT)+(12.70*HGT)-(6.76*AGE)

 I SEX="F" S BEE=655.10+(4.35*WGT)+(4.70*HGT)-(4.68*AGE)

 S BEE=$J(BEE,0,0) Q

FHASS1    ; GLRISC/REL - Nutritional Assessment Cont. ; 30-Jan-88  12:32 pm ; [ 06/07/90  12:32 PM ]

 +1       ;;3.16;NUTRITION & DIETETICS;;*;;1NOV90

 +2        SET RTE=0

           SET ACT=""

           DO BEE

           IF TYP="Y"

               DO STR

           IF TYP'="Y"

               DO ACT

           IF OPT'="M"

               DO RAT

           DO PRO

 +3        KILL IOP

           SET %IS="MQ"

           SET %IS("A")="Select Report Device: "

           SET %IS("B")="HOME"

           WRITE !

           DO ^%ZIS

           KILL %IS,IOP

           IF POP

               GOTO KIL^FHASS

 +4        IF $DATA(IO("Q"))

               SET FHPGM="^FHASS3"

               SET FHLST="NAM^SEX^AGE^WGT^IBW^FRM^HGT^UWGT^BEE^AMP^TYP^ACT^KCAL^RTE^OPT^PRO^NIT^EXT^X(^Y("

               DO EN2^FH

               GOTO F1^FHASS

 +5        USE IO

           DO ^FHASS3

           USE IO(0)

           XECUTE ^%ZIS("C")

           SET IOP=""

           DO ^%ZIS

           KILL %IS,IOP

           GOTO F1^FHASS

RAT        SET RTE=0

           WRITE !!,"Select rate of ",$SELECT(OPT="G":"gain",1:"loss")," in lbs./week (0-2.5): "

           READ RTE:DTIME

           IF "^"[RTE

               QUIT 

           IF RTE'?.N.1".".N!(RTE<0)!(RTE>2.5)

               WRITE *7," ??"

               GOTO RAT

 +1        SET KCAL=$SELECT(OPT="L":-RTE,1:RTE)*500+KCAL

           QUIT 

ACT        READ !!,"Activity Level (Sedentary, Moderate, High): ",ACT:DTIME

           IF ACT=""

               SET ACT="M"

           IF $PIECE("SEDENTARY",ACT,1)'=""

               IF $PIECE("MODERATE",ACT,1)'=""

                   IF $PIECE("HIGH",ACT,1)'=""

                       WRITE *7,"  Enter S, M or H"

                       GOTO ACT

 +1        SET ACT=$EXTRACT(ACT,1)

           SET KCAL=$SELECT(ACT="S":3,ACT="H":10,1:5)*WGT+BEE

           QUIT 

PRO        READ !!,"Select Protein Level (0.5-3.5 g/kg): 0.8// ",PRO:DTIME

           IF PRO=""

               SET PRO=0.8

 +1        IF PRO'?.N.1".".N!(PRO<.5)!(PRO>3.5)

               WRITE *7," Select value between .5 and 3.5"

               GOTO PRO

 +2        SET PRO=$SELECT(OPT="M":WGT,1:IBW)/2.2*PRO

           SET NIT=PRO/6.25

           QUIT 

STR        WRITE !!,"Activity Factor (AF)",!?3,"1  Confined to Bed (1.2)",!?3,"2  Out of Bed (1.3)"

 +1        READ !!?3,"Level: ",AF:DTIME

           IF AF'=1

               IF AF'=2

                   WRITE *7," Select 1 or 2"

                   GOTO STR

S1         WRITE !!,"Stress/Injury Factor (IF)",!?3,"1.20 Minor Operation",!?3,"1.35 Skeletal Trauma"

 +1        WRITE !?3,"1.60 Major Sepsis",!?3,"2.10 Severe Burn"

 +2        READ !!?3,"Level (1.00-2.10): ",IF:DTIME

           IF '$TEST

               SET IF=1

           IF IF'?.N.1".".N!(IF<1)!(IF>2.1)

               WRITE *7,"  select value between 1.00 and 2.10"

               GOTO S1

S2         READ !!,"Oral Temperature (deg F): ",FF:DTIME

           IF FF=""

               SET FF=98.6

           IF FF'?.N.1".".N!(FF<94)!(FF>107)

               WRITE *7," Enter values in degrees F."

               GOTO S2

 +1        SET KCAL=BEE*$SELECT(AF=1:1.2,1:1.3)*IF

 +2        IF FF>98.6

               SET KCAL=KCAL+(FF-98.6*.07*BEE)

           QUIT 

BEE        IF SEX="M"

               SET BEE=66.47+(6.25*WGT)+(12.70*HGT)-(6.76*AGE)

 +1        IF SEX="F"

               SET BEE=655.10+(4.35*WGT)+(4.70*HGT)-(4.68*AGE)

 +2        SET BEE=$JUSTIFY(BEE,0,0)

           QUIT