source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS51.m@ 1306

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

initial load of WorldVistAEHR
File size: 9.2 KB
Line 
1PSS51 ;BIR/LDT - API FOR INFORMATION FROM FILE 51; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4ALL(PSSIEN,PSSFT,LIST) ;
5 ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
6 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
8 ;Field Number of the data piece being returned.
9 ;Returns NAME field (#.01), SYNONYM field (#.05), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1),
10 ;MED ROUTE field (#2), SCHEDULE field (#3), INSTRUCTIONS field (#4), ADDITIONAL INSTRUCTION field (#5),
11 ;PLURAL field (#9), DEFAULT ADMIN TIMES field (#10), INTENDED USE field (#30), and FREQUENCY (IN MINUTES)
12 ;field (#31) of MEDICATION INSTRUCTION file (#51).
13 N DIERR,ZZERR,PSS51,PSS
14 I $G(LIST)']"" Q
15 K ^TMP($J,LIST)
16 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
17 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
18 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") D
19 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
20 .S ^TMP($J,LIST,0)=1
21 .D GETS^DIQ(51,+PSSIEN2,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
22 .F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO
23 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
24 .I PSSFT["??" D LOOP(1) Q
25 .D FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
26 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
27 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
28 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
29 ..F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO
30 K ^TMP("DILIST",$J)
31 Q
32 ;
33WARD(PSSIEN,PSSFT,LIST) ;
34 ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
35 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
36 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
37 ;Field Number of the data piece being returned.
38 ;Returns NAME field (#.01), WARD field (#.01), and DEFAULT ADMIN TIMES field (#.02) of WARD multiple (#51.01)
39 ;of MEDICATION INSTRUCTION file (#51).
40 N DIERR,ZZERR,PSS51,PSS,CNT
41 I $G(LIST)']"" Q
42 K ^TMP($J,LIST)
43 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
44 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
45 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") D
46 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
47 .S ^TMP($J,LIST,0)=1
48 .D GETS^DIQ(51,+PSSIEN2,".01;20*","IE","PSS51") S PSS(1)=0
49 .F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETWARD1 S PSS(2)=0,CNT=0 D
50 ..F S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2) D SETWARD2 S CNT=CNT+1
51 ..S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
52 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
53 .I PSSFT["??" D LOOP(2) Q
54 .D FIND^DIC(51,,"@;.01","QP",PSSFT,,"B",,,"")
55 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
56 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
57 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS51 D GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51") S PSS(1)=0
58 ..F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETWARD1 S PSS(2)=0,CNT=0 D
59 ...F S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2) D SETWARD2 S CNT=CNT+1
60 ...S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
61 K ^TMP("DILIST",$J)
62 Q
63 ;
64LOOKUP(PSSIEN,PSSFT,LIST) ;
65 ;PSSIEN - IEN of entry in MEDICATION INSTRUCTION file (#51).
66 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
67 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
68 ;Field Number of the data piece being returned.
69 ;Returns NAME field (#.01), and EXPANSION field (#1) of MEDICATION INSTRUCTION file (#51).
70 N DIERR,ZZERR,PSS51,PSS
71 I $G(LIST)']"" Q
72 K ^TMP($J,LIST)
73 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
74 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
75 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51,"","A","`"_PSSIEN,,,"") D
76 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
77 .S ^TMP($J,LIST,0)=1
78 .D GETS^DIQ(51,+PSSIEN2,".01;1","IE","PSS51") S PSS(1)=0
79 .F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO2
80 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
81 .I PSSFT["??" D LOOP(3) Q
82 .D FIND^DIC(51,,"@;.01;1","QP",PSSFT,,"B",,,"")
83 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
84 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
85 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51") S PSS(1)=0
86 ..F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO2
87 K ^TMP("DILIST",$J)
88 Q
89 ;
90CHK(PSSFT,LIST) ;
91 ;PSSFT - Free Text name in MEDICATION INSTRUCTION file (#51).
92 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
93 ;Field Number of the data piece being returned.
94 ;Returns NAME field (#.01) of MEDICATION INSTRUCTION file (#51).
95 N DIERR,ZZERR,PSS51,SCR,PSS
96 I $G(LIST)']"" Q
97 K ^TMP($J,LIST)
98 I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
99 S SCR("S")="I $P($G(^PS(51,+Y,0)),""^"",4)<2"
100 I PSSFT["??" D LOOP(4) Q
101 D FIND^DIC(51,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
102 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
103 I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
104 .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS51 D GETS^DIQ(51,+PSSIEN,".01","IE","PSS51") S PSS(1)=0
105 .F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D
106 ..S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
107 ..S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
108 Q
109 ;
110SETZRO ;
111 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
112 S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
113 S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51(51,PSS(1),1,"I"))
114 S ^TMP($J,LIST,+PSS(1),.5)=$G(PSS51(51,PSS(1),.5,"I"))
115 S ^TMP($J,LIST,+PSS(1),30)=$S($G(PSS51(51,PSS(1),30,"I"))="":"",1:PSS51(51,PSS(1),30,"I")_"^"_PSS51(51,PSS(1),30,"E"))
116 S ^TMP($J,LIST,+PSS(1),2)=$S($G(PSS51(51,PSS(1),2,"I"))="":"",1:PSS51(51,PSS(1),2,"I")_"^"_PSS51(51,PSS(1),2,"E"))
117 S ^TMP($J,LIST,+PSS(1),3)=$G(PSS51(51,PSS(1),3,"I"))
118 S ^TMP($J,LIST,+PSS(1),4)=$G(PSS51(51,PSS(1),4,"I"))
119 S ^TMP($J,LIST,+PSS(1),31)=$G(PSS51(51,PSS(1),31,"I"))
120 S ^TMP($J,LIST,+PSS(1),5)=$G(PSS51(51,PSS(1),5,"I"))
121 S ^TMP($J,LIST,+PSS(1),1.1)=$G(PSS51(51,PSS(1),1.1,"I"))
122 S ^TMP($J,LIST,+PSS(1),10)=$G(PSS51(51,PSS(1),10,"I"))
123 S ^TMP($J,LIST,+PSS(1),9)=$G(PSS51(51,PSS(1),9,"I"))
124 Q
125 ;
126SETWARD1 ;
127 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
128 S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
129 Q
130 ;
131SETWARD2 ;
132 S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.01)=$S($G(PSS51(51.01,PSS(2),.01,"I"))="":"",1:PSS51(51.01,PSS(2),.01,"I")_"^"_PSS51(51.01,PSS(2),.01,"E"))
133 S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.02)=$G(PSS51(51.01,PSS(2),.02,"I"))
134 Q
135 ;
136SETZRO2 ;
137 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
138 S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
139 S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51(51,PSS(1),1,"I"))
140 Q
141 ;
142LOOP(PSS) ;
143 N CNT,PSSIEN S CNT=0
144 S PSSIEN=0 F S PSSIEN=$O(^PS(51,PSSIEN)) Q:'PSSIEN D @PSS
145 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
146 Q
1471 ;
148 K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1;.5;30;2;3;4;31;10;5;1.1;9","IE","PSS51") S PSS(1)=0
149 F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO S CNT=CNT+1
150 Q
151 ;
1522 ;
153 N CNT2 S CNT2=0
154 K PSS51 D GETS^DIQ(51,+PSSIEN,".01;20*","IE","PSS51") S PSS(1)=0
155 F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETWARD1 S CNT=CNT+1,PSS(2)=0 D
156 .F S PSS(2)=$O(PSS51(51.01,PSS(2))) Q:'PSS(2) D SETWARD2 S CNT2=CNT2+1
157 .S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
158 Q
159 ;
1603 ;
161 K PSS51 D GETS^DIQ(51,+PSSIEN,".01;1","IE","PSS51") S PSS(1)=0
162 F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D SETZRO2 S CNT=CNT+1
163 Q
164 ;
1654 ;
166 Q:$P($G(^PS(51,+PSSIEN,0)),"^",4)>1
167 K PSS51 D GETS^DIQ(51,+PSSIEN,".01","IE","PSS51") S PSS(1)=0
168 F S PSS(1)=$O(PSS51(51,PSS(1))) Q:'PSS(1) D
169 .S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51(51,PSS(1),.01,"I"))
170 .S ^TMP($J,LIST,"B",$G(PSS51(51,PSS(1),.01,"I")),+PSS(1))=""
171 .S CNT=CNT+1
172 Q
173 ;
174A(PSSFT,LIST) ;
175 ;PSSFT - Free Text Name in Medication Instruction file (#51).
176 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,
177 ;Returns NAME field (#.01), EXPANSION field (#1), OTHER LANGUAGE EXPANSION field (#1.1), and PLURAL field (#9)
178 ;of MEDICATION INSTRUCTION file (#51).
179 N PSSAENT,PSSAENTN
180 I $G(LIST)']"" Q
181 K ^TMP($J,LIST)
182 I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
183 I '$D(^PS(51,"A",PSSFT)) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
184 S PSSAENT=$O(^PS(51,"B",PSSFT,0)) I 'PSSAENT S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
185 S PSSAENTN=$G(^PS(51,PSSAENT,0)) I $P(PSSAENTN,"^")="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
186 S ^TMP($J,LIST,0)=1
187 S ^TMP($J,LIST,+PSSAENT,.01)=$P(PSSAENTN,"^")
188 S ^TMP($J,LIST,"A",$P(PSSAENTN,"^"),+PSSAENT)=""
189 S ^TMP($J,LIST,+PSSAENT,1)=$P(PSSAENTN,"^",2)
190 S ^TMP($J,LIST,+PSSAENT,1.1)=$P($G(^PS(51,+PSSAENT,4)),"^")
191 S ^TMP($J,LIST,+PSSAENT,9)=$P($G(^PS(51,+PSSAENT,9)),"^")
192 Q
Note: See TracBrowser for help on using the repository browser.