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

PSXBPSMS.m

Go to the documentation of this file. 
  1. 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
  1.  ;Reference to $$RXFLDT^PSOBPSUT supported by IA 4701
  1.  ;Reference to LOG^BPSOSL supported by ICR# 6764
  1.  ;Reference to IEN59^BPSOSRX supported by ICR# 4412
  1.  ;Reference to ELIGDISP^PSOREJP1 supported by ICR# 6763
  1.  ;
  1.  ; PSXBPSMS sends an email at the conclusion of the CMOP process to
  1.  ; communicate to the users which prescriptions were left in the
  1.  ; suspense queue and not sent to the CMOP facility.  There are two
  1.  ; scenarios that could lead to this; either the prescription is
  1.  ; non-billable, or a response from the third party payer was not 
  1.  ; received by the time the CMOP process stopped waiting for
  1.  ; responses (see SDT^PSXRPPL and CHKDFN^PSXRPPL2).  Each of the
  1.  ; prescriptions listed in ^TMP("PSXEPHIN" are included in this email.
  1.  ; That global is set only in EPH^PSXRPPL2, which is called only
  1.  ; by EPHARM^PSXRPPL2.
  1.  ;
  1. EN ;Main entry point.
  1.  N DFN,DIV,EMCNT,ORCNT,PATCNT,PATNM,PSXACTIVITY,PSXELIG,PTLST,RFL,RX,SSN,VADM
  1.  K ^TMP("PSXEPHOUT",$J)
  1.  S ^XTMP("PSXBPSMS",0)=$$FMADD^XLFDT(DT,35)_"^"_DT
  1.  S (EMCNT,ORCNT,PATCNT)=0
  1.  ;
  1.  S DIV=""
  1.  F  S DIV=$O(^TMP("PSXEPHIN",$J,DIV)) Q:DIV=""  D
  1.  . D HEADER(DIV)
  1.  . S RX=""
  1.  . F  S RX=$O(^TMP("PSXEPHIN",$J,DIV,RX)) Q:RX=""  D
  1.  . . S RFL=+$G(^TMP("PSXEPHIN",$J,DIV,RX))
  1.  . . S ^XTMP("PSXBPSMS",1,RX,RFL,DT)=""
  1.  . . ;
  1.  . . ; Add an entry to the developer's log, BPS LOG, file# 9002313.12.
  1.  . . ;
  1.  . . D LOG^BPSOSL($$IEN59^BPSOSRX(RX,RFL),$T(+0)_"-Prescription being left on CMOP queue")  ; ICR #4412,6764
  1.  . . ;
  1.  . . ; Add an entry to the Activity Log for this Rx (sub-file# 52.3).
  1.  . . ;
  1.  . . I $$STATUS^PSOBPSUT(RX,RFL)="IN PROGRESS" D  ; ICR #4701
  1.  . . . S PSXELIG=$$ELIGDISP^PSOREJP1(RX,RFL)  ; ICR #6763
  1.  . . . I PSXELIG="" S PSXELIG="Veteran"
  1.  . . . S PSXACTIVITY=PSXELIG_"-Rx placed on Suspense due to ECME IN PROGRESS status"
  1.  . . . D RXACT^PSOBPSU2(RX,RFL,PSXACTIVITY,"M",DUZ)  ; ICR # 4970
  1.  . . ;
  1.  . . ; Determine the SSN and Patient Name.
  1.  . . ;
  1.  . . S DFN=+$P(^PSRX(RX,0),"^",2) D DEM^VADPT
  1.  . . S SSN=$E($P(VADM(2),U),6,9),PATNM=(VADM(1))
  1.  . . ;
  1.  . . ; Increment the count of orders (Rxs) and unique patients.
  1.  . . ;
  1.  . . S ORCNT=$G(ORCNT)+1
  1.  . . D PATCNT(PATNM_SSN)
  1.  . . ;
  1.  . . D FORMAT
  1.  . D FOOTER(DIV)
  1.  D MAIL,CLEAN
  1.  Q
  1.  ;
  1.  ; Format Row
  1. FORMAT ;
  1.  N LTXT
  1.  S LTXT=$$GET1^DIQ(52,RX,.01)_"/"_RFL
  1.  S $E(LTXT,17)=$E(PATNM,1,18)_"("_SSN_")",$E(LTXT,42)=$E($$GET1^DIQ(52,RX,6),1,23)
  1.  S $E(LTXT,67)=$$TRANS(RX,RFL)
  1.  D STORELN(LTXT)
  1.  Q
  1.  ;
  1.  ;Count patients.
  1. PATCNT(NAMSSN) ;
  1.  I '$D(PTLST(NAMSSN)) D
  1.  .S PTLST(NAMSSN)=""
  1.  .S PATCNT=$G(PATCNT)+1
  1.  Q
  1.  ;
  1.  ;Build header.
  1.  D STORELN("Division: "_$$GET1^DIQ(59,DIV,.01))
  1.  D STORELN($TR($J("",79)," ","-"))
  1.  D STORELN("                                                                NOT TRANSMITTED")
  1.  D STORELN("RX#/Fill        PATIENT(LAST4)           DRUG                     1ST DT  #DAYS")
  1.  D STORELN($TR($J("",79)," ","-"))
  1.  Q
  1.  ;       
  1.  ;Output patient count & prescriptions count & division number
  1.  D STORELN(" ")
  1.  D STORELN("Total "_$$GET1^DIQ(59,DIVN,.01)_": "_PATCNT_" Patients and "_ORCNT_" Prescriptions.")
  1.  D STORELN(" ")
  1.  K PTLST S (ORCNT,PATCNT)=0
  1.  Q
  1.  ;
  1.  ; MAIL builds the email message and sends it to users who hold the
  1.  ; key PSXMAIL (or PSXCMOPMGR).
  1.  ;
  1. MAIL ;
  1.  ;
  1.  N DIV,M1,PSBMSG,SITES,USER,XMDUZ,XMSUB,XMTEXT,XMY,Y
  1.  ;
  1.  S PSBMSG(1)="The prescriptions listed in this message did not transmit to CMOP for one of"
  1.  S PSBMSG(2)="the reasons below:"
  1.  S PSBMSG(3)=" "
  1.  S PSBMSG(4)="        A response from the third party payer was not received"
  1.  S PSBMSG(5)=" "
  1.  S PSBMSG(6)="        OR"
  1.  S PSBMSG(7)=" "
  1.  S PSBMSG(8)="        The prescriptions are non-billable in VistA"
  1.  S PSBMSG(9)=" "
  1.  S PSBMSG(10)="The prescriptions will remain in the CMOP queue and will transmit when the"
  1.  S PSBMSG(11)="response from the third party payer is received, or the non-billable issue"
  1.  S PSBMSG(12)="is resolved."
  1.  S PSBMSG(13)=" "
  1.  S M1=14
  1.  ;
  1.  S Y=""
  1.  F  S Y=$O(^TMP("PSXEPHOUT",$J,"M",Y)) Q:Y=""  D
  1.  . S PSBMSG(M1)=$P(^TMP("PSXEPHOUT",$J,"M",Y),"^")
  1.  . S M1=M1+1
  1.  ;
  1.  ; Setup the list of recipients (XMY).  Send the email to all users
  1.  ; holding the security key PSXMAIL, if any; otherwise, send to all
  1.  ; users holding the key PSXCMOPMGR.
  1.  ;
  1.  S USER=0
  1.  I $D(^XUSEC("PSXMAIL")) D
  1.  .F  S USER=$O(^XUSEC("PSXMAIL",USER)) Q:'USER  S XMY(USER)=""
  1.  E  D
  1.  .F  S USER=$O(^XUSEC("PSXCMOPMGR",USER)) Q:'USER  S XMY(USER)=""
  1.  ;
  1.  ; Set the subject (XMSUB), indicate the array containing the text of
  1.  ; the message is PSBMSG, and set the sender to be POSTMASTER (.5).
  1.  ;
  1.  S DIV="",SITES=""
  1.  F  S DIV=$O(^TMP("PSXEPHIN",$J,DIV)) Q:DIV=""  S SITES=SITES_$$GET1^DIQ(59,DIV_",",.01,"E")_","
  1.  S XMSUB=$E("ePharmacy CMOP Not TRANSMITTED Rxs - "_$E(SITES,1,$L(SITES)-1),1,65)
  1.  S XMTEXT="PSBMSG("
  1.  S XMDUZ=.5
  1.  ;
  1.  D ^XMD
  1.  ;
  1.  Q
  1.  ;
  1.  ;Store E-mail line for later use.
  1. STORELN(LINE) ;
  1.  S EMCNT=EMCNT+1
  1.  S ^TMP("PSXEPHOUT",$J,"M",EMCNT)=LINE
  1.  Q
  1.  ;
  1. TRANS(RX,RFL) ;
  1.  I '$G(RX) Q ""
  1.  I $G(RFL)="" Q ""
  1.  N TDT,CNT,FDT
  1.  S CNT=0,FDT=9999999
  1.  S TDT="" F  S TDT=$O(^XTMP("PSXBPSMS",1,RX,RFL,TDT)) Q:'TDT  D
  1.  . S CNT=CNT+1
  1.  S FDT=$O(^XTMP("PSXBPSMS",1,RX,RFL,""))
  1.  I FDT=9999999 S FDT="        "
  1.  E  S FDT=$E(FDT,4,5)_"/"_$E(FDT,6,7)_"/"_($E(FDT,2,3))
  1.  Q FDT_$E("    ",1,5-$L(CNT))_CNT
  1.  ;
  1.  ;Clean all remaining arrays and variables
  1.  ;Purge ^XTMP data older than 30 days
  1. CLEAN ;
  1.  K ^TMP("PSXEPHOUT",$J),^TMP("PSXEPHIN",$J)
  1.  ; Purge ^XTMP data older than 30 days
  1.  N FDT,RX,RFL,TDT
  1.  S FDT=$$FMADD^XLFDT(DT,-30)
  1.  S RX="" F  S RX=$O(^XTMP("PSXBPSMS",1,RX)) Q:'RX  D
  1.  . S RFL="" F  S RFL=$O(^XTMP("PSXBPSMS",1,RX,RFL)) Q:RFL=""  D
  1.  .. S TDT="" F  S TDT=$O(^XTMP("PSXBPSMS",1,RX,RFL,TDT)) Q:'TDT  D
  1.  ... I TDT<FDT K ^XTMP("PSXBPSMS",1,RX,RFL,TDT)
  1.  Q