source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUTL6.m@ 1123

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

revised back to 6/30/08 version

File size: 4.6 KB
Line 
1ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/2/06 8:30am
2 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
3 ;
4NUTKEY(P,D) ;Generate n&fs feeder key
5 ;Required variables
6 ; p - diet type production diet, standing orders, supplemental
7 ; feedings, or tube feedings.
8 ; d - diet ien from files 116.2, 116.3, 118, or 118.2
9 ;Check input
10 I $G(P)=""!'$G(D) Q ""
11 ;Init variables
12 N PRO,IENS,CODE,DIET
13 S (PRO,IENS,CODE,DIET)=0
14 S PRO=$O(^ECX(728.45,"B",P,PRO))
15 S CODE=D_$S(P="PD":";FH(116.2,",P="SO":";FH(116.3,",P="SF":";FH(118,",P="TF":";FH(118.2,",1:"")
16 S DIET=0,DIET=$O(^ECX(728.45,+PRO,1,"B",CODE,DIET))
17 S IENS=""_DIET_","_PRO_","_""
18 Q $$GET1^DIQ(728.451,IENS,1)
19 ;
20NUTLOC(P,D,FPD,FDD,FPF,DLT,DFL) ;Define nutrition fields
21 ;Required variables
22 ; p - patient status, inpatient or outpatient
23 ;
24 ; d - diet type production diet, standing orders, supplemental
25 ; feedings, or tube feedings.
26 ; Output: food production division, food delivery division, food
27 ; production facility, food delivery type, delivery feeder
28 ; location
29 ;Init variables
30 N WARD,TRSVP,OPLOC,MASWARD
31 S TRSVP=0,(WARD,ECXDLT,ECXDFL,MASWARD)=""
32 S OPLOC=""
33 ;Check input
34 I $G(P)=""!($G(D)="")!'($G(FHDFN)) Q ""
35 ;Get food production facility for inpatient, use 115.1.13 (dietetic
36 ;ward) field which points 119.6 (nutrition location), field 3 (tray
37 ;service point) or field 4 (cafeteria service point), which points to
38 ;119.72 (production facility) field 2.
39 I P="INP" D
40 .S WARD=$P($G(^FHPT(FHDFN,"A",ECXADM,0)),U,8)
41 .S TRSVP=$$GET1^DIQ(119.6,WARD,3,"I")
42 .;Get divisions
43 .D GETDIV
44 .Q
45 ;
46 ;Get food production facility for outpatient recurring meal, use
47 ;115.16.2 (outpatient location) which points to file 119.6 (nutrition
48 ;location) field 3 (tray service point) or field 4 (cafeteria service
49 ;point), which points to 119.72 (production facility) field 2.
50 I P["OP",D["RM" D
51 .S OPLOC=""_$P(NODE,U,3)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
52 .D GETDIV
53 .Q
54 ;
55 ;Get food production facility for outpatient tube feeding, use
56 ;115.16.2 (outpatient location) then use 119.6 nutrition location
57 ;which points to 119.72 field 2.
58 I P["OP",D["TF" D
59 .S OPLOC=""_$P(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM"),U,3)_","_""
60 .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
61 .;Get delivery division
62 .D GETDIV
63 .Q
64 ;
65 ;Get food production facility for special meals, use 115.17.2
66 ;location field 2 which is a pointer to 119.6 (nutrition location)
67 ;which points to 119.72 via field 2 (tray service point) which points
68 ;to file 119.71 (production facility) field 2.
69 I P["OP",D["SM" D
70 .S OPLOC=""_$P(NODE,U,3)_","_""
71 .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
72 .;Get delivery division
73 .D GETDIV
74 .Q
75 ;
76 ;Get food production facility for outpatient guest meals, use
77 ;115.18.4 (outpatient location) then use 119.6 nutrition location
78 ;which points to 119.72 (production facility) field 2.
79 I P["OP",D["GM" D
80 .S OPLOC=""_$P(NODE,U,5)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
81 .S ECXFPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I")
82 .;Get delivery division
83 .D GETDIV
84 .Q
85 ;
86 ;Get delivery location type for patients; with inpatients the type of
87 ;service needs to be pulled from the admission node, with outpatients
88 ;the type of service needs to be pulled from different nodes and use
89 ;field 101 of Nutrition Location file (#119.6). Delivery location
90 ;types only set for the following meals:
91 ; Inpatient with a production diet
92 ; Outpatient with a recurring meal
93 ; Outpatient with a special meal
94 ; Outpatient with a guest meal
95 ; all other meals are null
96 I P="INP",D="PD" D
97 .S ECXDLT=$P($G(NODE),U,8)
98 I P="OP",((D="RM")!(D="SM")) D
99 .S ECXDLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1)
100 I P="OP",D="GM" D
101 .S ECXDLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1)
102 ;
103 ;Delivery feeder location
104 I ECXDLT="C" S ECXDFL=$P(NODE,U,8) D
105 .S ECXDFL=$E($$GET1^DIQ(119.72,ECXDFL,2,"E"),1,10)
106 I (ECXDLT["T")!(ECXDLT["D") D
107 .S MASWARD=$O(^FH(119.6,$S(WARD:+WARD,+OPLOC:+OPLOC,1:""),"W","B",0))
108 .S ECXDFL=$$GET1^DIQ(42,+MASWARD,44,"I")
109 Q 1
110 ;
111GETDIV ;Get divisions and food production facility
112 ;Init variables
113 N IEN,SIEN
114 S (ECXFDD,ECXFPF,ECXFPD)=""
115 S IEN=$$GET1^DIQ(119.72,+TRSVP,2,"I")
116 Q:'IEN
117 ;Get delivery division
118 S SIEN=""_+TRSVP_";FH(119.72,"
119 S ECXFDD=$O(^ECX(728.46,"B",SIEN,ECXFDD))
120 S ECXFDD=""_$$GET1^DIQ(728.46,ECXFDD,1,"I")_","_""
121 S ECXFDD=$$GET1^DIQ(4,ECXFDD,99,"E")
122 ;Get production division and food production facility
123 S IEN=""_IEN_";FH(119.71,"
124 S ECXFPF=$O(^ECX(728.46,"B",IEN,ECXFPF))
125 S ECXFPD=""_$$GET1^DIQ(728.46,ECXFPF,1,"I")_","_""
126 S ECXFPD=$$GET1^DIQ(4,ECXFPD,99,"E")
127 S ECXFPF=$E($$GET1^DIQ(728.46,ECXFPF,.01,"E"),1,10)
128 Q
Note: See TracBrowser for help on using the repository browser.