Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHASM5

FHASM5.m

Go to the documentation of this file.
  1. FHASM5 ; HISC/REL - Energy/Calorie Factors ;3/20/95 08:18
  1. ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
  1. I AGE<19 G PED
  1. S CB="Energy" D GETW G HARRIS:CB=3,KIL^FHASM1:CB=0 W !!,"Calculate Energy Needs by: "
  1. W !!?6,"1 Harris-Benedict",!?6,"2 Kcal/Kg",!?6,"3 Mifflin-St Jeor"
  1. W !,?6,"4 Enter Manually"
  1. E2 W !!,"Choose: " W:CENB CENB_"// " R CM:DTIME S:CM=U FHQUIT=1 G:'$T!(CM["^") KIL^FHASM1
  1. I CM="",CENB S CM=CENB
  1. I "1234"'[CM!(CM'?1N) W !,*7,"Choose Either 1, 2, 3 or 4" G E2
  1. S CENB=CM
  1. S:CM=1 FHCM="Harris-Benedict"
  1. S:CM=2 FHCM="Kcal/Kg"
  1. S:CM=3 FHCM="Mifflin-St Jeor"
  1. S:CM=4 FHCM="Enter Manually"
  1. G HARRIS:CM=1,KCAL:CM=2,MIF:CM=3,MAN
  1. MAN ; Manual Entry
  1. M1 W !!,"Enter Energy Requirements (Kcal/day): " W:KCAL'="" KCAL_"// " R X:DTIME G:'$T!(X["^") KIL^FHASM1
  1. I (X'=""),(KCAL'=X) S KCAL=X
  1. S KCAL=+$J(KCAL,0,0) I KCAL'>0 W *7,!,"KCAL must be greater than 0" G M1
  1. G P5
  1. MIF ;Mifflin - St. Jeor entry; adding this new calculation for cal needs.
  1. I SEX="M" S KCAL=10*(W2)+(6.25*(2.5*HGT))-(5*AGE)+5
  1. I SEX="F" S KCAL=10*(W2)+(6.25*(2.5*HGT))-(5*AGE)-161
  1. S KCAL=$J(KCAL,0,0)
  1. G P5
  1. SUR ;add for s/p bariatic surgery
  1. ;S KCAL=20*W2
  1. ;S KCAL=KCAL+20,KCAL=$J(KCAL,0,0)
  1. ;G P5
  1. PED ; Pediatric
  1. S FHCM=" Pediatric"
  1. I AGE<11 S KCAL=$S(AGE<.6:115,AGE<1:105,AGE<4:100,AGE<7:85,1:86) G P1
  1. I SEX="M" S KCAL=$S(AGE<15:60,1:42) G P1
  1. S KCAL=$S(AGE<15:48,1:38)
  1. P1 S KCAL=+$J(KCAL*WGT/2.2,0,0) G P5
  1. HARRIS ; Harris Method
  1. I SEX="F" S KCAL=(655.10+(9.56*W2)+(1.85*HGT*2.54)-(4.68*AGE))
  1. I SEX="M" S KCAL=(66.47+(13.75*W2)+(5.0*HGT*2.54)-(6.67*AGE))
  1. S KCAL=$J(KCAL,0,0)
  1. H1 W !!,"Is patient confined to bed (Y/N): " W:FHYN'="" FHYN_"//" W:FHYN="" "N //" R AF:DTIME
  1. I '$T!(AF["^") S FHQUIT=1 G KIL^FHASM1
  1. I AF="",FHYN'="" S AF=FHYN
  1. I AF="",FHYN="" S AF="N"
  1. S X=AF D TR^FHASM1 S AF=X
  1. I $P("YES",AF,1)'="",$P("NO",AF,1)'="" W *7,!," Answer YES or NO" G H1
  1. S FHYN=AF
  1. S AF=$S(AF?1"Y".E:1.2,1:1.3) W " (Activity Factor = ",AF,")"
  1. W !!?27,"Injury/Stress Factors",!
  1. W !,"Surgery",?25,"1.1 - 1.3",?40,"Skeletal Trauma",?65,"1.35",!,"Major Sepsis",?25,"1.6",?40,"Severe Burn",?65,"2.1"
  1. W !,"Blunt Trauma",?25,"1.35",?40,"Trauma w/ Steroid",?65,"1.68",!,"Starvation",?25,".7",?40,"Trauma on Ventilator",?65,"1.6"
  1. W !,"Mild Infection",?25,"1.2",?40,"0-20% BSA Burn",?65,"1.25",!,"Moderate Infection",?25,"1.4",?40,"20-40% BSA Burn",?65,"1.5"
  1. W !,"Long Bone Fracture",?25,"1.6",?40,">40% BSA Burn",?65,"1.85",!,"Peritonitis",?25,"1.15"
  1. W !,"Stress - Low",?25,"1.3",?40,"Anabolism",?65,"1.5-1.75"
  1. W !," - Moderate",?25,"1.5",?40,"Cancer",?65,"1.6"
  1. W !," - Severe",?25,"2.0"
  1. W !!,"BEE = ",KCAL," Kcal/day"
  1. H2 W !!,"Select Energy Factor: " W:SEF SEF_"// " R EF:DTIME S:EF=U FHQUIT=1 G:'$T!(EF["^") KIL^FHASM1
  1. I EF="",SEF S EF=SEF
  1. I EF<.7!(EF>2.5) W !,*7,"Energy Factor must be Between .7 and 2.5" G H2
  1. S:EF<1 EF=0_EF
  1. S SEF=EF
  1. S FHEF="Energy Factor of "_EF
  1. S KCAL=+$J(KCAL*AF*EF,0,0) G P5
  1. KCAL ; KCAL Method
  1. W !!?35,"Caloric Factors"
  1. W !!,"Basal Energy",?30,"25",!,"Ambulatory w/ Weight Maint.",?30,"30"
  1. W !,"Malnutrition w/ Mild Sepsis",?30,"40",!,"Injuries/ Sepsis - Severe",?30,"50"
  1. W !,"Burn - Extensive",?30,"80",!,"Non-Dialysis Renal Failure",?30,"35"
  1. W !,"Dialysis",?30,"40",!,"Dialysis w/ Diabetes",?30,"30",!,"Anabolism",?30,"35-45"
  1. W !,"Conservative Mgnt Pre-Dialysis:"
  1. W !," (<60 years old)",?30,"35"
  1. W !," (>60 years old)",?30,"30-35"
  1. S FHECAL=""
  1. P4 W !!,"Enter Kcal/Kg (10-100): " W:EKKG'="" EKKG_"// " R FHECAL:DTIME I '$T!(FHECAL["^") S FHQUIT=1 G KIL^FHASM1
  1. I FHECAL="",EKKG'="" S FHECAL=EKKG
  1. I FHECAL'?1.3N!(FHECAL<10)!(FHECAL>100) W !,*7,"Kcal/Kg Must be Between 10 and 100" G P4
  1. I FHECAL'="" S (EKKG,KCAL)=FHECAL
  1. S FHKCAL="Caloric Factor of "_KCAL
  1. S KCAL=+$J(KCAL*W2,0,0)
  1. P5 ;
  1. S FHFEC=""
  1. S:FHEF'="" FHFEC=FHFEC_FHEF_", "
  1. S:FHCM'="" FHFEC=FHFEC_FHCM_", "
  1. S:FHKCAL'="" FHFEC=FHFEC_FHKCAL
  1. S:FHCFRBO'="" FHFEC=FHFEC_" and "_FHCFRBO
  1. W !!,"Enter Caloric Requirements (Kcal/day): ",KCAL,"// " R X:DTIME I '$T!(X["^") G KIL^FHASM1
  1. I X="",KCAL S X=KCAL
  1. I X'="",X'?.N.1".".N!(X<1)!(X>10000) W *7,!?5,"Enter a value between 1-10000" G P5
  1. I X'="",X'=KCAL S KCAL=+$J(X,0,0) S FHFEC="User sets the Calorie data"
  1. NEXT G ^FHASM6
  1. GETW W !!,"Calculate ",CB," Requirements Based On:" S CM="12"
  1. W !!?2,"1 Actual Body Weight",!?2,"2 Target Body Weight"
  1. I WGT/IBW'<1.2 W !?2,"3 Obese Calculation" S CM="123"
  1. E1 W !!,"Choose: " W:CFRBO CFRBO_"// " R CB:DTIME I '$T!(CB["^") S CB=0,FHQUIT=1 Q
  1. I CB="",CFRBO S CB=CFRBO
  1. I CM'[CB!(CB'?1N) W !,*7,"Choose either 1 or 2" W:CM["3" " or 3" G E1
  1. S CFRBO=CB
  1. S W2=$S(CB=2:IBW,CB=3:WGT-IBW*.25+IBW,1:WGT)/2.2 S:CB=3 CM=1
  1. S FHCFRBO=$S(CB=1:"Actual Body Wt",CB=2:"Target Body Wt",CB=3:"Obese Calculation",1:"")
  1. Q