source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50ATC.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1PSS50ATC ;BIR/LDT - API INFORMATION FROM FILE 50; 23 Mar 04
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4 ;External reference to PS(57.5 supported by DBIA 2112
5ATC ;
6 ;PSSIEN - IEN of entry in 50
7 ;PSSFT - Free Text name in 50
8 ;PSSFL - Inactive flag - "" - All entries
9 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
10 ;PSSPK - Application Package's Use - "" - All entries
11 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
12 ; part of their formulary.
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,PSS,PSSMLCT,PSSAXX,PSSAXX1,PSSAXX2,PSSAXXOK
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 S SCR("S")=""
20 I +$G(PSSFL)>0!($G(PSSPK)]"") N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
21 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
22 .K ^TMP("DIERR",$J)
23 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
24 .S PSSAXXOK=0 F PSSAXX=0:0 S PSSAXX=$O(^PSDRUG(+PSSIEN2,212,"AC",PSSAXX)) Q:'PSSAXX!(PSSAXXOK) S PSSAXX1="" F S PSSAXX1=$O(^PSDRUG(+PSSIEN2,212,"AC",PSSAXX,PSSAXX1)) Q:PSSAXX1=""!(PSSAXXOK) D
25 ..F PSSAXX2=0:0 S PSSAXX2=$O(^PSDRUG(+PSSIEN2,212,"AC",PSSAXX,PSSAXX1,PSSAXX2)) Q:'PSSAXX2!(PSSAXXOK) I $D(^PSDRUG(+PSSIEN2,212,PSSAXX2,0)) S PSSAXXOK=1
26 .I 'PSSAXXOK S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
27 .S ^TMP($J,LIST,0)=1
28 .D SETSUB9^PSS50AQM(+PSSIEN2)
29 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;212.2;212*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
30 .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETATC D
31 ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0212,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETATC2
32 ..S ^TMP($J,LIST,+PSS(1),"ATC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
33 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
34 I $G(PSSFT)]"" D
35 .I PSSFT["??" D LOOP Q
36 .K ^TMP("DILIST",$J)
37 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
38 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
39 .I +^TMP("DILIST",$J,0)>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
40 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
41 ..S PSSAXXOK=0 F PSSAXX=0:0 S PSSAXX=$O(^PSDRUG(+PSSIEN,212,"AC",PSSAXX)) Q:'PSSAXX!(PSSAXXOK) S PSSAXX1="" F S PSSAXX1=$O(^PSDRUG(+PSSIEN,212,"AC",PSSAXX,PSSAXX1)) Q:PSSAXX1=""!(PSSAXXOK) D
42 ...F PSSAXX2=0:0 S PSSAXX2=$O(^PSDRUG(+PSSIEN,212,"AC",PSSAXX,PSSAXX1,PSSAXX2)) Q:'PSSAXX2!(PSSAXXOK) I $D(^PSDRUG(+PSSIEN,212,PSSAXX2,0)) S PSSAXXOK=1
43 ..I 'PSSAXXOK Q
44 ..S ^TMP($J,LIST,0)=$S('$G(^TMP($J,LIST,0)):1,1:$G(^TMP($J,LIST,0))+1)
45 ..D SETSUB9^PSS50AQM(PSSIEN) K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;212.2;212*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
46 ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETATC D
47 ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0212,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETATC2
48 ...S ^TMP($J,LIST,+PSS(1),"ATC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
49 I '$O(^TMP($J,LIST,0)) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND"
50 K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
51 Q
52SETATC ;
53 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
54 S ^TMP($J,LIST,+PSS(1),212.2)=$G(^TMP("PSSP50",$J,50,PSS(1),212.2,"I"))
55 S ^TMP($J,LIST,"AC",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
56 Q
57 ;
58SETATC2 ;
59 S ^TMP($J,LIST,+PSS(1),"ATC",+PSS(2),.01)=$S($G(^TMP("PSSP50",$J,50.0212,PSS(2),.01,"I"))="":"",1:$G(^TMP("PSSP50",$J,50.0212,PSS(2),.01,"I"))_"^"_$G(^TMP("PSSP50",$J,50.0212,PSS(2),.01,"E")))
60 S ^TMP($J,LIST,+PSS(1),"ATC",+PSS(2),1)=$G(^TMP("PSSP50",$J,50.0212,PSS(2),1,"I"))
61 Q
62SETATCL ;
63 S ^TMP($J,LIST,+PSS(1),.01)=$P(^PSDRUG(PSS(1),0),"^")
64 S ^TMP($J,LIST,"AC",$P(^PSDRUG(+PSS(1),0),"^"),+PSS(1))=""
65 S ^TMP($J,LIST,+PSS(1),212.2)=$P($G(^PSDRUG(+PSS(1),8.5)),"^",2)
66 Q
67SETATCLM ;
68 N PSS50212 S PSS50212=0
69 I $O(^PSDRUG(+PSS(1),212,0)) N PSSATCND,PSSAT212 D
70 .F PSSAT212=0:0 S PSSAT212=$O(^PSDRUG(+PSS(1),212,PSSAT212)) Q:'PSSAT212 D
71 ..S PSSATCND=$G(^PSDRUG(+PSS(1),212,PSSAT212,0)) I $P(PSSATCND,"^")'="" S PSS50212=PSS50212+1 D
72 ...S ^TMP($J,LIST,+PSS(1),"ATC",PSSAT212,.01)=$S($P(PSSATCND,"^")&($P($G(^PS(57.5,+$P(PSSATCND,"^"),0)),"^")'=""):$P(PSSATCND,"^")_"^"_$P($G(^PS(57.5,+$P(PSSATCND,"^"),0)),"^"),1:"")
73 ...S ^TMP($J,LIST,+PSS(1),"ATC",PSSAT212,1)=$P(PSSATCND,"^",2)
74 S ^TMP($J,LIST,+PSS(1),"ATC",0)=$S(PSS50212:PSS50212,1:"-1^NO DATA FOUND")
75 Q
76LOOP ;
77 N PSSENCT
78 S PSSENCT=0
79 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
80 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
81 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
82 .;I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
83 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
84 .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
85 .I $G(PSSPK)]"",'PSSZ5 Q
86 .S PSSAXXOK=0 F PSSAXX=0:0 S PSSAXX=$O(^PSDRUG(PSS(1),212,"AC",PSSAXX)) Q:'PSSAXX!(PSSAXXOK) S PSSAXX1="" F S PSSAXX1=$O(^PSDRUG(PSS(1),212,"AC",PSSAXX,PSSAXX1)) Q:PSSAXX1=""!(PSSAXXOK) D
87 ..F PSSAXX2=0:0 S PSSAXX2=$O(^PSDRUG(PSS(1),212,"AC",PSSAXX,PSSAXX1,PSSAXX2)) Q:'PSSAXX2!(PSSAXXOK) I $D(^PSDRUG(PSS(1),212,PSSAXX2,0)) S PSSAXXOK=1
88 .I 'PSSAXXOK Q
89 .D SETSUB9^PSS50AQM(PSS(1))
90 .D SETATCL,SETATCLM
91 .S PSSENCT=PSSENCT+1
92 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
93 Q
94SETSYN2 ;
95 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),.01)=$G(^TMP("PSSP50",$J,50.1,PSS(2),.01,"I"))
96 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),1)=$S($G(^TMP("PSSP50",$J,50.1,PSS(2),1,"I"))="":"",1:^TMP("PSSP50",$J,50.1,PSS(2),1,"I")_"^"_^TMP("PSSP50",$J,50.1,PSS(2),1,"E"))
97 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),2)=$G(^TMP("PSSP50",$J,50.1,PSS(2),2,"I"))
98 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),400)=$G(^TMP("PSSP50",$J,50.1,PSS(2),400,"I"))
99 N PSSUTNX S PSSUTNX=$G(^TMP("PSSP50",$J,50.1,PSS(2),401,"I"))
100 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),401)=$S($G(PSSUTNX)="":"",1:$G(^TMP("PSSP50",$J,50.1,PSS(2),401,"I"))_"^"_$G(^TMP("PSSP50",$J,50.1,PSS(2),401,"E")))
101 I PSSUTNX'="" S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),401)=^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),401)_"^"_$P($G(^DIC(51.5,PSSUTNX,0)),"^",2)
102 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),402)=$G(^TMP("PSSP50",$J,50.1,PSS(2),402,"I"))
103 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),403)=$G(^TMP("PSSP50",$J,50.1,PSS(2),403,"I"))
104 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),404)=$G(^TMP("PSSP50",$J,50.1,PSS(2),404,"I"))
105 S ^TMP($J,LIST,+PSS(1),"SYN",+PSS(2),405)=$G(^TMP("PSSP50",$J,50.1,PSS(2),405,"I"))
106 Q
107 ;
108SETINV ;
109 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
110 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
111 S ^TMP($J,LIST,+PSS(1),11)=$G(^TMP("PSSP50",$J,50,PSS(1),11,"I"))
112 N PSSUTN S PSSUTN=$G(^TMP("PSSP50",$J,50,PSS(1),12,"I"))
113 S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSSUTN)="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),12,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),12,"E")))
114 I PSSUTN'="" S ^TMP($J,LIST,+PSS(1),12)=^TMP($J,LIST,+PSS(1),12)_"^"_$P($G(^DIC(51.5,PSSUTN,0)),"^",2)
115 S ^TMP($J,LIST,+PSS(1),13)=$G(^TMP("PSSP50",$J,50,PSS(1),13,"I"))
116 S ^TMP($J,LIST,+PSS(1),14)=$G(^TMP("PSSP50",$J,50,PSS(1),14,"I"))
117 S ^TMP($J,LIST,+PSS(1),15)=$G(^TMP("PSSP50",$J,50,PSS(1),15,"I"))
118 S ^TMP($J,LIST,+PSS(1),16)=$G(^TMP("PSSP50",$J,50,PSS(1),16,"I"))
119 S ^TMP($J,LIST,+PSS(1),17)=$G(^TMP("PSSP50",$J,50,PSS(1),17,"I"))
120 S ^TMP($J,LIST,+PSS(1),14.5)=$G(^TMP("PSSP50",$J,50,PSS(1),14.5,"I"))
121 S ^TMP($J,LIST,+PSS(1),17.1)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.1,"I"))="":"",1:^TMP("PSSP50",$J,50,PSS(1),17.1,"I")_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.1,"E")))
122 S ^TMP($J,LIST,+PSS(1),50)=$G(^TMP("PSSP50",$J,50,PSS(1),50,"I"))
123 Q
124SETIFC ;
125 S ^TMP($J,LIST,+PSS(1),"IFC",+PSS(2),.01)=$S($G(^TMP("PSSP50",$J,50.0441,PSS(2),.01,"I"))="":"",1:^TMP("PSSP50",$J,50.0441,PSS(2),.01,"I"))
126 Q
Note: See TracBrowser for help on using the repository browser.