FHASM6.m

FHASM6 ; HISC/REL - Protein/Fluid Requirements ;10/30/90  13:42

 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28

H2O W !!,"Calculate Fluid Requirements By:"

 W !!?5,"1)  Adult (35 ml/kg/day)",!?9,"Elderly Calculation  (30 ml/kg/day)",!?9,"Adolescent (40-60 ml/kg/day)",!?9,"Children (70-110 ml/kg/day)",!?9,"Infant (100-150 ml/kg/day)"

 W !?5,"2)  100 ml/kg first 10 kg +",!?9,"50 ml/kg second 10 kg +",!?9,"25 ml/kg remaining kg"

 W !?5,"3)  1 ml/Kcal",!?5,"4)  0.5 ml/Kcal  (Fluid Overload)"

 W !?5,"5)  1500 ml/sq meter"

 W !?5,"6)  Set Your Own Fluid Level",!?5,"7)  Omit Calculation"

H0 W !!,"Choose: " W:CFRB CFRB_"// " R H2O:DTIME S:H2O=U FHQUIT=1 G:'$T!(H2O["^") KIL^FHASM1

 I H2O="",CFRB S H2O=CFRB

 I "1234567"'[H2O!(H2O'?1N) W !,"Choose 1 - 7 Only" G H0

 S CFRB=H2O

 I "125"[H2O S CB="Fluid" D GETW^FHASM5 G:CB=0 KIL^FHASM1

 G H1:H2O=1,H2:H2O=2,H3:H2O=3,H4:H2O=4,H5:H2O=5,H6:H2O=6 S:'$D(FLD) FLD="" G PRO

H1 ;add elderly calculation here

 I AGE>64 S FLD=30 G H12

 I AGE>17 S FLD=35 G H12

 I AGE>10 S A1=40,A2=60 G H11

 I AGE'<1 S A1=70,A2=110 G H11

 S A1=100,A2=150

H11 W !!,"Select Level Between ",A1," and ",A2," ml/kg/day: " W:FLD'="" FLD_"// "

 R FLD:DTIME S:FLD=U FHQUIT=1 G:'$T!(FLD["^") KIL^FHASM1

 I FLD<A1!(FLD>A2) W *7,!,"Fluid Level is not within range." G H11

H12 S FLD=W2*FLD G H7

H2 S W1=W2,FLD=$S(W1<10:W1*100,W1<20:W1-10*50+1000,1:W1-20*25+1500) G H7

H3 S FLD=KCAL G H7

H4 S FLD=.5*KCAL G H7

H5 S X=W2,X1=.425 D PWR S FLD=Y,X=HGT*2.54,X1=.725 D PWR S FLD=FLD*Y*.007184*1500 G H7

H6 W !!,"Enter Fluid Requirements (ml/day): ",FLD,"// " R FLD:DTIME S:FLD=U FHQUIT=1 G:'$T!(FLD["^") KIL^FHASM1

 I FLD'?1N.N!(FLD<0)!(FLD>10000) W *7,!,"Level must be between 0-10000 ml/day" G H6

 S FLD=+$J(FLD,0,0) G PRO

H7 S FLD=+$J(FLD,0,0)

H8 W !!,"Select Fluid Requirements (ml/day): ",FLD,"// " R X:DTIME I '$T!(X["^") G KIL^FHASM1

 I X'="",X'?1N.N!(X<0)!(X>10000) W *7,!,"Level must be between 0-10000 ml/day" G H8

 I X'="",X'=FLD S FLD=+$J(X,0,0),H2O=6

PRO ;protein calculation.  Before setting protein, set the formula used in Fluid calculation.

 S (FHH2O,FHH2O)=""

 I H2O=1 D

 .I AGE>64 S FHH2O="Elderly Calculation (30 ml/kg/day)" Q

 .I AGE>17 S FHH2O="Adult (35 ml/kg/day)" Q

 .I AGE>10 S FHH2O="Adolescent (40-60 ml/kg/day)" Q

 .I AGE'<1 S FHH2O="Children (70-110 ml/kg/day)" Q

 .S FHH2O="Infant (100-150 ml/kg/day)" Q

 I H2O=2 D

 .I W1<10 S FHH2O="100 ml/kg first 10 kg" Q

 .I W1<20 S FHH2O="50N ml/kg 10 kg" Q

 .S FHH2O="25 ml/kg remaining kg"

 S:H2O=3 FHH2O="1 ml/kcal"

 S:H2O=4 FHH2O="0.5 ml/kcal (Fluid Overload"

 S:H2O=5 FHH2O="1500 ml/sq meter"

 S:H2O=6 FHH2O="Set Your Own Fluid Level"

 S:H2O=7 FHH2O="Omit Calculation"

 S FHFFC=FHH2O_" and "_FHCFRBO

 S CB="Protein" D GETW^FHASM5 G:CB=0 KIL^FHASM1 W !!?11,"Protein Requirements (g/kg)",!?16,"(Examples)"

 W !,"Acute Burn, Injury,  Trauma",?48,"2-4"

 W !,"Acute Encephalopathy",?48,"0.6-0.8"

 W !,"Acute Hepatitis",?48,"1.2-1.5"

 W !,"Anabolism",?48,"1.2-1.5"

 W !,"Burn",?48,"1.4"

 W !,"Chronic Encephalopathy",?48,"1.2"

 W !,"Chronic Hepatitis (no cirrhosis)",?48,"1.2-1.5"

 W !,"Chronic Liver Disease",?48,"1-1.5"

 W !,"Chronic Renal Failure",?48,"0.6"

 W !,"Conservative Mgt Pre-Dialysis",?48,"0.6-0.75"

 W !,"Convalescent Burn, Injury Trauma",?48,"2"

 W !,"ESRD Hemodialysis",?48,"1.2-1.3"

 W !,"ESRD Peritoneal Dialysis",?48,"1.2-1.3"

 W !,"Ileocolostomy",?48,"1-1.4"

 W !,"Liver transplant (pre-transplant/stable)",?48,"1.2-1.5"

 W !,"Malabsorption Syndrome",?48,"1"

 W !,"Nephrotic Syndrome",?48,"1-1.4"

 W !,"Post-liver transplant - short term(1-2 months)",?48,"1.2-2"

 W !,"                        long term",?48,"0.8-1.0"

 W !,"Pressure Ulcers",?48,"1.2-1.5"

 W !,"Protein-Sparing",?48,"1.5"

 W !,"Ulcerative Colitis",?48,"1-1.4"

 S P1=$S(AGE>18:0.8,AGE>14:0.84,AGE>10:1,AGE>6:1.2,AGE>3:1.5,AGE>1:1.8,AGE>.5:2,1:2.2)

P6 S FHPLX=$S($G(FHPL):FHPL,1:P1) I FHPLX<1,$E(FHPLX,1)'="0" S FHPLX="0"_FHPLX

 S X="" W !!,"Enter Protein Level (g/kg) ",FHPLX," // " R X:DTIME S:X="^" FHQUIT=1 I '$T!(X["^")!FHQUIT G KIL^FHASM1

 I FHPLX,X="" S X=FHPLX

 I X'?.1N.1".".2N!(X<.4)!(X>4) W *7,"  Level must be 0.4 to 4.0" G P6

 I X<1,$E(X,1)'="0" S X="0"_X

 S (PRO,FHPL)=X

 S PRO=+$J(PRO*W2,0,0)

 S FHFPC=FHCFRBO_" and protein level of "_X

P7 W !!,"Enter Protein Requirements (gm/day): ",PRO,"// " R X:DTIME I '$T!(X["^") G KIL^FHASM1

 I X'="",X'>0!(X>400) W *7," Enter a value greater than 0 but not more than 400." G P7

 I X'="",X'=PRO S PRO=+$J(X,0,0),FHFPC="User sets the Protein Level"

 I KCAL W "  ",$J(PRO*400/KCAL,0,0)," % of KCAL"

 ;

NEXT G ^FHASM7

 ;

PWR ; Raise X to X1 power - Output in Y

 I X'>0 S Y=0 Q

 S X2=1 I X>0 F X3=0:1 Q:(X/X2)<10  S X2=X2*10

 I X<1 F X3=0:-1 Q:(X/X2)>.1  S X2=X2*.1

 S X=X/X2

 S X=(X-1)/(X+1),(Y,X5)=X F X4=3:2 S X5=X5*X*X,X2=X5/X4,Y=X2+Y S:X2<0 X2=-X2 Q:X2<.000001

 S Y=Y*2+(X3*2.302585),X=Y*X1

 S (Y,X5)=X,Y=Y+1 F X4=2:1 S X5=X5*X/X4,Y=Y+X5 Q:X5<.000001

 S Y=+$J(Y,0,5) K X2,X3,X4,X5 Q

FHASM6    ; HISC/REL - Protein/Fluid Requirements ;10/30/90  13:42

 +1       ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28

H2O        WRITE !!,"Calculate Fluid Requirements By:"

 +1        WRITE !!?5,"1)  Adult (35 ml/kg/day)",!?9,"Elderly Calculation  (30 ml/kg/day)",!?9,"Adolescent (40-60 ml/kg/day)",!?9,"Children (70-110 ml/kg/day)",!?9,"Infant (100-150 ml/kg/day)"

 +2        WRITE !?5,"2)  100 ml/kg first 10 kg +",!?9,"50 ml/kg second 10 kg +",!?9,"25 ml/kg remaining kg"

 +3        WRITE !?5,"3)  1 ml/Kcal",!?5,"4)  0.5 ml/Kcal  (Fluid Overload)"

 +4        WRITE !?5,"5)  1500 ml/sq meter"

 +5        WRITE !?5,"6)  Set Your Own Fluid Level",!?5,"7)  Omit Calculation"

H0         WRITE !!,"Choose: "

           IF CFRB

               WRITE CFRB_"// "

           READ H2O:DTIME

           IF H2O=U

               SET FHQUIT=1

           IF '$TEST!(H2O["^")

               GOTO KIL^FHASM1

 +1        IF H2O=""

               IF CFRB

                   SET H2O=CFRB

 +2        IF "1234567"'[H2O!(H2O'?1N)

               WRITE !,"Choose 1 - 7 Only"

               GOTO H0

 +3        SET CFRB=H2O

 +4        IF "125"[H2O

               SET CB="Fluid"

               DO GETW^FHASM5

               IF CB=0

                   GOTO KIL^FHASM1

 +5        IF H2O=1

               GOTO H1

           IF H2O=2

               GOTO H2

           IF H2O=3

               GOTO H3

           IF H2O=4

               GOTO H4

           IF H2O=5

               GOTO H5

           IF H2O=6

               GOTO H6

           IF '$DATA(FLD)

               SET FLD=""

           GOTO PRO

H1        ;add elderly calculation here

 +1        IF AGE>64

               SET FLD=30

               GOTO H12

 +2        IF AGE>17

               SET FLD=35

               GOTO H12

 +3        IF AGE>10

               SET A1=40

               SET A2=60

               GOTO H11

 +4        IF AGE'<1

               SET A1=70

               SET A2=110

               GOTO H11

 +5        SET A1=100

           SET A2=150

H11        WRITE !!,"Select Level Between ",A1," and ",A2," ml/kg/day: "

           IF FLD'=""

               WRITE FLD_"// "

 +1        READ FLD:DTIME

           IF FLD=U

               SET FHQUIT=1

           IF '$TEST!(FLD["^")

               GOTO KIL^FHASM1

 +2        IF FLD<A1!(FLD>A2)

               WRITE *7,!,"Fluid Level is not within range."

               GOTO H11

H12        SET FLD=W2*FLD

           GOTO H7

H2         SET W1=W2

           SET FLD=$SELECT(W1<10:W1*100,W1<20:W1-10*50+1000,1:W1-20*25+1500)

           GOTO H7

H3         SET FLD=KCAL

           GOTO H7

H4         SET FLD=.5*KCAL

           GOTO H7

H5         SET X=W2

           SET X1=.425

           DO PWR

           SET FLD=Y

           SET X=HGT*2.54

           SET X1=.725

           DO PWR

           SET FLD=FLD*Y*.007184*1500

           GOTO H7

H6         WRITE !!,"Enter Fluid Requirements (ml/day): ",FLD,"// "

           READ FLD:DTIME

           IF FLD=U

               SET FHQUIT=1

           IF '$TEST!(FLD["^")

               GOTO KIL^FHASM1

 +1        IF FLD'?1N.N!(FLD<0)!(FLD>10000)

               WRITE *7,!,"Level must be between 0-10000 ml/day"

               GOTO H6

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

           GOTO PRO

H7         SET FLD=+$JUSTIFY(FLD,0,0)

H8         WRITE !!,"Select Fluid Requirements (ml/day): ",FLD,"// "

           READ X:DTIME

           IF '$TEST!(X["^")

               GOTO KIL^FHASM1

 +1        IF X'=""

               IF X'?1N.N!(X<0)!(X>10000)

                   WRITE *7,!,"Level must be between 0-10000 ml/day"

                   GOTO H8

 +2        IF X'=""

               IF X'=FLD

                   SET FLD=+$JUSTIFY(X,0,0)

                   SET H2O=6

PRO       ;protein calculation.  Before setting protein, set the formula used in Fluid calculation.

 +1        SET (FHH2O,FHH2O)=""

 +2        IF H2O=1

               Begin DoDot:1

 +3                IF AGE>64

                       SET FHH2O="Elderly Calculation (30 ml/kg/day)"

                       QUIT 

 +4                IF AGE>17

                       SET FHH2O="Adult (35 ml/kg/day)"

                       QUIT 

 +5                IF AGE>10

                       SET FHH2O="Adolescent (40-60 ml/kg/day)"

                       QUIT 

 +6                IF AGE'<1

                       SET FHH2O="Children (70-110 ml/kg/day)"

                       QUIT 

 +7                SET FHH2O="Infant (100-150 ml/kg/day)"

                   QUIT 

               End DoDot:1

 +8        IF H2O=2

               Begin DoDot:1

 +9                IF W1<10

                       SET FHH2O="100 ml/kg first 10 kg"

                       QUIT 

 +10               IF W1<20

                       SET FHH2O="50N ml/kg 10 kg"

                       QUIT 

 +11               SET FHH2O="25 ml/kg remaining kg"

               End DoDot:1

 +12       IF H2O=3

               SET FHH2O="1 ml/kcal"

 +13       IF H2O=4

               SET FHH2O="0.5 ml/kcal (Fluid Overload"

 +14       IF H2O=5

               SET FHH2O="1500 ml/sq meter"

 +15       IF H2O=6

               SET FHH2O="Set Your Own Fluid Level"

 +16       IF H2O=7

               SET FHH2O="Omit Calculation"

 +17       SET FHFFC=FHH2O_" and "_FHCFRBO

 +18       SET CB="Protein"

           DO GETW^FHASM5

           IF CB=0

               GOTO KIL^FHASM1

           WRITE !!?11,"Protein Requirements (g/kg)",!?16,"(Examples)"

 +19       WRITE !,"Acute Burn, Injury,  Trauma",?48,"2-4"

 +20       WRITE !,"Acute Encephalopathy",?48,"0.6-0.8"

 +21       WRITE !,"Acute Hepatitis",?48,"1.2-1.5"

 +22       WRITE !,"Anabolism",?48,"1.2-1.5"

 +23       WRITE !,"Burn",?48,"1.4"

 +24       WRITE !,"Chronic Encephalopathy",?48,"1.2"

 +25       WRITE !,"Chronic Hepatitis (no cirrhosis)",?48,"1.2-1.5"

 +26       WRITE !,"Chronic Liver Disease",?48,"1-1.5"

 +27       WRITE !,"Chronic Renal Failure",?48,"0.6"

 +28       WRITE !,"Conservative Mgt Pre-Dialysis",?48,"0.6-0.75"

 +29       WRITE !,"Convalescent Burn, Injury Trauma",?48,"2"

 +30       WRITE !,"ESRD Hemodialysis",?48,"1.2-1.3"

 +31       WRITE !,"ESRD Peritoneal Dialysis",?48,"1.2-1.3"

 +32       WRITE !,"Ileocolostomy",?48,"1-1.4"

 +33       WRITE !,"Liver transplant (pre-transplant/stable)",?48,"1.2-1.5"

 +34       WRITE !,"Malabsorption Syndrome",?48,"1"

 +35       WRITE !,"Nephrotic Syndrome",?48,"1-1.4"

 +36       WRITE !,"Post-liver transplant - short term(1-2 months)",?48,"1.2-2"

 +37       WRITE !,"                        long term",?48,"0.8-1.0"

 +38       WRITE !,"Pressure Ulcers",?48,"1.2-1.5"

 +39       WRITE !,"Protein-Sparing",?48,"1.5"

 +40       WRITE !,"Ulcerative Colitis",?48,"1-1.4"

 +41       SET P1=$SELECT(AGE>18:0.8,AGE>14:0.84,AGE>10:1,AGE>6:1.2,AGE>3:1.5,AGE>1:1.8,AGE>.5:2,1:2.2)

P6         SET FHPLX=$SELECT($GET(FHPL):FHPL,1:P1)

           IF FHPLX<1

               IF $EXTRACT(FHPLX,1)'="0"

                   SET FHPLX="0"_FHPLX

 +1        SET X=""

           WRITE !!,"Enter Protein Level (g/kg) ",FHPLX," // "

           READ X:DTIME

           IF X="^"

               SET FHQUIT=1

           IF '$TEST!(X["^")!FHQUIT

               GOTO KIL^FHASM1

 +2        IF FHPLX

               IF X=""

                   SET X=FHPLX

 +3        IF X'?.1N.1".".2N!(X<.4)!(X>4)

               WRITE *7,"  Level must be 0.4 to 4.0"

               GOTO P6

 +4        IF X<1

               IF $EXTRACT(X,1)'="0"

                   SET X="0"_X

 +5        SET (PRO,FHPL)=X

 +6        SET PRO=+$JUSTIFY(PRO*W2,0,0)

 +7        SET FHFPC=FHCFRBO_" and protein level of "_X

P7         WRITE !!,"Enter Protein Requirements (gm/day): ",PRO,"// "

           READ X:DTIME

           IF '$TEST!(X["^")

               GOTO KIL^FHASM1

 +1        IF X'=""

               IF X'>0!(X>400)

                   WRITE *7," Enter a value greater than 0 but not more than 400."

                   GOTO P7

 +2        IF X'=""

               IF X'=PRO

                   SET PRO=+$JUSTIFY(X,0,0)

                   SET FHFPC="User sets the Protein Level"

 +3        IF KCAL

               WRITE "  ",$JUSTIFY(PRO*400/KCAL,0,0)," % of KCAL"

 +4       ;

NEXT       GOTO ^FHASM7

 +1       ;

PWR       ; Raise X to X1 power - Output in Y

 +1        IF X'>0

               SET Y=0

               QUIT 

 +2        SET X2=1

           IF X>0

               FOR X3=0:1

                   IF (X/X2)<10

                       QUIT 

                   SET X2=X2*10

 +3        IF X<1

               FOR X3=0:-1

                   IF (X/X2)>.1

                       QUIT 

                   SET X2=X2*.1

 +4        SET X=X/X2

 +5        SET X=(X-1)/(X+1)

           SET (Y,X5)=X

           FOR X4=3:2

               SET X5=X5*X*X

               SET X2=X5/X4

               SET Y=X2+Y

               IF X2<0

                   SET X2=-X2

               IF X2<.000001

                   QUIT 

 +6        SET Y=Y*2+(X3*2.302585)

           SET X=Y*X1

 +7        SET (Y,X5)=X

           SET Y=Y+1

           FOR X4=2:1

               SET X5=X5*X/X4

               SET Y=Y+X5

               IF X5<.000001

                   QUIT 

 +8        SET Y=+$JUSTIFY(Y,0,5)

           KILL X2,X3,X4,X5

           QUIT