Changeset 623 for WorldVistAEHR/trunk/r/DIETETICS-FH/FHASM3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DIETETICS-FH/FHASM3.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DIETETICS-FH/FHASM3.m
r613 r623 1 FHASM3 ; HISC/REL - Antropometrics and TIU Notes ;5/14/93 09:17 2 ;;5.5;DIETETICS;**8,14**;Jan 28, 2005;Build 1 3 I EXT="Y" G NEXT 4 EXT R !!,"Do you wish Anthropometric Assessment? NO// ",EXT:DTIME S:EXT=U FHQUIT=1 G:'$T!(EXT["^") KIL^FHASM1 5 S:EXT="" EXT="N" 6 S X=EXT D TR^FHASM1 S EXT=X 7 I $P("YES",EXT,1)'="",$P("NO",EXT,1)'="" W *7,!," Enter YES if you have Anthropometric measurements; Otherwise NO" G EXT 8 S EXT=$E(EXT,1) I EXT="Y" D ANT G:EXT="" KIL^FHASM1 9 NEXT ; Calculate BMI 10 S A2=HGT*.0254,BMI=+$J(WGT/2.2/(A2*A2),0,1) 11 ;update nutrition assessment data in #115. 12 ; 13 ; 14 D ^FHASM3A G ^FHASM4 15 ANT ; Anthropometric measurements 16 W !!,"Triceps Skin Fold (mm): " W:$D(TSF) TSF_"// " R X:DTIME G QT:'$T!(X["^") 17 S:X'="" TSF=X 18 S:TSF="" TSF=X 19 G A1:TSF="" 20 I TSF'?.N.1".".N!(TSF<1)!(TSF>100) W !?5,"Enter value between 1 and 100; outside values should be assessed manually" G ANT 21 A1 W !,"Subscapular Skinfold (mm): " W:$D(SCA) SCA_"// " R X:DTIME G QT:'$T!(X["^") 22 S:X'="" SCA=X 23 S:SCA="" SCA=X 24 G A2:SCA="" 25 I SCA'?.N.1".".N!(SCA<1)!(SCA>100) W !?5,"Enter value between 1 and 100; outside values should be assessed manually" G A1 26 A2 W !,"Arm Circumference (cm): " W:$G(ACIR) ACIR_"// " R X:DTIME G QT:'$T!(X["^") 27 S:X'="" ACIR=X 28 S:SCA="" ACIR=X 29 G A3:ACIR="" 30 I ACIR'?.N.1".".N!(ACIR<5)!(ACIR>100) W !?5,"Enter number between 5 and 100; outside values should be assessed manually" G A2 31 A3 W !,"Calf Circumference (cm): " W:$G(CCIR) CCIR_"// " R X:DTIME G QT:'$T!(X["^") 32 S:X'="" CCIR=X 33 S:CCIR="" CCIR=X 34 G A4:CCIR="" 35 I CCIR'?.N.1".".N!(CCIR<10)!(CCIR>250) W !?5,"Enter value between 10 and 250; outside values should be assessed manually" G A3 36 A4 I ACIR,TSF S X1=ACIR-(TSF/10*3.1416),BFAMA=X1*X1/12.5664-$S(AGE<18:0,SEX="M":10,1:6.5),BFAMA=$J(BFAMA,0,1) 37 Q 38 QT S EXT="" Q 39 ; 40 REC ;recalculate calorie, protien and fluid requirements. 41 I '$G(IBW)!'$G(WGT)!'$G(HGT)!'$G(AGE) Q 42 I $D(CFRBO) S CB=CFRBO,W2=$S(CB=2:IBW,CB=3:WGT-IBW*.25+IBW,1:WGT)/2.2 43 Q:'$G(W2) 44 ;calorie 45 I $D(CENB),CENB=3 D 46 .I SEX="M" S KCAL=(10*W2)+(6.25*2.54*HGT)-(5*AGE)+5 47 .I SEX="F" S KCAL=(10*W2)+(6.25*2.54*HGT)-(5*AGE)-161 48 .S KCAL=$J(KCAL,0,0) 49 I $D(CENB),CENB=1 D 50 .I SEX="F" S KCAL=(655.10+(9.56*W2)+(1.85*HGT*2.54)-(4.68*AGE)) 51 .I SEX="M" S KCAL=(66.47+(13.75*W2)+(5.0*HGT*2.54)-(6.67*AGE)) 52 .I $D(SEF),$G(AF) S KCAL=+$J(KCAL*AF*SEF,0,0) 53 .S KCAL=$J(KCAL,0,0) 54 I $D(CENB),(CENB=2),$G(EKKG) S KCAL=+$J(EKKG*W2,0,0) 55 ;fluid 56 I $G(CFRB),CFRB=1 D 57 .S:AGE>17 FLD=35 58 .S:AGE>64 FLD=30 59 .S FLD=W2*FLD 60 I $D(CFRB),CFRB=2 S W1=W2,FLD=$S(W1<10:W1*100,W1<20:W1-10*50+1000,1:W1-20*25+1500) 61 I $D(CFRB),CFRB=3 S FLD=KCAL 62 I $D(CFRB),CFRB=4 S FLD=.5*KCAL 63 I $D(CFRB),CFRB=5 S X=W2,X1=.425 D PWR^FHASM6 S FLD=Y,X=HGT*2.54,X1=.725 D PWR^FHASM6 S FLD=FLD*Y*.007184*1500 64 S FLD=+$J(FLD,0,0) 65 I FLD'?1N.N!(FLD<0)!(FLD>10000) W *7,!,"Fluid level must be between 0-10000 ml/day" S FHQTALL=1 Q 66 S FLD=+$J(FLD,0,0) 67 ;protien 68 S P1=$S(AGE>18:.8,AGE>14:.84,AGE>10:1,AGE>6:1.2,AGE>3:1.5,AGE>1:1.8,AGE>.5:2,1:2.2) 69 I P1=FHPL S PRO=+$J(P1*W2,0,0) 70 I P1'=FHPL S PRO=+$J(FHPL*W2,0,0) 71 I PRO'="",(PRO'>0!(PRO>400)) W *7," Protien level is greater than 0 but not more than 400." S FHQTALL=1 72 ;FOLLOW-UP DATE. 73 S (FHDD,DTP)="" 74 I $G(RC),FHFUD<DT D 75 .S X=$P($G(^FH(115.4,RC,0)),U,2) D TR^FH 76 .I X["NORMAL" D 77 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,20) 78 ..S:FHDD DTP="T+"_FHDD 79 ..S:'FHDD DTP="T+11" 80 .I X["MILD" D 81 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,21) 82 ..S:FHDD DTP="T+"_FHDD 83 ..S:'FHDD DTP="T+9" 84 .I X["MODERATE" D 85 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,22) 86 ..S:FHDD DTP="T+"_FHDD 87 ..S:'FHDD DTP="T+7" 88 .I X["SEVERE" D 89 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,23) 90 ..S:FHDD DTP="T+"_FHDD 91 ..S:'FHDD DTP="T+5" 92 .S X=DTP,%DT="X",%DT(0)=DT D ^%DT S FHFUD=Y 93 .W ! K %DT 94 .S FHFUD=Y 95 I 'RC,FHFUD<DT S X="NOW",%DT="X" D ^%DT S FHFUD=Y 96 ; 97 Q 1 FHASM3 ; HISC/REL - Antropometrics and TIU Notes ;5/14/93 09:17 2 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28 3 I EXT="Y" G NEXT 4 EXT R !!,"Do you wish Anthropometric Assessment? NO// ",EXT:DTIME S:EXT=U FHQUIT=1 G:'$T!(EXT["^") KIL^FHASM1 5 S:EXT="" EXT="N" 6 S X=EXT D TR^FHASM1 S EXT=X 7 I $P("YES",EXT,1)'="",$P("NO",EXT,1)'="" W *7,!," Enter YES if you have Anthropometric measurements; Otherwise NO" G EXT 8 S EXT=$E(EXT,1) I EXT="Y" D ANT G:EXT="" KIL^FHASM1 9 NEXT ; Calculate BMI 10 S A2=HGT*.0254,BMI=+$J(WGT/2.2/(A2*A2),0,1) 11 ;update nutrition assessment data in #115. 12 ; 13 ; 14 D ^FHASM3A G ^FHASM4 15 ANT ; Anthropometric measurements 16 W !!,"Triceps Skin Fold (mm): " W:$D(TSF) TSF_"// " R X:DTIME G QT:'$T!(X["^") 17 S:X'="" TSF=X 18 S:TSF="" TSF=X 19 G A1:TSF="" 20 I TSF'?.N.1".".N!(TSF<1)!(TSF>100) W !?5,"Enter value between 1 and 100; outside values should be assessed manually" G ANT 21 A1 W !,"Subscapular Skinfold (mm): " W:$D(SCA) SCA_"// " R X:DTIME G QT:'$T!(X["^") 22 S:X'="" SCA=X 23 S:SCA="" SCA=X 24 G A2:SCA="" 25 I SCA'?.N.1".".N!(SCA<1)!(SCA>100) W !?5,"Enter value between 1 and 100; outside values should be assessed manually" G A1 26 A2 W !,"Arm Circumference (cm): " W:$G(ACIR) ACIR_"// " R X:DTIME G QT:'$T!(X["^") 27 S:X'="" ACIR=X 28 S:SCA="" ACIR=X 29 G A3:ACIR="" 30 I ACIR'?.N.1".".N!(ACIR<5)!(ACIR>100) W !?5,"Enter number between 5 and 100; outside values should be assessed manually" G A2 31 A3 W !,"Calf Circumference (cm): " W:$G(CCIR) CCIR_"// " R X:DTIME G QT:'$T!(X["^") 32 S:X'="" CCIR=X 33 S:CCIR="" CCIR=X 34 G A4:CCIR="" 35 I CCIR'?.N.1".".N!(CCIR<10)!(CCIR>250) W !?5,"Enter value between 10 and 250; outside values should be assessed manually" G A3 36 A4 I ACIR,TSF S X1=ACIR-(TSF/10*3.1416),BFAMA=X1*X1/12.5664-$S(AGE<18:0,SEX="M":10,1:6.5),BFAMA=$J(BFAMA,0,1) 37 Q 38 QT S EXT="" Q 39 ; 40 REC ;recalculate calorie, protien and fluid requirements. 41 I '$G(IBW)!'$G(WGT)!'$G(HGT)!'$G(AGE) Q 42 I $D(CFRBO) S CB=CFRBO,W2=$S(CB=2:IBW,CB=3:WGT-IBW*.25+IBW,1:WGT)/2.2 43 Q:'$G(W2) 44 ;calorie 45 I $D(CENB),CENB=3 D 46 .I SEX="M" S KCAL=(10*W2)+(6.25*2.54*HGT)-(5*AGE)+5 47 .I SEX="F" S KCAL=(10*W2)+(6.25*2.54*HGT)-(5*AGE)-161 48 .S KCAL=$J(KCAL,0,0) 49 I $D(CENB),CENB=1 D 50 .I SEX="F" S KCAL=(655.10+(9.56*W2)+(1.85*HGT*2.54)-(4.68*AGE)) 51 .I SEX="M" S KCAL=(66.47+(13.75*W2)+(5.0*HGT*2.54)-(6.67*AGE)) 52 .I $D(SEF),$G(AF) S KCAL=+$J(KCAL*AF*SEF,0,0) 53 .S KCAL=$J(KCAL,0,0) 54 I $D(CENB),(CENB=2),$G(EKKG) S KCAL=+$J(EKKG*W2,0,0) 55 ;fluid 56 I $G(CFRB),CFRB=1 D 57 .S:AGE>17 FLD=35 58 .S:AGE>64 FLD=30 59 .S FLD=W2*FLD 60 I $D(CFRB),CFRB=2 S W1=W2,FLD=$S(W1<10:W1*100,W1<20:W1-10*50+1000,1:W1-20*25+1500) 61 I $D(CFRB),CFRB=3 S FLD=KCAL 62 I $D(CFRB),CFRB=4 S FLD=.5*KCAL 63 I $D(CFRB),CFRB=5 S X=W2,X1=.425 D PWR^FHASM6 S FLD=Y,X=HGT*2.54,X1=.725 D PWR^FHASM6 S FLD=FLD*Y*.007184*1500 64 S FLD=+$J(FLD,0,0) 65 I FLD'?1N.N!(FLD<0)!(FLD>10000) W *7,!,"Fluid level must be between 0-10000 ml/day" S FHQTALL=1 Q 66 S FLD=+$J(FLD,0,0) 67 ;protien 68 S P1=$S(AGE>18:.8,AGE>14:.84,AGE>10:1,AGE>6:1.2,AGE>3:1.5,AGE>1:1.8,AGE>.5:2,1:2.2) 69 S PRO=+$J(P1*W2,0,0) 70 I PRO'="",(PRO'>0!(PRO>400)) W *7," Protien level is greater than 0 but not more than 400." S FHQTALL=1 71 ;FOLLOW-UP DATE. 72 S (FHDD,DTP)="" 73 I $G(RC),FHFUD<DT D 74 .S X=$P($G(^FH(115.4,RC,0)),U,2) D TR^FH 75 .I X["NORMAL" D 76 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,20) 77 ..S:FHDD DTP="T+"_FHDD 78 ..S:'FHDD DTP="T+11" 79 .I X["MILD" D 80 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,21) 81 ..S:FHDD DTP="T+"_FHDD 82 ..S:'FHDD DTP="T+9" 83 .I X["MODERATE" D 84 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,22) 85 ..S:FHDD DTP="T+"_FHDD 86 ..S:'FHDD DTP="T+7" 87 .I X["SEVERE" D 88 ..S:FHLOC FHDD=$P($G(^FH(119.6,FHLOC,0)),U,23) 89 ..S:FHDD DTP="T+"_FHDD 90 ..S:'FHDD DTP="T+5" 91 .S X=DTP,%DT="X",%DT(0)=DT D ^%DT S FHFUD=Y 92 .W ! K %DT 93 .S FHFUD=Y 94 I 'RC,FHFUD<DT S X="NOW",%DT="X" D ^%DT S FHFUD=Y 95 ; 96 Q
Note:
See TracChangeset
for help on using the changeset viewer.
