source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXUTL6.m@ 868

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1ECXUTL6 ;ALB/JRC - Utilities for DSS Extracts ; 11/28/07 11:34am
2 ;;3.0;DSS EXTRACTS;**92,105**;Dec 22, 1997;Build 70
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, 118.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(118.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,CRSVP,OPLOC,MASWARD
31 S (CRSVP,TRSVP)=0,(WARD,DLT,DFL,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 .S CRSVP=$$GET1^DIQ(119.6,WARD,4,"I")
43 .;Get divisions
44 .D GETDIV
45 .Q
46 ;
47 ;Get food production facility for outpatient recurring meal, use
48 ;115.16.2 (outpatient location) which points to file 119.6 (nutrition
49 ;location) field 3 (tray service point) or field 4 (cafeteria service
50 ;point), which points to 119.72 (production facility) field 2.
51 I P["OP",D["RM" D
52 .S OPLOC=""_$P(NODE,U,3)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
53 .D GETDIV
54 .Q
55 ;
56 ;Get food production facility for outpatient tube feeding, use
57 ;115.16.2 (outpatient location) then use 119.6 nutrition location
58 ;which points to 119.72 field 2.
59 I P["OP",D["TF" D
60 .S OPLOC=""_$P(^TMP($J,"FH",DATE,FHDFN,NUMBER,"RM"),U,3)_","_""
61 .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
62 .;Get delivery division
63 .D GETDIV
64 .Q
65 ;
66 ;Get food production facility for special meals, use 115.17.2
67 ;location field 2 which is a pointer to 119.6 (nutrition location)
68 ;which points to 119.72 via field 2 (tray service point) which points
69 ;to file 119.71 (production facility) field 2.
70 I P["OP",D["SM" D
71 .S OPLOC=""_$P(NODE,U,3)_","_""
72 .S TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
73 .;Get delivery division
74 .D GETDIV
75 .Q
76 ;
77 ;Get food production facility for outpatient guest meals, use
78 ;115.18.4 (outpatient location) then use 119.6 nutrition location
79 ;which points to 119.72 (production facility) field 2.
80 I P["OP",D["GM" D
81 .S OPLOC=""_$P(NODE,U,5)_","_"",TRSVP=$$GET1^DIQ(119.6,OPLOC,3,"I")
82 .S FPF=$$GET1^DIQ(119.72,""_TRSVP_","_"",2,"I")
83 .;Get delivery division
84 .D GETDIV
85 .Q
86 ;
87 ;Get delivery location type for patients; with inpatients the type of
88 ;service needs to be pulled from the admission node, with outpatients
89 ;the type of service needs to be pulled from different nodes and use
90 ;field 101 of Nutrition Location file (#119.6). Delivery location
91 ;types only set for the following meals:
92 ; Inpatient with a production diet
93 ; Outpatient with a recurring meal
94 ; Outpatient with a special meal
95 ; Outpatient with a guest meal
96 ; all other meals are null
97 I P="INP",D="PD" D
98 .S DLT=$P($G(NODE),U,8)
99 I P="OP",((D="RM")!(D="SM")) D
100 .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,3)_","_"",101,"E"),1)
101 I P="OP",D="GM" D
102 .S DLT=$E($$GET1^DIQ(119.6,""_$P(NODE,U,5)_","_"",101,"E"),1)
103 ;
104 ;Delivery feeder location
105 I DLT="C" D
106 .S DFL=$E($$GET1^DIQ(119.6,WARD,4,"E"),1,10)
107 .S IEN=$$GET1^DIQ(119.72,+CRSVP,2,"I")
108 .S IEN=""_IEN_";FH(119.71,"
109 .S FPF=$O(^ECX(728.46,"B",IEN,FPF))
110 .S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)
111 I (DLT["T")!(DLT["D") D
112 .I P="INP" D
113 ..S MASWARD=$O(^FH(119.6,+WARD,"W","B",0))
114 ..S DFL=$$GET1^DIQ(42,+MASWARD,44,"I")
115 .I P="OP" D
116 ..S DFL=$O(^FH(119.6,+OPLOC,"L","B",0))
117 I (DLT=""),"SFTFSO"[D D
118 .S DFL=$S(TRSVP:$$GET1^DIQ(119.6,WARD,3,"E"),1:$$GET1^DIQ(119.6,WARD,4,"E"))
119 Q 1
120 ;
121GETDIV ;Get divisions and food production facility
122 ;Init variables
123 N IEN,SIEN
124 S (FDD,FPF,FPD)=""
125 S IEN=$$GET1^DIQ(119.72,+TRSVP,2,"I")
126 Q:'IEN
127 ;Get delivery division
128 S SIEN=""_+TRSVP_";FH(119.72,"
129 S FDD=$O(^ECX(728.46,"B",SIEN,FDD))
130 S FDD=""_$$GET1^DIQ(728.46,FDD,1,"I")_","_""
131 S FDD=$$GET1^DIQ(4,FDD,99,"E")
132 ;Get production division and food production facility
133 S IEN=""_IEN_";FH(119.71,"
134 S FPF=$O(^ECX(728.46,"B",IEN,FPF))
135 S FPD=""_$$GET1^DIQ(728.46,FPF,1,"I")_","_""
136 S FPD=$$GET1^DIQ(4,FPD,99,"E")
137 S FPF=$E($$GET1^DIQ(728.46,FPF,.01,"E"),1,10)
138 Q
139 ;
140SUR(CRST,STCD,CLINIC) ;Surgery stop codes and clinic (outpatients only)
141 ;Init variables
142 S (CRST,STCD,CLINIC)=""
143 ;Quit if not outpatient
144 Q:$P(EC0,U,12)'="O" ""
145 ;Get stop codes (outpatient only)
146 I $P(EC0,U,12)="O" D
147 .;Get credit stop code (outpatient only)
148 .S CRST=""_$$GET1^DIQ(40.7,""_$$GET1^DIQ(44,$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")_","_""_","_"",2503,"I")_","_"",1,"E")
149 .;Get stop code (outpatient only)
150 .S STCD=""_$$GET1^DIQ(40.7,""_$$GET1^DIQ(44,$$GET1^DIQ(137.45,$P(EC0,U,4),2,"I")_","_""_","_"",8,"I")_","_"",1,"E")
151 ;Clinic for non-or case use associated clinic else non-or location
152 ;If non-or case
153 I $P($G(ECNO),U)="Y" S CLINIC=$S($P(EC0,U,21):$P(EC0,U,21),1:$P(ECNO,U,2))
154 ;Get stop codes non-or cases
155 I $P($G(ECNO),U)="Y" D
156 .;Get credit stop code for non-or case
157 .S CRST=$$GET1^DIQ(40.7,$$GET1^DIQ(44,CLINIC,2503,"I"),1,"E")
158 .;Get stop code for non-or case
159 .S STCD=$$GET1^DIQ(40.7,$$GET1^DIQ(44,CLINIC,8,"I"),1,"E")
160 ;Clinic, not a non-or case use surgical specialty associated clinic
161 I $P($G(ECNO),U)'="Y" S CLINIC=$$GET1^DIQ(137.45,+$P(EC0,U,4),2,"I")
162 Q 1
163 ;
164SURPODX(PRODX,PODX1,PODX2,PODX3,PODX4,PODX5) ;Get postop diagnosis codes
165 ;Init variables
166 N CODE,I,PODX
167 S (PRODX,PODX1,PODX2,PODX3,PODX4,PODX5)="",CODE=0
168 ;Check input
169 Q:'$D(DATAOP) 0
170 ;Get principal postop dx code
171 S PRODX=$$GET1^DIQ(80,$P(DATAOP,U,3),.01)
172 ;Get other postop dx codes
173 S (CODE,I)=0 F S CODE=$O(^SRO(136,ECD0,4,CODE)) Q:'CODE Q:I>5 D
174 .S I=I+1,PODX="PODX"_I,@PODX=$$GET1^DIQ(80,$P(^SRO(136,ECD0,4,CODE,0),U),.01)
175 Q 1
Note: See TracBrowser for help on using the repository browser.