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