source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50E.m@ 1259

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

initial load of WorldVistAEHR

File size: 7.7 KB
Line 
1PSS50E ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85,104**;9/30/97
3 ;
4SKB(PSSIEN2,PSSFL2) ;
5 ;PSSIEN2 - IEN of entry in 50
6 ;PSSFL2 - action flag - S to set the "B" cross-reference or
7 ; K to kill the "B" cross-reference.
8 ;
9 I +$G(PSSIEN2)'>0 Q 0
10 I "SK"'[$G(PSSFL2) Q 0
11 I PSSFL2="S",$G(^PSDRUG(+PSSIEN2,0))]"" S ^PSDRUG("B",$E($P($G(^PSDRUG(+PSSIEN2,0)),"^"),1,40),+PSSIEN2)="" Q 1
12 I PSSFL2="K",$G(^PSDRUG(+PSSIEN2,0))]"" K ^PSDRUG("B",$E($P($G(^PSDRUG(+PSSIEN2,0)),"^"),1,40),+PSSIEN2) Q 1
13 Q 0
14 ;
15 I $A(PSSVAL)'=34 S PSSVAL=$C(34)_PSSVAL_$C(34)
16AOC ;
17 ;PSSVAL - VA CLASSIFICATION field (#2) of the DRUG file (#50)
18 ;PSSFL - Inactive flag - "" - All entries
19 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
20 ;PSSPK - Application Package's Use - "" - All entries
21 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
22 ; part of their formulary.
23 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
24 ; piece being returned.
25 ;
26 N PSS
27 I $G(LIST)']"" Q
28 K ^TMP($J,LIST)
29 I $G(PSSVAL)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
30 S ^TMP($J,LIST,0)=0
31 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG("AOC",PSS(1))) Q:'PSS(1) S PSS(2)="" F S PSS(2)=$O(^PSDRUG("AOC",PSS(1),PSS(2))) Q:PSS(2)="" D
32 .Q:PSS(2)'=PSSVAL S PSS(3)=0 F S PSS(3)=$O(^PSDRUG("AOC",PSS(1),PSS(2),PSS(3))) Q:'PSS(3) D
33 ..N ZNODE,NODE2,INODE S ZNODE=$G(^PSDRUG(+PSS(3),0)),NODE2=$G(^(2)),INODE=$G(^("I"))
34 ..I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
35 ..;Naked reference below refers to ^PSDRUG(+PSS(3),2)
36 ..I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
37 ..I $G(PSSPK)]"",'PSSZ5 Q
38 ..S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1,^TMP($J,LIST,+PSS(3),.01)=$P(ZNODE,"^")
39 ..S ^TMP($J,LIST,"AOC",$P(ZNODE,"^"),+PSS(3))=""
40 I ^TMP($J,LIST,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
41 Q
42 ;
43C ;
44 ;PSSVAL - SYNONYM sub-field (#9) of the DRUG file (#50)
45 ;PSSFL - Inactive flag - "" - All entries
46 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
47 ;PSSPK - Application Package's Use - "" - All entries
48 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
49 ; part of their formulary.
50 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
51 ; piece being returned.
52 ;
53 N DIERR,ZZERR,PSS,PSSP50
54 I $G(LIST)']"" Q
55 K ^TMP($J,LIST)
56 I $G(PSSVAL)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
57 S ^TMP($J,LIST,0)=0
58 S PSS(1)="" F S PSS(1)=$O(^PSDRUG("C",PSS(1))) Q:PSS(1)="" S PSS(2)="" F S PSS(2)=$O(^PSDRUG("C",PSS(1),PSS(2))) Q:PSS(2)="" D
59 .Q:PSS(1)'=PSSVAL D
60 ..N ZNODE,NODE2,INODE S ZNODE=$G(^PSDRUG(+PSS(2),0)),NODE2=$G(^(2)),INODE=$P($G(^("I")),"^")
61 ..I +$G(PSSFL)>0,+INODE>0,+INODE'>PSSFL Q
62 ..;Naked reference below refers to ^PSDRUG(+PSS(2),2)
63 ..I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
64 ..I $G(PSSPK)]"",'PSSZ5 Q
65 ..S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1,^TMP($J,LIST,+PSS(2),.01)=$P(ZNODE,"^"),^TMP($J,LIST,"C",$P(ZNODE,"^"),+PSS(2))="" D
66 ...K PSSP50 D GETS^DIQ(50,+PSS(2),"9*","IE","PSSP50") S PSS(3)=0
67 ...F S PSS(3)=$O(PSSP50(50.1,PSS(3))) Q:'PSS(3) D
68 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),.01)=$G(PSSP50(50.1,PSS(3),.01,"I"))
69 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),2)=$G(PSSP50(50.1,PSS(3),2,"I"))
70 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),1)=$S($G(PSSP50(50.1,PSS(3),1,"I"))="":"",1:PSSP50(50.1,PSS(3),1,"I")_"^"_PSSP50(50.1,PSS(3),1,"E"))
71 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),400)=$G(PSSP50(50.1,PSS(3),400,"I"))
72 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),401)=$S($G(PSSP50(50.1,PSS(3),401,"I"))="":"",1:PSSP50(50.1,PSS(3),401,"I")_"^"_PSSP50(50.1,PSS(3),401,"E"))
73 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),402)=$G(PSSP50(50.1,PSS(3),402,"I"))
74 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),403)=$G(PSSP50(50.1,PSS(3),403,"I"))
75 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),404)=$G(PSSP50(50.1,PSS(3),404,"I"))
76 ....S ^TMP($J,LIST,+PSS(2),+PSS(3),405)=$G(PSSP50(50.1,PSS(3),405,"I"))
77 I ^TMP($J,LIST,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
78 K PSSP50
79 Q
80 ;
81SKAQ(PSSIEN2,PSSFL2) ;
82 ;PSSIEN2 - IEN of entry in 50
83 ;PSSFL2 - action flag - S to set the "AQ" cross-reference or
84 ; K to kill the "AQ" cross-reference.
85 ;
86 I +$G(PSSIEN2)'>0 Q 0
87 I "SK"'[$G(PSSFL2) Q 0
88 I PSSFL2="S",$G(^PSDRUG(+PSSIEN2,3))=1 S ^PSDRUG("AQ",+PSSIEN2)="" Q 1
89 I PSSFL2="K",+$G(^PSDRUG(+PSSIEN2,3))=0 K ^PSDRUG("AQ",+PSSIEN2) Q 1
90 Q 0
91 ;
92SKAQ1(PSSIEN2) ;
93 ;PSSIEN2 - IEN of entry in 50
94 I +$G(PSSIEN2)'>0 Q 0
95 N PSS,QFLG S PSS="" F S PSS=$O(^PSDRUG("AQ1",PSS)) Q:PSS="" D
96 .K ^PSDRUG("AQ1",PSS,+PSSIEN2) S QFLG=1
97 .I $P($G(^PSDRUG(+PSSIEN2,"ND")),"^",10)]"" S ^PSDRUG("AQ1",$E($P($G(^PSDRUG(+PSSIEN2,"ND")),"^",10),1,30),+PSSIEN2)="" S QFLG=1
98 I $D(QFLG) Q 1
99 Q 0
100A526 ;
101 ;PSSIEN - IEN of entry in 50
102 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST, of the data
103 ; being returned.
104 I $G(LIST)']"" Q
105 K ^TMP($J,LIST)
106 I +$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
107 N PSS,CNT S (PSS,CNT)=0 F S PSS=$O(^PSDRUG("A526",+PSSIEN,PSS)) Q:'PSS D
108 .S ^TMP($J,LIST,+PSS,.01)=$P($G(^PS(52.6,+PSS,0)),"^"),CNT=CNT+1
109 .S ^TMP($J,LIST,"A526",$P($G(^PS(52.6,+PSS,0)),"^"),+PSS)=""
110 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
111 Q
112A527 ;
113 ;PSSIEN - IEN of entry in 50
114 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST, of the data
115 ; being returned.
116 I $G(LIST)']"" Q
117 K ^TMP($J,LIST)
118 I +$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
119 N PSS,CNT S (PSS,CNT)=0 F S PSS=$O(^PSDRUG("A527",+PSSIEN,PSS)) Q:'PSS D
120 .S ^TMP($J,LIST,+PSS,.01)=$P($G(^PS(52.7,+PSS,0)),"^"),CNT=CNT+1
121 .S ^TMP($J,LIST,"A527",$P($G(^PS(52.7,+PSS,0)),"^"),+PSS)=""
122 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
123 Q
124SKAIU(PSSIEN2,PSSFL2) ;
125 ;PSSIEN2 - IEN of entry in 50
126 ;PSSFL2 - action flag - S to set the "AIU" cross-reference or
127 ; K to kill the "AIU" cross-reference
128 ;
129 I +$G(PSSIEN2)'>0 Q 0
130 I "SK"'[$G(PSSFL2) Q 0
131 N PSS,PSS2,PSSNM,PSSPK2,QFLG,PSSPK3
132 S PSSPK3="INOSUWX"
133 S PSSPK2=$P($G(^PSDRUG(+PSSIEN2,2)),"^",3),PSSNM=$P($G(^PSDRUG(+PSSIEN2,0)),"^")
134 I PSSNM']"" Q 0
135 I PSSNM]"" S PSS="" F PSS2=1:1:$L(PSSPK3) S PSS=$O(^PSDRUG("AIU"_$E(PSSPK3,PSS2))) Q:PSS="" D
136 .K ^PSDRUG("AIU"_$E(PSSPK3,PSS2),PSSNM,+PSSIEN2) S:$G(PSSFL2)="K" QFLG=1
137 I PSSPK2]"" F PSS=1:1:$L(PSSPK2) S ^PSDRUG("AIU"_$E(PSSPK2,PSS),PSSNM,PSSIEN2)="" S:$G(PSSFL2)="S" QFLG=1
138 I $D(QFLG) Q 1
139 Q 0
140SKIU(PSSIEN2) ;
141 ;PSSIEN2 - IEN of entry in 50
142 I +$G(PSSIEN2)'>0 Q 0
143 N PSS,PSSPK2,QFLG S PSS="" F S PSS=$O(^PSDRUG("IU",PSS)) Q:PSS="" D
144 .K ^PSDRUG("IU",PSS,+PSSIEN2) S QFLG=1
145 .S PSSPK2=$P($G(^PSDRUG(+PSSIEN2,2)),"^",3)
146 .I PSSPK2]"" S ^PSDRUG("IU",PSSPK2,+PSSIEN2)="" S QFLG=1
147 I $D(QFLG) Q 1
148 Q 0
149FNAME(PSSFNO2,PSSFILE2) ;
150 I +$G(PSSFNO2)'>0!(+$G(PSSFILE2)'>0) Q ""
151 N PSSNAME,PSSFFIND,PSSFILEZ,PSSFNUMB
152 S PSSFILEZ=0
153 I +$G(PSSFILE2)<60,+$G(PSSFILE2)'<50 S PSSFILEZ=1
154 I 'PSSFILEZ F PSSFFIND=1:1 S PSSFNUMB=$P($T(FLIST+PSSFFIND),";;",2) Q:PSSFILEZ!(PSSFNUMB="") I PSSFNUMB=+$G(PSSFILE2) S PSSFILEZ=1
155 I PSSFILEZ D FIELD^DID(+$G(PSSFILE2),PSSFNO2,"","LABEL","PSSNAME",)
156 Q $G(PSSNAME("LABEL"))
157 ;
158FLIST ;
159 ;;550
160 ;;550.04
161 ;;550.07
162 ;;550.08
163 ;;550.09
164 ;;550.1
165 ;;550.11
166 ;;550.1101
167 ;;550.2
168 ;;550.215
169 ;;550.216
170 ;;1020.1
171 ;;1020.2
172 ;;1020.3
173 ;;1020.4
174 ;;1020.5
175 ;;1020.51
176 ;;1020.6
177 ;;1020.7
178 ;;1020.8
179 ;;9009032.3
180 ;;9009032.4
181 ;;9009032.411
182 ;;9009032.412
183 ;;9009032.413
184 ;;9009032.414
185 ;;9009032.415
186 ;;9009032.416
187 ;;9009032.5
188 Q
Note: See TracBrowser for help on using the repository browser.