1 | PSS50D ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
|
---|
2 | ;;1.0;PHARMACY DATA MANAGEMENT;**85,105**;9/30/97
|
---|
3 | ;
|
---|
4 | B ;
|
---|
5 | ;PSSFT - Free Text name in 50
|
---|
6 | ;PSSFL - Inactive flag - "" - All entries
|
---|
7 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
8 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
9 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
10 | ; part of their formulary.
|
---|
11 | ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
|
---|
12 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
13 | ; piece being returned.
|
---|
14 | ;Returns list of drugs meeting input criteria
|
---|
15 | N DIERR,ZZERR,PSSP50,SCR,PSSIEN
|
---|
16 | I $G(LIST)']"" Q
|
---|
17 | K ^TMP($J,LIST)
|
---|
18 | I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
19 | S SCR("S")=""
|
---|
20 | I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
|
---|
21 | I $G(PSSFT)]"" D
|
---|
22 | .I PSSFT["??" D LOOPB^PSS50C1 Q
|
---|
23 | .K ^TMP("DILIST",$J)
|
---|
24 | .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
|
---|
25 | .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
26 | .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
|
---|
27 | ..S PSSIEN=+$G(^TMP("DILIST",$J,PSSXX,0)) I PSSIEN,$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)'="" D
|
---|
28 | ...S ^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
|
---|
29 | ...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),PSSIEN)=""
|
---|
30 | K ^TMP("DILIST",$J)
|
---|
31 | Q
|
---|
32 | ;
|
---|
33 | VAC ;
|
---|
34 | ;PSSVAL - NATIONAL DRUG CLASS field (#25) of the DRUG file (#50)
|
---|
35 | ;PSSFL - Inactive flag - "" - All entries
|
---|
36 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
37 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
38 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
39 | ; part of their formulary.
|
---|
40 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
41 | ; piece being returned.
|
---|
42 | ;Returns list of drugs meeting input criteria
|
---|
43 | N DIERR,ZZERR,PSSP50,SCR,PSSIEN
|
---|
44 | I $G(LIST)']"" Q
|
---|
45 | K ^TMP($J,LIST)
|
---|
46 | I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
47 | S SCR("S")="I $P($G(^PSDRUG(+Y,""ND"")),""^"",6)=PSSVAL"
|
---|
48 | I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50C1
|
---|
49 | I $G(PSSVAL)]"" D
|
---|
50 | .K ^TMP("DILIST",$J)
|
---|
51 | .D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"VAC",SCR("S"),,"")
|
---|
52 | .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
53 | .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
|
---|
54 | ..S PSSIEN=+$G(^TMP("DILIST",$J,PSSXX,0)) I PSSIEN,$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)'="" D
|
---|
55 | ...S ^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
|
---|
56 | ...S ^TMP($J,LIST,"VAC",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),PSSIEN)=""
|
---|
57 | K ^TMP("DILIST",$J)
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | NDC ;
|
---|
61 | ;PSSVAL - NDC field (#31) of the DRUG file (#50)
|
---|
62 | ;PSSFL - Inactive flag - "" - All entries
|
---|
63 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
64 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
65 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
66 | ; part of their formulary.
|
---|
67 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
68 | ; piece being returned.
|
---|
69 | ;Returns list of drugs meeting input criteria
|
---|
70 | ;
|
---|
71 | ; Must change to look directly at the NDC cross reference
|
---|
72 | N PSSNDC,PSSNDC1,PSSNDC2
|
---|
73 | I $G(LIST)']"" Q
|
---|
74 | K ^TMP($J,LIST)
|
---|
75 | I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
76 | S PSSNDC=0 F PSSNDC1=0:0 S PSSNDC1=$O(^PSDRUG("NDC",PSSVAL,PSSNDC1)) Q:'PSSNDC1 D
|
---|
77 | .S PSSNDC2=$P($G(^PSDRUG(PSSNDC1,0)),"^")
|
---|
78 | .I PSSNDC2="" Q
|
---|
79 | .I $G(PSSFL),$P($G(^PSDRUG(PSSNDC1,"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
|
---|
80 | .;Naked reference below refers to ^PSDRUG(PSSNDC1,"I"), or ^PSDRUG(PSSNDC1,0)
|
---|
81 | .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
|
---|
82 | .I $G(PSSPK)]"",'PSSZ5 Q
|
---|
83 | .S ^TMP($J,LIST,PSSNDC1,.01)=PSSNDC2
|
---|
84 | .S ^TMP($J,LIST,"NDC",PSSNDC2,PSSNDC1)=""
|
---|
85 | .S PSSNDC=PSSNDC+1
|
---|
86 | S ^TMP($J,LIST,0)=$S($G(PSSNDC):$G(PSSNDC),1:"-1^NO DATA FOUND")
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | ASP ;
|
---|
90 | ;PSSVAL - PHARMACY ORDERABLE ITEM field (#2.1) of the DRUG file (#50)
|
---|
91 | ;PSSFL - Inactive flag - "" - All entries
|
---|
92 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
93 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
94 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
95 | ; part of their formulary.
|
---|
96 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
97 | ; piece being returned.
|
---|
98 | ;Returns list of drugs meeting input criteria
|
---|
99 | N DIERR,ZZERR,PSSP50,SCR,PSSIEN
|
---|
100 | I $G(LIST)']"" Q
|
---|
101 | K ^TMP($J,LIST)
|
---|
102 | I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
103 | S SCR("S")=""
|
---|
104 | I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
|
---|
105 | S SCR("S")=SCR("S")_" I +$G(^PSDRUG(+Y,2))=PSSVAL"
|
---|
106 | I $G(PSSVAL)]"" D
|
---|
107 | .D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"ASP",SCR("S"),,"")
|
---|
108 | .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
109 | .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
|
---|
110 | ..S PSSIEN=+^TMP("DILIST",$J,XX,0),^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
|
---|
111 | ..S ^TMP($J,LIST,"ASP",$P(^TMP("DILIST",$J,XX,0),"^",2),PSSIEN)=""
|
---|
112 | K ^TMP("DILIST",$J)
|
---|
113 | Q
|
---|
114 | ;
|
---|
115 | AND ;
|
---|
116 | ;PSSVAL -NATIONAL DRUG FILE ENTRY field (#20) of the DRUG file (#50)
|
---|
117 | ;PSSFL - Inactive flag - "" - All entries
|
---|
118 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
119 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
120 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
121 | ; part of their formulary.
|
---|
122 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
123 | ; piece being returned.
|
---|
124 | ;Returns list of drugs meeting input criteria
|
---|
125 | N DIERR,ZZERR,PSSP50,SCR,PSSIEN,CNT
|
---|
126 | I $G(LIST)']"" Q
|
---|
127 | K ^TMP($J,LIST)
|
---|
128 | I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
129 | S SCR("S")=""
|
---|
130 | I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
|
---|
131 | I $G(PSSVAL)]"" D
|
---|
132 | .S CNT=0
|
---|
133 | .D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"AND",SCR("S"),,"")
|
---|
134 | .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
135 | .I +^TMP("DILIST",$J,0)>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
|
---|
136 | ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS50 D GETS^DIQ(50,+PSSIEN,".01;20","IE","PSS50") S PSS(1)=0
|
---|
137 | ..F S PSS(1)=$O(PSS50(50,PSS(1))) Q:'PSS(1) D
|
---|
138 | ...Q:PSS50(50,PSS(1),20,"I")'=PSSVAL
|
---|
139 | ...S ^TMP($J,LIST,PSSIEN,.01)=$G(PSS50(50,PSS(1),.01,"E")),CNT=CNT+1
|
---|
140 | ...S ^TMP($J,LIST,"AND",$G(PSS50(50,PSS(1),.01,"E")),PSSIEN)=""
|
---|
141 | ..S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
---|
142 | K ^TMP("DILIST",$J),PSS50
|
---|
143 | Q
|
---|
144 | ;
|
---|
145 | AP ;
|
---|
146 | ;PSSVAL - PRIMARY DRUG field (#64) of the DRUG file (#50)
|
---|
147 | ;PSSFL - Inactive flag - "" - All entries
|
---|
148 | ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
|
---|
149 | ;PSSPK - Application Package's Use - "" - All entries
|
---|
150 | ; Alphabetic codes that represent the DHCP packages that consider this drug to be
|
---|
151 | ; part of their formulary.
|
---|
152 | ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
|
---|
153 | ; piece being returned.
|
---|
154 | ;Returns list of drugs meeting input criteria
|
---|
155 | N DIERR,ZZERR,PSSP50,SCR,PSSIEN
|
---|
156 | I $G(LIST)']"" Q
|
---|
157 | K ^TMP($J,LIST)
|
---|
158 | I ($G(PSSVAL)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
159 | S SCR("S")=""
|
---|
160 | I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
|
---|
161 | S SCR("S")=SCR("S")_" I +$P($G(^PSDRUG(+Y,2)),""^"",6)=PSSVAL"
|
---|
162 | I $G(PSSVAL)]"" D
|
---|
163 | .D FIND^DIC(50,,"@;.01","QP",PSSVAL,,"AP",SCR("S"),,"")
|
---|
164 | .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
165 | .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
|
---|
166 | ..S PSSIEN=+^TMP("DILIST",$J,XX,0),^TMP($J,LIST,PSSIEN,.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
|
---|
167 | ..S ^TMP($J,LIST,"AP",$P(^TMP("DILIST",$J,XX,0),"^",2),PSSIEN)=""
|
---|
168 | K ^TMP("DILIST",$J)
|
---|
169 | Q
|
---|