source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50D.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1PSS50D ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85,105**;9/30/97
3 ;
4B ;
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 ;
33VAC ;
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 ;
60NDC ;
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 ;
89ASP ;
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 ;
115AND ;
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 ;
145AP ;
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
Note: See TracBrowser for help on using the repository browser.