source: FOIAVistA/tag/r/CMOP-PSX/PSXBPSRP.m@ 1279

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

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1PSXBPSRP ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT ;09/01/2006
2 ;;2.0;CMOP;**63**;11 Apr 97;Build 8
3 ;External reference to ^PSRX( supported by IA #1221
4 ;External reference to ^PS(59 supported by IA #1976
5 ;External reference to ^PSOBPSUT supported by IA #4701
6 ;External reference to ^BPSUTIL supported by IA #4410
7 ;External reference to ^IBNCPDPI supported by IA #4729
8 ;
9EN ; Entry Point
10 N %,%ZIS,EXCEL,STDT,TERM,ENDT,DIVDA,DIVNM,DTOUT,I,LINE,POP,VA,VAERR
11 N X,Y,ZTDESC,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
12 ;
13BDT ; - Prompt to select Date Range (Return: Start Date^End Date)
14 S X=$$SELDATE() I X="^" S POP=1 G EXIT
15 S STDT=$P(X,U),ENDT=$P(X,U,2)
16 ;
17DIV ; - Get Division(s) (Return: DIVDA and DIVNM arrays)
18 D SELDIV I '$D(DIVNM) S POP=1 G EXIT
19 ;
20EXC ;- Prompt for Excel Capture
21 S EXCEL=$$EXCEL^PSXBPSUT() I EXCEL="^" S POP=1 G EXIT
22 ;
23DEV ; - Prompt for Device
24 W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
25 D ^%ZIS I POP S POP=1 G EXIT
26 S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
27 I '$D(IO("Q")) G START
28 ;
29QUE ; - Process queue device
30 S ZTSAVE("*")=""
31 S ZTRTN="START^PSXBPSRP"
32 S ZTDESC="CMOP/ECME Activity Report"
33 D ^%ZTLOAD
34 W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
35 D HOME^%ZIS
36 S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
37 G EXIT
38 ;
39 ;Report Processing Tag
40 ;
41START N BPFND,STDTE,ENDTE,LINE,POP,Y
42 S BPFND=0,LINE="W ! F I=1:1:80 W ""="""
43 U IO
44 ;
45 ;Excel Display - Print Header Record
46 I EXCEL D PLINEX
47 ;
48 S Y=STDT X ^DD("DD") S STDTE=Y
49 S Y=ENDT X ^DD("DD") S ENDTE=Y
50 ;
51 ;Loop through divisions and display
52 S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:DIVDA'>0 D ONEDIV(.BPFND,STDTE,ENDTE) Q:$G(POP)
53 ;
54 ;Make sure a record was printed
55 I '$G(POP),BPFND=0 D
56 .I 'EXCEL D TITLE
57 .W !,"NO DATA FOUND FOR CHOSEN PARAMETERS"
58 .I TERM,'EXCEL D PAUSE2
59 ;
60 I '$G(POP),'EXCEL S POP=2
61 G EXIT
62 ;
63ONEDIV(BPFND,STDTE,ENDTE) ; - Display information for one division
64 N %,PSXDT,TRX,PS,Y
65 S PSXDT=STDT-.1
66 F S PSXDT=$O(^PSX(550.2,"D",PSXDT)) Q:'PSXDT!(PSXDT>(ENDT+.24)) D Q:$G(POP)
67 .S (PS,TRX)=0 F S TRX=$O(^PSX(550.2,"D",PSXDT,TRX)) Q:'TRX D Q:$G(POP)
68 . . N TEMP,DATA
69 . . D GETS^DIQ(550.2,TRX,".01;1;2;3;5;6;7;8;9;10;13;14","","TEMP")
70 . . M DATA=TEMP(550.2,TRX_",")
71 . . I $G(DATA(.01))="" Q
72 ..I '$D(DIVNM(DATA(2))) Q
73 ..I DATA(2)'=DIVDA(DIVDA) Q
74 ..;
75 ..;Set flag that at least one record was found
76 ..S BPFND=1
77 ..;
78 ..;Display Transmission Information - Normal Display Only
79 ..I 'EXCEL D
80 ...D TITLE
81 ...W !!,?7,"TRANSMISSION:",?35,DATA(.01)
82 ...W !,?7,"STATUS:",?35,DATA(1)
83 ...W !,?7,"DIVISION:",?35,DATA(2)
84 ...W !,?7,"CMOP SYSTEM:",?35,DATA(3)
85 ...W !,?7,"TRANSMISSION DATE/TIME:",?35,DATA(5)
86 ...I DATA(6) W !,?7,"CREATED DATE/TIME:",?35,DATA(6)
87 ...I DATA(7) W !,?7,"RECEIVED DATE/TIME:",?35,DATA(7)
88 ...I DATA(8) W !,?7,"RETRANSMISSION #:",?35,DATA(8)
89 ...I DATA(9) W !,?7,"ORIGINAL TRANS.:",?35,DATA(9)
90 ...I DATA(10) W !,?7,"CLOSED DATE/TIME:",?35,DATA(10)
91 ...W !,?7,"TOTAL PATIENTS:",?35,DATA(13)
92 ...W !,?7,"TOTAL RXS:",?35,DATA(14)
93 ..;
94 ..;Display Records in Normal Format
95 ..I 'EXCEL D Q
96 ...S PS=$$PDET(TRX) Q:$G(POP)
97 ...I 'PS D CHKP(3) Q:$G(POP) D NDAT
98 ...I TERM,'EXCEL D PAUSE Q:$G(POP)
99 ..;
100 ..;Display Records in Excel Format
101 ..D PDETEX(TRX)
102 Q
103 ;
104 ;Display Record(s) - Normal Format
105PDET(TRX) N BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
106 D PLINE
107 S (PS,RXS)=0 F S RXS=$O(^PSX(550.2,TRX,15,RXS)) Q:'RXS D Q:$G(POP)
108 .S RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
109 .S RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
110 .S DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
111 .Q:$$STATUS^PSOBPSUT(RXI,RFL)=""
112 .D CHKP(2) Q:$G(POP)
113 .S PS=1 D PID^VADPT
114 .S BIEN=RXI_"."_$E($TR($J("",4-$L(RFL))," ","0")_RFL,1,4)_1
115 .S RDT=$S(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
116 .W !,$E($$GET1^DIQ(2,DFN,.01),1,14)_" ("_$G(VA("BID"))_")"
117 .W ?22,RXI_"/"_$$GET1^DIQ(52,RXI,.01)_$S($G(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI)_"/"_RFL
118 .S (NDCS,NDCR)="",(M,N)=0
119 .F S M=$O(^PSRX(RXI,4,M)) Q:'M S N=^(M,0) I $P(N,"^",3)=RFL S NDCR=$P(N,"^",8),NDCS=$P(N,"^",9)
120 .W ?45,$E(NDCS,1,13),?59,$E(NDCR,1,13),?73,$S(RDT:"DISPENS",1:"TRANSMI")
121 .W !,?3,$E($$GET1^DIQ(52,RXI,6),1,18),?22,$$BPSPLN^BPSUTIL(RXI,RFL)
122 .W ?38,$E($$STATUS^PSOBPSUT(RXI,RFL),1,7),?48,$P($$BILLINFO^IBNCPDPI(RXI,RFL),"^",1)
123 .W ?58,$S(RDT:$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3),1:"")
124 Q PS
125 ;
126 ;Display Record(s) - Excel Format
127PDETEX(TRX) N BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
128 S RXS=0 F S RXS=$O(^PSX(550.2,TRX,15,RXS)) Q:'RXS D
129 .S RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
130 .S RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
131 .S DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
132 .Q:$$STATUS^PSOBPSUT(RXI,RFL)=""
133 .S PS=1 D PID^VADPT
134 .S BIEN=RXI_"."_$E($TR($J("",4-$L(RFL))," ","0")_RFL,1,4)_1
135 .S RDT=$S(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
136 .W !,DATA(.01),U ;Transmission
137 .W DATA(1),U ;Status
138 .W DATA(2),U ;Division
139 .W DATA(3),U ;CMOP System
140 .W DATA(5),U ;Transmission Date/Time
141 .W $E($$GET1^DIQ(2,DFN,.01),1,14),U ;Name
142 .W "("_$G(VA("BID"))_")",U ;Pt.ID
143 .W RXI,U ;ECME#
144 .W $$GET1^DIQ(52,RXI,.01)_$S($G(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI),U ;RX#
145 .W RFL,U ;RFL#
146 .N NDCS,NDCR,M,N S (NDCS,NDCR)="",(M,N)=0
147 .F S M=$O(^PSRX(RXI,4,M)) Q:'M S N=^(M,0) I $P(N,"^",3)=RFL S NDCR=$P(N,"^",8),NDCS=$P(N,"^",9)
148 .W $E(NDCS,1,13),U ;NDC SENT
149 .W $E(NDCR,1,13),U ;NDC RECVD
150 .W $S(RDT:"DISPENS",1:"TRANSMI"),U ;CMOP-STAT
151 .W $E($$GET1^DIQ(52,RXI,6),1,18),U ;DRUG
152 .W $$BPSPLN^BPSUTIL(RXI,RFL),U ;INSURANCE
153 .W $E($$STATUS^PSOBPSUT(RXI,RFL),1,7),U ;PAY-STAT
154 .W $P($$BILLINFO^IBNCPDPI(RXI,RFL),"^"),U ;BILL#
155 .W $S(RDT:$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3),1:"") ;REL-DATE
156 Q
157 ;
158 ;- Display Header - Normal
159PLINE W !,"NAME",?22,"ECME#/RX#/FL#",?45,"NDC SENT",?59,"NDC RECVD",?71,"CMOP-STAT"
160 W !," DRUG",?22,"INSURANCE",?38,"PAY-STAT",?48,"BILL#",?58,"REL-DATE"
161 X LINE
162 Q
163 ;
164 ;- Display Header - Excel
165PLINEX W !,"TRANSMISSION",U,"STATUS",U,"DIVISION",U,"CMOP SYSTEM",U,"TRANSMISSION DATE/TIME",U
166 W "NAME",U,"Pt.ID",U,"ECME#",U,"RX#",U,"FL#",U,"NDC SENT",U,"NDC RECVD",U,"CMOP-STAT",U
167 W "DRUG",U,"INSURANCE",U,"PAY-STAT",U,"BILL#",U,"REL-DATE"
168 Q
169 ;
170EXIT I '$G(POP) D PAUSE2
171 I $D(ZTQUEUED) S ZTREQ="@" Q
172 I $G(POP)'=1 D ^%ZISC
173 Q
174 ;
175 ;- Print message if no billable prescriptions
176NDAT W !!,"********* BATCH HAS NO ECME BILLABLE PRESCRIPTIONS *******",!
177 Q
178 ;
179TITLE W @IOF
180 W !,?25,"CMOP/ECME ACTIVITY REPORT "_$S($G(BPFND)=1:"for "_$E(DIVDA(DIVDA),1,24),1:"")
181 W !,"For ",STDTE," thru ",$P(ENDTE,"@"),?40,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT())
182 X LINE
183 Q
184 ;
185CHKP(BPLINES) Q:$G(EXCEL)
186 S BPLINES=BPLINES+1
187 I $G(TERM) S BPLINES=BPLINES+2
188 I $Y>(IOSL-BPLINES) D:$G(TERM) PAUSE Q:$G(POP) D TITLE,PLINE Q
189 Q
190 ;
191 ; Enter Date Range
192 ;
193 ; Return Value -> P1^P2
194 ;
195 ; where P1 = From Date
196 ; = ^ Exit
197 ; P2 = To Date
198 ; = blank for Exit
199 ;
200SELDATE() N DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y
201 S VAL=""
202 S DIR(0)="DA",DIR("A")="ENTER BEGINNING TRANSMISSION DATE: "
203 D ^DIR
204 ;
205 ;Check for "^", timeout, or blank entry
206 I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^"
207 ;
208 I VAL="" D
209 .S $P(VAL,U)=Y
210 .S DIR(0)="DA^"_VAL,DIR("A")="ENTER ENDING TRANSMISSION DATE: "
211 .D ^DIR
212 .;
213 .;Check for "^", timeout, or blank entry
214 .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q
215 .;
216 .;Define Entry
217 .S $P(VAL,U,2)=Y
218 ;
219 Q VAL
220 ;
221 ;Select Divisions
222 ;
223 ; Returns Arrays -> DIVNM("names of divisions") = selection number
224 ; DIVDA("iens of divisions") = name of division
225SELDIV N DIR,DIV,DIVX,DIRUT,DUOUT,DTOUT,I,X,Y
226 W !!,"SELECTION OF DIVISION(S)",!
227 S DIV="" F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV="" S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
228 S I=I-1
229 K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
230 ;
231 D ^DIR
232 ;
233 ;Check for "^", timeout, or blank entry
234 I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^") K DIVNM Q
235 ;
236 ;All Divisions
237 I Y="A" D ALL Q
238 ;
239 ;Select Divisions
240 I Y="S" D SELECT(I),ALL
241 Q
242 ;
243 ;Select which divisions to display
244SELECT(I) N C,DIR,DIVX,DIRUT,DUOUT,DTOUT,X,Y
245 F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
246 S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
247 D ^DIR
248 ;
249 ;Check for "^", timeout, or blank entry
250 I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="^")!('+Y) K DIVNM Q
251 ;
252 M DIVX=DIVNM K DIVNM
253 F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
254 Q
255 ;
256 ;Display selected divisions
257ALL N DA,DIR,DIV,DIRUT,DUOUT,DTOUT,X,Y
258 Q:'$D(DIVNM)
259 W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
260 S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="YES" D ^DIR
261 K DIR
262 I Y=1 S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
263 ;
264 ;Check for "^", timeout, or non-yes entry
265 I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)'=1) K DIVNM
266 Q
267 ;
268 ;Screen Pause 2
269PAUSE2 Q:'$G(TERM)
270 N X
271 U IO(0) W !!,"Press RETURN to continue:"
272 R X:$G(DTIME)
273 U IO
274 Q
275 ;
276 ;Screen Pause 1
277 ;
278 ; Return variable - BPQ = 0 Continue
279 ; 2 Quit
280PAUSE N X
281 U IO(0) W !!,"Press RETURN to continue, '^' to exit:"
282 R X:$G(DTIME) S:'$T X="^" S:X["^" POP=2
283 U IO
284 Q
Note: See TracBrowser for help on using the repository browser.