PSXRPPL1 ;BIR/WPB - Resets Suspense to Print/Transmit ;10/02/97
;;2.0;CMOP;**3,48,62,66,65,69,73,74,81,83,87,91,92**;11 Apr 97;Build 19
;Reference to ^PSRX( supported by DBIA #1977
;Reference to File #59 supported by DBIA #1976
;Reference to PSOSURST supported by DBIA #1970
;Reference to ^PS(52.5, supported by DBIA #1978
;Reference to ^BPSUTIL supported by DBIA #4410
;Reference to ^PSSLOCK supported by DBIA #2789
;Reference to ^PSOBPSUT supported by DBIA #4701
;Reference to ^PSOBPSU1 supported by DBIA #4702
;Reference to ^PSOREJUT supported by DBIA #4706
;Reference to ^PSOREJU3 supported by DBIA #5186
;Reference to ^PSOBPSU2 supported by DBIA #4970
;Reference to ^PSOSULB1 supported by DBIA #2478
;Reference to LOG^BPSOSL supported by ICR# 6764
;Reference to IEN59^BPSOSRX supported by ICR# 4412
;
;This routine will reset the Queued flags and the printed flags in
;PS(52.5 to 'Queued' and 'Printed' respectively and either retransmits
;the data to the CMOP or prints the labels.
START ;initializes local variables
I '$D(^XUSEC("PSXCMOPMGR",DUZ)) W !,"You are not authorized to use this option!" Q
I '$D(^XUSEC("PSX XMIT",DUZ)) W !,"You are not authorized to use this option!" Q
S SWITCH=0
K ^TMP($J,"PSX")
;
QRY ;initial message and option menu
W !
S DIR(0)="NAO^1:3:0",DIR("A")="Select (1, 2, 3): ",DIR("A",1)=" 1 - Reset CMOP Batches for Transmission"
S DIR("A",2)=" 2 - Reprint CMOP Batches",DIR("A",4)=" 3 - Standard Reprint Batches from Suspense"
S DIR("?")="Enter a number between 1 and 3.",DIR("??")=$S($G(PSXVER):"^D HELP^PSXSRP",1:"^D MSG2^PSXRHLP") D ^DIR K DIR G:(Y<0)!($D(DIRUT)) EXIT S REPLY=Y K Y,X
I REPLY=1 S (PSXTRANS,PSXFLAG,SWITCH)=1 G:$G(PSXVER) ^PSXSRST G:'$G(PSXVER) BEGIN
I REPLY=2 S (PSXTRANS,PSXFLAG,SWITCH)=2 G:$G(PSXVER) ^PSXSRST G:'$G(PSXVER) BEGIN
I REPLY=3 S PSXFLG=1 G START^PSOSURST
K REPLY
Q
;
BEGIN ;confirms CMOP processing, if Yes, checks for active site and status
;in the CMOP System file, if not an active site or the system status
;is not stopped the routine exits and processing stops
W !
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to continue",DIR("?",1)="No - Exits."
S DIR("?")=$S(SWITCH=1:"Yes - Transmits data to the CMOP.",SWITCH=2:"Yes - Prints labels.",1:0) D ^DIR K DIR G:(Y=0)!($D(DIRUT)) EXIT K Y
S STATUS=$P($G(^PSX(550,+PSXSYS,0)),"^",3) I STATUS'="H" W !,"There is another job in process, please try again later." G EXIT
ASK ;gets date for the resets
K BEGDATE,ENDDATE W !!,?10,$S($G(SWITCH)=1:"RESET and TRANSMIT CMOP DATA",$G(SWITCH)=2:"RESET and REPRINT CMOP LABELS",1:""),!!!,"**** Date Selection ****",!!
ASK1 I SWITCH=1 S %DT="AEX",%DT("A")=" BEGIN DATE: " D ^%DT K %DT,%DT("A") G:Y<0 EXIT S PRTDT=Y
I SWITCH=2 S %DT="AEX",%DT("A")=" BEGIN DATE: " D ^%DT K %DT,%DT("A") G:Y<0 EXIT S PRTDT=Y
W !! S %DT="AEX",%DT("A")=" ENDING DATE: " D ^%DT Q:Y<0 S PSXDTRG=Y K %DT,%DT("A")
I $G(PRTDT)>$G(PSXDTRG) W !,"Begin Date must be before Ending Date!" G ASK1
I '$O(^PS(52.5,"AP",PRTDT-1))!($O(^(0))>PSXDTRG) W !!,$S(SWITCH=1:"Nothing to Transmit.",SWITCH=2:"Nothing to Reprint.",1:0) G EXIT
D SDT S PSXERFLG=0
I SWITCH=1 D PSXTRANS Q
I SWITCH=2 D PRINT Q
S PSXSTAT="H" D PSXSTAT^PSXRSYU
G EXIT
;
PSXTRANS ;
W !!
S DIR(0)="Y",DIR("B")="YES",DIR("A")="DO YOU WISH TO TRANSMIT TO THE CMOP NOW",DIR("?",1)="No - Exits the option.",DIR("?")="Yes - Transmits to the CMOP." D ^DIR K DIR Q:(Y=0)!($D(DIRUT)) K Y
S PSXSTAT="T" D PSXSTAT^PSXRSYU,ASK^PSXRSUS
Q
;
PRINT ;
W !!
S DIR(0)="Y",DIR("B")="YES",DIR("A")="DO YOU WISH REPRINT CMOP LABELS NOW",DIR("?",1)="No - Exits the option.",DIR("?")="Yes - Reprints CMOP labels." D ^DIR K DIR Q:(Y=0)!($D(DIRUT)) K Y
S PSXSTAT="T" D PSXSTAT^PSXRSYU,ASK^PSXRSUS
Q
;
SDT ;the following subroutines go through the PS(52.5 global and pull the
;data needed to reset the Queued/Printed nodes
S SDT=PRTDT-1 F S SDT=$O(^PS(52.5,"AP",SDT)),DFN=0 Q:(SDT>PSXDTRG)!(SDT="") D DFN
Q
;
DFN ;
F S DFN=$O(^PS(52.5,"AP",SDT,DFN)),REC=0 Q:(DFN="")!(DFN'>0) D REC
Q
;
REC ;
F S REC=$O(^PS(52.5,"AP",SDT,DFN,REC)) Q:(REC'>0)!(REC="") D:$G(^PS(52.5,REC,0)) CHECK
K ZDIV
Q
;
CHECK ;
S STAT=$P($G(^PS(52.5,REC,0)),U,7),PRINT=$G(^PS(52.5,REC,"P")),PSXPTR=$P($G(^PS(52.5,REC,0)),U,1)
S RXF="" F XXF=0:0 S XXF=$O(^PSRX(PSXPTR,1,XXF)) Q:XXF'>0 S RXF=XXF
S ZDIV=$S($G(RXF)>0:$P($G(^PSRX(PSXPTR,1,RXF,0)),U,9),1:$P($G(^PSRX(PSXPTR,2)),U,9)) I $G(ZDIV)'=$G(PSOSITE) Q
S:RXF'="" GONE=$P($G(^PSRX(PSXPTR,1,RXF,0)),U,18)
S:RXF="" GONE=$P($G(^PSRX(PSXPTR,2)),U,13)
I (STAT="P")&(PRINT=1)&($G(GONE)="") D RESET
K GONE,RXF,XXF
Q
;
RESET ;resets the Queued/Printed flags to Queued and not Printed
L +^PS(52.5,REC):DTIME Q:'$T
S DIE="^PS(52.5,",DA=REC,DR="2////2;3////Q" D ^DIE L -^PS(52.5,REC) K DIE,DR,DA
S:$G(PSXVER) $P(^PSRX(PSXPTR,"STA"),U,1)=5 S:'$G(PSXVER) $P(^PSRX(PSXPTR,0),U,15)=5 K ^PS(52.5,"AC",DFN,SDT,REC)
Q
;
PRTERR ; auto error trap for prt cmop local
S XXERR=$$EC^%ZOSV
S PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
;save an image of the transient file 550.1 for 2 days
D NOW^%DTC S DTTM=%
S X=$$FMADD^XLFDT(DT,+2) S ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
M ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
S XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$G(PSXBAT),.01)
D GRP1^PSXNOTE
;S XMY(DUZ)=""
S XMTEXT="TEXT("
S TEXT(1,0)=$S($G(PSXCS):"",1:"NON-")_"CS CMOP Print Local encountered the following error. Please investigate"
S TEXT(2,0)="Division: "_PSXDIVNM
S TEXT(3,0)="Type/Batch "_$S($G(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,$G(PSXBAT),.01)
S TEXT(4,0)="Error: "_XXERR
S TEXT(5,0)="This batch has been set to closed."
S TEXT(6,0)="Call NVS to investigate which prescriptions have been printed and which are yet to print."
S TEXT(7,0)="A copy of file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
D ^%ZTER
D ^XMD
I $G(PSXBAT) D
. N DA,DIE,DR S DIE="^PSX(550.2,",DA=PSXBAT,DR="1////4"
. D ^DIE
G UNWIND^%ZTER
;
; $$SBTECME^PSXRPPL1 goes through the suspense queue for either CS
; or non-CS prescriptions (according to PSXTYP), up to and including
; the through date (PRTDT). For each Rx, it will send a claim if
; the patient has insurance.
;
SBTECME(PSXTP,PSXDV,THRDT,PULLDT) ;
;Input: PSXTP - Type of prescriptions "C" - Controlled Subs / "N" Non-Controlled Subs
; PSXDV - Pointer to DIVSION file (#59)
; THRDT - T+N when scheduling the THROUGH DATE to run CMOP Transmission
; PULLDT - T+N+PULL DAYS parameter in file# 59, OUTPATIENT SITE
;Output:SBTECME- Number of prescriptions submitted to ECME
;
N PSOLRX,REC,RESP,RFL,RX,SBTECME,SDT,XDFN
;
I '$$ECMEON^BPSUTIL(PSXDV)!'$$CMOPON^BPSUTIL(PSXDV) Q
K ^TMP("PSXEPHDFN",$J)
S (SDT,SBTECME)=0
F S SDT=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT)),XDFN=0 Q:(SDT>PULLDT)!(SDT'>0) D
. F S XDFN=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN)),REC=0 Q:(XDFN'>0)!(XDFN="") D
. . F S REC=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN,REC)) Q:(REC'>0)!(REC="") D
. . . S (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I") I 'RX Q
. . . S RFL=$$GET1^DIQ(52.5,REC,9,"I") I RFL="" S RFL=$$LSTRFL^PSOBPSU1(RX)
. . . I $$XMIT^PSXBPSUT(REC) D
. . . . I SDT>THRDT,'$D(^TMP("PSXEPHDFN",$J,XDFN)) Q
. . . . I $$PATCH^XPDUTL("PSO*7.0*148") D
. . . . . I $$RETRX^PSOBPSUT(RX,RFL),SDT>DT Q
. . . . . I $$DOUBLE(RX,RFL) Q
. . . . . I $$FIND^PSOREJUT(RX,RFL,,"79,88,943",,1) Q
. . . . . ;
. . . . . ; If TRI/CVA and the Rx already has a closed eT/eC
. . . . . ; pseudo-reject, then do not send another claim.
. . . . . ;
. . . . . I $$TRICVANB(RX,RFL) D Q
. . . . . . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-SBTECME, $$TRICVANB returned 1") ; ICR #4412,6764
. . . . . ;
. . . . . I '$$RETRX^PSOBPSUT(RX,RFL),'$$ECMESTAT^PSXRPPL2(RX,RFL) Q
. . . . . I $$PATCH^XPDUTL("PSO*7.0*289") Q:'$$DUR^PSXRPPL2(RX,RFL) ; ePharm Host error hold
. . . . . I $$PATCH^XPDUTL("PSO*7.0*289") Q:'$$DSH^PSXRPPL2(REC,1) ; ePharm 3/4 days supply
. . . . . ;
. . . . . ; ECMESND^PSOBPSU1 initiates the claim submission process.
. . . . . ;
. . . . . D ECMESND^PSOBPSU1(RX,RFL,"","PC",,1,,,,.RESP)
. . . . . ;
. . . . . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-SBTECME, RESP="_$G(RESP)) ; ICR #4412,6764
. . . . . ;
. . . . . I $G(RESP)'["IN PROGRESS",$$PATCH^XPDUTL("PSO*7.0*287"),$$TRISTA^PSOREJU3(RX,RFL,.RESP,"PC") S ^TMP("PSXEPHNB",$J,RX,RFL)=$G(RESP)
. . . . . ;
. . . . . I $D(RESP),'RESP S SBTECME=SBTECME+1
. . . . . S ^TMP("PSXEPHDFN",$J,XDFN)=""
. . . D PSOUL^PSSLOCK(PSOLRX)
K ^TMP("PSXEPHDFN",$J)
Q SBTECME
;
DOUBLE(RX,RFL) ; Checks if previous fill is still being worked on by CMOP
;Input: (r) RX - Prescription IEN
; (r) RFL - Fill number
;Output: 0 - Previous fill not with CMOP / 1 - CMOP working on previous fill
N CMP,DOUBLE,STS
;
I 'RFL!'$D(^PSRX(RX,4)) Q 0
I $$STATUS^PSOBPSUT(RX,RFL-1)="" Q 0
S DOUBLE=0,CMP=999
F S CMP=$O(^PSRX(RX,4,CMP),-1) Q:'CMP D I DOUBLE Q
. I $$GET1^DIQ(52.01,CMP_","_RX,2,"I")'=(RFL-1) Q
. S STS=$$GET1^DIQ(52.01,CMP_","_RX,3,"I")
. I STS=0!(STS=2) S DOUBLE=1
Q DOUBLE
;
EXIT ;
K DFN,PSXDAYS,PSXDTRG,SWITCH,STAT,PRINT,PSXTRANS,REC,REPLY,SDT,X,X1,X2,Y,ANSWER,STATUS,PSXFLAG,PSXPTR,PSXSTAT
K DIR,DIRUT,DTOUT,DUOUT,DIROUT
Q
;
TRICVANB(PSXRX,PSXRFL) ; Check for TRI/CVA non-billable w/closed eT/eC.
; Return: 1 if this is a TRICARE or CHAMPVA non-billable Rx
; which already has a closed eT/eC reject for this fill.
; 0 if other.
;
N PSXQUIT,PSXREJ,PSXREJCODE,PSXTRICVA
;
; Return 0 if not TRICARE or CHAMPVA.
;
S PSXTRICVA=$$TRIC^PSOREJP1(PSXRX,PSXRFL)
I 'PSXTRICVA Q 0
;
; Determine which pseudo-reject we're looking for.
;
I PSXTRICVA=1 S PSXREJCODE="eT"
E S PSXREJCODE="eC"
;
; Find the most recent eT or eC reject for the current fill, if any.
;
S PSXQUIT=0
S PSXREJ=999
F S PSXREJ=$O(^PSRX(PSXRX,"REJ","B",PSXREJCODE,PSXREJ),-1) Q:'PSXREJ D Q:PSXQUIT
. I $$GET1^DIQ(52.25,PSXREJ_","_PSXRX_",",5)=PSXRFL S PSXQUIT=1
. Q
;
; Return 0 if we did not find an eT/eC for the current fill.
;
I 'PSXREJ Q 0
;
; Return 0 if the reject is still open.
;
I $$GET1^DIQ(52.25,PSXREJ_","_PSXRX_",",10)="" Q 0
;
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRPPL1 10417 printed Nov 22, 2024@16:55:08 Page 2
PSXRPPL1 ;BIR/WPB - Resets Suspense to Print/Transmit ;10/02/97
+1 ;;2.0;CMOP;**3,48,62,66,65,69,73,74,81,83,87,91,92**;11 Apr 97;Build 19
+2 ;Reference to ^PSRX( supported by DBIA #1977
+3 ;Reference to File #59 supported by DBIA #1976
+4 ;Reference to PSOSURST supported by DBIA #1970
+5 ;Reference to ^PS(52.5, supported by DBIA #1978
+6 ;Reference to ^BPSUTIL supported by DBIA #4410
+7 ;Reference to ^PSSLOCK supported by DBIA #2789
+8 ;Reference to ^PSOBPSUT supported by DBIA #4701
+9 ;Reference to ^PSOBPSU1 supported by DBIA #4702
+10 ;Reference to ^PSOREJUT supported by DBIA #4706
+11 ;Reference to ^PSOREJU3 supported by DBIA #5186
+12 ;Reference to ^PSOBPSU2 supported by DBIA #4970
+13 ;Reference to ^PSOSULB1 supported by DBIA #2478
+14 ;Reference to LOG^BPSOSL supported by ICR# 6764
+15 ;Reference to IEN59^BPSOSRX supported by ICR# 4412
+16 ;
+17 ;This routine will reset the Queued flags and the printed flags in
+18 ;PS(52.5 to 'Queued' and 'Printed' respectively and either retransmits
+19 ;the data to the CMOP or prints the labels.
START ;initializes local variables
+1 IF '$DATA(^XUSEC("PSXCMOPMGR",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+2 IF '$DATA(^XUSEC("PSX XMIT",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+3 SET SWITCH=0
+4 KILL ^TMP($JOB,"PSX")
+5 ;
QRY ;initial message and option menu
+1 WRITE !
+2 SET DIR(0)="NAO^1:3:0"
SET DIR("A")="Select (1, 2, 3): "
SET DIR("A",1)=" 1 - Reset CMOP Batches for Transmission"
+3 SET DIR("A",2)=" 2 - Reprint CMOP Batches"
SET DIR("A",4)=" 3 - Standard Reprint Batches from Suspense"
+4 SET DIR("?")="Enter a number between 1 and 3."
SET DIR("??")=$SELECT($GET(PSXVER):"^D HELP^PSXSRP",1:"^D MSG2^PSXRHLP")
DO ^DIR
KILL DIR
if (Y<0)!($DATA(DIRUT))
GOTO EXIT
SET REPLY=Y
KILL Y,X
+5 IF REPLY=1
SET (PSXTRANS,PSXFLAG,SWITCH)=1
if $GET(PSXVER)
GOTO ^PSXSRST
if '$GET(PSXVER)
GOTO BEGIN
+6 IF REPLY=2
SET (PSXTRANS,PSXFLAG,SWITCH)=2
if $GET(PSXVER)
GOTO ^PSXSRST
if '$GET(PSXVER)
GOTO BEGIN
+7 IF REPLY=3
SET PSXFLG=1
GOTO START^PSOSURST
+8 KILL REPLY
+9 QUIT
+10 ;
BEGIN ;confirms CMOP processing, if Yes, checks for active site and status
+1 ;in the CMOP System file, if not an active site or the system status
+2 ;is not stopped the routine exits and processing stops
+3 WRITE !
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to continue"
SET DIR("?",1)="No - Exits."
+5 SET DIR("?")=$SELECT(SWITCH=1:"Yes - Transmits data to the CMOP.",SWITCH=2:"Yes - Prints labels.",1:0)
DO ^DIR
KILL DIR
if (Y=0)!($DATA(DIRUT))
GOTO EXIT
KILL Y
+6 SET STATUS=$PIECE($GET(^PSX(550,+PSXSYS,0)),"^",3)
IF STATUS'="H"
WRITE !,"There is another job in process, please try again later."
GOTO EXIT
ASK ;gets date for the resets
+1 KILL BEGDATE,ENDDATE
WRITE !!,?10,$SELECT($GET(SWITCH)=1:"RESET and TRANSMIT CMOP DATA",$GET(SWITCH)=2:"RESET and REPRINT CMOP LABELS",1:""),!!!,"**** Date Selection ****",!!
ASK1 IF SWITCH=1
SET %DT="AEX"
SET %DT("A")=" BEGIN DATE: "
DO ^%DT
KILL %DT,%DT("A")
if Y<0
GOTO EXIT
SET PRTDT=Y
+1 IF SWITCH=2
SET %DT="AEX"
SET %DT("A")=" BEGIN DATE: "
DO ^%DT
KILL %DT,%DT("A")
if Y<0
GOTO EXIT
SET PRTDT=Y
+2 WRITE !!
SET %DT="AEX"
SET %DT("A")=" ENDING DATE: "
DO ^%DT
if Y<0
QUIT
SET PSXDTRG=Y
KILL %DT,%DT("A")
+3 IF $GET(PRTDT)>$GET(PSXDTRG)
WRITE !,"Begin Date must be before Ending Date!"
GOTO ASK1
+4 IF '$ORDER(^PS(52.5,"AP",PRTDT-1))!($ORDER(^(0))>PSXDTRG)
WRITE !!,$SELECT(SWITCH=1:"Nothing to Transmit.",SWITCH=2:"Nothing to Reprint.",1:0)
GOTO EXIT
+5 DO SDT
SET PSXERFLG=0
+6 IF SWITCH=1
DO PSXTRANS
QUIT
+7 IF SWITCH=2
DO PRINT
QUIT
+8 SET PSXSTAT="H"
DO PSXSTAT^PSXRSYU
+9 GOTO EXIT
+10 ;
PSXTRANS ;
+1 WRITE !!
+2 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="DO YOU WISH TO TRANSMIT TO THE CMOP NOW"
SET DIR("?",1)="No - Exits the option."
SET DIR("?")="Yes - Transmits to the CMOP."
DO ^DIR
KILL DIR
if (Y=0)!($DATA(DIRUT))
QUIT
KILL Y
+3 SET PSXSTAT="T"
DO PSXSTAT^PSXRSYU
DO ASK^PSXRSUS
+4 QUIT
+5 ;
PRINT ;
+1 WRITE !!
+2 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="DO YOU WISH REPRINT CMOP LABELS NOW"
SET DIR("?",1)="No - Exits the option."
SET DIR("?")="Yes - Reprints CMOP labels."
DO ^DIR
KILL DIR
if (Y=0)!($DATA(DIRUT))
QUIT
KILL Y
+3 SET PSXSTAT="T"
DO PSXSTAT^PSXRSYU
DO ASK^PSXRSUS
+4 QUIT
+5 ;
SDT ;the following subroutines go through the PS(52.5 global and pull the
+1 ;data needed to reset the Queued/Printed nodes
+2 SET SDT=PRTDT-1
FOR
SET SDT=$ORDER(^PS(52.5,"AP",SDT))
SET DFN=0
if (SDT>PSXDTRG)!(SDT="")
QUIT
DO DFN
+3 QUIT
+4 ;
DFN ;
+1 FOR
SET DFN=$ORDER(^PS(52.5,"AP",SDT,DFN))
SET REC=0
if (DFN="")!(DFN'>0)
QUIT
DO REC
+2 QUIT
+3 ;
REC ;
+1 FOR
SET REC=$ORDER(^PS(52.5,"AP",SDT,DFN,REC))
if (REC'>0)!(REC="")
QUIT
if $GET(^PS(52.5,REC,0))
DO CHECK
+2 KILL ZDIV
+3 QUIT
+4 ;
CHECK ;
+1 SET STAT=$PIECE($GET(^PS(52.5,REC,0)),U,7)
SET PRINT=$GET(^PS(52.5,REC,"P"))
SET PSXPTR=$PIECE($GET(^PS(52.5,REC,0)),U,1)
+2 SET RXF=""
FOR XXF=0:0
SET XXF=$ORDER(^PSRX(PSXPTR,1,XXF))
if XXF'>0
QUIT
SET RXF=XXF
+3 SET ZDIV=$SELECT($GET(RXF)>0:$PIECE($GET(^PSRX(PSXPTR,1,RXF,0)),U,9),1:$PIECE($GET(^PSRX(PSXPTR,2)),U,9))
IF $GET(ZDIV)'=$GET(PSOSITE)
QUIT
+4 if RXF'=""
SET GONE=$PIECE($GET(^PSRX(PSXPTR,1,RXF,0)),U,18)
+5 if RXF=""
SET GONE=$PIECE($GET(^PSRX(PSXPTR,2)),U,13)
+6 IF (STAT="P")&(PRINT=1)&($GET(GONE)="")
DO RESET
+7 KILL GONE,RXF,XXF
+8 QUIT
+9 ;
RESET ;resets the Queued/Printed flags to Queued and not Printed
+1 LOCK +^PS(52.5,REC):DTIME
if '$TEST
QUIT
+2 SET DIE="^PS(52.5,"
SET DA=REC
SET DR="2////2;3////Q"
DO ^DIE
LOCK -^PS(52.5,REC)
KILL DIE,DR,DA
+3 if $GET(PSXVER)
SET $PIECE(^PSRX(PSXPTR,"STA"),U,1)=5
if '$GET(PSXVER)
SET $PIECE(^PSRX(PSXPTR,0),U,15)=5
KILL ^PS(52.5,"AC",DFN,SDT,REC)
+4 QUIT
+5 ;
PRTERR ; auto error trap for prt cmop local
+1 SET XXERR=$$EC^%ZOSV
+2 SET PSXDIVNM=$$GET1^DIQ(59,PSOSITE,.01)
+3 ;save an image of the transient file 550.1 for 2 days
+4 DO NOW^%DTC
SET DTTM=%
+5 SET X=$$FMADD^XLFDT(DT,+2)
SET ^XTMP("PSXERR "_DTTM,0)=X_U_DT_U_"CMOP "_XXERR
+6 MERGE ^XTMP("PSXERR "_DTTM,550.1)=^PSX(550.1)
+7 SET XMSUB="CMOP Error "_PSXDIVNM_" "_$$GET1^DIQ(550.2,+$GET(PSXBAT),.01)
+8 DO GRP1^PSXNOTE
+9 ;S XMY(DUZ)=""
+10 SET XMTEXT="TEXT("
+11 SET TEXT(1,0)=$SELECT($GET(PSXCS):"",1:"NON-")_"CS CMOP Print Local encountered the following error. Please investigate"
+12 SET TEXT(2,0)="Division: "_PSXDIVNM
+13 SET TEXT(3,0)="Type/Batch "_$SELECT($GET(PSXCS):"CS",1:"NON-CS")_" / "_$$GET1^DIQ(550.2,$GET(PSXBAT),.01)
+14 SET TEXT(4,0)="Error: "_XXERR
+15 SET TEXT(5,0)="This batch has been set to closed."
+16 SET TEXT(6,0)="Call NVS to investigate which prescriptions have been printed and which are yet to print."
+17 SET TEXT(7,0)="A copy of file 550.1 can be found in ^XTMP(""PSXERR "_DTTM_""")"
+18 DO ^%ZTER
+19 DO ^XMD
+20 IF $GET(PSXBAT)
Begin DoDot:1
+21 NEW DA,DIE,DR
SET DIE="^PSX(550.2,"
SET DA=PSXBAT
SET DR="1////4"
+22 DO ^DIE
End DoDot:1
+23 GOTO UNWIND^%ZTER
+24 ;
+25 ; $$SBTECME^PSXRPPL1 goes through the suspense queue for either CS
+26 ; or non-CS prescriptions (according to PSXTYP), up to and including
+27 ; the through date (PRTDT). For each Rx, it will send a claim if
+28 ; the patient has insurance.
+29 ;
SBTECME(PSXTP,PSXDV,THRDT,PULLDT) ;
+1 ;Input: PSXTP - Type of prescriptions "C" - Controlled Subs / "N" Non-Controlled Subs
+2 ; PSXDV - Pointer to DIVSION file (#59)
+3 ; THRDT - T+N when scheduling the THROUGH DATE to run CMOP Transmission
+4 ; PULLDT - T+N+PULL DAYS parameter in file# 59, OUTPATIENT SITE
+5 ;Output:SBTECME- Number of prescriptions submitted to ECME
+6 ;
+7 NEW PSOLRX,REC,RESP,RFL,RX,SBTECME,SDT,XDFN
+8 ;
+9 IF '$$ECMEON^BPSUTIL(PSXDV)!'$$CMOPON^BPSUTIL(PSXDV)
QUIT
+10 KILL ^TMP("PSXEPHDFN",$JOB)
+11 SET (SDT,SBTECME)=0
+12 FOR
SET SDT=$ORDER(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT))
SET XDFN=0
if (SDT>PULLDT)!(SDT'>0)
QUIT
Begin DoDot:1
+13 FOR
SET XDFN=$ORDER(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN))
SET REC=0
if (XDFN'>0)!(XDFN="")
QUIT
Begin DoDot:2
+14 FOR
SET REC=$ORDER(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN,REC))
if (REC'>0)!(REC="")
QUIT
Begin DoDot:3
+15 SET (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I")
IF 'RX
QUIT
+16 SET RFL=$$GET1^DIQ(52.5,REC,9,"I")
IF RFL=""
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+17 IF $$XMIT^PSXBPSUT(REC)
Begin DoDot:4
+18 IF SDT>THRDT
IF '$DATA(^TMP("PSXEPHDFN",$JOB,XDFN))
QUIT
+19 IF $$PATCH^XPDUTL("PSO*7.0*148")
Begin DoDot:5
+20 IF $$RETRX^PSOBPSUT(RX,RFL)
IF SDT>DT
QUIT
+21 IF $$DOUBLE(RX,RFL)
QUIT
+22 IF $$FIND^PSOREJUT(RX,RFL,,"79,88,943",,1)
QUIT
+23 ;
+24 ; If TRI/CVA and the Rx already has a closed eT/eC
+25 ; pseudo-reject, then do not send another claim.
+26 ;
+27 IF $$TRICVANB(RX,RFL)
Begin DoDot:6
+28 ; ICR #4412,6764
DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-SBTECME, $$TRICVANB returned 1")
End DoDot:6
QUIT
+29 ;
+30 IF '$$RETRX^PSOBPSUT(RX,RFL)
IF '$$ECMESTAT^PSXRPPL2(RX,RFL)
QUIT
+31 ; ePharm Host error hold
IF $$PATCH^XPDUTL("PSO*7.0*289")
if '$$DUR^PSXRPPL2(RX,RFL)
QUIT
+32 ; ePharm 3/4 days supply
IF $$PATCH^XPDUTL("PSO*7.0*289")
if '$$DSH^PSXRPPL2(REC,1)
QUIT
+33 ;
+34 ; ECMESND^PSOBPSU1 initiates the claim submission process.
+35 ;
+36 DO ECMESND^PSOBPSU1(RX,RFL,"","PC",,1,,,,.RESP)
+37 ;
+38 ; ICR #4412,6764
DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-SBTECME, RESP="_$GET(RESP))
+39 ;
+40 IF $GET(RESP)'["IN PROGRESS"
IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $$TRISTA^PSOREJU3(RX,RFL,.RESP,"PC")
SET ^TMP("PSXEPHNB",$JOB,RX,RFL)=$GET(RESP)
+41 ;
+42 IF $DATA(RESP)
IF 'RESP
SET SBTECME=SBTECME+1
+43 SET ^TMP("PSXEPHDFN",$JOB,XDFN)=""
End DoDot:5
End DoDot:4
+44 DO PSOUL^PSSLOCK(PSOLRX)
End DoDot:3
End DoDot:2
End DoDot:1
+45 KILL ^TMP("PSXEPHDFN",$JOB)
+46 QUIT SBTECME
+47 ;
DOUBLE(RX,RFL) ; Checks if previous fill is still being worked on by CMOP
+1 ;Input: (r) RX - Prescription IEN
+2 ; (r) RFL - Fill number
+3 ;Output: 0 - Previous fill not with CMOP / 1 - CMOP working on previous fill
+4 NEW CMP,DOUBLE,STS
+5 ;
+6 IF 'RFL!'$DATA(^PSRX(RX,4))
QUIT 0
+7 IF $$STATUS^PSOBPSUT(RX,RFL-1)=""
QUIT 0
+8 SET DOUBLE=0
SET CMP=999
+9 FOR
SET CMP=$ORDER(^PSRX(RX,4,CMP),-1)
if 'CMP
QUIT
Begin DoDot:1
+10 IF $$GET1^DIQ(52.01,CMP_","_RX,2,"I")'=(RFL-1)
QUIT
+11 SET STS=$$GET1^DIQ(52.01,CMP_","_RX,3,"I")
+12 IF STS=0!(STS=2)
SET DOUBLE=1
End DoDot:1
IF DOUBLE
QUIT
+13 QUIT DOUBLE
+14 ;
EXIT ;
+1 KILL DFN,PSXDAYS,PSXDTRG,SWITCH,STAT,PRINT,PSXTRANS,REC,REPLY,SDT,X,X1,X2,Y,ANSWER,STATUS,PSXFLAG,PSXPTR,PSXSTAT
+2 KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
+3 QUIT
+4 ;
TRICVANB(PSXRX,PSXRFL) ; Check for TRI/CVA non-billable w/closed eT/eC.
+1 ; Return: 1 if this is a TRICARE or CHAMPVA non-billable Rx
+2 ; which already has a closed eT/eC reject for this fill.
+3 ; 0 if other.
+4 ;
+5 NEW PSXQUIT,PSXREJ,PSXREJCODE,PSXTRICVA
+6 ;
+7 ; Return 0 if not TRICARE or CHAMPVA.
+8 ;
+9 SET PSXTRICVA=$$TRIC^PSOREJP1(PSXRX,PSXRFL)
+10 IF 'PSXTRICVA
QUIT 0
+11 ;
+12 ; Determine which pseudo-reject we're looking for.
+13 ;
+14 IF PSXTRICVA=1
SET PSXREJCODE="eT"
+15 IF '$TEST
SET PSXREJCODE="eC"
+16 ;
+17 ; Find the most recent eT or eC reject for the current fill, if any.
+18 ;
+19 SET PSXQUIT=0
+20 SET PSXREJ=999
+21 FOR
SET PSXREJ=$ORDER(^PSRX(PSXRX,"REJ","B",PSXREJCODE,PSXREJ),-1)
if 'PSXREJ
QUIT
Begin DoDot:1
+22 IF $$GET1^DIQ(52.25,PSXREJ_","_PSXRX_",",5)=PSXRFL
SET PSXQUIT=1
+23 QUIT
End DoDot:1
if PSXQUIT
QUIT
+24 ;
+25 ; Return 0 if we did not find an eT/eC for the current fill.
+26 ;
+27 IF 'PSXREJ
QUIT 0
+28 ;
+29 ; Return 0 if the reject is still open.
+30 ;
+31 IF $$GET1^DIQ(52.25,PSXREJ_","_PSXRX_",",10)=""
QUIT 0
+32 ;
+33 QUIT 1
+34 ;
