Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXBPSRP

PSXBPSRP.m

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