PSXBPSMS ;BIRM/BSR - BPS (ECME) Utilities ;10/29/98 2:13 PM
;;2.0;CMOP;**48,77,81,91**;11 Apr 97;Build 33
;Reference to $$RXFLDT^PSOBPSUT supported by IA 4701
;Reference to LOG^BPSOSL supported by ICR# 6764
;Reference to IEN59^BPSOSRX supported by ICR# 4412
;Reference to ELIGDISP^PSOREJP1 supported by ICR# 6763
;
; PSXBPSMS sends an email at the conclusion of the CMOP process to
; communicate to the users which prescriptions were left in the
; suspense queue and not sent to the CMOP facility. There are two
; scenarios that could lead to this; either the prescription is
; non-billable, or a response from the third party payer was not
; received by the time the CMOP process stopped waiting for
; responses (see SDT^PSXRPPL and CHKDFN^PSXRPPL2). Each of the
; prescriptions listed in ^TMP("PSXEPHIN" are included in this email.
; That global is set only in EPH^PSXRPPL2, which is called only
; by EPHARM^PSXRPPL2.
;
EN ;Main entry point.
N DFN,DIV,EMCNT,ORCNT,PATCNT,PATNM,PSXACTIVITY,PSXELIG,PTLST,RFL,RX,SSN,VADM
K ^TMP("PSXEPHOUT",$J)
S ^XTMP("PSXBPSMS",0)=$$FMADD^XLFDT(DT,35)_"^"_DT
S (EMCNT,ORCNT,PATCNT)=0
;
S DIV=""
F S DIV=$O(^TMP("PSXEPHIN",$J,DIV)) Q:DIV="" D
. D HEADER(DIV)
. S RX=""
. F S RX=$O(^TMP("PSXEPHIN",$J,DIV,RX)) Q:RX="" D
. . S RFL=+$G(^TMP("PSXEPHIN",$J,DIV,RX))
. . S ^XTMP("PSXBPSMS",1,RX,RFL,DT)=""
. . ;
. . ; Add an entry to the developer's log, BPS LOG, file# 9002313.12.
. . ;
. . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-Prescription being left on CMOP queue") ; ICR #4412,6764
. . ;
. . ; Add an entry to the Activity Log for this Rx (sub-file# 52.3).
. . ;
. . I $$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS" D ; ICR #4701
. . . S PSXELIG=$$ELIGDISP^PSOREJP1(RX,RFL) ; ICR #6763
. . . I PSXELIG="" S PSXELIG="Veteran"
. . . S PSXACTIVITY=PSXELIG_"-Rx placed on Suspense due to ECME IN PROGRESS status"
. . . D RXACT^PSOBPSU2(RX,RFL,PSXACTIVITY,"M",DUZ) ; ICR # 4970
. . ;
. . ; Determine the SSN and Patient Name.
. . ;
. . S DFN=+$P(^PSRX(RX,0),"^",2) D DEM^VADPT
. . S SSN=$E($P(VADM(2),U),6,9),PATNM=(VADM(1))
. . ;
. . ; Increment the count of orders (Rxs) and unique patients.
. . ;
. . S ORCNT=$G(ORCNT)+1
. . D PATCNT(PATNM_SSN)
. . ;
. . D FORMAT
. D FOOTER(DIV)
D MAIL,CLEAN
Q
;
; Format Row
FORMAT ;
N LTXT
S LTXT=$$GET1^DIQ(52,RX,.01)_"/"_RFL
S $E(LTXT,17)=$E(PATNM,1,18)_"("_SSN_")",$E(LTXT,42)=$E($$GET1^DIQ(52,RX,6),1,23)
S $E(LTXT,67)=$$TRANS(RX,RFL)
D STORELN(LTXT)
Q
;
;Count patients.
PATCNT(NAMSSN) ;
I '$D(PTLST(NAMSSN)) D
.S PTLST(NAMSSN)=""
.S PATCNT=$G(PATCNT)+1
Q
;
;Build header.
D STORELN("Division: "_$$GET1^DIQ(59,DIV,.01))
D STORELN($TR($J("",79)," ","-"))
D STORELN(" NOT TRANSMITTED")
D STORELN("RX#/Fill PATIENT(LAST4) DRUG 1ST DT #DAYS")
D STORELN($TR($J("",79)," ","-"))
Q
;
;Output patient count & prescriptions count & division number
D STORELN(" ")
D STORELN("Total "_$$GET1^DIQ(59,DIVN,.01)_": "_PATCNT_" Patients and "_ORCNT_" Prescriptions.")
D STORELN(" ")
K PTLST S (ORCNT,PATCNT)=0
Q
;
; MAIL builds the email message and sends it to users who hold the
; key PSXMAIL (or PSXCMOPMGR).
;
MAIL ;
;
N DIV,M1,PSBMSG,SITES,USER,XMDUZ,XMSUB,XMTEXT,XMY,Y
;
S PSBMSG(1)="The prescriptions listed in this message did not transmit to CMOP for one of"
S PSBMSG(2)="the reasons below:"
S PSBMSG(3)=" "
S PSBMSG(4)=" A response from the third party payer was not received"
S PSBMSG(5)=" "
S PSBMSG(6)=" OR"
S PSBMSG(7)=" "
S PSBMSG(8)=" The prescriptions are non-billable in VistA"
S PSBMSG(9)=" "
S PSBMSG(10)="The prescriptions will remain in the CMOP queue and will transmit when the"
S PSBMSG(11)="response from the third party payer is received, or the non-billable issue"
S PSBMSG(12)="is resolved."
S PSBMSG(13)=" "
S M1=14
;
S Y=""
F S Y=$O(^TMP("PSXEPHOUT",$J,"M",Y)) Q:Y="" D
. S PSBMSG(M1)=$P(^TMP("PSXEPHOUT",$J,"M",Y),"^")
. S M1=M1+1
;
; Setup the list of recipients (XMY). Send the email to all users
; holding the security key PSXMAIL, if any; otherwise, send to all
; users holding the key PSXCMOPMGR.
;
S USER=0
I $D(^XUSEC("PSXMAIL")) D
.F S USER=$O(^XUSEC("PSXMAIL",USER)) Q:'USER S XMY(USER)=""
E D
.F S USER=$O(^XUSEC("PSXCMOPMGR",USER)) Q:'USER S XMY(USER)=""
;
; Set the subject (XMSUB), indicate the array containing the text of
; the message is PSBMSG, and set the sender to be POSTMASTER (.5).
;
S DIV="",SITES=""
F S DIV=$O(^TMP("PSXEPHIN",$J,DIV)) Q:DIV="" S SITES=SITES_$$GET1^DIQ(59,DIV_",",.01,"E")_","
S XMSUB=$E("ePharmacy CMOP Not TRANSMITTED Rxs - "_$E(SITES,1,$L(SITES)-1),1,65)
S XMTEXT="PSBMSG("
S XMDUZ=.5
;
D ^XMD
;
Q
;
;Store E-mail line for later use.
STORELN(LINE) ;
S EMCNT=EMCNT+1
S ^TMP("PSXEPHOUT",$J,"M",EMCNT)=LINE
Q
;
TRANS(RX,RFL) ;
I '$G(RX) Q ""
I $G(RFL)="" Q ""
N TDT,CNT,FDT
S CNT=0,FDT=9999999
S TDT="" F S TDT=$O(^XTMP("PSXBPSMS",1,RX,RFL,TDT)) Q:'TDT D
. S CNT=CNT+1
S FDT=$O(^XTMP("PSXBPSMS",1,RX,RFL,""))
I FDT=9999999 S FDT=" "
E S FDT=$E(FDT,4,5)_"/"_$E(FDT,6,7)_"/"_($E(FDT,2,3))
Q FDT_$E(" ",1,5-$L(CNT))_CNT
;
;Clean all remaining arrays and variables
;Purge ^XTMP data older than 30 days
CLEAN ;
K ^TMP("PSXEPHOUT",$J),^TMP("PSXEPHIN",$J)
; Purge ^XTMP data older than 30 days
N FDT,RX,RFL,TDT
S FDT=$$FMADD^XLFDT(DT,-30)
S RX="" F S RX=$O(^XTMP("PSXBPSMS",1,RX)) Q:'RX D
. S RFL="" F S RFL=$O(^XTMP("PSXBPSMS",1,RX,RFL)) Q:RFL="" D
.. S TDT="" F S TDT=$O(^XTMP("PSXBPSMS",1,RX,RFL,TDT)) Q:'TDT D
... I TDT<FDT K ^XTMP("PSXBPSMS",1,RX,RFL,TDT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXBPSMS 5917 printed Sep 23, 2025@19:19:32 Page 2
PSXBPSMS ;BIRM/BSR - BPS (ECME) Utilities ;10/29/98 2:13 PM
+1 ;;2.0;CMOP;**48,77,81,91**;11 Apr 97;Build 33
+2 ;Reference to $$RXFLDT^PSOBPSUT supported by IA 4701
+3 ;Reference to LOG^BPSOSL supported by ICR# 6764
+4 ;Reference to IEN59^BPSOSRX supported by ICR# 4412
+5 ;Reference to ELIGDISP^PSOREJP1 supported by ICR# 6763
+6 ;
+7 ; PSXBPSMS sends an email at the conclusion of the CMOP process to
+8 ; communicate to the users which prescriptions were left in the
+9 ; suspense queue and not sent to the CMOP facility. There are two
+10 ; scenarios that could lead to this; either the prescription is
+11 ; non-billable, or a response from the third party payer was not
+12 ; received by the time the CMOP process stopped waiting for
+13 ; responses (see SDT^PSXRPPL and CHKDFN^PSXRPPL2). Each of the
+14 ; prescriptions listed in ^TMP("PSXEPHIN" are included in this email.
+15 ; That global is set only in EPH^PSXRPPL2, which is called only
+16 ; by EPHARM^PSXRPPL2.
+17 ;
EN ;Main entry point.
+1 NEW DFN,DIV,EMCNT,ORCNT,PATCNT,PATNM,PSXACTIVITY,PSXELIG,PTLST,RFL,RX,SSN,VADM
+2 KILL ^TMP("PSXEPHOUT",$JOB)
+3 SET ^XTMP("PSXBPSMS",0)=$$FMADD^XLFDT(DT,35)_"^"_DT
+4 SET (EMCNT,ORCNT,PATCNT)=0
+5 ;
+6 SET DIV=""
+7 FOR
SET DIV=$ORDER(^TMP("PSXEPHIN",$JOB,DIV))
if DIV=""
QUIT
Begin DoDot:1
+8 DO HEADER(DIV)
+9 SET RX=""
+10 FOR
SET RX=$ORDER(^TMP("PSXEPHIN",$JOB,DIV,RX))
if RX=""
QUIT
Begin DoDot:2
+11 SET RFL=+$GET(^TMP("PSXEPHIN",$JOB,DIV,RX))
+12 SET ^XTMP("PSXBPSMS",1,RX,RFL,DT)=""
+13 ;
+14 ; Add an entry to the developer's log, BPS LOG, file# 9002313.12.
+15 ;
+16 ; ICR #4412,6764
DO LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$TEXT(+0)_"-Prescription being left on CMOP queue")
+17 ;
+18 ; Add an entry to the Activity Log for this Rx (sub-file# 52.3).
+19 ;
+20 ; ICR #4701
IF $$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS"
Begin DoDot:3
+21 ; ICR #6763
SET PSXELIG=$$ELIGDISP^PSOREJP1(RX,RFL)
+22 IF PSXELIG=""
SET PSXELIG="Veteran"
+23 SET PSXACTIVITY=PSXELIG_"-Rx placed on Suspense due to ECME IN PROGRESS status"
+24 ; ICR # 4970
DO RXACT^PSOBPSU2(RX,RFL,PSXACTIVITY,"M",DUZ)
End DoDot:3
+25 ;
+26 ; Determine the SSN and Patient Name.
+27 ;
+28 SET DFN=+$PIECE(^PSRX(RX,0),"^",2)
DO DEM^VADPT
+29 SET SSN=$EXTRACT($PIECE(VADM(2),U),6,9)
SET PATNM=(VADM(1))
+30 ;
+31 ; Increment the count of orders (Rxs) and unique patients.
+32 ;
+33 SET ORCNT=$GET(ORCNT)+1
+34 DO PATCNT(PATNM_SSN)
+35 ;
+36 DO FORMAT
End DoDot:2
+37 DO FOOTER(DIV)
End DoDot:1
+38 DO MAIL
DO CLEAN
+39 QUIT
+40 ;
+41 ; Format Row
FORMAT ;
+1 NEW LTXT
+2 SET LTXT=$$GET1^DIQ(52,RX,.01)_"/"_RFL
+3 SET $EXTRACT(LTXT,17)=$EXTRACT(PATNM,1,18)_"("_SSN_")"
SET $EXTRACT(LTXT,42)=$EXTRACT($$GET1^DIQ(52,RX,6),1,23)
+4 SET $EXTRACT(LTXT,67)=$$TRANS(RX,RFL)
+5 DO STORELN(LTXT)
+6 QUIT
+7 ;
+8 ;Count patients.
PATCNT(NAMSSN) ;
+1 IF '$DATA(PTLST(NAMSSN))
Begin DoDot:1
+2 SET PTLST(NAMSSN)=""
+3 SET PATCNT=$GET(PATCNT)+1
End DoDot:1
+4 QUIT
+5 ;
+6 ;Build header.
+1 DO STORELN("Division: "_$$GET1^DIQ(59,DIV,.01))
+2 DO STORELN($TRANSLATE($JUSTIFY("",79)," ","-"))
+3 DO STORELN(" NOT TRANSMITTED")
+4 DO STORELN("RX#/Fill PATIENT(LAST4) DRUG 1ST DT #DAYS")
+5 DO STORELN($TRANSLATE($JUSTIFY("",79)," ","-"))
+6 QUIT
+7 ;
+8 ;Output patient count & prescriptions count & division number
+1 DO STORELN(" ")
+2 DO STORELN("Total "_$$GET1^DIQ(59,DIVN,.01)_": "_PATCNT_" Patients and "_ORCNT_" Prescriptions.")
+3 DO STORELN(" ")
+4 KILL PTLST
SET (ORCNT,PATCNT)=0
+5 QUIT
+6 ;
+7 ; MAIL builds the email message and sends it to users who hold the
+8 ; key PSXMAIL (or PSXCMOPMGR).
+9 ;
MAIL ;
+1 ;
+2 NEW DIV,M1,PSBMSG,SITES,USER,XMDUZ,XMSUB,XMTEXT,XMY,Y
+3 ;
+4 SET PSBMSG(1)="The prescriptions listed in this message did not transmit to CMOP for one of"
+5 SET PSBMSG(2)="the reasons below:"
+6 SET PSBMSG(3)=" "
+7 SET PSBMSG(4)=" A response from the third party payer was not received"
+8 SET PSBMSG(5)=" "
+9 SET PSBMSG(6)=" OR"
+10 SET PSBMSG(7)=" "
+11 SET PSBMSG(8)=" The prescriptions are non-billable in VistA"
+12 SET PSBMSG(9)=" "
+13 SET PSBMSG(10)="The prescriptions will remain in the CMOP queue and will transmit when the"
+14 SET PSBMSG(11)="response from the third party payer is received, or the non-billable issue"
+15 SET PSBMSG(12)="is resolved."
+16 SET PSBMSG(13)=" "
+17 SET M1=14
+18 ;
+19 SET Y=""
+20 FOR
SET Y=$ORDER(^TMP("PSXEPHOUT",$JOB,"M",Y))
if Y=""
QUIT
Begin DoDot:1
+21 SET PSBMSG(M1)=$PIECE(^TMP("PSXEPHOUT",$JOB,"M",Y),"^")
+22 SET M1=M1+1
End DoDot:1
+23 ;
+24 ; Setup the list of recipients (XMY). Send the email to all users
+25 ; holding the security key PSXMAIL, if any; otherwise, send to all
+26 ; users holding the key PSXCMOPMGR.
+27 ;
+28 SET USER=0
+29 IF $DATA(^XUSEC("PSXMAIL"))
Begin DoDot:1
+30 FOR
SET USER=$ORDER(^XUSEC("PSXMAIL",USER))
if 'USER
QUIT
SET XMY(USER)=""
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 FOR
SET USER=$ORDER(^XUSEC("PSXCMOPMGR",USER))
if 'USER
QUIT
SET XMY(USER)=""
End DoDot:1
+33 ;
+34 ; Set the subject (XMSUB), indicate the array containing the text of
+35 ; the message is PSBMSG, and set the sender to be POSTMASTER (.5).
+36 ;
+37 SET DIV=""
SET SITES=""
+38 FOR
SET DIV=$ORDER(^TMP("PSXEPHIN",$JOB,DIV))
if DIV=""
QUIT
SET SITES=SITES_$$GET1^DIQ(59,DIV_",",.01,"E")_","
+39 SET XMSUB=$EXTRACT("ePharmacy CMOP Not TRANSMITTED Rxs - "_$EXTRACT(SITES,1,$LENGTH(SITES)-1),1,65)
+40 SET XMTEXT="PSBMSG("
+41 SET XMDUZ=.5
+42 ;
+43 DO ^XMD
+44 ;
+45 QUIT
+46 ;
+47 ;Store E-mail line for later use.
STORELN(LINE) ;
+1 SET EMCNT=EMCNT+1
+2 SET ^TMP("PSXEPHOUT",$JOB,"M",EMCNT)=LINE
+3 QUIT
+4 ;
TRANS(RX,RFL) ;
+1 IF '$GET(RX)
QUIT ""
+2 IF $GET(RFL)=""
QUIT ""
+3 NEW TDT,CNT,FDT
+4 SET CNT=0
SET FDT=9999999
+5 SET TDT=""
FOR
SET TDT=$ORDER(^XTMP("PSXBPSMS",1,RX,RFL,TDT))
if 'TDT
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
End DoDot:1
+7 SET FDT=$ORDER(^XTMP("PSXBPSMS",1,RX,RFL,""))
+8 IF FDT=9999999
SET FDT=" "
+9 IF '$TEST
SET FDT=$EXTRACT(FDT,4,5)_"/"_$EXTRACT(FDT,6,7)_"/"_($EXTRACT(FDT,2,3))
+10 QUIT FDT_$EXTRACT(" ",1,5-$LENGTH(CNT))_CNT
+11 ;
+12 ;Clean all remaining arrays and variables
+13 ;Purge ^XTMP data older than 30 days
CLEAN ;
+1 KILL ^TMP("PSXEPHOUT",$JOB),^TMP("PSXEPHIN",$JOB)
+2 ; Purge ^XTMP data older than 30 days
+3 NEW FDT,RX,RFL,TDT
+4 SET FDT=$$FMADD^XLFDT(DT,-30)
+5 SET RX=""
FOR
SET RX=$ORDER(^XTMP("PSXBPSMS",1,RX))
if 'RX
QUIT
Begin DoDot:1
+6 SET RFL=""
FOR
SET RFL=$ORDER(^XTMP("PSXBPSMS",1,RX,RFL))
if RFL=""
QUIT
Begin DoDot:2
+7 SET TDT=""
FOR
SET TDT=$ORDER(^XTMP("PSXBPSMS",1,RX,RFL,TDT))
if 'TDT
QUIT
Begin DoDot:3
+8 IF TDT<FDT
KILL ^XTMP("PSXBPSMS",1,RX,RFL,TDT)
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
