PSXBPSRP ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT ;30-Aug-2013 16:46;PLS
;;2.0;CMOP;**63,65,1016**;11 Apr 97;Build 74
;External reference to ^PSRX( supported by IA #1221
;External reference to ^PSOBPSUT supported by IA #4701
;External reference to ^BPSUTIL supported by IA #4410
;External reference to ^IBNCPDPI supported by IA #4729
;
; Modified - IHS/MSC/PLS - 06/20/13 - Line CHKEPH+11,PDET+7
; 08/30/13 - Line PDET+21
EN ; Entry Point
N %,%ZIS,EXCEL,STDT,TERM,ENDT,DIVDA,DIVNM,DTOUT,I,LINE,POP,VA,VAERR
N TYPE,PATS
N X,Y,ZTDESC,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
;
BDT ; - Prompt to select Date Range (Return: Start Date^End Date)
S X=$$SELDATE() I X="^" S POP=1 G EXIT
S STDT=$P(X,U),ENDT=$P(X,U,2)
;
TYPE ; - Get (S)ummary or (D)etailed report type
S TYPE=$$SELTYPE() I TYPE="^" S POP=1 G EXIT
;
PATS ; - Get Patient array
I $$SELPATS(.PATS)'=1 S POP=1 G EXIT
;
DIV ; - Get Division(s) (Return: DIVDA and DIVNM arrays)
D SELDIV I '$D(DIVNM) S POP=1 G EXIT
;
SELREL ; - Get release, unreleased or all
N RLNRALL S RLNRALL="",RLNRALL=$$SELRLNRL^PSXBPSR1(.RLNRALL) G EXIT:RLNRALL="^"
;
EXC ;- Prompt for Excel Capture
S EXCEL=$$EXCEL^PSXBPSUT() I EXCEL="^" S POP=1 G EXIT
;
DEV ; - Prompt for Device
W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
D ^%ZIS I POP S POP=1 G EXIT
S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
I '$D(IO("Q")) G START
;
QUE ; - Process queue device
S ZTSAVE("*")=""
S ZTRTN="START^PSXBPSRP"
S ZTDESC="CMOP/ECME Activity Report"
D ^%ZTLOAD
W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
D HOME^%ZIS
S TERM=$S($E($G(IOST),1,2)="C-":1,1:0)
G EXIT
;
;Report Processing Tag
;
START N BPFND,STDTE,ENDTE,LINE,POP,Y
S BPFND=0,LINE="W ! F I=1:1:80 W ""="""
U IO
;
;Excel Display - Print Header Record
I EXCEL D PLINEX
;
S Y=STDT X ^DD("DD") S STDTE=Y
S Y=ENDT X ^DD("DD") S ENDTE=Y
;
;Loop through divisions and display
S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:DIVDA'>0 D ONEDIV(.BPFND,STDTE,ENDTE,.PATS) Q:$G(POP)
;
;Make sure a record was printed
I '$G(POP),BPFND=0 D
.I 'EXCEL D TITLE
.W !,"NO DATA FOUND FOR CHOSEN PARAMETERS"
.I TERM,'EXCEL D PAUSE2
;
I '$G(POP),'EXCEL S POP=2
G EXIT
;
ONEDIV(BPFND,STDTE,ENDTE,PATS) ; - Display information for one division
N %,PSXDT,TRX,PS,Y,BATCHES,EPHFL
S PSXDT=STDT-.1
I TYPE="D" S EPHFL=1
F S PSXDT=$O(^PSX(550.2,"D",PSXDT)) Q:'PSXDT!(PSXDT>(ENDT+.24)) D Q:$G(POP)
.S (PS,TRX)=0 F S TRX=$O(^PSX(550.2,"D",PSXDT,TRX)) Q:'TRX D Q:$G(POP)
. . N TEMP,DATA
. . D GETS^DIQ(550.2,TRX,".01;1;2;3;5;6;7;8;9;10;13;14","","TEMP")
. . M DATA=TEMP(550.2,TRX_",")
. . I $G(DATA(.01))="" Q
..I '$D(DIVNM(DATA(2))) Q
..I DATA(2)'=DIVDA(DIVDA) Q
..I TYPE="S" S EPHFL=$$CHKEPH(TRX)
..Q:'EPHFL
..;
..;Set flag that at least one record was found
..S BPFND=1
..;
..;Display Transmission Information - Normal Display Only
..I 'EXCEL D HEAD1
..;
..;Display Records in Normal Format
..I 'EXCEL D Q
...S PS=$$PDET(TRX,.PATS) Q:$G(POP)
...I 'PS D CHKP(3) Q:$G(POP) D NDAT
...I TERM,'EXCEL D PAUSE Q:$G(POP)
..;
..;Display Records in Excel Format
..D PDETEX(TRX,.PATS)
Q
;
CHKEPH(TRX) ;check batch for ePharmacy Rx's
N DATA,SEQ,RX,RFL,RELDAT,EPHARM,EDFN
S (EPHARM,SEQ)=0 F S SEQ=$O(^PSX(550.2,TRX,15,SEQ)) Q:SEQ=""!(EPHARM) D Q:EPHARM
. Q:'$D(^PSX(550.2,TRX,15,SEQ,0))
. S DATA=^PSX(550.2,TRX,15,SEQ,0),RX=$P(DATA,"^",1),RFL=$P(DATA,"^",2),EDFN=$P(DATA,"^",3)
. Q:$$GOODPAT(EDFN,.PATS)=0
. I RFL=0 S RELDAT=$$GET1^DIQ(52,RX,31,"I")
. I RFL>0 S RELDAT=$$GET1^DIQ(52.1,RFL_","_RX,17,"I")
. Q:RLNRALL=2&(RELDAT="")
. Q:RLNRALL=3&(RELDAT'="")
.;IHS/MSC/PLS - 06/20/13
. ;I $$STATUS^PSOBPSUT(RX,RFL)'="" S EPHARM=1
.S EPHARM=1
Q EPHARM
;
HEAD1 ;
D TITLE
I $G(TYPE)="D" D
.W !!,?7,"TRANSMISSION:",?35,DATA(.01)
.W !,?7,"STATUS:",?35,DATA(1)
.W !,?7,"DIVISION:",?35,DATA(2)
.W !,?7,"CMOP SYSTEM:",?35,DATA(3)
.W !,?7,"TRANSMISSION DATE/TIME:",?35,DATA(5)
.I DATA(6) W !,?7,"CREATED DATE/TIME:",?35,DATA(6)
.I DATA(7) W !,?7,"RECEIVED DATE/TIME:",?35,DATA(7)
.I DATA(8) W !,?7,"RETRANSMISSION #:",?35,DATA(8)
.I DATA(9) W !,?7,"ORIGINAL TRANS.:",?35,DATA(9)
.I DATA(10) W !,?7,"CLOSED DATE/TIME:",?35,DATA(10)
.W !,?7,"TOTAL PATIENTS:",?35,DATA(13)
.W !,?7,"TOTAL RXS:",?35,DATA(14)
E D
.W !
.W $$RJ^XLFSTR("TRANSMISSION:",15),$$RJ^XLFSTR(DATA(.01),3)
.W $$RJ^XLFSTR("TRANSMISSION DATE/TIME: ",35),DATA(5)
.W !
.W $$RJ^XLFSTR("TOTAL PATIENTS:",15),$$RJ^XLFSTR(DATA(13),3)
.W $$RJ^XLFSTR("TOTAL RXS: ",35),DATA(14)
.W !
Q
;Display Record(s) - Normal Format
PDET(TRX,PATS) N BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
D PLINE
S (PS,RXS)=0 F S RXS=$O(^PSX(550.2,TRX,15,RXS)) Q:'RXS D Q:$G(POP)
.S RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
.S RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
.S DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
.Q:$$GOODPAT(DFN,.PATS)=0
.;Q:$$STATUS^PSOBPSUT(RXI,RFL)="" ;IHS/MSC/PLS - 06/20/13
.D CHKP(2) Q:$G(POP)
.I RFL=0 S RELDAT=$$GET1^DIQ(52,RXI,31,"I")
.I RFL>0 S RELDAT=$$GET1^DIQ(52.1,RFL_","_RXI,17,"I")
.Q:RLNRALL=2&(RELDAT="")
.Q:RLNRALL=3&(RELDAT'="")
.S PS=1 D PID^VADPT
.S BIEN=RXI_"."_$E($TR($J("",4-$L(RFL))," ","0")_RFL,1,4)_1
.S RDT=$S(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
.W !,$E($$GET1^DIQ(2,DFN,.01),1,14)_" ("_$G(VA("BID"))_")"
.W ?22,RXI_"/"_$$GET1^DIQ(52,RXI,.01)_$S($G(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI)_"/"_RFL
.S (NDCS,NDCR)="",(M,N)=0
.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)
.W ?45,$E(NDCS,1,13),?59,$E(NDCR,1,13),?73,$S(RDT:"D",1:"T")
.;IHS/MSC/PLS - 08/30/2013
.;W !,?3,$E($$GET1^DIQ(52,RXI,6),1,18),?22,$E($$BPSPLN^BPSUTIL(RXI,RFL),1,15)
.W !,?3,$E($$GET1^DIQ(52,RXI,6),1,18)
.;W ?38,$E($$STATUS^PSOBPSUT(RXI,RFL),1,7),?48,$P($$BILLINFO^IBNCPDPI(RXI,RFL),"^",1)
.W ?38,$E($$STATUS^PSOBPSUT(RXI,RFL),1,7)
.W ?58,$S(RDT:$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3),1:"")
Q PS
;
;Display Record(s) - Excel Format
PDETEX(TRX,PATS) N BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
S RXS=0 F S RXS=$O(^PSX(550.2,TRX,15,RXS)) Q:'RXS D
.S RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
.S RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
.S DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
.Q:$$GOODPAT(DFN,.PATS)=0
.Q:$$STATUS^PSOBPSUT(RXI,RFL)=""
.I RFL=0 S RELDAT=$$GET1^DIQ(52,RXI,31,"I")
.I RFL>0 S RELDAT=$$GET1^DIQ(52.1,RFL_","_RXI,17,"I")
.Q:RLNRALL=2&(RELDAT="")
.Q:RLNRALL=3&(RELDAT'="")
.S PS=1 D PID^VADPT
.S BIEN=RXI_"."_$E($TR($J("",4-$L(RFL))," ","0")_RFL,1,4)_1
.S RDT=$S(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
.W !,DATA(.01),U ;Transmission
.W DATA(1),U ;Status
.W DATA(2),U ;Division
.W DATA(3),U ;CMOP System
.W DATA(5),U ;Transmission Date/Time
.W $E($$GET1^DIQ(2,DFN,.01),1,14),U ;Name
.W "("_$G(VA("BID"))_")",U ;Pt.ID
.W RXI,U ;ECME#
.W $$GET1^DIQ(52,RXI,.01)_$S($G(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI),U ;RX#
.W RFL,U ;RFL#
.N NDCS,NDCR,M,N S (NDCS,NDCR)="",(M,N)=0
.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)
.W $E(NDCS,1,13),U ;NDC SENT
.W $E(NDCR,1,13),U ;NDC RECVD
.W $S(RDT:"D",1:"T"),U ;CMOP-STAT
.W $E($$GET1^DIQ(52,RXI,6),1,18),U ;DRUG
.W $$BPSPLN^BPSUTIL(RXI,RFL),U ;INSURANCE
.W $E($$STATUS^PSOBPSUT(RXI,RFL),1,7),U ;PAY-STAT
.W $P($$BILLINFO^IBNCPDPI(RXI,RFL),"^"),U ;BILL#
.W $S(RDT:$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3),1:"") ;REL-DATE
Q
;
;- Check Selected Patient Array
GOODPAT(DFN,PATS) ;
I $G(PATS(-1))="^ALL" Q 1
I $G(PATS(DFN))'="" Q 1
Q 0
;
;- Display Header - Normal
PLINE W !,"NAME",?22,"ECME#/RX#/FL#",?45,"NDC SENT",?59,"NDC RECVD",?71,"CMOP-STAT"
W !," DRUG",?22,"INSURANCE",?38,"PAY-STAT",?48,"BILL#",?58,"REL-DATE"
X LINE
Q
;
;- Display Header - Excel
PLINEX W !,"TRANSMISSION",U,"STATUS",U,"DIVISION",U,"CMOP SYSTEM",U,"TRANSMISSION DATE/TIME",U
W "NAME",U,"Pt.ID",U,"ECME#",U,"RX#",U,"FL#",U,"NDC SENT",U,"NDC RECVD",U,"CMOP-STAT",U
W "DRUG",U,"INSURANCE",U,"PAY-STAT",U,"BILL#",U,"REL-DATE"
Q
;
EXIT I '$G(POP) D PAUSE2
I $D(ZTQUEUED) S ZTREQ="@" Q
I $G(POP)'=1 D ^%ZISC
Q
;
;- Print message if no billable prescriptions
NDAT W !!,"********* BATCH HAS NO ECME BILLABLE PRESCRIPTIONS *******",!
Q
;
TITLE W @IOF
W $$CJ^XLFSTR("CMOP/ECME ACTIVITY REPORT "_$S($G(BPFND)=1:"for "_$E(DIVDA(DIVDA),1,24),1:""),80)
W $$CJ^XLFSTR("For "_STDTE_" thru "_$P(ENDTE,"@")_" Printed: "_$$FMTE^XLFDT($$NOW^XLFDT()),80)
X LINE
Q
;
CHKP(BPLINES) Q:$G(EXCEL)
S BPLINES=BPLINES+1
I $G(TERM) S BPLINES=BPLINES+2
I $Y>(IOSL-BPLINES) D:$G(TERM) PAUSE Q:$G(POP) D TITLE,PLINE Q
Q
;
SELDATE() Q $$SELDATE^PSXBPSR1()
;
SELDIV D SELDIV^PSXBPSR1 Q
;
SELECT(I) D SELECT^PSXBPSR1(I) Q
;
SELTYPE() Q $$SELTYPE^PSXBPSR1()
;
SELPATS(ARRAY) Q $$SELPATS^PSXBPSR1(.ARRAY)
;
;Display selected divisions
ALL D ALL^PSXBPSR1 Q
;
;Screen Pause 2
PAUSE2 Q:'$G(TERM)
N X
U IO(0) W !!,"Press RETURN to continue:"
R X:$G(DTIME)
U IO
Q
;
;Screen Pause 1
;
; Return variable - BPQ = 0 Continue
; 2 Quit
PAUSE N X
U IO(0) W !!,"Press RETURN to continue, '^' to exit:"
R X:$G(DTIME) S:'$T X="^" S:X["^" POP=2
U IO
Q
PSXBPSRP ;BHAM ISC/MFR - CMOP/ECME ACTIVITY REPORT ;30-Aug-2013 16:46;PLS
+1 ;;2.0;CMOP;**63,65,1016**;11 Apr 97;Build 74
+2 ;External reference to ^PSRX( supported by IA #1221
+3 ;External reference to ^PSOBPSUT supported by IA #4701
+4 ;External reference to ^BPSUTIL supported by IA #4410
+5 ;External reference to ^IBNCPDPI supported by IA #4729
+6 ;
+7 ; Modified - IHS/MSC/PLS - 06/20/13 - Line CHKEPH+11,PDET+7
+8 ; 08/30/13 - Line PDET+21
EN ; Entry Point
+1 NEW %,%ZIS,EXCEL,STDT,TERM,ENDT,DIVDA,DIVNM,DTOUT,I,LINE,POP,VA,VAERR
+2 NEW TYPE,PATS
+3 NEW X,Y,ZTDESC,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+4 ;
BDT ; - Prompt to select Date Range (Return: Start Date^End Date)
+1 SET X=$$SELDATE()
IF X="^"
SET POP=1
GOTO EXIT
+2 SET STDT=$PIECE(X,U)
SET ENDT=$PIECE(X,U,2)
+3 ;
TYPE ; - Get (S)ummary or (D)etailed report type
+1 SET TYPE=$$SELTYPE()
IF TYPE="^"
SET POP=1
GOTO EXIT
+2 ;
PATS ; - Get Patient array
+1 IF $$SELPATS(.PATS)'=1
SET POP=1
GOTO EXIT
+2 ;
DIV ; - Get Division(s) (Return: DIVDA and DIVNM arrays)
+1 DO SELDIV
IF '$DATA(DIVNM)
SET POP=1
GOTO EXIT
+2 ;
SELREL ; - Get release, unreleased or all
+1 NEW RLNRALL
SET RLNRALL=""
SET RLNRALL=$$SELRLNRL^PSXBPSR1(.RLNRALL)
IF RLNRALL="^"
GOTO EXIT
+2 ;
EXC ;- Prompt for Excel Capture
+1 SET EXCEL=$$EXCEL^PSXBPSUT()
IF EXCEL="^"
SET POP=1
GOTO EXIT
+2 ;
DEV ; - Prompt for Device
+1 WRITE !!
SET %ZIS="MQ"
SET %ZIS("A")="Select Printer: "
SET %ZIS("B")=""
+2 DO ^%ZIS
IF POP
SET POP=1
GOTO EXIT
+3 SET TERM=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+4 IF '$DATA(IO("Q"))
GOTO START
+5 ;
QUE ; - Process queue device
+1 SET ZTSAVE("*")=""
+2 SET ZTRTN="START^PSXBPSRP"
+3 SET ZTDESC="CMOP/ECME Activity Report"
+4 DO ^%ZTLOAD
+5 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+6 DO HOME^%ZIS
+7 SET TERM=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+8 GOTO EXIT
+9 ;
+10 ;Report Processing Tag
+11 ;
START NEW BPFND,STDTE,ENDTE,LINE,POP,Y
+1 SET BPFND=0
SET LINE="W ! F I=1:1:80 W ""="""
+2 USE IO
+3 ;
+4 ;Excel Display - Print Header Record
+5 IF EXCEL
DO PLINEX
+6 ;
+7 SET Y=STDT
XECUTE ^DD("DD")
SET STDTE=Y
+8 SET Y=ENDT
XECUTE ^DD("DD")
SET ENDTE=Y
+9 ;
+10 ;Loop through divisions and display
+11 SET DIVDA=0
FOR
SET DIVDA=$ORDER(DIVDA(DIVDA))
IF DIVDA'>0
QUIT
DO ONEDIV(.BPFND,STDTE,ENDTE,.PATS)
IF $GET(POP)
QUIT
+12 ;
+13 ;Make sure a record was printed
+14 IF '$GET(POP)
IF BPFND=0
Begin DoDot:1
+15 IF 'EXCEL
DO TITLE
+16 WRITE !,"NO DATA FOUND FOR CHOSEN PARAMETERS"
+17 IF TERM
IF 'EXCEL
DO PAUSE2
End DoDot:1
+18 ;
+19 IF '$GET(POP)
IF 'EXCEL
SET POP=2
+20 GOTO EXIT
+21 ;
ONEDIV(BPFND,STDTE,ENDTE,PATS) ; - Display information for one division
+1 NEW %,PSXDT,TRX,PS,Y,BATCHES,EPHFL
+2 SET PSXDT=STDT-.1
+3 IF TYPE="D"
SET EPHFL=1
+4 FOR
SET PSXDT=$ORDER(^PSX(550.2,"D",PSXDT))
IF 'PSXDT!(PSXDT>(ENDT+.24))
QUIT
Begin DoDot:1
+5 SET (PS,TRX)=0
FOR
SET TRX=$ORDER(^PSX(550.2,"D",PSXDT,TRX))
IF 'TRX
QUIT
Begin DoDot:2
+6 NEW TEMP,DATA
+7 DO GETS^DIQ(550.2,TRX,".01;1;2;3;5;6;7;8;9;10;13;14","","TEMP")
+8 MERGE DATA=TEMP(550.2,TRX_",")
+9 IF $GET(DATA(.01))=""
QUIT
+10 IF '$DATA(DIVNM(DATA(2)))
QUIT
+11 IF DATA(2)'=DIVDA(DIVDA)
QUIT
+12 IF TYPE="S"
SET EPHFL=$$CHKEPH(TRX)
+13 IF 'EPHFL
QUIT
+14 ;
+15 ;Set flag that at least one record was found
+16 SET BPFND=1
+17 ;
+18 ;Display Transmission Information - Normal Display Only
+19 IF 'EXCEL
DO HEAD1
+20 ;
+21 ;Display Records in Normal Format
+22 IF 'EXCEL
Begin DoDot:3
+23 SET PS=$$PDET(TRX,.PATS)
IF $GET(POP)
QUIT
+24 IF 'PS
DO CHKP(3)
IF $GET(POP)
QUIT
DO NDAT
+25 IF TERM
IF 'EXCEL
DO PAUSE
IF $GET(POP)
QUIT
End DoDot:3
QUIT
+26 ;
+27 ;Display Records in Excel Format
+28 DO PDETEX(TRX,.PATS)
End DoDot:2
IF $GET(POP)
QUIT
End DoDot:1
IF $GET(POP)
QUIT
+29 QUIT
+30 ;
CHKEPH(TRX) ;check batch for ePharmacy Rx's
+1 NEW DATA,SEQ,RX,RFL,RELDAT,EPHARM,EDFN
+2 SET (EPHARM,SEQ)=0
FOR
SET SEQ=$ORDER(^PSX(550.2,TRX,15,SEQ))
IF SEQ=""!(EPHARM)
QUIT
Begin DoDot:1
+3 IF '$DATA(^PSX(550.2,TRX,15,SEQ,0))
QUIT
+4 SET DATA=^PSX(550.2,TRX,15,SEQ,0)
SET RX=$PIECE(DATA,"^",1)
SET RFL=$PIECE(DATA,"^",2)
SET EDFN=$PIECE(DATA,"^",3)
+5 IF $$GOODPAT(EDFN,.PATS)=0
QUIT
+6 IF RFL=0
SET RELDAT=$$GET1^DIQ(52,RX,31,"I")
+7 IF RFL>0
SET RELDAT=$$GET1^DIQ(52.1,RFL_","_RX,17,"I")
+8 IF RLNRALL=2&(RELDAT="")
QUIT
+9 IF RLNRALL=3&(RELDAT'="")
QUIT
+10 ;IHS/MSC/PLS - 06/20/13
+11 ;I $$STATUS^PSOBPSUT(RX,RFL)'="" S EPHARM=1
+12 SET EPHARM=1
End DoDot:1
IF EPHARM
QUIT
+13 QUIT EPHARM
+14 ;
HEAD1 ;
+1 DO TITLE
+2 IF $GET(TYPE)="D"
Begin DoDot:1
+3 WRITE !!,?7,"TRANSMISSION:",?35,DATA(.01)
+4 WRITE !,?7,"STATUS:",?35,DATA(1)
+5 WRITE !,?7,"DIVISION:",?35,DATA(2)
+6 WRITE !,?7,"CMOP SYSTEM:",?35,DATA(3)
+7 WRITE !,?7,"TRANSMISSION DATE/TIME:",?35,DATA(5)
+8 IF DATA(6)
WRITE !,?7,"CREATED DATE/TIME:",?35,DATA(6)
+9 IF DATA(7)
WRITE !,?7,"RECEIVED DATE/TIME:",?35,DATA(7)
+10 IF DATA(8)
WRITE !,?7,"RETRANSMISSION #:",?35,DATA(8)
+11 IF DATA(9)
WRITE !,?7,"ORIGINAL TRANS.:",?35,DATA(9)
+12 IF DATA(10)
WRITE !,?7,"CLOSED DATE/TIME:",?35,DATA(10)
+13 WRITE !,?7,"TOTAL PATIENTS:",?35,DATA(13)
+14 WRITE !,?7,"TOTAL RXS:",?35,DATA(14)
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 WRITE !
+17 WRITE $$RJ^XLFSTR("TRANSMISSION:",15),$$RJ^XLFSTR(DATA(.01),3)
+18 WRITE $$RJ^XLFSTR("TRANSMISSION DATE/TIME: ",35),DATA(5)
+19 WRITE !
+20 WRITE $$RJ^XLFSTR("TOTAL PATIENTS:",15),$$RJ^XLFSTR(DATA(13),3)
+21 WRITE $$RJ^XLFSTR("TOTAL RXS: ",35),DATA(14)
+22 WRITE !
End DoDot:1
+23 QUIT
+24 ;Display Record(s) - Normal Format
PDET(TRX,PATS) NEW BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
+1 DO PLINE
+2 SET (PS,RXS)=0
FOR
SET RXS=$ORDER(^PSX(550.2,TRX,15,RXS))
IF 'RXS
QUIT
Begin DoDot:1
+3 SET RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
+4 SET RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
+5 SET DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
+6 IF $$GOODPAT(DFN,.PATS)=0
QUIT
+7 ;Q:$$STATUS^PSOBPSUT(RXI,RFL)="" ;IHS/MSC/PLS - 06/20/13
+8 DO CHKP(2)
IF $GET(POP)
QUIT
+9 IF RFL=0
SET RELDAT=$$GET1^DIQ(52,RXI,31,"I")
+10 IF RFL>0
SET RELDAT=$$GET1^DIQ(52.1,RFL_","_RXI,17,"I")
+11 IF RLNRALL=2&(RELDAT="")
QUIT
+12 IF RLNRALL=3&(RELDAT'="")
QUIT
+13 SET PS=1
DO PID^VADPT
+14 SET BIEN=RXI_"."_$EXTRACT($TRANSLATE($JUSTIFY("",4-$LENGTH(RFL))," ","0")_RFL,1,4)_1
+15 SET RDT=$SELECT(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
+16 WRITE !,$EXTRACT($$GET1^DIQ(2,DFN,.01),1,14)_" ("_$GET(VA("BID"))_")"
+17 WRITE ?22,RXI_"/"_$$GET1^DIQ(52,RXI,.01)_$SELECT($GET(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI)_"/"_RFL
+18 SET (NDCS,NDCR)=""
SET (M,N)=0
+19 FOR
SET M=$ORDER(^PSRX(RXI,4,M))
IF 'M
QUIT
SET N=^(M,0)
IF $PIECE(N,"^",3)=RFL
SET NDCR=$PIECE(N,"^",8)
SET NDCS=$PIECE(N,"^",9)
+20 WRITE ?45,$EXTRACT(NDCS,1,13),?59,$EXTRACT(NDCR,1,13),?73,$SELECT(RDT:"D",1:"T")
+21 ;IHS/MSC/PLS - 08/30/2013
+22 ;W !,?3,$E($$GET1^DIQ(52,RXI,6),1,18),?22,$E($$BPSPLN^BPSUTIL(RXI,RFL),1,15)
+23 WRITE !,?3,$EXTRACT($$GET1^DIQ(52,RXI,6),1,18)
+24 ;W ?38,$E($$STATUS^PSOBPSUT(RXI,RFL),1,7),?48,$P($$BILLINFO^IBNCPDPI(RXI,RFL),"^",1)
+25 WRITE ?38,$EXTRACT($$STATUS^PSOBPSUT(RXI,RFL),1,7)
+26 WRITE ?58,$SELECT(RDT:$EXTRACT(RDT,4,5)_"/"_$EXTRACT(RDT,6,7)_"/"_$EXTRACT(RDT,2,3),1:"")
End DoDot:1
IF $GET(POP)
QUIT
+27 QUIT PS
+28 ;
+29 ;Display Record(s) - Excel Format
PDETEX(TRX,PATS) NEW BIEN,DFN,RFL,M,N,NDCR,NDCS,RXS,PS,RDT,RXI,VA
+1 SET RXS=0
FOR
SET RXS=$ORDER(^PSX(550.2,TRX,15,RXS))
IF 'RXS
QUIT
Begin DoDot:1
+2 SET RXI=+$$GET1^DIQ(550.215,RXS_","_TRX,".01","I")
+3 SET RFL=+$$GET1^DIQ(550.215,RXS_","_TRX,".02","I")
+4 SET DFN=+$$GET1^DIQ(550.215,RXS_","_TRX,".03","I")
+5 IF $$GOODPAT(DFN,.PATS)=0
QUIT
+6 IF $$STATUS^PSOBPSUT(RXI,RFL)=""
QUIT
+7 IF RFL=0
SET RELDAT=$$GET1^DIQ(52,RXI,31,"I")
+8 IF RFL>0
SET RELDAT=$$GET1^DIQ(52.1,RFL_","_RXI,17,"I")
+9 IF RLNRALL=2&(RELDAT="")
QUIT
+10 IF RLNRALL=3&(RELDAT'="")
QUIT
+11 SET PS=1
DO PID^VADPT
+12 SET BIEN=RXI_"."_$EXTRACT($TRANSLATE($JUSTIFY("",4-$LENGTH(RFL))," ","0")_RFL,1,4)_1
+13 SET RDT=$SELECT(RFL=0:$$GET1^DIQ(52,RXI,31,"I"),1:$$GET1^DIQ(52.1,RFL_","_RXI_",",17,"I"))
+14 ;Transmission
WRITE !,DATA(.01),U
+15 ;Status
WRITE DATA(1),U
+16 ;Division
WRITE DATA(2),U
+17 ;CMOP System
WRITE DATA(3),U
+18 ;Transmission Date/Time
WRITE DATA(5),U
+19 ;Name
WRITE $EXTRACT($$GET1^DIQ(2,DFN,.01),1,14),U
+20 ;Pt.ID
WRITE "("_$GET(VA("BID"))_")",U
+21 ;ECME#
WRITE RXI,U
+22 ;RX#
WRITE $$GET1^DIQ(52,RXI,.01)_$SELECT($GET(^PSRX(RXI,"IB")):"$",1:"")_$$ECME^PSOBPSUT(RXI),U
+23 ;RFL#
WRITE RFL,U
+24 NEW NDCS,NDCR,M,N
SET (NDCS,NDCR)=""
SET (M,N)=0
+25 FOR
SET M=$ORDER(^PSRX(RXI,4,M))
IF 'M
QUIT
SET N=^(M,0)
IF $PIECE(N,"^",3)=RFL
SET NDCR=$PIECE(N,"^",8)
SET NDCS=$PIECE(N,"^",9)
+26 ;NDC SENT
WRITE $EXTRACT(NDCS,1,13),U
+27 ;NDC RECVD
WRITE $EXTRACT(NDCR,1,13),U
+28 ;CMOP-STAT
WRITE $SELECT(RDT:"D",1:"T"),U
+29 ;DRUG
WRITE $EXTRACT($$GET1^DIQ(52,RXI,6),1,18),U
+30 ;INSURANCE
WRITE $$BPSPLN^BPSUTIL(RXI,RFL),U
+31 ;PAY-STAT
WRITE $EXTRACT($$STATUS^PSOBPSUT(RXI,RFL),1,7),U
+32 ;BILL#
WRITE $PIECE($$BILLINFO^IBNCPDPI(RXI,RFL),"^"),U
+33 ;REL-DATE
WRITE $SELECT(RDT:$EXTRACT(RDT,4,5)_"/"_$EXTRACT(RDT,6,7)_"/"_$EXTRACT(RDT,2,3),1:"")
End DoDot:1
+34 QUIT
+35 ;
+36 ;- Check Selected Patient Array
GOODPAT(DFN,PATS) ;
+1 IF $GET(PATS(-1))="^ALL"
QUIT 1
+2 IF $GET(PATS(DFN))'=""
QUIT 1
+3 QUIT 0
+4 ;
+5 ;- Display Header - Normal
PLINE WRITE !,"NAME",?22,"ECME#/RX#/FL#",?45,"NDC SENT",?59,"NDC RECVD",?71,"CMOP-STAT"
+1 WRITE !," DRUG",?22,"INSURANCE",?38,"PAY-STAT",?48,"BILL#",?58,"REL-DATE"
+2 XECUTE LINE
+3 QUIT
+4 ;
+5 ;- Display Header - Excel
PLINEX WRITE !,"TRANSMISSION",U,"STATUS",U,"DIVISION",U,"CMOP SYSTEM",U,"TRANSMISSION DATE/TIME",U
+1 WRITE "NAME",U,"Pt.ID",U,"ECME#",U,"RX#",U,"FL#",U,"NDC SENT",U,"NDC RECVD",U,"CMOP-STAT",U
+2 WRITE "DRUG",U,"INSURANCE",U,"PAY-STAT",U,"BILL#",U,"REL-DATE"
+3 QUIT
+4 ;
EXIT IF '$GET(POP)
DO PAUSE2
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 IF $GET(POP)'=1
DO ^%ZISC
+3 QUIT
+4 ;
+5 ;- Print message if no billable prescriptions
NDAT WRITE !!,"********* BATCH HAS NO ECME BILLABLE PRESCRIPTIONS *******",!
+1 QUIT
+2 ;
TITLE WRITE @IOF
+1 WRITE $$CJ^XLFSTR("CMOP/ECME ACTIVITY REPORT "_$SELECT($GET(BPFND)=1:"for "_$EXTRACT(DIVDA(DIVDA),1,24),1:""),80)
+2 WRITE $$CJ^XLFSTR("For "_STDTE_" thru "_$PIECE(ENDTE,"@")_" Printed: "_$$FMTE^XLFDT($$NOW^XLFDT()),80)
+3 XECUTE LINE
+4 QUIT
+5 ;
CHKP(BPLINES) IF $GET(EXCEL)
QUIT
+1 SET BPLINES=BPLINES+1
+2 IF $GET(TERM)
SET BPLINES=BPLINES+2
+3 IF $Y>(IOSL-BPLINES)
IF $GET(TERM)
DO PAUSE
IF $GET(POP)
QUIT
DO TITLE
DO PLINE
QUIT
+4 QUIT
+5 ;
SELDATE() QUIT $$SELDATE^PSXBPSR1()
+1 ;
SELDIV DO SELDIV^PSXBPSR1
QUIT
+1 ;
SELECT(I) DO SELECT^PSXBPSR1(I)
QUIT
+1 ;
SELTYPE() QUIT $$SELTYPE^PSXBPSR1()
+1 ;
SELPATS(ARRAY) QUIT $$SELPATS^PSXBPSR1(.ARRAY)
+1 ;
+2 ;Display selected divisions
ALL DO ALL^PSXBPSR1
QUIT
+1 ;
+2 ;Screen Pause 2
PAUSE2 IF '$GET(TERM)
QUIT
+1 NEW X
+2 USE IO(0)
WRITE !!,"Press RETURN to continue:"
+3 READ X:$GET(DTIME)
+4 USE IO
+5 QUIT
+6 ;
+7 ;Screen Pause 1
+8 ;
+9 ; Return variable - BPQ = 0 Continue
+10 ; 2 Quit
PAUSE NEW X
+1 USE IO(0)
WRITE !!,"Press RETURN to continue, '^' to exit:"
+2 READ X:$GET(DTIME)
IF '$TEST
SET X="^"
IF X["^"
SET POP=2
+3 USE IO
+4 QUIT
