source: FOIAVistA/trunk/r/DIETETICS-FH/FHASM2A.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1FHASM2A ; HISC/REL - Target Weight - Metropolitan 83 ;5/14/93 08:59
2 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
3M ; Metropolitan Height & Weight tables
4 ; 1983 Metropolitan Life Insurance Company Height & Weight Tables
5 ; as measured with 1" heels and clothes weighing 5# for men and 3# for women.
6M1 S OFF=$S(SEX="M":H1-61,1:H1-43),A1=$P($T(MM1+OFF),";",$F("SML",FRM)+2)
7 S W1=$P(A1,"-",1),W2=$P(A1,"-",2) G:METH="M" M3
8 ; Target Weight for Spinal Cord Patients
9 ; Nutrition Assessment of the Spinal Cord Injured Patient by
10 ; Suzanne C Peiffer, R.D., Patricia Blust, R.D., and Jose Florante J Leyson
11M2 W !!,"Extent of Injury:",!!?7,"P Paraplegic",!?7,"Q Quadriplegic"
12 W !!,"Select: ",FHSPC,"//" R SP:DTIME I '$T!(SP["^") S FHQUIT=1 Q
13 I SP="",FHSPC'="" S SP=FHSPC
14 S X=SP D TR^FHASM1 S SP=X
15 I SP'="P",SP'="Q" W !?3,*7,"Only P or Q are Valid Choices" G M2
16 S FHSPC=SP
17 S W1=W1-$S(SP="P":15,1:20),W2=W2-$S(SP="P":20,1:25)
18M3 S W3=+$J(W1+W2/2,0,0),X1=$S(FHU'="M":W1,1:+$J(W1/2.2,0,1)),X2=$S(FHU'="M":W2,1:+$J(W2/2.2,0,1)),X3=$S(FHU'="M":W3,1:+$J(W3/2.2,0,1))
19M4 W !!,"Select Target Weight (",X1,"-",X2,") ",X3,$S(FHU'="M":" lb",1:" kg"),"// " R X:DTIME I '$T!(X["^") S FHQUIT=1 Q
20 I X="" S IBW=W3 Q
21 D WGT^FHASM1 I Y<1 D WGP^FHASM1 G M4
22 S IBW=+Y I IBW<W1!(IBW>W2) S METH="E"
23 Q
24 ;
25ALRT ;process nutrition assessment alert.
26 Q:'DFN ;only inpt will have the alert
27 Q:'$G(WRD)
28 S WARD=$G(^DPT(DFN,.1)) Q:WARD=""
29 S ADM=$P($G(^FHPT(FHDFN,"A",0)),U,3)
30 S:'$G(FHDUZ) FHDUZ=""
31 I $G(DT) S DTE=DT
32 S FHSDT=DTE
33 F FHPDT=FHSDT:0 S FHPDT=$O(^FHPT("E",FHPDT)) Q:FHPDT'>0 I $D(^FHPT("E",FHPDT,FHDFN)) D
34 .S FHNAS=$O(^FHPT("E",FHPDT,FHDFN,0))
35 .I $P($G(^FHPT(FHDFN,"N",FHNAS,"DI")),U,9)'=""!($P($G(^FHPT(FHDFN,"N",FHNAS,"DI")),U,5)<DTE) Q
36 .Q:$P($G(^FHPT(FHDFN,"N",FHNAS,"DI")),U,6)'="C"
37 .K XQA,XQAMSG,XQAOPT,XQAROU
38 .S XQAID="FH,"_$J_","_$H
39 .S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
40 .S XQAMSG=XQAMSG_" has Assessment Follow-up Date on "_$E(FHPDT,4,5)_"/"_$E(FHPDT,6,7)_"/"_$E(FHPDT,2,3)
41 .F A=0:0 S A=$O(^FH(119.6,WRD,2,A)) Q:A'>0 S TK=$P($G(^FH(119.6,WRD,2,A,0)),U,1),XQA(TK)=""
42 .S:'$D(XQA(FHDUZ)) XQA(FHDUZ)=""
43 .D SETUP^XQALERT
44 .S $P(^FHPT(FHDFN,"N",FHNAS,"DI"),U,9)=FHSDT
45 K XQA,XQAMSG,XQAOPT,XQAROU,TK,FHSDT,FHPDT,FHNAS,FHNAA
46 ;
47PHA ;process food/drug classification alert
48 I $G(DT) S DTE=DT
49 ;call Pharmacy API
50 S PX=1 D DRUG^FHASM4
51 S FHI9=""
52 F S FHI9=$O(PCLS(FHI9)) Q:FHI9="" S FHP605=PCLS(FHI9) D
53 .D AL1
54 .Q:$G(FHALFLG)
55 .K XQA,XQAMSG,XQAOPT,XQAROU
56 .S XQAID="FH,"_$J_","_$H
57 .S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
58 .S XQAMSG=XQAMSG_"Food/drug interaction w/ "_FHI9
59 .F A=0:0 S A=$O(^FH(119.6,WRD,2,A)) Q:A'>0 D
60 ..S TK=$P($G(^FH(119.6,WRD,2,A,0)),U,1),XQA(TK)=""
61 ..S:'$D(XQA(FHDUZ)) XQA(FHDUZ)=""
62 .D SETUP^XQALERT
63 .S DIC="^FHPT("_FHDFN_",""D"",",DIC(0)="L",X=DT,DA(1)=FHDFN
64 .K DD,DO D FILE^DICN I +Y<0 Q
65 .S $P(^FHPT(FHDFN,"D",+Y,0),U,2)="S"
66 .S $P(^FHPT(FHDFN,"D",+Y,0),U,3)=WRD
67 .S $P(^FHPT(FHDFN,"D",+Y,0),U,4)=FHI9
68 .K DIC
69 K POP,PORD,PSCL605,PSNIEN,PSSTMP2,RMSDF,SCR,PCA,PCAL,PCNS,PCORD
70 K FHAL,FHALDAT,FHALFLG,FHALWRD,FHDOB,FHFDNM,FHGMDT,FHI9,FHP605,FHPAL,FHPPA
71 K XQA,XQAMSG,XQAOPT,XQAROU,TK,FHSDT,FHPDT,FHNAS,FHNAA,FHPPOR,FHPPNS
72 Q
73 ;
74AL1 S FHALFLG=0
75 F FHAL=0:0 S FHAL=$O(^FHPT(FHDFN,"D",FHAL)) Q:FHAL'>0 D
76 .S FHALDAT=$G(^FHPT(FHDFN,"D",FHAL,0))
77 .S FHFDNM=$P(FHALDAT,U,4),FHALWRD=$P(FHALDAT,U,3)
78 .I FHALWRD=WRD,FHFDNM=FHI9 S FHALFLG=1
79 Q
80MM1 ;;62;128-134;131-141;138-150
81 ;;63;130-136;133-143;140-153
82 ;;64;132-138;135-145;142-156
83 ;;65;134-140;137-148;144-160
84 ;;66;136-142;139-151;146-164
85 ;;67;138-145;142-154;149-168
86 ;;68;140-148;145-157;152-172
87 ;;69;142-151;148-160;155-176
88 ;;70;144-154;151-163;158-180
89 ;;71;146-157;154-166;161-184
90 ;;72;149-160;157-170;164-188
91 ;;73;152-164;160-174;168-192
92 ;;74;155-168;164-178;172-197
93 ;;75;158-172;167-182;176-202
94 ;;76;162-176;171-187;181-207
95MW1 ;;58;102-111;109-121;118-131
96 ;;59;103-113;111-123;120-134
97 ;;60;104-115;113-126;122-137
98 ;;61;106-118;115-129;125-140
99 ;;62;108-121;118-132;128-143
100 ;;63;111-124;121-135;131-147
101 ;;64;114-127;124-138;134-151
102 ;;65;117-130;127-141;137-155
103 ;;66;120-133;130-144;140-159
104 ;;67;123-136;133-147;143-163
105 ;;68;126-139;136-150;146-167
106 ;;69;129-142;139-153;149-170
107 ;;70;132-145;142-156;152-173
108 ;;71;135-148;145-159;155-176
109 ;;72;138-151;148-162;158-179
Note: See TracBrowser for help on using the repository browser.