source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXNUT1.m@ 619

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

initial load of WorldVistAEHR
File size: 9.6 KB
RevLine 
[613]1ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 11/23/07 12:27pm
2 ;;3.0;DSS EXTRACTS;**92,107,105**;Dec 22, 1997;Build 70
3 Q
4GETMEALS ;get patient meals
5 ; variable names: ordate - regular diet order date
6 ; sdate - diet order npo/withhold date
7 ; norder - "sf" or "so" order date
8 ; note: there is a relationship
9 ; between "sf", "so" and regular diets
10 ; adate - admission date
11 ; ddate - discharge date
12 N I,J,P,D,ECXADM,FHDFN,ORDATE,DATES,NODE,SF,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,MEAL,MEALS,SORDATE,NUMBER,TF,TFNODE,ECXTFU,SDATE
13 ;set ecsd to first day of the month before setting meals array
14 S ECSD=ECSD+.1,ECXTFU=""
15 ;setup individual meals array for inpatients
16 F I=ECSD:1:ECED F J=I+.0800,I+.1300,I+.1800 S MEALS(J)=J
17 ;get "inp", "sf", and "so" inpatient meals
18 S ECXADM=0 F S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM D
19 .S FHDFN=0 F S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN D
20 ..S ORDATE=0,(ADATE,DDATE,SDATE)=""
21 ..F S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE D
22 ...Q:$P($G(^TMP($J,"FH",ECXADM,FHDFN,+ORDATE,"INP")),U,7)'=""
23 ...S DATES=$$GETDATES(),SDATE=ORDATE
24 ...;create regular diet individual meals
25 ...S P="INP",D="PD"
26 ...;get new order date and time if exist
27 ...S NORDER=$$NEWORDER(D,ORDATE)
28 ...S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,ORDATE,"INP")) Q:'NODE
29 ...S PRODUCT=$P(NODE,U,13),ECXQTY=1,ORDER=""_$P(NODE,U,14)_","_""
30 ...;Resolve feeder key for nutrition product
31 ...S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)
32 ...I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
33 ...S MEAL=ORDATE F S MEAL=$O(MEALS(MEAL)) Q:'MEAL D
34 ....I $P(DATES,U) Q:MEAL>$P(DATES,U)
35 ....I NORDER]"" Q:MEAL>NORDER
36 ....I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3)
37 ....S ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I")
38 ....;Get additional data and file record.
39 ....S DATE=MEAL D GET^ECXNUT
40 ;create supplemental feeding meals if they exist
41 S ECXADM=0 F S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM D
42 .S FHDFN=0 F S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN D
43 ..S ORDATE=0,(ADATE,DDATE,SDATE)=""
44 ..F S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE D
45 ...S DATES=$$GETDATES()
46 ...;get "sf" orders if they exist
47 ...N SFNODE S (SFNODE,ECXORDPH,CDATE)=""
48 ...S SFNODE=$G(@ARRAY@(ECXADM,FHDFN,ORDATE,"SF"))
49 ...I +SFNODE D
50 ....S P="INP",D="SF"
51 ....;get new order date and time if exist
52 ....S NORDER=$$NEWORDER(D,ORDATE),CDATE=$P(SFNODE,U,32)
53 ....;order thru all "sf" product fields and generate records
54 ....F SF=5:2:27 S PRODUCT=$P(SFNODE,U,SF) S ECXQTY=$P(SFNODE,U,(SF+1)) D
55 .....Q:PRODUCT']""
56 .....;Resolve external value for product key
57 .....S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT)
58 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
59 .....;create individual meals
60 .....F MEAL=ECSD:1:ECED D
61 ......I CDATE]"" Q:MEAL>CDATE
62 ......I NORDER]"" Q:MEAL>NORDER
63 ......I $P(DATES,U,3)]"" Q:MEAL>$P(DATES,U,3)
64 ......;Get additional data and file record.
65 ......S DATE=$P(MEAL,".")_"."_$S("57911"[SF:10,"13151719"[SF:14,1:18)
66 ......D GET^ECXNUT
67 ;create standing order meals if they exist
68 S ECXADM=0 F S ECXADM=$O(@ARRAY@(ECXADM)) Q:'ECXADM D
69 .S FHDFN=0 F S FHDFN=$O(@ARRAY@(ECXADM,FHDFN)) Q:'FHDFN D
70 ..S ORDATE=0,(ADATE,DDATE,SDATE)=""
71 ..F S ORDATE=$O(@ARRAY@(ECXADM,FHDFN,ORDATE)) Q:'ORDATE D
72 ...S DATES=$$GETDATES()
73 ...N SONODE,NUM S (SONODE,ECXORDPH)="",NUM=0
74 ...S NUM=$O(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM)) Q:'NUM D
75 ....S SONODE=$G(@ARRAY@(ECXADM,FHDFN,ORDATE,"SO",NUM))
76 ....I +SONODE D
77 .....;create standing order meals
78 .....N SMEAL S P="INP",D="SO"
79 .....;get new order date and time if exist
80 .....S NORDER=$$NEWORDER(D,ORDATE),SMEAL=$P(SONODE,U,3)
81 .....S PRODUCT=$P(SONODE,U,2),ECXQTY=$P(SONODE,U,8)
82 .....;Resolve feeder key for nutrition product
83 .....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)
84 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
85 .....;create individual meals
86 .....S MEAL=ORDATE F S MEAL=$O(MEALS(MEAL)) Q:'MEAL D
87 ......N TIME S TIME=$P(MEALS(MEAL),".",2)
88 ......Q:SMEAL'["B"&(TIME=08)
89 ......Q:SMEAL'["N"&(TIME=13)
90 ......Q:SMEAL'["E"&(TIME=18)
91 ......I $P(DATES,U) Q:MEAL>$P(DATES,U)
92 ......I NORDER]"" Q:MEAL>NORDER
93 ......I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3)
94 ......;Get additional data and file record.
95 ......S DATE=MEAL D GET^ECXNUT
96 ;remove individual meals array
97 K MEALS
98 ;Get inpatient tube feedings
99 N P1,PNODE,CDATE,ECXTFU,MEALS
100 ;set daily meals array for inpatient tube feedings
101 F I=ECSD:1:ECED S MEALS(I)=""
102 S (FHDFN,DATE,P1,CDATE)=0,(ECXADM,NODE,ECXORDPH,PNODE)=""
103 S P="INP",D="TF" F S ECXADM=$O(^TMP($J,"FH",ECXADM)) Q:'ECXADM D
104 .F S FHDFN=$O(^TMP($J,"FH",ECXADM,FHDFN)) Q:'FHDFN D
105 ..F S DATE=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE)) Q:'DATE D
106 ...S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF")) Q:'NODE D
107 ....F S P1=$O(^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF",P1)) Q:'P1 D
108 .....S PNODE=^TMP($J,"FH",ECXADM,FHDFN,DATE,"TF",P1,"P")
109 .....S ORDATE=DATE,DATES=$$GETDATES(),CDATE=$P(NODE,U,11)
110 .....S PRODUCT=$P(PNODE,U,1),ORDER=""_$P(NODE,U,14)_","_""
111 .....S ECXQTY=$S($P(PNODE,U,3)["GM":$P(PNODE,U,3),1:$P(PNODE,U,4))
112 .....S ECXTFU=$S($P(PNODE,U,3)["GM":"GM",1:"ML")
113 .....;Resolve external value for product key
114 .....S ECXKEY=$$NUTKEY^ECXUTL6(D,PRODUCT)
115 .....I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
116 .....;create daily meals
117 .....S MEAL=DATE F S MEAL=$O(MEALS(MEAL)) Q:'MEAL D
118 ......I $P(DATES,U) Q:MEAL>$P(DATES,U)
119 ......I CDATE]"" Q:MEAL>CDATE
120 ......I $P(DATES,U,3) Q:MEAL>$P(DATES,U,3)
121 ......S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")
122 ......;Get additional data and file record.
123 ......S DATE=MEAL D GET^ECXNUT S DATE=ORDATE
124 ;Get outpatient recurring meals
125 S DATE=0,(ECXADM,NODE,ECXORDPH,ECXTFU)=""
126 S P="OP",D="RM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D
127 . S FHDFN=0 F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D
128 .. S NUMBER=0 F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D
129 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM")) Q:'NODE
130 ... S PRODUCT=$P(NODE,U,2),ECXQTY=1,ORDER=""_$P(NODE,U,12)_","_""
131 ... S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")
132 ... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I")
133 ... ;Resolve external value for product key
134 ... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT)
135 ... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
136 ... ;Get additional data and file record.
137 ... D GET^ECXNUT
138 ;Get outpatient tube feedings
139 S DATE=0,(ECXADM,NODE,ECXORDPH)=""
140 S P="OP",D="TF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D
141 . S FHDFN=0 F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D
142 .. S NUMBER=0 F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D
143 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF")) Q:NODE=""
144 ... S TF=0 F S TF=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)) Q:'TF D
145 .... S TFNODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)
146 .... S PRODUCT=$P(TFNODE,U,1),ECXQTY=$P(TFNODE,U,4)
147 .... ;Resolve external value for product key
148 .... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT)
149 .... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
150 .... ;Get additional data and file record.
151 .... D GET^ECXNUT
152 ;Get outpatient special meals
153 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""
154 S P="OP",D="SM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D
155 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D
156 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"SM")) Q:'NODE
157 .. S PRODUCT=$P(NODE,U,4),ECXQTY=1,ECXORDPH=$P(NODE,U,5)
158 .. S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I")
159 .. ;Resolve external value for product key
160 .. S ECXKEY=$$NUTKEY^ECXUTL6("SM",PRODUCT)
161 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
162 .. ;Get additional data and file record.
163 .. D GET^ECXNUT
164 ;Get outpatient guest meals
165 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)=""
166 S P="OP",D="GM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D
167 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D
168 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"GM")) Q:'NODE
169 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1
170 .. ;Resolve external value for product key
171 .. S ECXKEY=$$NUTKEY^ECXUTL6("GM",PRODUCT)
172 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL)
173 .. ;Get additional data and file record.
174 .. D GET^ECXNUT
175 Q
176GETDATES() ;Get admit, discharge, npo/withhold dates,for "inp", "sf" and "so"
177 ; return in string i.e. stop date^admission date^discharge date
178 ; input: ecxadm - movement file ien
179 ; fhdfn - nutrition patient file (#115)
180 ;
181 ; output: stop date - npo/withhold date
182 ; admit date - admission date and time
183 ; discharge date - discharge date and time
184 ;init variables
185 N ADATE,DDATE,DATE,STDATE,NORDATE,IENS
186 ;check input
187 Q:'$G(ECXADM)!'$G(FHDFN) "0^0^0"
188 ;get admission and discharge dates
189 S (ADATE,DDATE,DATE,SDATE,NORDATE,STDATE)="",IENS=""_ECXADM_","_FHDFN_","_"",ADATE=$$GET1^DIQ(115.01,IENS,.01,"I"),DDATE=$$GET1^DIQ(115.01,IENS,18,"I")
190 ;get "inp" order's npo/withhold date return it as 'stdate' if exist
191 S DATE=ORDATE F S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE D
192 .I $P($G(@ARRAY@(ECXADM,FHDFN,+DATE,"INP")),U,7)'="" S STDATE=DATE
193 Q STDATE_U_ADATE_U_DDATE
194NEWORDER(TYPE,DATE) ;Look for new order for inpatient meal type if exist
195 ; Input ecxadm - movement #
196 ; fhdfn - nutrition file (#115) fhdfn
197 ; date - starting order date to begin lookup
198 ; type - meal type "sf", "so", or "pd"
199 ; Output: new order date and time for specific meal type
200 ;init variables
201 N NORDER
202 S NORDER=""
203 ;check input
204 Q:$G(TYPE)']""!'$G(DATE) NORDER
205 F S DATE=$O(@ARRAY@(ECXADM,FHDFN,DATE)) Q:'DATE Q:NORDER D
206 .S NODE=$G(^TMP($J,"FH",ECXADM,FHDFN,DATE,TYPE)) Q:'NODE
207 .S NORDER=DATE
208 Q NORDER
Note: See TracBrowser for help on using the repository browser.