Produced by Araxis Merge on 8/15/2018 12:48:13 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | EPIP_Combined_CiF.zip\EPIP_Combined_CiF\111 | PSB 3.0 111 - Routine PSBMD.txt | Tue Aug 14 13:18:38 2018 UTC |
2 | EPIP_Combined_CiF.zip\EPIP_Combined_CiF\111 | PSB 3.0 111 - Routine PSBMD.txt | Tue Aug 14 14:49:33 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 694 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | PSBMD * * 321 LINES , (total 13835, com ments 2534 ) BYTES Page 1 | |
2 | RS UM: old 26 060112, ne w 15118709 4 | |
3 | UCI: VISTA ,ROU Site: TEST .CHEYENNE URL JUL 31,201 8@07:44 | |
4 | ||
5 | 1 PSBMD ;BIRMINGH AM/EFC - B CMA MISSIN G DOSE FUN CTIONS ; 9 /26/17 3:2 5pm | |
6 | 2 ;;3.0;BAR CODE MED ADMIN;**23 ,42,70,100 ,111**;Mar 2004;Buil d 101 | |
7 | 3 ; | |
8 | 4 ; Referen ce/IA | |
9 | 5 ; ^DIC(42 /10039 | |
10 | 6 ; ^DPT(/1 0035 | |
11 | 7 ; IN5^VAD PT/10061 | |
12 | 8 ; DEM^VAD PT/10061 | |
13 | 9 ; ^XMB/10 070 | |
14 | 10 ; 52.6/43 6 | |
15 | 11 ; 52.7/43 7 | |
16 | 12 ; ^DG(40. 8/417 | |
17 | 13 ; 4/2171 | |
18 | 14 ; ^DG(40. 8/2817 | |
19 | 15 ; ^VA(200 /10060 | |
20 | 16 ; ^DIC(4/ 10090 | |
21 | 17 ; ^DG(43/ 6812 | |
22 | 18 ; | |
23 | 19 ;*70 - a dd new ker nel variab le for CO Missing Do se Printer . | |
24 | 20 ; u se Clinc n ame if pas sed in for the new f ield Clini c or | |
25 | 21 ; assume War d and get ien. | |
26 | 22 ; | |
27 | 23 RPC(RE SULTS,PSBD FN,PSBDRUG ,PSBDOSE,P SBRSN,PSBA DMIN,PSBNE ED,PSBUID, PSBON,PSBS CHD,PSBCLI N,PSBCLNIE N) -- | |
28 | ; | |
29 | 24 ; | |
30 | 25 ; RPC: PS B SUBMIT M ISSING DOS E | |
31 | 26 ; | |
32 | 27 ; Descrip tion: | |
33 | 28 ; Allows the client to submit a missing dose inte ractively | |
34 | 29 ; | |
35 | 30 N DFN,PSB NOW,PSBFDA ,PSBIENS,P SBMD,PSBMS G | |
36 | 31 S PSBCLNI EN=+$G(PSB CLNIEN) ;*70 insu re numeric | |
37 | 32 D NEW(.PS BMD) | |
38 | 33 I +PSBMD( 0)<1 S RES ULTS(0)="- 1^Unable t o create m issing dos e request" Q | |
39 | 34 S PSBIENS =+PSBMD(0) _"," | |
40 | 35 D NOW^%DT C S PSBNOW =% | |
41 | 36 S PSBFDA( 53.68,PSBI ENS,.02)=P SBNOW | |
42 | 37 S PSBFDA( 53.68,PSBI ENS,.03)=D UZ | |
43 | 38 S PSBFDA( 53.68,PSBI ENS,.04)=D UZ(2) | |
44 | 39 S PSBFDA( 53.68,PSBI ENS,.11)=P SBDFN | |
45 | 40 ; Ward or Clinic - use Clinic name if p assed, els e get Ward ien. *70 | |
46 | 41 I PSBCLIN ]"" D | |
47 | 42 .S PSBFDA (53.68,PSB IENS,1)=PS BCLNIEN | |
48 | 43 E D | |
49 | 44 .S X=$G(^ DPT(PSBDFN ,.1)) | |
50 | 45 .I X]"" S X=$O(^DIC (42,"B",X, 0)) S:X PS BFDA(53.68 ,PSBIENS,. 12)=X | |
51 | 46 .S DFN=PS BDFN D IN5 ^VADPT S P SBFDA(53.6 8,PSBIENS, .18)=$P(VA IP(6),U,1) | |
52 | 47 S PSBFDA( 53.68,PSBI ENS,.13)=P SBDRUG | |
53 | 48 S PSBFDA( 53.68,PSBI ENS,.14)=P SBDOSE | |
54 | 49 S PSBFDA( 53.68,PSBI ENS,.15)=P SBRSN | |
55 | 50 S PSBFDA( 53.68,PSBI ENS,.16)=P SBADMIN | |
56 | 51 S PSBFDA( 53.68,PSBI ENS,.17)=P SBNEED | |
57 | 52 S PSBFDA( 53.68,PSBI ENS,.19)=P SBSCHD | |
58 | 53 S PSBFDA( 53.68,PSBI ENS,.25)=P SBUID | |
59 | 54 D FILE^DI E("","PSBF DA","PSBMS G") | |
60 | 55 L +^PSB(5 3.68,+PSBI ENS):$S($G (DILOCKTM) >0:DILOCKT M,1:3) ; PSB*3*23 | |
61 | 56 I $G(PSBU ID)'="" D | |
62 | 57 .D PSJ1^P SBVT(PSBDF N,PSBON) K PSBADA,PS BSOLA | |
63 | 58 .I '$D(PS BUIDA(PSBU ID)) F D PSJ1^PSBVT (PSBDFN,PS BPONX) K P SBADA,PSBS OLA Q:$D(P SBUIDA(PSB UID)) Q:P SBPONX="" | |
64 | 59 .F I=1:1 S PSBAD=$P (PSBUIDA(P SBUID),U,I ) Q:PSBAD= "" I PSBA D["ADD" S PSBADA($P( PSBAD,";", 2))="" | |
65 | 60 .I $D(PSB ADA) S X=" " F I=1:1 S X=$O(PSB ADA(X)) Q: X="" S PS BFDA(53.68 6,I_","_PS BIENS,.01) =X,^PSB(53 .68,+PSBIE NS,. | |
66 | 6,I,0)=I | |
67 | 61 .F I=1:1 S PSBSOL=$ P(PSBUIDA( PSBUID),U, I) Q:PSBSO L="" I PS BSOL["SOL" S PSBSOLA ($P(PSBSOL ,";",2))=" " | |
68 | 62 .I $D(PSB SOLA) S X= "" F I=1:1 S X=$O(PS BSOLA(X)) Q:X="" S PSBFDA(53. 687,I_","_ PSBIENS,.0 1)=X,^PSB( 53.68,+PSB IENS | |
69 | ,.7,I,0) =I | |
70 | 63 I $G(PSBU ID)="",$G( PSBDRUG)=" " D | |
71 | 64 .D PSJ1^P SBVT(PSBDF N,PSBON) | |
72 | 65 .I $D(PSB ADA) S X=" " F I=1:1 S X=$O(PSB ADA(X)) Q: X="" S PS BFDA(53.68 6,I_","_PS BIENS,.01) =$P(PSBADA (X),U,2),^ PSB( | |
73 | 53.68,+P SBIENS,.6, I,0)=X | |
74 | 66 .I $D(PSB SOLA) S X= "" F I=1:1 S X=$O(PS BSOLA(X)) Q:X="" S PSBFDA(53. 687,I_","_ PSBIENS,.0 1)=$P(PSBS OLA(X),U,2 ),^P | |
75 | SB(53.68 ,+PSBIENS, .7,I,0)=X | |
76 | 67 D FILE^DI E("","PSBF DA","PSBMS G") | |
77 | 68 L -^PSB(5 3.68,+PSBI ENS) ; PSB 83*23 | |
78 | 69 D SUBMIT( +PSBIENS) | |
79 | 70 S RESULTS (0)="1^Mis sing Dose Submitted^ "_+PSBIENS | |
80 | 71 D CLEAN^P SBVT | |
81 | 72 Q | |
82 | 73 ; | |
83 | 74 XQ ; Called via Kernel Menus | |
84 | 75 N PSBMD,P SBSAVE,DA, DIK,DR,DDS FILE,XMY,X MTEXT,XMSU B | |
85 | 76 D NEW(.PS BMD) | |
86 | 77 I +PSBMD( 0)<1 W !," Error: ",$ P(PSBMD(0) ,U,2) S DI R(0)="E" D ^DIR Q | |
87 | 78 S DA=+PSB MD(0),DR=" [PSB MISSI NG DOSE RE QUEST]",DD SFILE=53.6 8 D ^DDS | |
88 | 79 W @IOF | |
89 | 80 I 'PSBSAV E W !,"Can celling Re quest..." S DIK="^PS B(53.68," D ^DIK W " Cancelled! " | |
90 | 81 D:PSBSAVE SUBMIT(DA ) | |
91 | 82 Q | |
92 | 83 ; | |
93 | 84 SUBMIT (DA) -- | |
94 | ; Submit Request t o Pharmacy | |
95 | 85 N PSBWRD, PSBMG,PSBP RT,CLIEN | |
96 | 86 S PSBWRD= $P(^PSB(53 .68,DA,.1) ,U,2) | |
97 | 87 S PSBWRD= +$G(^DIC(4 2,+PSBWRD, 44)) | |
98 | 88 I PSBCLIN ]"" S CLIE N=+$O(^PS( 53.46,"B", PSBCLNIEN, "")) | |
99 | 89 ; | |
100 | 90 ; Get Mai l Group | |
101 | 91 ; | |
102 | 92 S PSBMG=$ $GET^XPAR( PSBWRD_";S C(","PSB M G MISSING DOSE",,"E" ) | |
103 | 93 S:PSBMG=" " PSBMG=$$ GET^XPAR(" DIV","PSB MG MISSING DOSE",,"E ") | |
104 | 94 S $P(^PSB (53.68,DA, 0),U,5)=PS BMG ; Add MG to noti fication | |
105 | 95 ; | |
106 | 96 ; Get Pri nter - If NO printer can be fo und, then DO NOT pri nt!! | |
107 | 97 ;*70 - ge t CO print er if Clin ic orders, else IM m ed & get I M printer | |
108 | 98 ; IM prin ter uses V ariable PS B PRINTER MISSING DO SE | |
109 | 99 ; CO prin ter can co me from 3 sources: | |
110 | 100 ; 1st fr om Clinic Defintion file for t he specifi c Clinic i f defined | |
111 | 101 ; 2nd fr om the Var iable PSB PRINTER CO MISSING D OSE if def ined | |
112 | 102 ; 3rd ju st use the IM med pr inter Vari able. | |
113 | 103 ; | |
114 | 104 D:PSBCLIN ]"" ;* 70 | |
115 | 105 .S PSBPRT =$$GET1^DI Q(53.46,CL IEN,4) | |
116 | 106 .S:PSBPRT ="" PSBPRT =$$GET^XPA R("DIV","P SB PRINTER CO MISSIN G DOSE",," E") | |
117 | 107 .S:PSBPRT ="" PSBPRT =$$GET^XPA R("DIV","P SB PRINTER MISSING D OSE",,"E") | |
118 | 108 D:PSBCLIN ="" ;* 70 | |
119 | 109 .S PSBPRT =$$GET^XPA R(PSBWRD_" ;SC(","PSB PRINTER M ISSING DOS E",,"E") | |
120 | 110 .S:PSBPRT ="" PSBPRT =$$GET^XPA R("DIV","P SB PRINTER MISSING D OSE",,"E") | |
121 | 111 ; | |
122 | 112 S $P(^PSB (53.68,DA, 0),U,6)=PS BPRT ; Add MG to not ification | |
123 | 113 ; | |
124 | 114 ; Send th e report t o the spec ified prin ter | |
125 | 115 ; | |
126 | 116 D:PSBPRT] "" | |
127 | 117 .W !,"Sub mitting Re quest To P harmacy on device ", PSBPRT,".. ." | |
128 | 118 .D NOW^%D TC | |
129 | 119 .S ZTIO=P SBPRT | |
130 | 120 .S ZTDTH= % | |
131 | 121 .S ZTDESC ="BCMA - M ISSING DOS E REQUEST" | |
132 | 122 .S ZTRTN= "DQ^PSBMD( "_DA_")" | |
133 | 123 .D ^%ZTLO AD | |
134 | 124 .W "Done! " | |
135 | 125 ; | |
136 | 126 ; Send th e same stu ff to the mail group | |
137 | 127 ; | |
138 | 128 D:PSBMG]" " | |
139 | 129 .W !,"Not ifying Pha rmacy via Mail Group ",PSBMG," ..." | |
140 | 130 .D HFSOPE N^PSBUTL(" MISSING DO SE") | |
141 | 131 .U IO D D Q(DA,1) | |
142 | 132 .D HFSCLO SE^PSBUTL( "MISSING D OSE") | |
143 | 133 .S XMY("G ."_PSBMG)= "",XMTEXT= "^TMP(""PS BO"",$J," | |
144 | 134 .S XMSUB= "BCMA - Mi ssing Dose Request" | |
145 | 135 .D ^XMD | |
146 | 136 .W "Done! " | |
147 | 137 Q | |
148 | 138 ; | |
149 | 139 DQ(PSB MD,PSBMM) -- | |
150 | ; Dequeu e report f rom Taskma n | |
151 | 140 N PSBFLD, PSBRET | |
152 | 141 Q:'$D(^PS B(53.68,PS BMD,0)) | |
153 | 142 L +^PSB(5 3.68,PSBMD ):$S($G(DI LOCKTM)>0: DILOCKTM,1 :3) ; PSB* 3*23 | |
154 | 143 S PSBCFLD =$P(^PSB(5 3.68,PSBMD ,.1),U,3) | |
155 | 144 L -^PSB(5 3.68,PSBMD ) ; PSB*3* 23 | |
156 | 145 D:'$G(PSB MM) ; It is not a m ail messag e | |
157 | 146 .W !,$TR( $J("",75), " ","=") | |
158 | 147 .W !,"Rep ort: MISSING D OSE REQUES T" | |
159 | 148 .W !,"Dat e Created: " D NOW^% DTC S Y=% D D^DIQ W Y | |
160 | 149 .W !,$TR( $J("",75), " ","="),! | |
161 | 150 I $G(PSBC FLD)'="" F PSBFLD=.0 1,.02,.03, .04,.05,.0 6,.11,.12, .18,1,.13, .14,.19,.1 5,.16,.17 D OUT ;*7 0 | |
162 | 151 I $G(PSBC FLD)="" F PSBFLD=.01 ,.02,.03,. 04,.05,.06 ,.11,.12,. 18,1,.25,. 15,.19,.16 ,.17 D OUT ;*70 | |
163 | 152 I $D(^PSB (53.68,PSB MD,.6)) S X=0 F S X =$O(^PSB(5 3.68,PSBMD ,.6,X)) Q: 'X W !?3, "ADDITIVE: ",$$GET1 ^DIQ(52.6, +^PS | |
164 | B(53.68, PSBMD,.6,X ,0),.01) | |
165 | 153 I $D(^PSB (53.68,PSB MD,.7)) S X=0 F S X =$O(^PSB(5 3.68,PSBMD ,.7,X)) Q: 'X W !?3, "SOLUTION: ",$$GET1 ^DIQ(52.7, +^PS | |
166 | B(53.68, PSBMD,.7,X ,0),.01) | |
167 | 154 Q | |
168 | 155 OUT ; | |
169 | 156 D FIELD^D ID(53.68,P SBFLD,""," LABEL","PS BRET") | |
170 | 157 W !?3,PSB RET("LABEL "),":" F Q:$X>30 W "." | |
171 | 158 W $$GET1^ DIQ(53.68, PSBMD_",", PSBFLD) | |
172 | 159 I PSBFLD= .11 D | |
173 | 160 .N DFN,VA ,VADM S DF N=$$GET1^D IQ(53.68,P SBMD_",",. 11,"I") D DEM^VADPT | |
174 | 161 .W !?3,$$ GET^XPAR(" ALL","PSB PATIENT ID LABEL") | |
175 | 162 .I $G(DUZ ("AG"))="I " D | |
176 | 163 ..W ":" F Q:$X>30 W "." | |
177 | 164 .E D | |
178 | 165 ..W " (LA ST 4 NUMBE RS):" F Q :$X>30 W "." | |
179 | 166 .W VA("BI D") | |
180 | 167 W:PSBFLD= .13 " ("_$ P($G(^PSB( 53.68,PSBM D,.1)),U,3 )_")" | |
181 | 168 S ZTREQ=" @" | |
182 | 169 Q | |
183 | 170 ; | |
184 | 171 NEW(RE SULTS) -- | |
185 | ; Create a new mis sing dose request | |
186 | 172 ; Called interactiv ely and vi a RPCBroke r | |
187 | 173 N DIC | |
188 | 174 K RESULTS | |
189 | 175 I '+$G(DU Z) S RESUL TS(0)="-1^ Undefined User" Q | |
190 | 176 I '$G(DUZ (2)) S RES ULTS(0)="- 1^Undefine d Division " Q | |
191 | 177 ; Lock Lo g | |
192 | 178 L +^PSB(5 3.68,0):$S ($G(DILOCK TM)>0:DILO CKTM,1:3) | |
193 | 179 E S RESU LTS(0)="-1 ^Request L og Locked" Q | |
194 | 180 ; Generat e Unique E ntry and C reate | |
195 | 181 F D NOW^ %DTC S X=$ E(%_"00000 0",1,14),X =(1700+$E( X,1,3))_$E (X,4,14),X ="MD-"_$TR (X,".","-" ) Q:'$D(^P SB(53.68," B",X | |
196 | )) | |
197 | 182 S DIC="^P SB(53.68," ,DIC(0)="L " | |
198 | 183 S DIC("DR ")=".02/// N;.03////^ S X=DUZ;.0 4////^S X= DUZ(2);.07 ///1" | |
199 | 184 K D0 ;VRN | |
200 | 185 D FILE^DI CN | |
201 | 186 L -^PSB(5 3.68,0) | |
202 | 187 ; Okay, s etup retur n and Boog ie | |
203 | 188 I +Y<1 S RESULTS(0) ="-1^Error Creating Request" | |
204 | 189 E S RESU LTS(0)=Y | |
205 | 190 Q | |
206 | 191 ; | |
207 | 192 VAL(PS BFLDS) -- | |
208 | ; Valida te that fi elds in PS BFLDS are filled in | |
209 | 193 N PSB,PSB FLD,PSBMSG | |
210 | 194 F PSB=1:1 Q:$P(PSBF LDS,";",PS B)="" S P SBFLD=$P(P SBFLDS,";" ,PSB),PSBF LD(PSBFLD) =$$GET^DDS VAL(53.68, DA,PSBFLD) | |
211 | 195 I $D(PSBF LD(.21)) K :PSBFLD(.2 1)="N" PSB FLD(.22),P SBFLD(.23) | |
212 | 196 S PSB="" F S PSB= $O(PSBFLD( PSB)) Q:PS B="" D:PS BFLD(PSB)= "" | |
213 | 197 .I '$D(PS BMSG) S PS BMSG(0)="U NABLE TO F ILE REQUES T",PSBMSG( 1)=" ",PSB MSG(2)="ER ROR: MISSI NG DATA - ALL FIELDS ARE | |
214 | REQUIRE D" | |
215 | 198 .D FIELD^ DID(53.68, PSB,"","TI TLE;LABEL" ,"PSB") | |
216 | 199 .S X=" M issing Fie ld: "_$S(P SB("TITLE" )]"":PSB(" TITLE"),1: PSB("LABEL ")),PSBMSG ($O(PSBMSG (""),-1)+1 )=X | |
217 | 200 Q:'$D(PSB MSG) ; Al l is well | |
218 | 201 D MSG^DDS UTL(.PSBMS G) | |
219 | 202 S DDSERRO R=1 | |
220 | 203 Q | |
221 | 204 ; | |
222 | 205 CHK1 ; Start P SB*3*100 c hanges: us e 'DIVAS' cross ref for multid ivision si tes | |
223 | 206 ; DUZ(2), the user' s division , is set a t sign-on. At multid ivision si tes where a user has access | |
224 | 207 ; to mult iple divis ions, allo w selectio n of a div ision from the divis ions defin ed in file #40.8. | |
225 | 208 ; The use r must hav e at least one divis ion from f ile #40.8 in his fil e #200 rec ord. | |
226 | 209 K ^TMP("P SBMD",$J) | |
227 | 210 N DIR | |
228 | 211 W ! | |
229 | 212 S DIR(0)= "SB^A:All Divisions; O:One Divi sion" | |
230 | 213 S DIR("?" )="Select either All Divisions or One Di vision." | |
231 | 214 S DIR("A" )="Do you want (A)ll Divisions or just ( O)ne Divis ion" | |
232 | 215 S DIR("B" )="O" | |
233 | 216 D ^DIR K DIR I $D(D UOUT)!$D(D TOUT)!$D(D IROUT)!$D( DIRUT) Q | |
234 | 217 I Y="" Q | |
235 | 218 I Y(0)="O ne Divisio n" D ONE Q ; regar dless user divisions in file # 200 | |
236 | 219 I Y(0)="A ll Divisio ns" D ALL Q | |
237 | 220 Q | |
238 | 221 ; | |
239 | 222 ALL ; user ge ts all div isions (cu rrent beha vior); app licable to single di vision sit es as well | |
240 | 223 S Y(0)="A ll Divisio ns" | |
241 | 224 S PSBDIV= DUZ(2) | |
242 | 225 S PSBSTIE N=+$O(^DG( 40.8,"AD", DUZ(2),"") ) ; curren t IEN for station | |
243 | 226 S Y=$$GET 1^DIQ(40.8 ,PSBSTIEN, .01,"E") | |
244 | 227 I '$D(Y) S Y=DUZ(2) | |
245 | 228 S PSBNAME =$$NAME^XU AF4(DUZ(2) ) | |
246 | 229 S PSBMUDV =0 | |
247 | 230 S ^TMP("P SBMD",$J)= PSBMUDV_U_ PSBDIV_U_P SBNAME | |
248 | 231 Q | |
249 | 232 ; | |
250 | 233 ONE ; when us er selects one divis ion from m any in fil e #200, lo ok at file #40.8 for a match i f availabl e | |
251 | 234 W ! | |
252 | 235 S PSBSTIE N=+$O(^DG( 40.8,"AD", DUZ(2),"") ) ; curren t IEN for station | |
253 | 236 S PSBDVNM =$$GET1^DI Q(40.8,PSB STIEN,.01, "I") ;divi sion name | |
254 | 237 S DIC("B" )=PSBDVNM | |
255 | 238 S DIC("A" )="Select Division: ",DIC="^DG (40.8,",DI C(0)="AEMQ ",DIC("S") ="I $$SITE ^VASITE(,+ Y)>0" | |
256 | 239 D ^DIC | |
257 | 240 ; capture the divis ion name a nd number after user selection | |
258 | 241 S PSBNAME =$$GET1^DI Q(40.8,+Y, .01,"E") | |
259 | 242 S PSBDPTR =$$GET1^DI Q(40.8,+Y, .07,"I") ; pointer t o file #4 | |
260 | 243 S PSBDIV= PSBDPTR | |
261 | 244 S ^TMP("P SBMD",$J)= PSBMUDV_U_ PSBDIV_U_P SBNAME | |
262 | 245 Q | |
263 | 246 ;end of c hanges for PSB*3*100 | |
264 | 247 ; | |
265 | 248 FLWUP ; Follow- Up on miss ing dose | |
266 | 249 ; start P SB*3*100 c hanges | |
267 | 250 N D0,DIC, PSBDATA,PS BDPTR,PSBD IV,PSBDVNM ,PSBNAME,P SBMUDV,PSB STIEN,X,Y | |
268 | 251 S D0=1,PS BMUDV=$S($ $GET1^DIQ( 43,D0,11," I")=1:1,1: 0) | |
269 | 252 I $P($G(^ VA(200,DUZ ,2,0)),U,4 )=0 W !!,$ C(7),"You have no va lid divisi ons in the NEW PERSO N file." S Y="^" Q | |
270 | 253 I '$O(^DG (40.8,"AD" ,DUZ(2),"" )) W !!,$C (7),"Your NEW PERSON file divi sion was n ot found i n the MEDI CAL CENTER DIV | |
271 | ISION fi le." S Y=" ^" Q | |
272 | 254 I PSBMUDV =1 D CHK1 | |
273 | 255 I PSBMUDV =0 D ALL | |
274 | 256 I Y=""!(Y <0)!(Y="^" ) Q | |
275 | 257 S PSBDIV= $P($G(^TMP ("PSBMD",$ J)),U,2) | |
276 | 258 S PSBNAME =$P($G(^TM P("PSBMD", $J)),U,3) | |
277 | 259 ; end of changes fo r PSB*3*10 0 | |
278 | 260 N DIR,PSB IEN,PSBX,D A,DR,DDSFI LE,PSBHDR, PSBDRUG,LO C ;*70 | |
279 | 261 S Y="" F Q:Y="^" D | |
280 | 262 .K ^TMP(" PSB",$J) S X="" | |
281 | 263 .;start P SB*3*100 c hanges: us er did not select on e division and will see all th e records (single st ation func tion | |
282 | ality) | |
283 | 264 .I $G(PSB MUDV)=0 D | |
284 | 265 ..F S X= $O(^PSB(53 .68,"AS",1 ,X),-1) Q: 'X S Y=$O (^TMP("PSB ",$J,""),- 1)+1,^TMP( "PSB",$J,Y )=X,^TMP(" PSB",$J,0) =Y | |
285 | 266 .; | |
286 | 267 .; user s elected on e division | |
287 | 268 .I $G(PSB MUDV)=1 D | |
288 | 269 ..F S X= $O(^PSB(53 .68,"DIVAS ",1,PSBDIV ,X),-1) Q: 'X S Y=$O (^TMP("PSB ",$J,""),- 1)+1,^TMP( "PSB",$J,Y )=X,^TMP(" PSB" | |
289 | ,$J,0)=Y | |
290 | 270 .; | |
291 | 271 .I '$O(^T MP("PSB",$ J,0)) W !! ,"No Unres olved Miss ing Dose R equests Fo und." S Y= "^" Q | |
292 | 272 .I $G(PSB MUDV)=0 S PSBHDR="Cu rrently Un resolved M issing Dos e Requests " | |
293 | 273 .I $G(PSB MUDV)=1 S PSBHDR="Cu rrently Un resolved M issing Dos e Requests for: "_PS BNAME | |
294 | 274 .;end of changes fo r PSB*3*10 0 | |
295 | 275 .W @IOF,P SBHDR,!,$T R($J("",IO M)," ","-" ) | |
296 | 276 .F PSBX=0 :0 S PSBX= $O(^TMP("P SB",$J,PSB X)) Q:'PSB X!(Y="^") S PSBIEN= ^(PSBX)_", " D | |
297 | 277 ..W !,$J( PSBX,2),". ",$$GET1^ DIQ(53.68, PSBIEN,.01 ) | |
298 | 278 ..W ?25,$ $GET1^DIQ( 53.68,PSBI EN,.11) | |
299 | 279 ..; get c orrect loc ation ;*70 | |
300 | 280 ..S LOC=$ S($$GET1^D IQ(53.68,P SBIEN,1)]" ":$$GET1^D IQ(53.68,P SBIEN,1),1 :$$GET1^DI Q(53.68,PS BIEN,.12)) | |
301 | 281 ..W ?57,L OC ;*70 | |
302 | 282 ..S PSBDR UG=$$GET1^ DIQ(53.68, PSBIEN,.13 ) | |
303 | 283 ..I PSBDR UG]"" W !? 5,PSBDRUG | |
304 | 284 ..I PSBDR UG="" D | |
305 | 285 ...W !?5, "UNIQUE ID : ",$$GET1 ^DIQ(53.68 ,PSBIEN,.2 5) | |
306 | 286 ...S X=0 F S X=$O( ^PSB(53.68 ,+PSBIEN,. 6,X)) Q:'X W !?10," ADDITIVES: ",$$GET1 ^DIQ(52.6, +^PSB(53.6 8,+PSBIEN, .6,X | |
307 | ,0),.01) | |
308 | 287 ...S X=0 F S X=$O( ^PSB(53.68 ,+PSBIEN,. 7,X)) Q:'X W !?10," SOLUTIONS: ",$$GET1 ^DIQ(52.7, +^PSB(53.6 8,+PSBIEN, .7,X | |
309 | ,0),.01) | |
310 | 288 ..S:$Y>(I OSL-4) Y=$ $PAGE(PSBX ) | |
311 | 289 .S:Y'="^" Y=$$PAGE( PSBX) | |
312 | 290 K ^TMP("P SB",$J),^T MP("PSBMD" ,$J) ; PSB *3*100 | |
313 | 291 Q | |
314 | 292 ; | |
315 | 293 PAGE(P SBIX) -- | |
316 | ; | |
317 | 294 ; | |
318 | 295 N X,X1,PS BCX,PSBDX | |
319 | 296 S DIR("A" )="Select Missing Do se Request # (<RET> to continu e, '^' to quit)" | |
320 | 297 I PSBIX=" " S DIR("A ")="Select Missing D ose Reques t # (<RET> or '^' to quit)" | |
321 | 298 S DIR(0)= "NO^1:"_$S (PSBIX="": $O(^TMP("P SB",$J,PSB X),-1),1:P SBIX)_":0" | |
322 | 299 D ^DIR S PSBDX=+Y | |
323 | 300 I PSBIX=" ",Y="" S Y ="^" Q Y | |
324 | 301 I $G(DTOU T) S Y="^" Q Y | |
325 | 302 I Y="^" Q Y | |
326 | 303 I Y="" W @IOF,PSBHD R,!,$TR($J ("",IOM)," ","-") Q Y | |
327 | 304 S (DA,PSB CX)=^TMP(" PSB",$J,+Y ),DR="[PSB MISSING D OSE FOLLOW UP]",DDSFI LE=53.68 | |
328 | 305 D Q Y | |
329 | 306 .D ^DDS | |
330 | 307 .; start changes fo r PSB*3*10 0 | |
331 | 308 .I $G(PSB MUDV)=0,$D (^PSB(53.6 8,"AS",0,P SBCX)) K ^ TMP("PSB", $J) S X="" F S X=$O (^PSB(53.6 8,"AS",1,X ),-1) Q:'X S | |
332 | X1=$O(^T MP("PSB",$ J,""),-1)+ 1,^TMP("PS B",$J,X1)= X,^TMP("PS B",$J,0)=X 1 | |
333 | 309 .I $G(PSB MUDV)=1,$D (^PSB(53.6 8,"DIVAS", 0,PSBDIV)) K ^TMP("P SB",$J) S X="" F S X=$O(^PSB( 53.68,"DIV AS",1,PSBD IV,X | |
334 | ),-1) Q: 'X S X1=$ O(^TMP("PS B",$J,""), -1)+1,^TMP ("PSB",$J, X1)=X,^TMP ("PSB",$J, 0)=X1 | |
335 | 310 .; stop p rinting he ader twice (old bug) by checki ng PSBX be fore setti ng it to z ero. | |
336 | 311 .I PSBX>0 S PSBX=0 W @IOF,PSB HDR,!,$TR( $J("",IOM) ," ","-") | |
337 | 312 ; end of changes fo r PSB*3*10 0 | |
338 | 313 ; | |
339 | 314 POST ;call fro m 'Patient ' field of screenman form PSB MISSING DO SE REQUEST | |
340 | 315 ; | |
341 | 316 N DFN | |
342 | 317 S DFN=X D IN5^VADPT | |
343 | 318 D PUT^DDS VAL(DIE,.D A,.12,$P(V AIP(5),U,2 )) ; valu e of DIE i s 53.68, B CMA MISSIN G DOSE REQ UEST FILE called fro m Sc | |
344 | reenMan | |
345 | 319 D PUT^DDS VAL(DIE,.D A,.18,$P(V AIP(6),U,1 ),"","I") ; value o f DIE is 5 3.68, BCMA MISSING D OSE REQUES T FILE cal led | |
346 | from Scr eenMan | |
347 | 320 D REFRESH ^DDSUTL | |
348 | 321 Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.