source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS52P6A.m@ 1806

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

initial load of WorldVistAEHR
File size: 7.9 KB
Line 
1PSS52P6A ;BIR/LDT - SETS ARRAYS AND INACTIVE SCREEN CALLED FROM PSS52P6; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4 ;
5 ;
6SETSCRN ;Set Screen for inactive Additives
7 ;Naked reference below refers to ^PS(52.6,+Y,"I")
8 S SCR("S")="S ND=$P($G(^(""I"")),U) I ND=""""!(ND>PSSFL)"
9 Q
10 ;
11SETZRO ;
12 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS52P6(52.6,PSS(1),.01,"I"))
13 S ^TMP($J,LIST,"B",$G(PSS52P6(52.6,PSS(1),.01,"I")),+PSS(1))=""
14 S ^TMP($J,LIST,+PSS(1),1)=$S($G(PSS52P6(52.6,PSS(1),1,"I"))="":"",1:PSS52P6(52.6,PSS(1),1,"I")_"^"_PSS52P6(52.6,PSS(1),1,"E"))
15 S ^TMP($J,LIST,+PSS(1),2)=$S($G(PSS52P6(52.6,PSS(1),2,"I"))="":"",1:PSS52P6(52.6,PSS(1),2,"I")_"^"_PSS52P6(52.6,PSS(1),2,"E"))
16 S ^TMP($J,LIST,+PSS(1),3)=$G(PSS52P6(52.6,PSS(1),3,"I"))
17 S ^TMP($J,LIST,+PSS(1),4)=$G(PSS52P6(52.6,PSS(1),4,"I"))
18 S ^TMP($J,LIST,+PSS(1),5)=$G(PSS52P6(52.6,PSS(1),5,"I"))
19 S ^TMP($J,LIST,+PSS(1),7)=$G(PSS52P6(52.6,PSS(1),7,"I"))
20 S ^TMP($J,LIST,+PSS(1),14)=$G(PSS52P6(52.6,PSS(1),14,"I"))
21 S ^TMP($J,LIST,+PSS(1),13)=$G(PSS52P6(52.6,PSS(1),13,"I"))
22 S ^TMP($J,LIST,+PSS(1),15)=$S($G(PSS52P6(52.6,PSS(1),15,"I"))="":"",1:PSS52P6(52.6,PSS(1),15,"I")_"^"_PSS52P6(52.6,PSS(1),15,"E"))
23 S ^TMP($J,LIST,+PSS(1),17)=$S($G(PSS52P6(52.6,PSS(1),17,"I"))="":"",1:PSS52P6(52.6,PSS(1),17,"I")_"^"_PSS52P6(52.6,PSS(1),17,"E"))
24 S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSS52P6(52.6,PSS(1),12,"I"))="":"",1:PSS52P6(52.6,PSS(1),12,"I")_"^"_PSS52P6(52.6,PSS(1),12,"E"))
25 Q
26 ;
27SETZRO2 ;
28 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I"))
29 S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I")),+PSS(1))=""
30 S ^TMP($J,LIST,+PSS(1),14)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),14,"I"))
31 Q
32 ;
33SETQCD ;
34 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),.01,"I"))
35 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),1)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),1,"I"))
36 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),2)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),2,"I"))
37 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),3)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),3,"I"))
38 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),4)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),4,"I"))
39 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),5)=$G(^TMP("PSS52P6",$J,52.61,PSS(1),5,"I"))
40 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),6)=$S($G(^TMP("PSS52P6",$J,52.61,PSS(1),6,"I"))="":"",1:^TMP("PSS52P6",$J,52.61,PSS(1),6,"I")_"^"_^TMP("PSS52P6",$J,52.61,PSS(1),6,"E"))
41 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(1),7)=$S($G(^TMP("PSS52P6",$J,52.61,PSS(1),7,"I"))="":"",1:^TMP("PSS52P6",$J,52.61,PSS(1),7,"I")_"^"_^TMP("PSS52P6",$J,52.61,PSS(1),7,"E"))
42 Q
43 ;
44SETQCD2 ;
45 S ^TMP($J,LIST,+PSSIEN,"QCODE",+PSS(2),.01)=$G(^TMP("PSS52P6",$J,52.61,PSS(2),.01,"I"))
46 Q
47 ;
48SETLTS ;
49 S ^TMP($J,LIST,+PSSIEN,"ELYTES",+PSS(1),.01)=$S($G(^TMP("PSS52P6",$J,52.62,PSS(1),.01,"I"))="":"",1:^TMP("PSS52P6",$J,52.62,PSS(1),.01,"I")_"^"_^TMP("PSS52P6",$J,52.62,PSS(1),.01,"E"))
50 S ^TMP($J,LIST,+PSSIEN,"ELYTES",+PSS(1),1)=$G(^TMP("PSS52P6",$J,52.62,PSS(1),1,"I"))
51 Q
52 ;
53SETSYN ;
54 S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.63,PSS(1),.01,"I"))
55 Q
56 ;
57SETSYN2 ;
58 S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(3),.01)=$G(^TMP("PSS52P6",$J,52.63,PSS(3),.01,"I"))
59 Q
60 ;
61SETDRI ;
62 S ^TMP($J,LIST,+PSS(1),"DRGINF",+PSS(3),.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3)))
63 Q
64 ;
65SETIACT ;
66 S ^TMP($J,LIST,+PSS(1),12)=$S($G(PSS52P6(52.6,PSS(1),12,"I"))="":"",1:PSS52P6(52.6,PSS(1),12,"I")_"^"_PSS52P6(52.6,PSS(1),12,"E"))
67 Q
68 ;
69LOOP(PSSNUM) ;
70 N CNT S CNT=0
71 S PSS(2)=0 F S PSS(2)=$O(^PS(52.6,PSS(2))) Q:'PSS(2) D @(PSSNUM)
72 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
73 Q
74 ;
751 ;Called from LOOP in response to "??" entered at ZERO^PSS52P6.
76 S PSSIEN=+PSS(2) K PSS52P6
77 S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;1;2;3;4;5;7;12;13;14;15;17","IE","PSS52P6") S PSS(1)=0 D
78 .F S PSS(1)=$O(PSS52P6(52.6,PSS(1))) Q:'PSS(1) D SETZRO S CNT=CNT+1
79 Q
80 ;
812 ;Called from LOOP in response to "??" entered at QCODE^PSS52P6.
82 N CNT2
83 S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
84 S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;6*","IE","^TMP(""PSS52P6"",$J)") D
85 .S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(3))) Q:'PSS(3) D
86 ..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"I"))
87 ..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"E")),+PSSIEN)="",CNT=CNT+1
88 .I '$D(^TMP("PSS52P6",$J,52.61)) S ^TMP($J,LIST,+PSSIEN,"QCODE",0)="-1^NO DATA FOUND"
89 .S (PSS(1),CNT2)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.61,PSS(1))) Q:'PSS(1) D SETQCD S CNT2=CNT2+1
90 .S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
91 Q
92 ;
933 ;Called from LOOP in response to "??" entered at ELYTES^PSS52P6.
94 N CNT2
95 S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
96 S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;8*","IE","^TMP(""PSS52P6"",$J)") D
97 .S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(3))) Q:'PSS(3) D
98 ..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"I"))
99 ..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"E")),+PSSIEN)="",CNT=CNT+1
100 ..S (PSS(1),CNT2)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.62,PSS(1))) Q:'PSS(1) D SETLTS S CNT2=CNT2+1
101 ..S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
102 Q
103 ;
1044 ;Called from LOOP in response to "??" entered at SYNONYM^PSS52P6.
105 S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
106 S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;9*","IE","^TMP(""PSS52P6"",$J)") D
107 .N CNT2 S (PSS(1),CNT2)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.63,PSS(1))) Q:'PSS(1) D SETSYN S CNT2=CNT2+1
108 .S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(3))) Q:'PSS(3) D
109 ..S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"I"))
110 ..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(3),.01,"E")),+PSSIEN)="",CNT=CNT+1
111 .S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
112 Q
113 ;
1145 ;Called from LOOP in response to "??" entered at DRGINFO^PSS52P6.
115 N CNT2
116 S PSSIEN=+PSS(2) K ^TMP("PSS52P6",$J)
117 S ND=$P($G(^PS(52.6,+PSSIEN,"I")),U) I ND=""!(ND>$G(PSSFL)) D GETS^DIQ(52.6,+PSSIEN,".01;10","E","^TMP(""PSS52P6"",$J)") D
118 .S PSS(1)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
119 ..S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E"))
120 ..S ^TMP($J,LIST,"B",$G(^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E")),+PSS(1))="",CNT=CNT+1
121 ..S (PSS(3),CNT2)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3))) Q:'PSS(3) D SETDRI^PSS52P6A S CNT2=CNT2+1
122 ..S ^TMP($J,LIST,+PSSIEN,"DRGINF",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
123 Q
124QCODE ;
125 S SCR("S")=""
126 I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
127 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
128 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
129 .S ^TMP($J,LIST,0)=1
130 .D GETS^DIQ(52.6,+PSSIEN2,".01;6*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0
131 .F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
132 ..S ^TMP($J,LIST,+PSSIEN2,.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I")
133 ..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I"),+PSSIEN2)=""
134 .N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.61,PSS(1))) Q:'PSS(1) D SETQCD^PSS52P6A S CNT=CNT+1
135 .S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
136 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
137 .I PSSFT["??" D LOOP^PSS52P6A(2) Q
138 .D FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B^C",SCR("S"),,"")
139 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
140 .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
141 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,"6*","IE","^TMP(""PSS52P6"",$J)") D
142 ...S ^TMP($J,LIST,+PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
143 ...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),+PSSIEN)=""
144 ..N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.61,PSS(1))) Q:'PSS(1) D SETQCD^PSS52P6A S CNT=CNT+1
145 ..S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
146 K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
147 Q
Note: See TracBrowser for help on using the repository browser.