source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS52P7.m@ 1452

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1PSS52P7 ;BIR/LDT - API FOR INFORMATION FROM FILE 52.7; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4ZERO(PSSIEN,PSSFT,PSSFL,LIST) ;
5 ;PSSIEN - IEN of entry in IV SOLUTIONS file (#52.7).
6 ;PSSFT - Free Text name in IV SOLUTIONS file (#52.7).
7 ;PSSFL - Inactive flag - 0 or "" - All entries
8 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
10 ; Field Number of the data piece being returned.
11 ;Returns PRINT NAME field (#.01), PRINT NAME {2} field (#.02), GENERIC DRUG field (#1), VOLUME field (#2),
12 ;AVERAGE DRUG COST PER UNIT field (#7), INACTIVATION DATE field (#8), PHARMACY ORDERABLE ITEM field (#9),
13 ;USED IN IV FLUID ORDER ENTRY field (#17), ELECTROLYTES multiple (#4), ELECTROLYTES field (#.01),
14 ;CONCENTRATION (#1) of IV SOLUTIONS file (#52.7).
15 N DIERR,ZZERR,PSS52P7,SCR,PSS,CNT2
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 N ND D SETSCRN
22 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.7,"","A","`"_PSSIEN,,SCR("S"),"") D
23 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
24 .S ^TMP($J,LIST,0)=1
25 .D GETS^DIQ(52.7,+PSSIEN,".01;1;2;.02;7;8;9;17","IE","PSS52P7") S PSS(1)=0
26 .F S PSS(1)=$O(PSS52P7(52.7,PSS(1))) Q:'PSS(1) D SETZERO^PSS52P7A,GETS^DIQ(52.7,+PSSIEN,"4*","IE","PSS52P7") S (PSS(2),CNT2)=0
27 .F S PSS(2)=$O(PSS52P7(52.702,PSS(2))) Q:'PSS(2) D SETLTS^PSS52P7A S CNT2=CNT2+1
28 .S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
29 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
30 .I PSSFT["??" D LOOP^PSS52P7A(1) Q
31 .D FIND^DIC(52.7,,"@;.01;2","QP",PSSFT,,"B",SCR("S"),,"")
32 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
33 .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
34 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS52P7 D GETS^DIQ(52.7,+PSSIEN,".01;1;2;.02;7;8;9;17","IE","PSS52P7") S PSS(1)=0
35 ..F S PSS(1)=$O(PSS52P7(52.7,PSS(1))) Q:'PSS(1) D SETZERO^PSS52P7A K PSS52P7 D GETS^DIQ(52.7,+PSSIEN,"4*","IE","PSS52P7") S (PSS(2),CNT2)=0
36 ..F S PSS(2)=$O(PSS52P7(52.702,PSS(2))) Q:'PSS(2) D SETLTS^PSS52P7A S CNT2=CNT2+1
37 ..S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
38 K ^TMP("DILIST",$J)
39 Q
40 ;
41DRGIEN(PSS50,PSSFL,LIST) ;
42 ;PSS50 - IEN of entry in DRUG file (#50).
43 ;PSSFL - Inactive flag - 0 or "" - All entries
44 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
45 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
46 ; Field Number of the data piece being returned.
47 ;Returns PRINT NAME field (#.01) and VOLUME field (#2) of IV SOLUTIONS file (#52.7).
48 N DIERR,ZZERR,PSS52P7,SCR
49 I $G(LIST)']"" Q
50 K ^TMP($J,LIST)
51 I +$G(PSS50)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
52 S SCR("S")=""
53 I +$G(PSSFL)>0 N ND D SETSCRN
54 I +$G(PSS50)>0 D FIND^DIC(52.7,,"@;.01;2","QPX",PSS50,,"AC",SCR("S"),,"PSS52P7")
55 I +PSS52P7("DILIST",0)=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
56 I +PSS52P7("DILIST",0)>0 S ^TMP($J,LIST,0)=+PSS52P7("DILIST",0) N PSSXX S PSSXX=0 F S PSSXX=$O(PSS52P7("DILIST",PSSXX)) Q:'PSSXX D
57 .S ^TMP($J,LIST,+PSS52P7("DILIST",PSSXX,0),.01)=$P($G(PSS52P7("DILIST",PSSXX,0)),"^",2)
58 .S ^TMP($J,LIST,"AC",$P($G(PSS52P7("DILIST",PSSXX,0)),"^",2),+PSS52P7("DILIST",PSSXX,0))=""
59 .S ^TMP($J,LIST,+PSS52P7("DILIST",PSSXX,0),2)=$P($G(PSS52P7("DILIST",PSSXX,0)),"^",3)
60 Q
61 ;
62INACTDT(PSSIEN) ;
63 ;PSSIEN - IEN of entry in IV SOLUTIONS file (#52.7).
64 ;Returns INACTIVATION DATE field (#8) of IV SOLUTIONS file (#52.7).
65 N DIERR,ZZERR,PSS52P7,PSS
66 I +$G(PSSIEN)'>0 Q ""
67 I +$G(PSSIEN)>0 D GETS^DIQ(52.7,+PSSIEN,"8","I","PSS52P7") S PSS(1)=0 D
68 .I '$D(PSS52P7) S PSSINACT="" Q
69 .F S PSS(1)=$O(PSS52P7(52.7,PSS(1))) Q:'PSS(1) S PSSINACT=$G(PSS52P7(52.7,PSS(1),8,"I"))
70 Q PSSINACT
71 ;
72LOOKUP(PSSFT,LIST) ;
73 ;PSSFT - Free Text name in IV SOLUTIONS file (#52.7).
74 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
75 ; Field Number of the data piece being returned.
76 ;Returns PRINT NAME field (#.01), VOLUME field (#2), and PRINT NAME {2} field (#.02) of IV SOLUTIONS file (#52.7).
77 N DIERR,ZZERR,PSS52P7,PSS
78 I $G(LIST)']"" Q
79 K ^TMP($J,LIST)
80 I $G(PSSFT)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
81 I PSSFT["??" D LOOP^PSS52P7A(2) Q
82 D FIND^DIC(52.7,,"@;.01;","QP",PSSFT,,"B",,,"")
83 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
84 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
85 .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS52P7 D GETS^DIQ(52.7,+PSSIEN,".01;2;.02","IE","PSS52P7") S PSS(1)=0
86 .F S PSS(1)=$O(PSS52P7(52.7,PSS(1))) Q:'PSS(1) D SETLOOK^PSS52P7A
87 K ^TMP("DILIST",$J)
88 Q
89 ;
90POICHK(PSSIEN) ;
91 ;PSSIEN - IEN of entry in IV SOLUTIONS file (#52.7).
92 ;Returns PHARMACY ORDERABLE ITEM field (#9) PHARMACY ORDERABLE ITEM of IV SOLUTIONS file (#52.7).
93 N DIERR,ZZERR,PSS52P7,PSS
94 I +$G(PSSIEN)'>0 Q 0
95 I +$G(PSSIEN)>0 D GETS^DIQ(52.7,+PSSIEN,"9","I","PSS52P7") S PSS(1)=0 D
96 .I '$D(PSS52P7) S PSSOI=0
97 .F S PSS(1)=$O(PSS52P7(52.7,PSS(1))) Q:'PSS(1) S PSSOI=+$G(PSS52P7(52.7,PSS(1),9,"I"))
98 Q PSSOI
99 ;
100POI(PSSOI,PSSFL,LIST) ;
101 ;PSSOI - IEN of entry in the PHARMACY ORDERABLE ITEM file (#50.7) [required].
102 ;PSSFL - Inactive flag - 0 or "" - All entries
103 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
104 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
105 ; Field Number of the data piece being returned.
106 ;Returns PRINT NAME field (#.01) and VOLUME field (#2) of IV SOLUTIONS file (#52.7).
107 N DIERR,ZZERR,PSS52P7,SCR
108 I $G(LIST)']"" Q
109 K ^TMP($J,LIST)
110 I +$G(PSSOI)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
111 S SCR("S")=""
112 I +$G(PSSFL)>0 N ND D SETSCRN
113 D FIND^DIC(52.7,,"@;.01;2","QPX",PSSOI,,"AOI",SCR("S"),,"")
114 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
115 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
116 .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
117 .S ^TMP($J,LIST,+PSSIEN,.01)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2)
118 .S ^TMP($J,LIST,"AOI",$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",2),+PSSIEN)=""
119 .S ^TMP($J,LIST,+PSSIEN,2)=$P($G(^TMP("DILIST",$J,PSSXX,0)),"^",3)
120 K ^TMP("DILIST",$J)
121 Q
122 ;
123ACTSOL(PSSFL,LIST) ;
124 ;PSSFL - Inactive flag - 0 or "" - All entries
125 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
126 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
127 ; Field Number of the data piece being returned.
128 ;Returns PRINT NAME field (#.01) and VOLUME field (#2) of IV SOLUTIONS file (#52.7).
129 N DIERR,ZZERR,PSSIEN,CNT,SCR
130 I $G(LIST)']"" Q
131 K ^TMP($J,LIST)
132 S SCR("S")=""
133 I +$G(PSSFL)>0 N ND D SETSCRN
134 ;Naked reference below refers to ^PS(52.7,+Y,"I")
135 I +$G(PSSFL)'>0 S SCR("S")="S ND=$P($G(^(""I"")),U) I ND=""""!(ND>DT)"
136 N PSSIEN S (CNT,PSSIEN)=0 F S PSSIEN=$O(^PS(52.7,PSSIEN)) Q:'PSSIEN D
137 .D FIND^DIC(52.7,,"@;.01;2","QP","`"_PSSIEN,,"B",SCR("S"),,"")
138 .I ^TMP("DILIST",$J,0)>0 S CNT=CNT+1 D
139 ..S ^TMP($J,LIST,+PSSIEN,.01)=$P($G(^TMP("DILIST",$J,1,0)),"^",2)
140 ..S ^TMP($J,LIST,"B",$P($G(^TMP("DILIST",$J,1,0)),"^",2),+PSSIEN)=""
141 ..S ^TMP($J,LIST,+PSSIEN,2)=$P($G(^TMP("DILIST",$J,1,0)),"^",3)
142 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:-1_"^"_"NO DATA FOUND")
143 K ^TMP("DILIST",$J)
144 Q
145 ;
146SETSCRN ;Set Screen for inactive Solutions
147 ;Naked reference below refers to ^PS(52.7,+Y,"I")
148 S SCR("S")="S ND=$P($G(^(""I"")),U) I ND=""""!(ND>PSSFL)"
149 Q
Note: See TracBrowser for help on using the repository browser.