1 | PSBMD ;BIRMINGHAM/EFC-BCMA MISSING DOSE FUNCTIONS ;Mar 2004 [5/17/05 8:39am]
|
---|
2 | ;;3.0;BAR CODE MED ADMIN;**23**;Mar 2004
|
---|
3 | ;
|
---|
4 | ; Reference/IA
|
---|
5 | ; ^DIC(42/10039
|
---|
6 | ; ^DPT(/10035
|
---|
7 | ; IN5^VADPT/10061
|
---|
8 | ; ^XMB/10070
|
---|
9 | ; 52.6/436
|
---|
10 | ; 52.7/437
|
---|
11 | ;
|
---|
12 | RPC(RESULTS,PSBDFN,PSBDRUG,PSBDOSE,PSBRSN,PSBADMIN,PSBNEED,PSBUID,PSBON,PSBSCHD) ;
|
---|
13 | ;
|
---|
14 | ; RPC: PSB SUBMIT MISSING DOSE
|
---|
15 | ;
|
---|
16 | ; Description:
|
---|
17 | ; Allows the client to submit a missing dose interactively
|
---|
18 | ;
|
---|
19 | N DFN,PSBNOW,PSBFDA,PSBIENS,PSBMD,PSBMSG
|
---|
20 | D NEW(.PSBMD)
|
---|
21 | I +PSBMD(0)<1 S RESULTS(0)="-1^Unable to create missing dose request" Q
|
---|
22 | S PSBIENS=+PSBMD(0)_","
|
---|
23 | D NOW^%DTC S PSBNOW=%
|
---|
24 | S PSBFDA(53.68,PSBIENS,.02)=PSBNOW
|
---|
25 | S PSBFDA(53.68,PSBIENS,.03)=DUZ
|
---|
26 | S PSBFDA(53.68,PSBIENS,.04)=DUZ(2)
|
---|
27 | S PSBFDA(53.68,PSBIENS,.11)=PSBDFN
|
---|
28 | S X=$G(^DPT(PSBDFN,.1)) I X]"" S X=$O(^DIC(42,"B",X,0)) S:X PSBFDA(53.68,PSBIENS,.12)=X
|
---|
29 | S PSBFDA(53.68,PSBIENS,.13)=PSBDRUG
|
---|
30 | S PSBFDA(53.68,PSBIENS,.14)=PSBDOSE
|
---|
31 | S PSBFDA(53.68,PSBIENS,.15)=PSBRSN
|
---|
32 | S PSBFDA(53.68,PSBIENS,.16)=PSBADMIN
|
---|
33 | S PSBFDA(53.68,PSBIENS,.17)=PSBNEED
|
---|
34 | S PSBFDA(53.68,PSBIENS,.19)=PSBSCHD
|
---|
35 | S PSBFDA(53.68,PSBIENS,.25)=PSBUID
|
---|
36 | S DFN=PSBDFN D IN5^VADPT S PSBFDA(53.68,PSBIENS,.18)=$P(VAIP(6),U,1)
|
---|
37 | D FILE^DIE("","PSBFDA","PSBMSG")
|
---|
38 | L +^PSB(53.68,+PSBIENS) ; PSB*3*23
|
---|
39 | I $G(PSBUID)'="" D
|
---|
40 | .D PSJ1^PSBVT(PSBDFN,PSBON) K PSBADA,PSBSOLA
|
---|
41 | .I '$D(PSBUIDA(PSBUID)) F D PSJ1^PSBVT(PSBDFN,PSBPONX) K PSBADA,PSBSOLA Q:$D(PSBUIDA(PSBUID)) Q:PSBPONX=""
|
---|
42 | .F I=1:1 S PSBAD=$P(PSBUIDA(PSBUID),U,I) Q:PSBAD="" I PSBAD["ADD" S PSBADA($P(PSBAD,";",2))=""
|
---|
43 | .I $D(PSBADA) S X="" F I=1:1 S X=$O(PSBADA(X)) Q:X="" S PSBFDA(53.686,I_","_PSBIENS,.01)=X,^PSB(53.68,+PSBIENS,.6,I,0)=I
|
---|
44 | .F I=1:1 S PSBSOL=$P(PSBUIDA(PSBUID),U,I) Q:PSBSOL="" I PSBSOL["SOL" S PSBSOLA($P(PSBSOL,";",2))=""
|
---|
45 | .I $D(PSBSOLA) S X="" F I=1:1 S X=$O(PSBSOLA(X)) Q:X="" S PSBFDA(53.687,I_","_PSBIENS,.01)=X,^PSB(53.68,+PSBIENS,.7,I,0)=I
|
---|
46 | I $G(PSBUID)="",$G(PSBDRUG)="" D
|
---|
47 | .D PSJ1^PSBVT(PSBDFN,PSBON)
|
---|
48 | .I $D(PSBADA) S X="" F I=1:1 S X=$O(PSBADA(X)) Q:X="" S PSBFDA(53.686,I_","_PSBIENS,.01)=$P(PSBADA(X),U,2),^PSB(53.68,+PSBIENS,.6,I,0)=X
|
---|
49 | .I $D(PSBSOLA) S X="" F I=1:1 S X=$O(PSBSOLA(X)) Q:X="" S PSBFDA(53.687,I_","_PSBIENS,.01)=$P(PSBSOLA(X),U,2),^PSB(53.68,+PSBIENS,.7,I,0)=X
|
---|
50 | D FILE^DIE("","PSBFDA","PSBMSG")
|
---|
51 | L -^PSB(53.68,+PSBIENS) ; PSB83*23
|
---|
52 | D SUBMIT(+PSBIENS)
|
---|
53 | S RESULTS(0)="1^Missing Dose Submitted^"_+PSBIENS
|
---|
54 | D CLEAN^PSBVT
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | XQ ; Called via Kernel Menus
|
---|
58 | N PSBMD,PSBSAVE,DA,DIK,DR,DDSFILE,XMY,XMTEXT,XMSUB
|
---|
59 | D NEW(.PSBMD)
|
---|
60 | I +PSBMD(0)<1 W !,"Error: ",$P(PSBMD(0),U,2) S DIR(0)="E" D ^DIR Q
|
---|
61 | S DA=+PSBMD(0),DR="[PSB MISSING DOSE REQUEST]",DDSFILE=53.68 D ^DDS
|
---|
62 | W @IOF
|
---|
63 | I 'PSBSAVE W !,"Cancelling Request..." S DIK="^PSB(53.68," D ^DIK W "Cancelled!"
|
---|
64 | D:PSBSAVE SUBMIT(DA)
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | SUBMIT(DA) ; Submit Request to Pharmacy
|
---|
68 | N PSBWRD,PSBMG,PSBPRT
|
---|
69 | S PSBWRD=$P(^PSB(53.68,DA,.1),U,2)
|
---|
70 | S PSBWRD=+$G(^DIC(42,+PSBWRD,44))
|
---|
71 | ;
|
---|
72 | ; Get Mail Group
|
---|
73 | ;
|
---|
74 | S PSBMG=$$GET^XPAR(PSBWRD_";SC(","PSB MG MISSING DOSE",,"E")
|
---|
75 | S:PSBMG="" PSBMG=$$GET^XPAR("DIV","PSB MG MISSING DOSE",,"E")
|
---|
76 | S $P(^PSB(53.68,DA,0),U,5)=PSBMG ; Add MG to notification
|
---|
77 | ;
|
---|
78 | ; Get Printer
|
---|
79 | ;
|
---|
80 | S PSBPRT=$$GET^XPAR(PSBWRD_";SC(","PSB PRINTER MISSING DOSE",,"E")
|
---|
81 | S:PSBPRT="" PSBPRT=$$GET^XPAR("DIV","PSB PRINTER MISSING DOSE",,"E")
|
---|
82 | S $P(^PSB(53.68,DA,0),U,6)=PSBPRT ; Add MG to notification
|
---|
83 | ;
|
---|
84 | ; Send the report to the specified printer
|
---|
85 | ;
|
---|
86 | D:PSBPRT]""
|
---|
87 | .W !,"Submitting Request To Pharmacy on device ",PSBPRT,"..."
|
---|
88 | .D NOW^%DTC
|
---|
89 | .S ZTIO=PSBPRT
|
---|
90 | .S ZTDTH=%
|
---|
91 | .S ZTDESC="BCMA - MISSING DOSE REQUEST"
|
---|
92 | .S ZTRTN="DQ^PSBMD("_DA_")"
|
---|
93 | .D ^%ZTLOAD
|
---|
94 | .W "Done!"
|
---|
95 | ;
|
---|
96 | ; Send the same stuff to the mail group
|
---|
97 | ;
|
---|
98 | D:PSBMG]""
|
---|
99 | .W !,"Notifying Pharmacy via Mail Group ",PSBMG,"..."
|
---|
100 | .D HFSOPEN^PSBUTL("MISSING DOSE")
|
---|
101 | .U IO D DQ(DA,1)
|
---|
102 | .D HFSCLOSE^PSBUTL("MISSING DOSE")
|
---|
103 | .S XMY("G."_PSBMG)="",XMTEXT="^TMP(""PSBO"",$J,"
|
---|
104 | .S XMSUB="BCMA - Missing Dose Request"
|
---|
105 | .D ^XMD
|
---|
106 | .W "Done!"
|
---|
107 | Q
|
---|
108 | ;
|
---|
109 | DQ(PSBMD,PSBMM) ; Dequeue report from Taskman
|
---|
110 | N PSBFLD,PSBRET
|
---|
111 | Q:'$D(^PSB(53.68,PSBMD,0))
|
---|
112 | L +^PSB(53.68,PSBMD) ; PSB*3*23
|
---|
113 | S PSBCFLD=$P(^PSB(53.68,PSBMD,.1),U,3)
|
---|
114 | L -^PSB(53.68,PSBMD) ; PSB*3*23
|
---|
115 | D:'$G(PSBMM) ; It is not a mail message
|
---|
116 | .W !,$TR($J("",75)," ","=")
|
---|
117 | .W !,"Report: MISSING DOSE REQUEST"
|
---|
118 | .W !,"Date Created: " D NOW^%DTC S Y=% D D^DIQ W Y
|
---|
119 | .W !,$TR($J("",75)," ","="),!
|
---|
120 | I $G(PSBCFLD)'="" F PSBFLD=.01,.02,.03,.04,.05,.06,.11,.12,.18,.13,.14,.19,.15,.16,.17 D OUT
|
---|
121 | I $G(PSBCFLD)="" F PSBFLD=.01,.02,.03,.04,.05,.06,.11,.12,.18,.25,.15,.19,.16,.17 D OUT
|
---|
122 | I $D(^PSB(53.68,PSBMD,.6)) S X=0 F S X=$O(^PSB(53.68,PSBMD,.6,X)) Q:'X W !?3,"ADDITIVE: ",$$GET1^DIQ(52.6,+^PSB(53.68,PSBMD,.6,X,0),.01)
|
---|
123 | I $D(^PSB(53.68,PSBMD,.7)) S X=0 F S X=$O(^PSB(53.68,PSBMD,.7,X)) Q:'X W !?3,"SOLUTION: ",$$GET1^DIQ(52.7,+^PSB(53.68,PSBMD,.7,X,0),.01)
|
---|
124 | Q
|
---|
125 | OUT ;
|
---|
126 | D FIELD^DID(53.68,PSBFLD,"","LABEL","PSBRET")
|
---|
127 | W !?3,PSBRET("LABEL"),":" F Q:$X>30 W "."
|
---|
128 | W $$GET1^DIQ(53.68,PSBMD_",",PSBFLD)
|
---|
129 | I PSBFLD=.11 D
|
---|
130 | .S PSBDFN=$$GET1^DIQ(53.68,PSBMD_",",.11,"I")
|
---|
131 | .W !?3,"SSN (LAST 4 NUMBERS):" F Q:$X>30 W "."
|
---|
132 | .W $E($$GET1^DIQ(2,PSBDFN_",",.09),6,9)
|
---|
133 | W:PSBFLD=.13 " ("_$P($G(^PSB(53.68,PSBMD,.1)),U,3)_")"
|
---|
134 | S ZTREQ="@"
|
---|
135 | Q
|
---|
136 | ;
|
---|
137 | NEW(RESULTS) ; Create a new missing dose request
|
---|
138 | ; Called interactively and via RPCBroker
|
---|
139 | N DIC
|
---|
140 | K RESULTS
|
---|
141 | I '+$G(DUZ) S RESULTS(0)="-1^Undefined User" Q
|
---|
142 | I '$G(DUZ(2)) S RESULTS(0)="-1^Undefined Division" Q
|
---|
143 | ; Lock Log
|
---|
144 | L +^PSB(53.68,0):3
|
---|
145 | E S RESULTS(0)="-1^Request Log Locked" Q
|
---|
146 | ; Generate Unique Entry and Create
|
---|
147 | F D NOW^%DTC S X=$E(%_"000000",1,14),X=(1700+$E(X,1,3))_$E(X,4,14),X="MD-"_$TR(X,".","-") Q:'$D(^PSB(53.68,"B",X))
|
---|
148 | S DIC="^PSB(53.68,",DIC(0)="L"
|
---|
149 | S DIC("DR")=".02///N;.03////^S X=DUZ;.04////^S X=DUZ(2);.07///1"
|
---|
150 | K D0 ;VRN
|
---|
151 | D FILE^DICN
|
---|
152 | L -^PSB(53.68,0)
|
---|
153 | ; Okay, setup return and Boogie
|
---|
154 | I +Y<1 S RESULTS(0)="-1^Error Creating Request"
|
---|
155 | E S RESULTS(0)=Y
|
---|
156 | Q
|
---|
157 | ;
|
---|
158 | VAL(PSBFLDS) ; Validate that fields in PSBFLDS are filled in
|
---|
159 | N PSB,PSBFLD,PSBMSG
|
---|
160 | F PSB=1:1 Q:$P(PSBFLDS,";",PSB)="" S PSBFLD=$P(PSBFLDS,";",PSB),PSBFLD(PSBFLD)=$$GET^DDSVAL(53.68,DA,PSBFLD)
|
---|
161 | I $D(PSBFLD(.21)) K:PSBFLD(.21)="N" PSBFLD(.22),PSBFLD(.23)
|
---|
162 | S PSB="" F S PSB=$O(PSBFLD(PSB)) Q:PSB="" D:PSBFLD(PSB)=""
|
---|
163 | .I '$D(PSBMSG) S PSBMSG(0)="UNABLE TO FILE REQUEST",PSBMSG(1)=" ",PSBMSG(2)="ERROR: MISSING DATA - ALL FIELDS ARE REQUIRED"
|
---|
164 | .D FIELD^DID(53.68,PSB,"","TITLE;LABEL","PSB")
|
---|
165 | .S X=" Missing Field: "_$S(PSB("TITLE")]"":PSB("TITLE"),1:PSB("LABEL")),PSBMSG($O(PSBMSG(""),-1)+1)=X
|
---|
166 | Q:'$D(PSBMSG) ; All is well
|
---|
167 | D MSG^DDSUTL(.PSBMSG)
|
---|
168 | S DDSERROR=1
|
---|
169 | Q
|
---|
170 | ;
|
---|
171 | FLWUP ; Follow-Up on missing dose
|
---|
172 | N DIR,PSBIEN,PSBX,DA,DR,DDSFILE,PSBHDR,PSBDRUG
|
---|
173 | S Y="" F Q:Y="^" D
|
---|
174 | .K ^TMP("PSB",$J) S X=""
|
---|
175 | .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
|
---|
176 | .I '$O(^TMP("PSB",$J,0)) W !!,"No Unresolved Missing Dose Requests Found." S Y="^" Q
|
---|
177 | .S PSBHDR="Currently Unresolved Missing Dose Requests"
|
---|
178 | .W @IOF,PSBHDR,!,$TR($J("",IOM)," ","-")
|
---|
179 | .F PSBX=0:0 S PSBX=$O(^TMP("PSB",$J,PSBX)) Q:'PSBX!(Y="^") S PSBIEN=^(PSBX)_"," D
|
---|
180 | ..W !,$J(PSBX,2),". ",$$GET1^DIQ(53.68,PSBIEN,.01)
|
---|
181 | ..W ?25,$$GET1^DIQ(53.68,PSBIEN,.11)
|
---|
182 | ..W ?57,$$GET1^DIQ(53.68,PSBIEN,.12)
|
---|
183 | ..S PSBDRUG=$$GET1^DIQ(53.68,PSBIEN,.13)
|
---|
184 | ..I PSBDRUG]"" W !?5,PSBDRUG
|
---|
185 | ..I PSBDRUG="" D
|
---|
186 | ...W !?5,"UNIQUE ID: ",$$GET1^DIQ(53.68,PSBIEN,.25)
|
---|
187 | ...S X=0 F S X=$O(^PSB(53.68,+PSBIEN,.6,X)) Q:'X W !?10,"ADDITIVES: ",$$GET1^DIQ(52.6,+^PSB(53.68,+PSBIEN,.6,X,0),.01)
|
---|
188 | ...S X=0 F S X=$O(^PSB(53.68,+PSBIEN,.7,X)) Q:'X W !?10,"SOLUTIONS: ",$$GET1^DIQ(52.7,+^PSB(53.68,+PSBIEN,.7,X,0),.01)
|
---|
189 | ..S:$Y>(IOSL-4) Y=$$PAGE(PSBX)
|
---|
190 | .S:Y'="^" Y=$$PAGE(PSBX)
|
---|
191 | Q
|
---|
192 | PAGE(PSBIX) ;
|
---|
193 | ;
|
---|
194 | N X,X1,PSBCX,PSBDX
|
---|
195 | S DIR("A")="Select Missing Dose Request # (<RET> to continue, '^' to quit)"
|
---|
196 | I PSBIX="" S DIR("A")="Select Missing Dose Request # (<RET> or '^' to quit)"
|
---|
197 | S DIR(0)="NO^1:"_$S(PSBIX="":$O(^TMP("PSB",$J,PSBX),-1),1:PSBIX)_":0"
|
---|
198 | D ^DIR S PSBDX=+Y
|
---|
199 | I PSBIX="",Y="" S Y="^" Q Y
|
---|
200 | I $G(DTOUT) S Y="^" Q Y
|
---|
201 | I Y="^" Q Y
|
---|
202 | I Y="" W @IOF,PSBHDR,!,$TR($J("",IOM)," ","-") Q Y
|
---|
203 | S (DA,PSBCX)=^TMP("PSB",$J,+Y),DR="[PSB MISSING DOSE FOLLOWUP]",DDSFILE=53.68
|
---|
204 | D Q Y
|
---|
205 | .D ^DDS
|
---|
206 | .I $D(^PSB(53.68,"AS",0,PSBCX)) K ^TMP("PSB",$J) S X="" F S X=$O(^PSB(53.68,"AS",1,X),-1) Q:'X S X1=$O(^TMP("PSB",$J,""),-1)+1,^TMP("PSB",$J,X1)=X,^TMP("PSB",$J,0)=X1
|
---|
207 | .S PSBX=0 W @IOF,PSBHDR,!,$TR($J("",IOM)," ","-")
|
---|
208 | ;
|
---|
209 | POST ;call from 'Patient' field of screenman form PSB MISSING DOSE REQUEST
|
---|
210 | ;
|
---|
211 | N DFN
|
---|
212 | S DFN=X D IN5^VADPT
|
---|
213 | D PUT^DDSVAL(DIE,.DA,.12,$P(VAIP(5),U,2)) ; value of DIE is 53.68, BCMA MISSING DOSE REQUEST FILE called from ScreenMan
|
---|
214 | D PUT^DDSVAL(DIE,.DA,.18,$P(VAIP(6),U,1),"","I") ; value of DIE is 53.68, BCMA MISSING DOSE REQUEST FILE called from ScreenMan
|
---|
215 | D REFRESH^DDSUTL
|
---|
216 | Q
|
---|