source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50C1.m@ 1250

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

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1PSS50C1 ;BIR/RTR - APIs for encapsulation continued; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4SETWS ;
5 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
6 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
7 S ^TMP($J,LIST,+PSS(1),300)=$G(^TMP("PSSP50",$J,50,PSS(1),300,"I"))
8 S ^TMP($J,LIST,+PSS(1),301)=$S($G(^TMP("PSSP50",$J,50,PSS(1),301,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),301,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),301,"E")))
9 S ^TMP($J,LIST,+PSS(1),302)=$G(^TMP("PSSP50",$J,50,PSS(1),302,"I"))
10 Q
11 ;
12LOOP ;
13 N PSS50DD6,PSS50ER6,PSSPCATS D FIELD^DID(50,301,"Z","POINTER","PSS50DD6","PSS50ER6") S PSSPCATS=$G(PSS50DD6("POINTER"))
14 N PSSENCT
15 S PSSENCT=0
16 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
17 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
18 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
19 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
20 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
21 .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
22 .I $G(PSSPK)]"",'PSSZ5 Q
23 .D SETWSL
24 .S PSSENCT=PSSENCT+1
25 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
26 Q
27 ;
28SETWSL ;
29 N PSSZNODE,PSSPSGND
30 S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSSPSGND=$G(^("PSG"))
31 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
32 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
33 S ^TMP($J,LIST,+PSS(1),300)=$P(PSSPSGND,"^")
34 N PSSPCAT S PSSPCAT=$P(PSSPSGND,"^",2) D
35 .I PSSPCAT'="",PSSPCATS'="",PSSPCATS[(PSSPCAT_":") S ^TMP($J,LIST,+PSS(1),301)=PSSPCAT_"^"_$P($E(PSSPCATS,$F(PSSPCATS,(PSSPCAT_":")),999),";") Q
36 .S ^TMP($J,LIST,+PSS(1),301)=""
37 S ^TMP($J,LIST,+PSS(1),302)=$P(PSSPSGND,"^",3)
38 Q
39 ;
40LOOPMR ;
41 N PSSENCT
42 S PSSENCT=0
43 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
44 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
45 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
46 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
47 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
48 .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
49 .I $G(PSSPK)]"",'PSSZ5 Q
50 .D SETMRTNL
51 .S PSSENCT=PSSENCT+1
52 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
53 Q
54 ;
55SETMRTN ;
56 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
57 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
58 S ^TMP($J,LIST,+PSS(1),17.2)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"E")))
59 S ^TMP($J,LIST,+PSS(1),17.5)=$G(^TMP("PSSP50",$J,50,PSS(1),17.5,"I"))
60 S ^TMP($J,LIST,+PSS(1),31)=$G(^TMP("PSSP50",$J,50,PSS(1),31,"I"))
61 Q
62SETMRTNL ;
63 N PSSZNODE,PSS50CL,PSS50CL1,PSS50CL2
64 S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50CL=$G(^("CLOZ")),PSS50CL1=$G(^("CLOZ1")),PSS50CL2=$G(^(2))
65 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
66 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
67 N PSSCLZAR D GETS^DIQ(50,+PSS(1),"17.2","IE","PSSCLZAR")
68 S ^TMP($J,LIST,+PSS(1),17.2)=$S($G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))="":"",1:$G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))_"^"_$G(PSSCLZAR(50,+PSS(1)_",",17.2,"E")))
69 S ^TMP($J,LIST,+PSS(1),17.5)=$P(PSS50CL1,"^")
70 S ^TMP($J,LIST,+PSS(1),31)=$P(PSS50CL2,"^",4)
71 Q
72SETZRO ;
73 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
74 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
75 S ^TMP($J,LIST,+PSS(1),2)=$G(^TMP("PSSP50",$J,50,PSS(1),2,"I"))
76 S ^TMP($J,LIST,+PSS(1),3)=$G(^TMP("PSSP50",$J,50,PSS(1),3,"I"))
77 S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSSP50",$J,50,PSS(1),4,"I"))
78 S ^TMP($J,LIST,+PSS(1),5)=$G(^TMP("PSSP50",$J,50,PSS(1),5,"I"))
79 S ^TMP($J,LIST,+PSS(1),6)=$G(^TMP("PSSP50",$J,50,PSS(1),6,"I"))
80 S ^TMP($J,LIST,+PSS(1),8)=$G(^TMP("PSSP50",$J,50,PSS(1),8,"I"))
81 S ^TMP($J,LIST,+PSS(1),51)=$S($G(^TMP("PSSP50",$J,50,PSS(1),51,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),51,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),51,"E")))
82 S ^TMP($J,LIST,+PSS(1),52)=$S($G(^TMP("PSSP50",$J,50,PSS(1),52,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),52,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),52,"E")))
83 S ^TMP($J,LIST,+PSS(1),101)=$G(^TMP("PSSP50",$J,50,PSS(1),101,"I"))
84 Q
85LOOPZR ;
86 N PSS50DD7,PSS50DD8,PSS50ER7,PSS50ER8,PSS51NFD,PSS52NFD
87 D FIELD^DID(50,51,"Z","POINTER","PSS50DD7","PSS50ER7") S PSS51NFD=$G(PSS50DD7("POINTER"))
88 D FIELD^DID(50,52,"Z","POINTER","PSS50DD8","PSS50ER8") S PSS52NFD=$G(PSS50DD8("POINTER"))
89 N PSSENCT
90 S PSSENCT=0
91 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
92 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
93 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
94 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
95 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
96 .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
97 .I $G(PSSPK)]"",'PSSZ5 Q
98 .D LOOPZRD
99 .S PSSENCT=PSSENCT+1
100 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
101 Q
102LOOPZRD ;
103 N PSSZNODE
104 S PSSZNODE=$G(^PSDRUG(PSS(1),0))
105 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
106 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
107 S ^TMP($J,LIST,+PSS(1),2)=$P(PSSZNODE,"^",2)
108 S ^TMP($J,LIST,+PSS(1),3)=$P(PSSZNODE,"^",3)
109 S ^TMP($J,LIST,+PSS(1),4)=$P(PSSZNODE,"^",4)
110 S ^TMP($J,LIST,+PSS(1),5)=$P(PSSZNODE,"^",5)
111 S ^TMP($J,LIST,+PSS(1),6)=$P(PSSZNODE,"^",6)
112 S ^TMP($J,LIST,+PSS(1),8)=$P(PSSZNODE,"^",8)
113 N PSS51NF S PSS51NF=$P(PSSZNODE,"^",9) D
114 .I PSS51NF'="",PSS51NFD'="",PSS51NFD[(PSS51NF_":") S ^TMP($J,LIST,+PSS(1),51)=PSS51NF_"^"_$P($E(PSS51NFD,$F(PSS51NFD,(PSS51NF_":")),999),";") Q
115 .S ^TMP($J,LIST,+PSS(1),51)=""
116 N PSS52NF S PSS52NF=$P(PSSZNODE,"^",11) D
117 .I PSS52NF'="",PSS52NFD'="",PSS52NFD[(PSS52NF_":") S ^TMP($J,LIST,+PSS(1),52)=PSS52NF_"^"_$P($E(PSS52NFD,$F(PSS52NFD,(PSS52NF_":")),999),";") Q
118 .S ^TMP($J,LIST,+PSS(1),52)=""
119 S ^TMP($J,LIST,+PSS(1),101)=$P(PSSZNODE,"^",10)
120 Q
121LOOPB ;
122 N PSSENCT,PSSZNAM
123 S PSSENCT=0
124 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
125 .S PSSZNAM=$P($G(^PSDRUG(PSS(1),0)),"^")
126 .I PSSZNAM="" Q
127 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
128 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
129 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
130 .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
131 .I $G(PSSPK)]"",'PSSZ5 Q
132 .S ^TMP($J,LIST,+PSS(1),.01)=PSSZNAM
133 .S ^TMP($J,LIST,"B",PSSZNAM,+PSS(1))=""
134 .S PSSENCT=PSSENCT+1
135 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
136 Q
137CSYN ;
138 ;PSSIEN = internal entry number from Drug (#50) file
139 ;PSSVAL = Synonym name
140 ;LIST = Global return subscript
141 I $G(LIST)']"" Q
142 K ^TMP($J,LIST)
143 I '$G(PSSIEN)!($G(PSSVAL)="") S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
144 N PSSCSNAM,PSSCSX,PSSCSSYN
145 S PSSCSNAM=$P($G(^PSDRUG(PSSIEN,0)),"^") I PSSCSNAM="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
146 S PSSCSX=$O(^PSDRUG("C",PSSVAL,PSSIEN,"")) I 'PSSCSX S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
147 S PSSCSSYN=$P($G(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^") I PSSCSSYN="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
148 S ^TMP($J,LIST,PSSIEN,.01)=PSSCSNAM
149 S ^TMP($J,LIST,PSSIEN,"SYN",0)=1
150 S ^TMP($J,LIST,PSSIEN,"SYN",PSSCSX,.01)=PSSCSSYN
151 S ^TMP($J,LIST,PSSIEN,"SYN",PSSCSX,403)=$P($G(^PSDRUG(PSSIEN,1,PSSCSX,0)),"^",7)
152 S ^TMP($J,LIST,"C",PSSCSSYN,PSSIEN)=""
153 S ^TMP($J,LIST,0)=1
154 Q
155DSPUNT ;
156 ;PSSIEN = internal entry number from Drug (#50) file
157 ;PSSIEN2 = internal entry from the Synonym multiple
158 ;LIST = Global return subscript
159 I $G(LIST)']"" Q
160 K ^TMP($J,LIST)
161 I +$G(PSSIEN)'>0!(+$G(PSSIEN2)'>0) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
162 N PSSDSNAM,PSSDSX,PSSDSSYN
163 S PSSDSNAM=$P($G(^PSDRUG(PSSIEN,0)),"^") I PSSDSNAM="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
164 S PSSDSSYN=$P($G(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^") I PSSDSSYN="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
165 S ^TMP($J,LIST,PSSIEN,.01)=PSSDSNAM
166 S ^TMP($J,LIST,PSSIEN,"SYN",0)=1
167 S ^TMP($J,LIST,PSSIEN,"SYN",PSSIEN2,.01)=PSSDSSYN
168 S ^TMP($J,LIST,PSSIEN,"SYN",PSSIEN2,403)=$P($G(^PSDRUG(PSSIEN,1,PSSIEN2,0)),"^",7)
169 S ^TMP($J,LIST,"C",PSSDSSYN,PSSIEN)=""
170 S ^TMP($J,LIST,0)=1
171 Q
172 ;
173SETSCRN ;Set Screen
174 I +$G(PSSFL)>0 D
175 .;Naked reference below refers to ^PSDRUG(+Y,"I")
176 .I SCR("S")]"" S SCR("S")=SCR("S")_" S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)" Q
177 .;Naked reference below refers to ^PSDRUG(+Y,"I")
178 .S SCR("S")="S PSS5ND=$P($G(^(""I"")),""^"") I PSS5ND=""""!(PSS5ND>PSSFL)"
179 I $G(PSSRTOI)=1 D
180 .;Naked reference below refers to ^PSDRUG(+Y,2)
181 .I SCR("S")]"" S SCR("S")=SCR("S")_" I $P($G(^(2)),""^"")" Q
182 .;Naked reference below refers to ^PSDRUG(+Y,2)
183 .S SCR("S")="I $P($G(^(2)),""^"")"
184 I $G(PSSPK)]"" D
185 .;Naked reference below refers to ^PSDRUG(+Y,2)
186 .I SCR("S")]"" S SCR("S")=SCR("S")_" S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3 I $P($G(^(2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1" Q
187 .;Naked reference below refers to ^PSDRUG(+Y,2)
188 .S SCR("S")="S PSSZ3=0 F PSSZ4=1:1:$L(PSSPK) Q:PSSZ3 I $P($G(^(2)),""^"",3)[$E(PSSPK,PSSZ4) S PSSZ3=1"
189 ;I $G(PSSPK)]"" S SCR("S")=$S(SCR("S")]"":SCR("S")_" I $G(^PSDRUG(+Y,2)),$P($G(^PSDRUG(+Y,2)),""^"",3)[PSSPK",1:"I $G(^PSDRUG(+Y,2)),$P($G(^PSDRUG(+Y,2)),""^"",3)[PSSPK")
190 Q
Note: See TracBrowser for help on using the repository browser.