source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50B.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: 7.9 KB
Line 
1PSS50B ;BIR/LDT - API FOR INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4INV ;
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,SCR,PSS,PSSMLCT,PSSP50
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)]"")!($G(PSSRTOI)=1) 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 ^TMP($J,LIST,0)=1
25 .D SETSUB1^PSS50AQM(+PSSIEN2),SETSUB4^PSS50AQM(+PSSIEN2)
26 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;9*;11:17.1;50;441*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
27 .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETINV^PSS50ATC D
28 ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.1,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETSYN2^PSS50ATC
29 ..S ^TMP($J,LIST,+PSS(1),"SYN",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
30 ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0441,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETIFC^PSS50ATC
31 ..S ^TMP($J,LIST,+PSS(1),"IFC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
32 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
33 I $G(PSSFT)]"" D
34 .I PSSFT["??" D LOOP^PSS50B1 Q
35 .K ^TMP("DILIST",$J)
36 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
37 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
38 .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
39 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
40 ..D SETSUB1^PSS50AQM(PSSIEN),SETSUB4^PSS50AQM(PSSIEN) K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;9*;11:17.1;50;441*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
41 ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETINV^PSS50ATC D
42 ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.1,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETSYN2^PSS50ATC
43 ...S ^TMP($J,LIST,+PSS(1),"SYN",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
44 ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0441,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SETIFC^PSS50ATC
45 ...S ^TMP($J,LIST,+PSS(1),"IFC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
46 K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
47 Q
48 ;
49NDF ;
50 ;PSSIEN - IEN of entry in 50
51 ;PSSFT - Free Text name in 50
52 ;PSSFL - Inactive flag - "" - All entries
53 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
54 ;PSSPK - Application Package's Use - "" - All entries
55 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
56 ; part of their formulary.
57 ;;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
58 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
59 ; piece being returned.
60 N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
61 I $G(LIST)']"" Q
62 K ^TMP($J,LIST)
63 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
64 S SCR("S")=""
65 I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
66 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
67 .K ^TMP("DIERR",$J)
68 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
69 .S ^TMP($J,LIST,0)=1
70 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;20:25;27;29","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
71 .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETND^PSS50NDF
72 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
73 I $G(PSSFT)]"" D
74 .I PSSFT["??" D LOOP^PSS50NDF Q
75 .K ^TMP("DILIST",$J)
76 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
77 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
78 .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
79 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
80 ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;20:25;27;29","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
81 ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETND^PSS50NDF
82 K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
83 Q
84 ;
85DOSE ;
86 ;PSSIEN - IEN of entry in 50
87 ;PSSFT - Free Text name in 50
88 ;PSSFL - Inactive flag - "" - All entries
89 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
90 ;PSSPK - Application Package's Use - "" - All entries
91 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
92 ; part of their formulary.
93 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
94 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
95 ; piece being returned.
96 N DIERR,ZZERR,PSSP50,SCR,PSSMLCT,PSS
97 I $G(LIST)']"" Q
98 K ^TMP($J,LIST)
99 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
100 S SCR("S")=""
101 I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
102 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
103 .K ^TMP("DIERR",$J)
104 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
105 .S ^TMP($J,LIST,0)=1
106 .D SETSUB7^PSS50AQM(+PSSIEN2),SETSUB8^PSS50AQM(+PSSIEN2)
107 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;901;902;903*;904*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
108 .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SDOSE^PSS50DOS D
109 ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0903,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SDOSE2^PSS50DOS
110 ..S ^TMP($J,LIST,+PSS(1),"POS",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
111 ..S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0904,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SDOSE3^PSS50DOS
112 ..S ^TMP($J,LIST,+PSS(1),"LOC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
113 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
114 I $G(PSSFT)]"" D
115 .I PSSFT["??" D LOOP^PSS50DOS Q
116 .K ^TMP("DILIST",$J)
117 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
118 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
119 .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
120 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
121 ..D SETSUB7^PSS50AQM(PSSIEN),SETSUB8^PSS50AQM(PSSIEN) K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;901;902;903*;904*","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
122 ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SDOSE^PSS50DOS D
123 ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0903,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SDOSE2^PSS50DOS
124 ...S ^TMP($J,LIST,+PSS(1),"POS",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
125 ...S (PSS(2),PSSMLCT)=0 F S PSS(2)=$O(^TMP("PSSP50",$J,50.0904,PSS(2))) Q:'PSS(2) S PSSMLCT=PSSMLCT+1 D SDOSE3^PSS50DOS
126 ...S ^TMP($J,LIST,+PSS(1),"LOC",0)=$S($G(PSSMLCT):PSSMLCT,1:"-1^NO DATA FOUND")
127 K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
128 Q
Note: See TracBrowser for help on using the repository browser.