source: FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXNUT1.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 5.4 KB
Line 
1ECXNUT1 ;ALB/JRC Nutrition DSS Extract ; 10/27/06 1:53pm
2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
3 Q
4 ;
5GETMEALS ;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 TracBrowser for help on using the repository browser.