PSXRPPL1 ;BIR/WPB-Resets Suspense to Print/Transmit ;29-May-2012 15:19;PLS
;;2.0;CMOP;**3,48,62,66,65,1015**;11 Apr 97;Build 62
;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
;
;Modified - IHS/MSC/PLS - 05/28/2010 - Line SBTECME+8
;
;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(PSXTP,PSXDV,THRDT,PULLDT) ; - Sumitting prescriptions to EMCE (3rd Party Billing)
;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 the DIVISION file (#59)
;Output:SBTECME- Number of prescriptions submitted to ECME
Q ;IHS/MSC/PLS - 05/28/2010
N RX,RFL,SBTECME,PSOLRX,RESP,SDT,XDFN,REC,PSOLRX,DOS
I '$$ECMEON^BPSUTIL(PSXDV)!'$$CMOPON^BPSUTIL(PSXDV) Q
S (SDT,SBTECME)=0 K ^TMP("PSXEPHDFN",$J)
F S SDT=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT)) S XDFN=0 Q:(SDT>PULLDT)!(SDT'>0) D
. F S XDFN=$O(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN)) S 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") Q
. . . . . 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"),$$STATUS^PSOBPSUT(RX,RFL-1)'="" Q:'$$DSH^PSXRPPL2(REC) ;ePharm 3/4 days supply
. . . . . S DOS=$$RXFLDT^PSOBPSUT(RX,RFL) I DOS>DT S DOS=DT
. . . . . D ECMESND^PSOBPSU1(RX,RFL,DOS,"PC",,1,,,,.RESP)
. . . . . I $$PATCH^XPDUTL("PSO*7.0*287"),$$TRISTA^PSOREJU3(RXN,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
PSXRPPL1 ;BIR/WPB-Resets Suspense to Print/Transmit ;29-May-2012 15:19;PLS
+1 ;;2.0;CMOP;**3,48,62,66,65,1015**;11 Apr 97;Build 62
+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 ;
+15 ;Modified - IHS/MSC/PLS - 05/28/2010 - Line SBTECME+8
+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")
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
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
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
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
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
DFN ;
+1 FOR
SET DFN=$ORDER(^PS(52.5,"AP",SDT,DFN))
SET REC=0
IF (DFN="")!(DFN'>0)
QUIT
DO REC
+2 QUIT
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
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
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
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 ;
SBTECME(PSXTP,PSXDV,THRDT,PULLDT) ; - Sumitting prescriptions to EMCE (3rd Party Billing)
+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 the DIVISION file (#59)
+5 ;Output:SBTECME- Number of prescriptions submitted to ECME
+6 ;IHS/MSC/PLS - 05/28/2010
QUIT
+7 NEW RX,RFL,SBTECME,PSOLRX,RESP,SDT,XDFN,REC,PSOLRX,DOS
+8 IF '$$ECMEON^BPSUTIL(PSXDV)!'$$CMOPON^BPSUTIL(PSXDV)
QUIT
+9 SET (SDT,SBTECME)=0
KILL ^TMP("PSXEPHDFN",$JOB)
+10 FOR
SET SDT=$ORDER(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT))
SET XDFN=0
IF (SDT>PULLDT)!(SDT'>0)
QUIT
Begin DoDot:1
+11 FOR
SET XDFN=$ORDER(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN))
SET REC=0
IF (XDFN'>0)!(XDFN="")
QUIT
Begin DoDot:2
+12 FOR
SET REC=$ORDER(^PS(52.5,"CMP","Q",PSXTP,PSXDV,SDT,XDFN,REC))
IF (REC'>0)!(REC="")
QUIT
Begin DoDot:3
+13 SET (PSOLRX,RX)=+$$GET1^DIQ(52.5,REC,.01,"I")
IF 'RX
QUIT
+14 SET RFL=$$GET1^DIQ(52.5,REC,9,"I")
IF RFL=""
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+15 IF $$XMIT^PSXBPSUT(REC)
Begin DoDot:4
+16 IF SDT>THRDT
IF '$DATA(^TMP("PSXEPHDFN",$JOB,XDFN))
QUIT
+17 IF $$PATCH^XPDUTL("PSO*7.0*148")
Begin DoDot:5
+18 IF $$RETRX^PSOBPSUT(RX,RFL)
IF SDT>DT
QUIT
+19 IF $$DOUBLE(RX,RFL)
QUIT
+20 IF $$FIND^PSOREJUT(RX,RFL,,"79,88")
QUIT
+21 IF '$$RETRX^PSOBPSUT(RX,RFL)
IF '$$ECMESTAT^PSXRPPL2(RX,RFL)
QUIT
+22 ;ePharm Host error hold
IF $$PATCH^XPDUTL("PSO*7.0*289")
IF '$$DUR^PSXRPPL2(RX,RFL)
QUIT
+23 ;ePharm 3/4 days supply
IF $$PATCH^XPDUTL("PSO*7.0*289")
IF $$STATUS^PSOBPSUT(RX,RFL-1)'=""
IF '$$DSH^PSXRPPL2(REC)
QUIT
+24 SET DOS=$$RXFLDT^PSOBPSUT(RX,RFL)
IF DOS>DT
SET DOS=DT
+25 DO ECMESND^PSOBPSU1(RX,RFL,DOS,"PC",,1,,,,.RESP)
+26 IF $$PATCH^XPDUTL("PSO*7.0*287")
IF $$TRISTA^PSOREJU3(RXN,RFL,.RESP,"PC")
SET ^TMP("PSXEPHNB",$JOB,RX,RFL)=$GET(RESP)
+27 IF $DATA(RESP)
IF 'RESP
SET SBTECME=SBTECME+1
+28 SET ^TMP("PSXEPHDFN",$JOB,XDFN)=""
End DoDot:5
End DoDot:4
+29 DO PSOUL^PSSLOCK(PSOLRX)
End DoDot:3
End DoDot:2
End DoDot:1
+30 KILL ^TMP("PSXEPHDFN",$JOB)
+31 QUIT SBTECME
+32 ;
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
