source: FOIAVistA/trunk/r/DIETETICS-FH/FHWORA1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1FHWORA1 ; HISC/GJC/JH - OE/RR Procedure Call (Assessments) 2 of 2;1/31/97 12:56 ;11/6/97 15:28
2 ;;5.5;DIETETICS;;Jan 28, 2005
3SETUP ; Set up our ^TMP($J,"FHASM",DFN) global. Called from FHWORA
4 S DTP=ADT D DTP^FH
5 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$CJ^XLFSTR("Date of Assessment: "_$E(DTP,1,9),80," ")
6 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
7 ;
8 S X1=$S(HGT\12:HGT\12_"'",1:"")_$S(HGT#12:" "_(HGT#12)_"""",1:"")
9 S X2=+$J(HGT*2.54,0,0)_" cm" K STR S $P(STR," ",81)=""
10 S STR1="Height: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")",TAB=0
11 I HGP'="" S STR1=STR1_" "_$S(HGP="K":"knee hgt",HGP="S":"stated",1:"")
12 S STR=$$STRING(STR,STR1,TAB)
13 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
14 ;
15 S X1=WGT_" lbs",X2=+$J(WGT/2.2,0,1)_" kg"
16 S STR1="Weight: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")",TAB=0
17 I WGP'="" S STR1=STR1_" "_$S(WGP="A":"anthro",WGP="S":"stated",1:"")
18 S STR=$$STRING(STR,STR1,TAB)
19 S DTP=DWGT D DTP^FH S TAB=50,STR1="Weight Taken: "_DTP
20 S STR=$$STRING(STR,STR1,TAB)
21 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
22 ;
23 S (X1,X2)="" I UWGT S X1=UWGT_" lbs",X2=+$J(UWGT/2.2,0,1)_" kg"
24 K STR S $P(STR," ",81)="",TAB=0,STR1="Usual Weight: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")"
25 S STR=$$STRING(STR,STR1,TAB)
26 S STR1="Weight/Usual Wt: "_$S(UWGT:($J(WGT/UWGT*100,3,0)_"%"),1:"")
27 S TAB=50 S STR=$$STRING(STR,STR1,TAB)
28 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
29 ;
30 S X1=IBW_" lbs",X2=+$J(IBW/2.2,0,1)_" kg"
31 K STR S $P(STR," ",81)="",TAB=0
32 S STR1="Ideal Weight: "_$S(FHUNIT'="M":X1,1:X2)_" ("_$S(FHUNIT'="M":X2,1:X1)_")"
33 S STR=$$STRING(STR,STR1,TAB)
34 S TAB=50,STR1="Weight/IBW: "_$S(IBW:($J(WGT/IBW*100,3,0)_"%"),1:"")
35 S STR=$$STRING(STR,STR1,TAB)
36 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
37 ;
38 I AMP S TAB=6 K STR S $P(STR," ",81)="",STR1="Ideal weight adjusted for amputation",STR=$$STRING(STR,STR1,TAB),^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
39 ;
40 S TAB=0 K STR S $P(STR," ",81)=""
41 S STR1="Frame Size: "_$S(FRM="S":"Small",FRM="M":"Medium",FRM="L":"Large",1:"")
42 S STR=$$STRING(STR,STR1,TAB),TAB=50
43 S STR1="Body Mass Index: "_BMI S:BMIP'="" STR1=STR1_" ("_BMIP_"%)"
44 S STR=$$STRING(STR,STR1,TAB)
45 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
46 ;
47 I FHASMNT(1)]"" D
48 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" " K STR
49 . S $P(STR," ",81)="",TAB=26
50 . S STR1="Anthropometric Measurements"
51 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$STRING(STR,STR1,TAB)
52 . K STR S $P(STR," ",81)=""
53 . S TAB=35,STR1="%ile",STR=$$STRING(STR,STR1,TAB)
54 . S TAB=71,STR1="%ile",STR=$$STRING(STR,STR1,TAB)
55 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=$$STRING(STR,STR1,TAB)
56 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
57 . K STR S $P(STR," ",81)="",TAB=4
58 . S STR1="Triceps Skinfold (mm)",STR=$$STRING(STR,STR1,TAB)
59 . I TSF D
60 .. S TAB=31,STR1=$J(+TSF,3,0),STR=$$STRING(STR,STR1,TAB)
61 .. S TAB=36,STR1=$J(TSFP,3),STR=$$STRING(STR,STR1,TAB)
62 .. Q
63 . S TAB=43,STR1="Arm Circumference (cm)"
64 . S STR=$$STRING(STR,STR1,TAB)
65 . I ACIR D
66 .. S TAB=67,STR1=$J(+ACIR,3,0),STR=$$STRING(STR,STR1,TAB)
67 .. S TAB=72,STR1=$J(ACIRP,3),STR=$$STRING(STR,STR1,TAB)
68 .. Q
69 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
70 . K STR S $P(STR," ",81)="",TAB=4,STR1="Subscapular Skinfold (mm)"
71 . S STR=$$STRING(STR,STR1,TAB)
72 . I SCA D
73 .. S TAB=31,STR1=$J(+SCA,3,0),STR=$$STRING(STR,STR1,TAB)
74 .. S TAB=36,STR1=$J(SCAP,3),STR=$$STRING(STR,STR1,TAB)
75 .. Q
76 . S TAB=43,STR1="Bone-free AMA (cm2)"
77 . S STR=$$STRING(STR,STR1,TAB)
78 . I BFAMA D
79 .. S TAB=67,STR1=$J(+BFAMA,3,0),STR=$$STRING(STR,STR1,TAB)
80 .. S TAB=72,STR1=$J(BFAMAP,3),STR=$$STRING(STR,STR1,TAB)
81 .. Q
82 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
83 . K STR S $P(STR," ",81)=""
84 . S TAB=4,STR1="Calf Circumference (cm)",STR=$$STRING(STR,STR1,TAB)
85 . I CCIR>0 D
86 .. S TAB=31,STR1=$J(+CCIR,3,0),STR=$$STRING(STR,STR1,TAB)
87 .. S TAB=36,STR1=$J(CCIRP,3),STR=$$STRING(STR,STR1,TAB)
88 .. Q
89 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
90 . Q
91 ;
92 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
93 K STR S $P(STR," ",81)="",TAB=32,STR1="Laboratory Data"
94 S STR=$$STRING(STR,STR1,TAB)
95 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
96 K STR S $P(STR," ",81)="",TAB=5,STR1="Test",STR=$$STRING(STR,STR1,TAB)
97 S TAB=30,STR1="Result units",STR=$$STRING(STR,STR1,TAB)
98 S TAB=51,STR1="Ref. range",STR=$$STRING(STR,STR1,TAB)
99 S TAB=67,STR1="Date",STR=$$STRING(STR,STR1,TAB)
100 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
101 ;
102 S (I,X3)=0 F S I=$O(FHLAB(I)) Q:I'>0 D LAB^FHWORA(I)
103 I 'X3 D
104 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" ",TAB=5
105 . K STR S $P(STR," ",81)=""
106 . S STR1="No laboratory data available last "_$S($D(^FH(119.9,1,3)):$P(^(3),"^",2),1:90)_" days"
107 . S STR=$$STRING(STR,STR1,TAB),^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
108 . Q
109 ;
110 S N=PRO/6.25,^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" ",TAB=0
111 K STR S $P(STR," ",81)="",STR1="Energy Requirements: "_KCAL_" Kcal/day"
112 S STR=$$STRING(STR,STR1,TAB)
113 I N D
114 . S TAB=50,STR1="Kcal:N "_$J(KCAL/N,0,0)_":1"
115 . S STR=$$STRING(STR,STR1,TAB)
116 . Q
117 I NB'="" D
118 . S TAB=67,STR1="N-Bal: "_NB
119 . S STR=$$STRING(STR,STR1,TAB)
120 . Q
121 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
122 K STR S $P(STR," ",81)="",TAB=0,STR1="Protein Requirements: "_PRO_" gm/day"
123 S STR=$$STRING(STR,STR1,TAB)
124 I N D
125 . S TAB=50,STR1="NPC:N "_$J(KCAL-(PRO*4)/N,0,0)_":1"
126 . S STR=$$STRING(STR,STR1,TAB)
127 . Q
128 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
129 ;
130 S:FLD'="" ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))="Fluid Requirements: "_FLD_" ml/day"
131 ;
132 I FHAPPER]"" D
133 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
134 . K STR S $P(STR," ",81)="",TAB=0,STR1="Appearance: "
135 . S STR=$$STRING(STR,STR1,TAB)
136 . S TAB=20,$E(STR,(TAB+1),(TAB+$L(FHAPPER)))=FHAPPER
137 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
138 . Q
139 I XD D
140 . N Y S Y=$L($P($G(^FH(115.3,XD,0)),"^"))
141 . S Y(0)=$P($G(^FH(115.3,XD,0)),"^")
142 . S TAB=0 K STR S $P(STR," ",81)="",STR1="Nutrition Class: "
143 . S STR=$$STRING(STR,STR1,TAB)
144 . S TAB=20,$E(STR,(TAB+1),(TAB+Y))=Y(0)
145 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
146 . Q
147 I RC D
148 . N Y S Y=$L($P($G(^FH(115.4,RC,0)),"^",2))
149 . S Y(0)=$P($G(^FH(115.4,RC,0)),"^",2)
150 . S TAB=0 K STR S $P(STR," ",81)="",STR1="Nutrition Status: "
151 . S STR=$$STRING(STR,STR1,TAB)
152 . S TAB=20,$E(STR,(TAB+1),(TAB+Y))=Y(0)
153 . S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
154 . Q
155 D COMMENT^FHWORA ; display nutritional assessment comments
156 K STR S STR="" S:SIGN1'="" STR=SIGN1
157 K SIGN1 Q:STR=""
158 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=STR
159 Q
160STRING(STR,STR1,TAB) ; Build our data string
161 S $E(STR,(TAB+1),(TAB+$L(STR1)))=STR1
162 Q STR
Note: See TracBrowser for help on using the repository browser.