source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50B2.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1PSS50B2 ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4CLOZ ;
5 ;PSSIEN - IEN of entry in 50
6 ;PSSFT - Free Text name in 50
7 ;PSSFL - Inactive flag - "" - All entries
8 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
9 ;PSSPK - Application Package's Use - "" - All entries
10 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
11 ; part of their formulary.
12 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
13 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
14 ; piece being returned.
15 N DIERR,ZZERR,PSSP50,SCR,PSSMLCT,PSS
16 I $G(LIST)']"" Q
17 K ^TMP($J,LIST)
18 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
19 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
20 S SCR("S")=""
21 I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
22 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
23 .K ^TMP("DIERR",$J)
24 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
25 .S ^TMP($J,LIST,0)=1
26 .D SETSUB6^PSS50AQM(+PSSIEN2)
27 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;17.7*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
28 .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SCLOZ D
29 ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.02,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SCLOZM
30 ..S ^TMP($J,LIST,+PSS(1),"CLOZ",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
31 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
32 I $G(PSSFT)]"" D
33 .I PSSFT["??" D LOOP Q
34 .K ^TMP("DILIST",$J)
35 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
36 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
37 .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
38 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
39 ..D SETSUB6^PSS50AQM(PSSIEN) K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;17.7*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
40 ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SCLOZ D
41 ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.02,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SCLOZM
42 ...S ^TMP($J,LIST,+PSS(1),"CLOZ",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
43 K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
44 Q
45 ;
46FRMALT ;
47 ;PSSIEN - IEN of entry in 50
48 ;PSSFT - Free Text name in 50
49 ;PSSFL - Inactive flag - "" - All entries
50 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
51 ;PSSPK - Application Package's Use - "" - All entries
52 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
53 ; part of their formulary.
54 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
55 ; piece being returned.
56 N DIERR,ZZERR,PSS50,SCR,PSSFRCT,PSS
57 I $G(LIST)']"" Q
58 K ^TMP($J,LIST)
59 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
60 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
61 S SCR("S")=""
62 I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
63 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSS50",$J) Q
64 .K ^TMP("DIERR",$J)
65 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
66 .S ^TMP($J,LIST,0)=1
67 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;25;100;101;65*","IE","^TMP(""PSS50"",$J)") S PSS(1)=0
68 .F S PSS(1)=$O(^TMP("PSS50",$J,50,PSS(1))) Q:'PSS(1) D SFRM D
69 ..S (PSS(2),PSSFRCT)=0 F S PSS(2)=$O(^TMP("PSS50",$J,50.065,PSS(2))) Q:'PSS(2) S PSSFRCT=PSSFRCT+1 D SFRMA
70 ..S ^TMP($J,LIST,+PSS(1),"FRM",0)=$S($G(PSSFRCT):PSSFRCT,1:"-1^NO DATA FOUND")
71 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
72 I $G(PSSFT)]"" D
73 .I PSSFT["??" D LOOP2 Q
74 .K ^TMP("DILIST",$J)
75 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
76 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
77 .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
78 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
79 ..K ^TMP("PSS50",$J) D GETS^DIQ(50,+PSSIEN,".01;25;100;101;65*","IE","^TMP(""PSS50"",$J)") S PSS(1)=0
80 ..F S PSS(1)=$O(^TMP("PSS50",$J,50,PSS(1))) Q:'PSS(1) D SFRM D
81 ...S (PSS(2),PSSFRCT)=0 F S PSS(2)=$O(^TMP("PSS50",$J,50.065,PSS(2))) Q:'PSS(2) S PSSFRCT=PSSFRCT+1 D SFRMA
82 ...S ^TMP($J,LIST,+PSS(1),"FRM",0)=$S($G(PSSFRCT):PSSFRCT,1:"-1^NO DATA FOUND")
83 K ^TMP("DILIST",$J),^TMP("PSS50",$J)
84 Q
85 ;
86SCLOZ ;
87 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
88 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
89 Q
90SCLOZM ;
91 S ^TMP($J,LIST,+PSS(1),"CLOZ",+PSS(2),.01)=$S($G(^TMP("PSSP50",$J,50.02,PSS(2),.01,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.02,PSS(2),.01,"I"))_"^"_$G(^TMP("PSSP50",$J,50.02,PSS(2),.01,"E")))
92 S ^TMP($J,LIST,+PSS(1),"CLOZ",+PSS(2),1)=$G(^TMP("PSSP50",$J,50.02,PSS(2),1,"I"))
93 S ^TMP($J,LIST,+PSS(1),"CLOZ",+PSS(2),2)=$S($G(^TMP("PSSP50",$J,50.02,PSS(2),2,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.02,PSS(2),2,"I"))_"^"_$G(^TMP("PSSP50",$J,50.02,PSS(2),2,"E")))
94 S ^TMP($J,LIST,+PSS(1),"CLOZ",+PSS(2),3)=$S($G(^TMP("PSSP50",$J,50.02,PSS(2),3,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.02,PSS(2),3,"I"))_"^"_$G(^TMP("PSSP50",$J,50.02,PSS(2),3,"E")))
95 Q
96SFRM ;
97 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS50",$J,50,PSS(1),.01,"I"))
98 S ^TMP($J,LIST,"B",$G(^TMP("PSS50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
99 S ^TMP($J,LIST,+PSS(1),25)=$G(^TMP("PSS50",$J,50,PSS(1),25,"I"))
100 S ^TMP($J,LIST,+PSS(1),100)=$S($G(^TMP("PSS50",$J,50,PSS(1),100,"I"))="":"",1:$G(^TMP("PSS50",$J,50,PSS(1),100,"I"))_"^"_$G(^TMP("PSS50",$J,50,PSS(1),100,"E")))
101 S ^TMP($J,LIST,+PSS(1),101)=$G(^TMP("PSS50",$J,50,PSS(1),101,"I"))
102 Q
103SFRMA ;
104 S ^TMP($J,LIST,+PSS(1),"FRM",+PSS(2),.01)=$S($G(^TMP("PSS50",$J,50.065,PSS(2),.01,"I"))="":"",1:$G(^TMP("PSS50",$J,50.065,PSS(2),.01,"I"))_"^"_$G(^TMP("PSS50",$J,50.065,PSS(2),.01,"E")))
105 Q
106LOOP ;
107 N PSSENCT
108 S PSSENCT=0
109 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
110 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
111 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
112 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
113 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
114 .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
115 .I $G(PSSPK)]"",'PSSZ5 Q
116 .D SETSUB6^PSS50AQM(PSS(1))
117 .D SCLOZ1
118 .S PSSENCT=PSSENCT+1
119 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
120 Q
121SCLOZ1 ;
122 N PSSZNODE
123 S PSSZNODE=$G(^PSDRUG(PSS(1),0))
124 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
125 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),PSS(1))=""
126 ;Set CLOZ2 multiple information
127 N PSSCZPC S PSSCZPC=0
128 I $O(^PSDRUG(PSS(1),"CLOZ2",0)) N PSSCZP,PSSCZP1 D
129 .F PSSCZP=0:0 S PSSCZP=$O(^PSDRUG(PSS(1),"CLOZ2",PSSCZP)) Q:'PSSCZP D
130 ..S PSSCZP1=$G(^PSDRUG(PSS(1),"CLOZ2",PSSCZP,0)) I $P(PSSCZP1,"^")'="" S PSSCZPC=PSSCZPC+1 D
131 ...N PSSCARZ,DA,DR,DIC,DIQ K PSSCARZ S DIC=50,DR="17.7",DA=PSS(1),DR(50.02)=".01;1;2;3",DA(50.02)=PSSCZP,DIQ="PSSCARZ",DIQ(0)="IE" D EN^DIQ1
132 ...S ^TMP($J,LIST,+PSS(1),"CLOZ",PSSCZP,.01)=$S($G(PSSCARZ(50.02,PSSCZP,.01,"I"))="":"",1:$G(PSSCARZ(50.02,PSSCZP,.01,"I"))_"^"_$G(PSSCARZ(50.02,PSSCZP,.01,"E")))
133 ...S ^TMP($J,LIST,+PSS(1),"CLOZ",PSSCZP,1)=$G(PSSCARZ(50.02,PSSCZP,1,"I"))
134 ...S ^TMP($J,LIST,+PSS(1),"CLOZ",PSSCZP,2)=$S($G(PSSCARZ(50.02,PSSCZP,2,"I"))="":"",1:$G(PSSCARZ(50.02,PSSCZP,2,"I"))_"^"_$G(PSSCARZ(50.02,PSSCZP,2,"E")))
135 ...S ^TMP($J,LIST,+PSS(1),"CLOZ",PSSCZP,3)=$S($G(PSSCARZ(50.02,PSSCZP,3,"I"))="":"",1:$G(PSSCARZ(50.02,PSSCZP,3,"I"))_"^"_$G(PSSCARZ(50.02,PSSCZP,3,"E")))
136 S ^TMP($J,LIST,+PSS(1),"CLOZ",0)=$S(PSSCZPC:PSSCZPC,1:"-1^NO DATA FOUND")
137 Q
138LOOP2 ;
139 N PSSENCT,PSSIEN
140 S PSSENCT=0
141 S PSSIEN=0 F S PSSIEN=$O(^PSDRUG(PSSIEN)) Q:'PSSIEN D
142 .I $P($G(^PSDRUG(PSSIEN,0)),"^")="" Q
143 .I $G(PSSFL),$P($G(^PSDRUG(PSSIEN,"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
144 .;Naked reference below refers to ^PSDRUG(PSSIEN,2)
145 .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
146 .I $G(PSSPK)]"",'PSSZ5 Q
147 .K ^TMP("PSS50",$J) D GETS^DIQ(50,+PSSIEN,".01;25;100;101;65*","IE","^TMP(""PSS50"",$J)") S PSS(1)=0
148 .F S PSS(1)=$O(^TMP("PSS50",$J,50,PSS(1))) Q:'PSS(1) D SFRM D
149 ..S (PSS(2),PSSFRCT)=0 F S PSS(2)=$O(^TMP("PSS50",$J,50.065,PSS(2))) Q:'PSS(2) S PSSFRCT=PSSFRCT+1 D SFRMA
150 ..S ^TMP($J,LIST,+PSS(1),"FRM",0)=$S($G(PSSFRCT):PSSFRCT,1:"-1^NO DATA FOUND")
151 .S PSSENCT=PSSENCT+1
152 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
153 K ^TMP("PSS50",$J)
154 Q
Note: See TracBrowser for help on using the repository browser.