Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXNUT1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXNUT1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXNUT1.m
r613 r623 1 ECXNUT1 ;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 4 GETMEALS ;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 176 GETDATES() ;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 194 NEWORDER(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 1 ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 10/27/06 1:53pm 2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30 3 Q 4 ; 5 GETMEALS ;get patient meals 6 ;init variables 7 N DATE,FHDFN,ECXADM,NODE,PRODUCT,ECXQTY,ORDER,ECXORDPH,ECXKEY,P,D 8 N ECXFPD,ECXFDD,ECXFPF,ECXDLT,ECXDFL,NUMBER,PNODE,SF,TF,TFNODE 9 ;S (DATE,FHDFN,NUMBER,ECXQTY)=0,(ECXADM,NODE,ORDER,ECXORDPH)="" 10 ;Get inpatient diets 11 ;S P="INP",D="PD" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 12 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 13 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 14 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"INP")) Q:'NODE 15 ;... S PRODUCT=$P(NODE,U,13),ECXQTY=1,ORDER=""_$P(NODE,U,14)_","_"" 16 ;... S ECXORDPH=$$GET1^DIQ(100,+ORDER,1,"I") 17 ;... ;Resolve feeder key for nutrition product 18 ;... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT) 19 ;... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 20 ;... ;Get additional data and file record. 21 ;... D GET^ECXNUT 22 ;Get inpatient supplemental feedings 23 ;S (FHDFN,DATE)=0,(ECXADM,NODE,ORDER,ECXORDPH)="" 24 ;S P="INP",D="SF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 25 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 26 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 27 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"SF")) Q:'NODE 28 ;... F SF=5:2:27 S PRODUCT=$P(NODE,U,SF) Q:PRODUCT']"" S ECXQTY=1 D 29 ;.... S ORDER=""_$P(NODE,U,7)_","_"" 30 ;.... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I") 31 ;.... ;Resolve external value for product key 32 ;.... S ECXKEY=$$NUTKEY^ECXUTL6("SF",PRODUCT) 33 ;.... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 34 ;.... ;Get additional data and file record. 35 ;.... D GET^ECXNUT 36 ;Get inpatient standing orders 37 ;S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)="" 38 ;S P="INP",D="SO" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 39 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 40 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 41 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"SO")) Q:'NODE 42 ;... S PRODUCT=$P(NODE,U,2),ECXQTY=1 43 ;... ;Resolve external value for product key 44 ;... S ECXKEY=$$NUTKEY^ECXUTL6("SO",PRODUCT) 45 ;... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 46 ;... ;Get additional data and file record. 47 ;... D GET^ECXNUT 48 ;Get inpatient tube feedings 49 ;S (FHDFN,DATE,P)=0,(ECXADM,NODE,ECXORDPH,PNODE)="" 50 ;S P="INP",D="TF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 51 ;. F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 52 ;.. F S ECXADM=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM)) Q:'ECXADM D 53 ;... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF")) Q:'NODE 54 ;... S P=$O(^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF",P)) Q:'P D 55 ;.... S PNODE=^TMP($J,"FH",DATE,FHDFN,ECXADM,"TF",P,"P") 56 ;.... S PRODUCT=$P(PNODE,U,1),ECXQTY=$P(PNODE,U,4) 57 ;.... S ORDER=""_$P(NODE,U,14)_","_"" 58 ;.... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I") 59 ;.... ;Resolve external value for product key 60 ;.... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT) 61 ;.... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 62 ;.... ;Get additional data and file record. 63 ;.... D GET^ECXNUT 64 ;Get outpatient recurring meals 65 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)="" 66 S P="OP",D="RM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 67 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 68 .. S NUMBER=0 F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D 69 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM")) Q:'NODE 70 ... S PRODUCT=$P(NODE,U,2),ECXQTY=1,ORDER=""_$P(NODE,U,12)_","_"" 71 ... S PRODUCT=$$GET1^DIQ(111,PRODUCT,4,"I") 72 ... S ECXORDPH=$$GET1^DIQ(100,ORDER,1,"I") 73 ... ;Resolve external value for product key 74 ... S ECXKEY=$$NUTKEY^ECXUTL6("PD",PRODUCT) 75 ... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 76 ... ;Get additional data and file record. 77 ... D GET^ECXNUT 78 ;Get outpatient tube feedings 79 S (FHDFN,DATE,NUMBER)=0,(ECXADM,NODE,ECXORDPH)="" 80 S P="OP",D="TF" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 81 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 82 .. F S NUMBER=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER)) Q:'NUMBER D 83 ... S NODE=$G(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF")) Q:'NODE 84 ... S TF=$O(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF)) Q:'TF D 85 .... S TFNODE=^TMP($J,"FH",DATE,FHDFN,NUMBER,"RMTF",TF) 86 .... S PRODUCT=$P(TFNODE,U,1),ECXQTY=$P(TFNODE,U,4) 87 .... ;Resolve external value for product key 88 .... S ECXKEY=$$NUTKEY^ECXUTL6("TF",PRODUCT) 89 .... I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 90 .... ;Get additional data and file record. 91 .... D GET^ECXNUT 92 ;Get outpatient special meals 93 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)="" 94 S P="OP",D="SM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 95 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 96 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"SM")) Q:'NODE 97 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1,ECXORDPH=$P(NODE,U,5) 98 .. ;Resolve external value for product key 99 .. S ECXKEY=$$NUTKEY^ECXUTL6("SM",PRODUCT) 100 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 101 .. ;Get additional data and file record. 102 .. D GET^ECXNUT 103 ;Get outpatient guest meals 104 S (FHDFN,DATE)=0,(ECXADM,NODE,ECXORDPH)="" 105 S P="OP",D="GM" F S DATE=$O(^TMP($J,"FH",DATE)) Q:'DATE D 106 . F S FHDFN=$O(^TMP($J,"FH",DATE,FHDFN)) Q:'FHDFN D 107 .. S NODE=$G(^TMP($J,"FH",DATE,FHDFN,"GM")) Q:'NODE 108 .. S PRODUCT=$P(NODE,U,13),ECXQTY=1 109 .. ;Resolve external value for product key 110 .. S ECXKEY=$$NUTKEY^ECXUTL6("GM",PRODUCT) 111 .. I $$NUTLOC^ECXUTL6(P,D,.ECXFPD,.ECXFDD,.ECXFPF,.ECXDLT,.ECXDFL) 112 .. ;Get additional data and file record. 113 .. D GET^ECXNUT 114 Q
Note:
See TracChangeset
for help on using the changeset viewer.
