source: FOIAVistA/trunk/r/NATIONAL_DRUG_FILE-PSN/PSN50P41.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1PSN50P41 ;BIR/LDT - API FOR INFORMATION FROM FILE 50.416; 5 Sep 03
2 ;;4.0; NATIONAL DRUG FILE;**80**; 30 Oct 98
3 ;
4B() ;RETURNS THE GLOBAL ROOT OF THE "B" CROSSREFERENCE IN ^PS(50.416
5 Q "^PS(50.416,""B"")"
6 ;
7ZERO(PSNIEN,PSNFT,PSNFL,LIST) ;
8 ;PSNIEN - IEN of entry in DRUG INGREDIENTS file (#50.416).
9 ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
10 ;PSNFL - Inactive flag - "" - All entries.
11 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
12 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
13 ; Field Number of the data piece being returned.
14 ;Returns NAME field (#.01), PRIMARY INGREDIENT field (#2), and INACTIVATION DATE field (#3)
15 ;of DRUG INGREDIENTS file (#50.416).
16 N DIERR,ZZERR,PSN50P41,SCR,PSN
17 I $G(LIST)']"" Q
18 K ^TMP($J,LIST)
19 I $G(PSNIEN)']"",($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
20 I $G(PSNIEN)]"",(+$G(PSNIEN)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
21 S SCR("S")=""
22 I +$G(PSNFL)>0 D SETSCRN^PSN50P4A
23 I $G(PSNIEN)]"" N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.416,"","A","`"_PSNIEN,,SCR("S"),"") D
24 .I +PSNIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
25 .S ^TMP($J,LIST,0)=1
26 .D GETS^DIQ(50.416,+PSNIEN2,".01;2;3","IE","PSN50P41") S PSN(1)=0
27 .F S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1) D SETALL^PSN50P4A
28 I $G(PSNIEN)="",$G(PSNFT)]"" D
29 .I PSNFT["??" D LOOP^PSN50P4A(1) Q
30 .D FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"B",SCR("S"),,"")
31 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
32 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSNXX S PSNXX=0 F S PSNXX=$O(^TMP("DILIST",$J,PSNXX)) Q:'PSNXX D
33 ..S PSNIEN=+^TMP("DILIST",$J,PSNXX,0) K PSN50P41 D GETS^DIQ(50.416,+PSNIEN,".01;2;3","IE","PSN50P41") S PSN(1)=0
34 ..F S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1) D SETALL^PSN50P4A K PSN50P41
35 K ^TMP("DILIST",$J)
36 Q
37 ;
38NAME(PSNFT,LIST) ;
39 ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
40 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
41 ; Field Number of the data piece being returned.
42 ;Returns NAME field (#.01), and PRIMARY INGREDIENT field (#2) of DRUG INGREDIENTS file (#50.416).
43 N DIERR,ZZERR,PSN50P41,PSN
44 I $G(LIST)']"" Q
45 K ^TMP($J,LIST)
46 I ($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
47 I PSNFT["??" D LOOP2^PSN50P4A Q
48 D FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"P",,,"")
49 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
50 I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSNXX S PSNXX=0 F S PSNXX=$O(^TMP("DILIST",$J,PSNXX)) Q:'PSNXX D
51 .S PSNIEN=+^TMP("DILIST",$J,PSNXX,0) K PSN50P41 D GETS^DIQ(50.416,+PSNIEN,".01;2;","IE","PSN50P41") S PSN(1)=0
52 .F S PSN(1)=$O(PSN50P41(50.416,PSN(1))) Q:'PSN(1) D SETALL2^PSN50P4A K PSN50P41
53 K ^TMP("DILIST",$J)
54 Q
55 ;
56ID(PSNIEN,PSNFT,LIST) ;
57 ;PSNIEN - IEN of entry in DRUG INGREDIENTS file (#50.416).
58 ;PSNFT - Free Text name in DRUG INGREDIENTS file (#50.416).
59 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
60 ; Field Number of the data piece being returned.
61 ;Returns DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
62 N DIERR,ZZERR,PSN50P41,PSN
63 I $G(LIST)']"" Q
64 K ^TMP($J,LIST)
65 I +$G(PSNIEN)'>0,($G(PSNFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
66 I $G(PSNIEN)]"",(+$G(PSNIEN)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
67 I +$G(PSNIEN)>0 N PSNIEN2 S PSNIEN2=$$FIND1^DIC(50.416,"","A","`"_PSNIEN,,,"") D
68 .I +PSNIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
69 .S ^TMP($J,LIST,0)=1
70 .S PSNIEN=PSNIEN2 I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
71 .D GETS^DIQ(50.416,+PSNIEN2,".01;1*","IE","^TMP(""PSNAPD"",$J)") S PSN(1)=0
72 .F S PSN(1)=$O(^TMP("PSNAPD",$J,50.416,PSN(1))) Q:'PSN(1) D
73 ..S ^TMP($J,LIST,+PSN(1),.01)=$G(^TMP("PSNAPD",$J,50.416,PSN(1),.01,"I"))
74 ..S ^TMP($J,LIST,"B",$G(^TMP("PSNAPD",$J,50.416,PSN(1),.01,"I")),+PSN(1))=""
75 ..S (CNT,PSN(2))=0 F S PSN(2)=$O(^TMP("PSNAPD",$J,50.4161,PSN(2))) Q:'PSN(2) D
76 ...S ^TMP($J,LIST,+PSN(1),"ID",+PSN(2),.01)=$G(^TMP("PSNAPD",$J,50.4161,PSN(2),.01,"I")),CNT=CNT+1
77 ..S ^TMP($J,LIST,+PSN(1),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
78 I $G(PSNIEN)="",$G(PSNFT)]"" D
79 .I PSNFT["??" D LOOP^PSN50P4A(2) Q
80 .D FIND^DIC(50.416,,"@;.01;","QP",PSNFT,,"B",,,"")
81 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
82 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSNXX S PSNXX=0 F S PSNXX=$O(^TMP("DILIST",$J,PSNXX)) Q:'PSNXX D
83 ..S PSNIEN=+^TMP("DILIST",$J,PSNXX,0)
84 ..I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
85 ..K ^TMP("PSNAPD",$J) D GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPD"",$J)") S PSN(1)=0
86 ..F S PSN(1)=$O(^TMP("PSNAPD",$J,50.416,PSN(1))) Q:'PSN(1) D K PSN50P41
87 ...S ^TMP($J,LIST,+PSN(1),.01)=$G(^TMP("PSNAPD",$J,50.416,PSN(1),.01,"I"))
88 ...S ^TMP($J,LIST,"B",$G(^TMP("PSNAPD",$J,50.416,PSN(1),.01,"I")),+PSN(1))=""
89 ...S (CNT,PSN(2))=0 F S PSN(2)=$O(^TMP("PSNAPD",$J,50.4161,PSN(2))) Q:'PSN(2) D
90 ....S ^TMP($J,LIST,+PSN(1),"ID",+PSN(2),.01)=$G(^TMP("PSNAPD",$J,50.4161,PSN(2),.01,"I")),CNT=CNT+1
91 ...S ^TMP($J,LIST,+PSN(1),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
92 K ^TMP("DILIST",$J),^TMP("PSNAPD",$J)
93 Q
94 ;
95APS(PSNPI,LIST) ;
96 ;PSNPI - PRIMARY INGREDIENT field (#2) of the DRUG INGREDIENTS file (#50.416)
97 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
98 ; Field Number of the data piece being returned.
99 ;Returns DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
100 N DIERR,ZZERR,PSN50P41,PSN,CNT
101 I $G(LIST)']"" Q
102 K ^TMP($J,LIST)
103 I +$G(PSNPI)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
104 ;Naked reference below refers to ^PS(50.416,+Y,0)
105 S SCR("S")="S ND=$G(^(0)) I $P(ND,""^"",2)=PSNPI"
106 I +$G(PSNPI)>0 D FIND^DIC(50.416,,"@;.01","QP",PSNPI,,"APS",SCR("S"),"")
107 I +^TMP("DILIST",$J,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
108 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
109 S PSN(1)=0 F S PSN(1)=$O(^TMP("DILIST",$J,PSN(1))) Q:'PSN(1) D
110 .S PSNIEN=+^TMP("DILIST",$J,PSN(1),0)
111 .I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
112 .K ^TMP("PSNAPS",$J) D GETS^DIQ(50.416,+PSNIEN,".01;1*","IE","^TMP(""PSNAPS"",$J)") S PSN(2)=0
113 .F S PSN(2)=$O(^TMP("PSNAPS",$J,50.416,PSN(2))) Q:'PSN(2) D
114 ..S ^TMP($J,LIST,+PSN(2),.01)=$G(^TMP("PSNAPS",$J,50.416,PSN(2),.01,"I"))
115 ..S ^TMP($J,LIST,"APS",$G(^TMP("PSNAPS",$J,50.416,PSN(2),.01,"I")),+PSN(2))=""
116 ..S (CNT,PSN(3))=0 F S PSN(3)=$O(^TMP("PSNAPS",$J,50.4161,PSN(3))) Q:'PSN(3) D
117 ...S ^TMP($J,LIST,+PSN(2),"ID",+PSN(3),.01)=$G(^TMP("PSNAPS",$J,50.4161,PSN(3),.01,"I")),CNT=CNT+1
118 ...S ^TMP($J,LIST,+PSN(2),"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
119 K ^TMP("DILIST",$J),^TMP("PSNAPS",$J)
120 Q
121 ;
122APD(PSNID,LIST) ;
123 ;PSNID - DRUG IDENTIFIER field (#.01) of the DRUG IDENTIFIER multiple of the DRUG INGREDIENTS file (#50.416)
124 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
125 ; Field Number of the data piece being returned.
126 ;Returns NAME field (#.01), PRIMARY INGREDIENTS field (#2), and DRUG IDENTIFIER field (#.01)
127 ;of the DRUG IDENTIFIER multiple (#50.4161) of DRUG INGREDIENTS file (#50.416).
128 N DIERR,ZZERR,PSN,CNT,CNT1
129 I $G(LIST)']"" Q
130 K ^TMP($J,LIST),^TMP("PSNAPD",$J)
131 I $G(PSNID)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
132 I $L(PSNID)>30!($L(PSNID)<3)!'(PSNID?1.N1"A"1.N) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
133 D FIND^DIC(50.416,,"@;.01","QP",PSNID,,"APD",,,"")
134 I +^TMP("DILIST",$J,0)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
135 ;S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
136 S (CNT1,PSN(1))=0 F S PSN(1)=$O(^TMP("DILIST",$J,PSN(1))) Q:'PSN(1) D
137 .S PSNIEN=+^TMP("DILIST",$J,PSN(1),0)
138 .I $O(^PS(50.416,+PSNIEN,1,0)),'$D(^PS(50.416,+PSNIEN,1,0)) D SETHDR^PSN50P4A
139 .K ^TMP("PSNAPD",$J) D GETS^DIQ(50.416,+PSNIEN,".01;2;1*","IE","^TMP(""PSNAPD"",$J)") D
140 ..Q:'$D(^PS(50.416,"APD",PSNID,+PSNIEN))
141 ..S CNT1=CNT1+1
142 ..S (CNT,PSN(2))=0 F S PSN(2)=$O(^TMP("PSNAPD",$J,50.4161,PSN(2))) Q:'PSN(2) D
143 ...S ^TMP($J,LIST,+PSNIEN,"ID",+PSN(2),.01)=$G(^TMP("PSNAPD",$J,50.4161,PSN(2),.01,"I")),CNT=CNT+1
144 ..S ^TMP($J,LIST,+PSNIEN,"ID",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
145 ..S PSN(3)=0 F S PSN(3)=$O(^TMP("PSNAPD",$J,50.416,PSN(3))) Q:'PSN(3) D
146 ...S ^TMP($J,LIST,+PSN(3),.01)=$G(^TMP("PSNAPD",$J,50.416,PSN(3),.01,"I"))
147 ...S ^TMP($J,LIST,"APD",$G(^TMP("PSNAPD",$J,50.416,PSN(3),.01,"I")),+PSN(3))=""
148 ...S ^TMP($J,LIST,+PSN(3),2)=$S($G(^TMP("PSNAPD",$J,50.416,PSN(3),2,"I"))="":"",1:^TMP("PSNAPD",$J,50.416,PSN(3),2,"I")_"^"_^TMP("PSNAPD",$J,50.416,PSN(3),2,"E"))
149 S ^TMP($J,LIST,0)=$S(CNT1>0:CNT1,1:"-1^NO DATA FOUND")
150 K ^TMP("DILIST",$J),^TMP("PSNAPD",$J)
151 Q
Note: See TracBrowser for help on using the repository browser.