source: FOIAVistA/tag/r/DIETETICS-FH/FHASMR2.m@ 1679

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1FHASMR2 ;HISC/RVD - Progress Notes To TIU ;04/27/07 06:59
2 ;;5.5;DIETETICS;**8**;Apr 27, 2007;Build 28
3 ;input var: fhdfn,na ien (var ASN),dfn
4 ;only process inpatient assessment.
5 ;uses DBIA #1911
6EN ; save note to a temp global
7 K ^TMP("TIUP",$J)
8 D NOW^%DTC S NOW=% K % S FHN=1
9 S ($P(LN5," ",5),$P(LN10," ",10),$P(LN20," ",20),$P(LN25," ",25),$P(LN30," ",30))=""
10 S ($P(LN35," ",35),$P(LN40," ",40),$P(LN45," ",45),$P(LN50," ",45),$P(LN55," ",55),$P(LN60," ",60))=""
11 S ($P(LN65," ",65))=""
12 S ^TMP("TIUP",$J,FHN,0)=NAM_LN10_$S(SEX="M":"Male",1:"Female")_LN10_"Age: "_AGE
13 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
14 S DTP=ADT D DTP^FH S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN25_"Date of Assessment: "_$E(DTP,1,9)
15 S (FHRDIPLD,FHRDIST,FHRDIPL,FHRDINFD,FHRDINA,FHRDINFD,FHRDINF,FHREDU,FHRDIDI,FHRDITF,FHRDITFM,FHRDITFK,FHRDITFC,FHRNWGT,FHRDNWGT,FHRFUD,FHRFEC,FHRFPC,FHRFDC)="" D DIA
16EN1 S DTP="" I FHRDIPLD S DTP=FHRDIPLD D DTP^FH
17 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Diagnosis: "_$E(FHRDIPL,1,30)
18 S DTP="" I FHRDINFD S DTP=FHRDINFD D DTP^FH
19 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Problem: "_$E(FHRDINA,1,30)
20 S DTP="" I FHRDINFD S DTP=FHRDINFD D DTP^FH
21 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Additional Problem: "_$E(FHRDINF,1,30)
22 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
23 S FHN=FHN+1
24 S ^TMP("TIUP",$J,FHN,0)="Current Diet: "_$E(FHRDIDI,1,53)
25 I FHRDITF'="" D
26 .S DTP=FHRDITF D DTP^FH
27 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Tubefeed Ordered: "_DTP
28 .I ASN I $D(^FHPT(FHDFN,"N",ASN,"TF")) F FHTUN=0:0 S FHTUN=$O(^FHPT(FHDFN,"N",ASN,"TF",FHTUN)) Q:FHTUN'>0 D
29 ..S FHASTFZN=$G(^FHPT(FHDFN,"N",ASN,"TF",FHTUN,0))
30 ..S TNM=$P(FHASTFZN,U,1),STR=$P(FHASTFZN,U,2),QUA=$P(FHASTFZN,U,3)
31 ..S FHTFPROD=$P($G(^FH(118.2,TNM,0)),"^",1)_", "_$S(STR=4:"Full",STR=1:"1/4",STR=2:"1/2",1:"3/4")_" Str., "_QUA
32 ..S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=" "_FHTFPROD
33 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Total Quantity: "_FHRDITFM_"ml"_LN5_"Total KCAL: "_FHRDITFK
34 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Tubefeed Comment: "_FHRDITFC
35 K FHRDIPL,FHRDIPLD,FHRDINF,FHRDINFD,FHRDIDI,FHTFPROD,FHRDITF,FHRDITFM,FHRDITFK,FHRDITFC,DTP
36 S X1=$S(HGT\12:HGT\12_"'",1:"")_$S(HGT#12:" "_(HGT#12)_"""",1:""),X2=+$J(HGT*2.54,0,0)_" cm"
37 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="",FHN=FHN+1
38 S ^TMP("TIUP",$J,FHN,0)="Height: "_$S(FHU'="M":X1,1:X2)_" ("_$S(FHU'="M":X2,1:X1)_")" I HGP'="" S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_" "_$S(HGP="K":"knee hgt",HGP="S":"stated",1:"")
39 S X1=WGT_" lbs",X2=+$J(WGT/2.2,0,1)_" kg"
40 S FHN=FHN+1
41 S ^TMP("TIUP",$J,FHN,0)="Weight: "_$S(FHU'="M":X1,1:X2)_" ("_$S(FHU'="M":X2,1:X1)_")" I WGP'="" S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_" "_$S(WGP="A":"anthro",WGP="S":"stated",1:"")
42 S DTP=DWGT D DTP^FH
43 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_LN5_" Weight Taken: "_DTP
44 S X1=FHRNWGT_" lbs",X2=+$J(FHRNWGT/2.2,0,1)_" kg"
45 K FHRNWGT,FHRDNWGT
46 I UWGT S X1=UWGT_" lbs",X2=+$J(UWGT/2.2,0,1)_" kg"
47 S FHN=FHN+1
48 S ^TMP("TIUP",$J,FHN,0)="Usual Weight: "
49 I UWGT S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$S(FHU'="M":X1,1:X2)_" ("_$S(FHU'="M":X2,1:X1)_")"
50 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_LN5_"% Usual Wt: "
51 I UWGT S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$J(WGT/UWGT*100,3,0)_"%"
52 S X1=IBW_" lbs",X2=+$J(IBW/2.2,0,1)_" kg"
53 S FHN=FHN+1
54 S ^TMP("TIUP",$J,FHN,0)="Target Weight: "_$S(FHU'="M":X1,1:X2)_" ("_$S(FHU'="M":X2,1:X1)_") % Target Wt: "
55 I IBW S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$J(WGT/IBW*100,3,0)_"%"
56 I AMP S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Target weight adjusted for amputation"
57 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Frame Size: "_$S(FRM="S":"Small",FRM="M":"Medium",FRM="L":"Large",1:"")
58 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_LN10_" Body Mass Index: "_BMI
59 S EXT="" I $G(TSF)!$G(SCA)!$G(ACIR)!$G(CCIR) S EXT="Y"
60 G:EXT'="Y" EN2 ;there is no antthropometric measurement.
61 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="",FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
62 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN25_"Anthropometric Measurements"
63 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN35_"%ile %ile"
64 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Triceps Skinfold (mm) "_$J(+TSF,3,0)_" "_$J(TSFP,3)_LN5_"Arm Circumference (cm) "
65 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$J(+ACIR,3,0)_" "_$J(ACIRP,3)
66 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Subscapular Skinfold (mm) "
67 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$J(+SCA,3,0)_" "_$J(SCAP,3)_" Bone-free AMA (cm2) "
68 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$J(+BFAMA,3,0)_" "_$J(BFAMAP,3)
69 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Calf Circumference (cm) "
70 S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_$J(+CCIR,3,0)_" "_$J(CCIRP,3)
71EN2 ;skip here if there is no anthropometric measurement.
72 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
73 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN30_"Laboratory Data"
74 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Test"_LN20_"Result units"_LN10_"Ref. range"_LN10_"Date"
75 S N1=0 F K=0:0 S K=$O(LRTST(K)) Q:K="" D LAB
76 I 'N1 D
77 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
78 .S FHN=FHN+1,^TMP("TIYP",$J,FHN,0)=LN5_"No laboratory data available last "_$S($D(^FH(119.9,1,3)):$P(^(3),"^",2),1:90)_" days"
79 S N=PRO/6.25
80DRU ;pharmacy data.
81 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
82 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
83 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Medications"
84 S PX=1 D DRUG^FHASM4
85 I $D(PSCA) D
86 .F FHI=0:0 S FHI=$O(PSCA(FHI)) Q:FHI'>0 S FHJ="" F S FHJ=$O(PSCA(FHI,FHJ)) Q:FHJ="" D
87 ..S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
88 ..S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_FHJ
89 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
90 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Educated on Food/Drug Interactions: "_$S(FHREDU="Y":"Yes",1:"No") K FHREDU
91 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="FOOD/DRUG COMMENT: "_FHRFDC
92 K FHI,FHJ,PSD,PSCA
93 ;
94 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
95 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Energy Requirements: "_KCAL_" Kcal/day"
96 I N S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_" Kcal:N "_$J(KCAL/N,0,0)_":1"
97 I NB'="" S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_" N-Bal: "_NB
98 I FHRFEC'="" D
99 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Energy calculation is based on: "_FHRFEC
100 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Protein Requirements: "_PRO_" gm/day"
101 I N S ^TMP("TIUP",$J,FHN,0)=^TMP("TIUP",$J,FHN,0)_" NPC:N "_$J(KCAL-(PRO*4)/N,0,0)_":1"
102 I FHRFPC'="" D
103 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN5_"Protein calculation is based on: "_FHRFPC
104 K FHRFEC,FHRFPC
105 I FLD'="" D
106 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Fluid Requirements: "_FLD_" ml/day"
107 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
108 I FHAPP'="" D
109 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Appearance: "_FHAPP
110 I XD D
111 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Nutrition Class: "_$P($G(^FH(115.3,XD,0)),"^",1)
112 I RC D
113 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Nutrition Status: "_$P($G(^FH(115.4,RC,0)),"^",2)
114 D DCOM
115 Q
116DIA ;get data from DI node.
117 I ASN S FHDIA=$G(^FHPT(FHDFN,"N",ASN,"DI")) Q:FHDIA="" D
118 .S FHRDIPL=$P(FHDIA,U,1)
119 .S FHRDIPLD=$P(FHDIA,U,2)
120 .S FHRDINF=$P(FHDIA,U,3)
121 .S FHRDINFD=$P(FHDIA,U,4)
122 .S FHRFUD=$P(FHDIA,U,5)
123 .S FHRDIST=$P(FHDIA,U,6)
124 .S FHRDIDI=$P(FHDIA,U,7)
125 .S FHRDITF=$P(FHDIA,U,8)
126 .S FHRDITFM=$P(FHDIA,U,10)
127 .S FHRDITFK=$P(FHDIA,U,11)
128 .S FHRDITFC=$P($G(^FHPT(FHDFN,"N",ASN,4)),U,1)
129 .S FHRFEC=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,2)
130 .S FHRFPC=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,3)
131 .S FHRDINA=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,4)
132 .S FHREDU=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,5)
133 .S FHRFDC=$P($G(^FHPT(FHDFN,"N",ASN,3)),U,6)
134 Q
135DCOM ;print follow up date and status and comments
136 S DTP="" I FHRFUD S DTP=FHRFUD D DTP^FH
137 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
138 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Follow-up Date: "_DTP
139 K FHRFUD,FHRDIST
140 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
141 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="Comments:"
142 I ASN F K=0:0 S K=$O(^FHPT(FHDFN,"N",ASN,"X",K)) Q:K<1 D
143 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=^FHPT(FHDFN,"N",ASN,"X",K,0)
144 S SIGN=$P(^FHPT(FHDFN,"N",ASN,0),U,23)
145 S FHRDT=DT,FHIFN="",FHESBY=FHCLI
146 ;Use data from user selection from file 8925.1
147 K DIC,DA W !!,"Enter a Progress Note Title for this Assessment!!",!
148 S DIC=8925.1,DIC(0)="AEQMZ",DIC("S")="I ($P($G(^TIU(8925.1,+Y,0)),U,7)'=13),($P(^(0),U,1)[""NUTRITION""),($P(^(0),U,4)=""DOC"")" D ^DIC
149 K DIC I X["^"!$D(DTOUT)!(Y<1) S FHOUT=1 Q
150 S FHIEN1=+Y
151 ;call TIU to create a progress notes; DBIA #1911
152 ;D NEW^TIUPNAPI(.FHIFN,DFN,DUZ,FHRDT,FHIEN1,"","","",FHESBY,"","")
153 D NEW^TIUPNAPI(.FHIFN,DFN,DUZ,FHRDT,FHIEN1,"","","","","","")
154 I $P(FHIFN,U,1)'>0 S FHOUT=1
155 K FHIFN,FHRDT,FHTITLE,FHESBY,FHTIUST,FH251,FHIEN1
156 ;done
157 Q
158Q6 D FOOT Q
159LAB S X1=$P(LRTST(K),"^",7) Q:X1="" S DTP=X1\1 D DTP^FH
160 I 'N1 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)="" S N1=N1+1
161 S FHLABTE=$P(LRTST(K),U,1)_" "
162 S FHLABRE=$P(LRTST(K),U,6)_" "
163 S FHLABUN=$P(LRTST(K),U,4)_" "
164 S FHLABRR=$P(LRTST(K),U,5)_" "
165 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=$E(FHLABTE,1,20)_" "_$E(FHLABRE,1,9)_" "_$E(FHLABUN,1,14)_" "_$E(FHLABRR,1,21)_" "_DTP
166 Q
167HEAD ; Page Header
168 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN
169 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=DTP_LN30_"NUTRITION ASSESSMENT"
170 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN
171 Q
172FOOT ; Page Footer
173 D SITE^FH
174 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
175 I $G(DFN) S W1=$G(^DPT(DFN,.1)) S:$D(^DPT(DFN,.101)) W1=W1_"/"_^DPT(DFN,.101) I W1'="" D
176 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
177 .S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN30_W1_LN5_"(Vice SF 509)"
178 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
179 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=LN
180 S FHN=FHN+1,^TMP("TIUP",$J,FHN,0)=""
181 Q
Note: See TracBrowser for help on using the repository browser.