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

PSO160P1.m

Go to the documentation of this file. 
  1. PSO160P1 ;BIR/BHW-Patch 160 Post Install routine - Part 1 ;11/24/03
  1.  ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
  1.  ;
  1. EN ;Begin Processing.  Entry point for PSO160DR
  1.  N PSRX,PSRXLDT,PSOTCNT,PSRXPROV,NVAPROV,PSRXDIV,PSORXTPB,PRVPSTAT
  1.  N NVAPROVE,PSRXDRG,PROVTYPE,PSRXRX,DIE,DR,DA
  1.  ;
  1.  ;If Date of Pharmacy Benefit = Inactivation of Benefit Date Don't Process
  1.  I PSOTDBG="" Q
  1.  I PSOTDBG=PSOTIBD Q
  1.  ;
  1.  S PSOTCNT=0
  1.  F  S PSOTCNT=$O(^PS(55,PSOTDFN,"P",PSOTCNT)) Q:'PSOTCNT  D
  1.  . ;Get Prescription Number
  1.  . S PSRX=$G(^PS(55,PSOTDFN,"P",PSOTCNT,0)) Q:'$L(PSRX)
  1.  . S PSRXLDT=$$GET1^DIQ(52,PSRX,21,"I")         ;Get LOGIN DATE
  1.  . S PSRXLDT=$P(PSRXLDT,".",1) Q:'PSRXLDT
  1.  . ;
  1.  . ;Determine if Login Date within Benefit Range, If not Don't Process
  1.  . I (PSRXLDT<PSOTDBG)!((PSOTIBD'="")&(PSRXLDT>PSOTIBD)) Q
  1.  . ;
  1.  . ;Get PRESCRIPTION (#52) field TPB (#201), If already set, Don't Process
  1.  . S PSRXTPB=$$GET1^DIQ(52,PSRX,201,"I") Q:PSRXTPB
  1.  . ;
  1.  . ;Get Provider, If not defined OR not an NVA provider, Don't Process
  1.  . S PSRXPROV=$$GET1^DIQ(52,PSRX,4,"I") Q:'PSRXPROV
  1.  . S NVAPROV=$$GET1^DIQ(200,PSRXPROV,53.91,"I") Q:'NVAPROV
  1.  . ;
  1.  . ;Get Previous PATIENT STATUS (#3) prior to setting to NON-VA
  1.  . S PRVPSTAT=$$GET1^DIQ(52,PSRX,3)
  1.  . ;
  1.  . ;**********************************************************************
  1.  . ;Set TPB (#201) ="YES" & PATIENT STATUS (#3) = NON-VA in PRESCRIPTION (#52)
  1.  . S DIE="^PSRX(",DA=PSRX,DR="201///YES"
  1.  . S:$G(PATSTATC)'="" DR=DR_";3///"_PATSTATC
  1.  . D ^DIE K DIE,DA,DR
  1.  . ;
  1.  . ;If Unique TPB Clinic, Reset RX CLINIC to that clinic (Save Previous value)
  1.  . I TPBCL S DIE="^PSRX(",DA=PSRX,DR="5///"_TPBCLE D ^DIE K DIE,DA,DR
  1.  . ;
  1.  . ;**********************************************************************
  1.  . ;
  1.  . ;Get display fields and Set Temporary DB for E-mail Report
  1.  . S TPBCLP=$$GET1^DIQ(52,PSRX,5)               ;Get Clinic
  1.  . S PSRXDRG=$$GET1^DIQ(52,PSRX,6)              ;Get Drug (External Form)
  1.  . S PSRXRX=$$GET1^DIQ(52,PSRX,.01)             ;Get Rx Number (External Form)
  1.  . I '$L(PSRXRX) S PSRXRX=PSRX
  1.  . S NVAPROVE=$$GET1^DIQ(200,PSRXPROV,.01)      ;Get Provider Name (External Form)
  1.  . S PROVTYPE=$$GET1^DIQ(200,PSRXPROV,53.6)     ;Get Provider type (External Form)
  1.  . S PSRXDIV=$$GET1^DIQ(52,PSRX,20)             ;Get Division (External Form)
  1.  . I '$L(PSRXDIV) S PSRXDIV="Unknown Division"
  1.  . I $L(PROVTYPE) S NVAPROVE="*"_NVAPROVE
  1.  . ;
  1.  . ;Create Temporary global for E-mail Message
  1.  . S TEMP=PATSSN_U_PSRXDRG_U_NVAPROVE_U_TPBCLP_U_TPBCLE_U_PRVPSTAT_U_"NON-VA"_U_TPBCL
  1.  . S ^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX)=TEMP
  1.  . Q
  1.  Q
  1.  ;
  1.  ;======================================================================
  1.  ;Loop Temporary Global and Format for E-mail
  1. MAIL ;
  1.  N PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE,EMCNT,PATCNT,RXCNT,DASH
  1.  N DIVFLAG,PNAM,RXSTS,TEMP,TPBRX,RX,L,DATA,PATSSNL
  1.  S (PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE)="",EMCNT=1
  1.  S (PATCNT,RXCNT,DIVFLAG,PATSSNL)=0,$P(DASH,"-",80)=""
  1.  ;
  1.  ;Create Header for Mail Report
  1.  D STORELN("The Post-Install process for PSO*7*160 - Part 1 successfully completed.")
  1.  D STORELN(" ")
  1.  D STORELN("Started on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"START"))))
  1.  D STORELN("Finished on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"FINISH"))))
  1.  D STORELN(" ")
  1.  ;
  1.  ;If no entries created above, skip reporting
  1.  I '$L($O(^XTMP("PSO160P1",$J,"T",""))) D  G SEND
  1.  . D STORELN("No prescriptions have been marked as TPB (Transitional Pharmacy).")
  1.  . Q
  1.  ;
  1.  D STORELN("The following Prescriptions have been marked as TPB (Transitional Pharmacy")
  1.  D STORELN("Benefits) prescription by the post-install process.")
  1.  D STORELN(" ")
  1.  ;
  1.  F  S PSRXDIV=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV)) Q:'$L(PSRXDIV)  D
  1.  . ;Check if Division Changed
  1.  . I DIVFLAG'=PSRXDIV D
  1.  . . ;Print Sub-Header
  1.  . . D STORELN("DIVISION: "_PSRXDIV)
  1.  . . D STORELN(DASH)
  1.  . . D STORELN($E("Patient Name (LAST4SSN)"_SP,1,25)_$E("Rx#"_SP,1,10)_$E("DRUG"_SP,1,24)_$E("PROVIDER"_SP,1,20))
  1.  . . D STORELN(DASH)
  1.  . . Q
  1.  . E  S DIVFLAG=PSRXDIV
  1.  . ;
  1.  . S PATNAM=""
  1.  . F  S PATNAM=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM)) Q:'$L(PATNAM)  D
  1.  . . S PSRXRX="",PATCNT=PATCNT+1
  1.  . . ;
  1.  . . F  S PSRXRX=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX)) Q:'$L(PSRXRX)  D
  1.  . . . S DATA=$G(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX))
  1.  . . . S PATSSN=$P(DATA,U,1),PSRXDRG=$P(DATA,U,2),NVAPROVE=$P(DATA,U,3),TPBCLP=$P(DATA,U,4)
  1.  . . . S TPBCLE=$P(DATA,U,5),PRVPSTAT=$P(DATA,U,6),PATSTAT=$P(DATA,U,7),TPBCL=$P(DATA,U,8)
  1.  . . . ;Line 1
  1.  . . . S TEMP="",RXCNT=RXCNT+1
  1.  . . . S TEMP=$E(PATNAM_SP,1,20)
  1.  . . . S TEMP=$E($E(PATNAM,1,16)_" ("_$E(PATSSN,1,5)_")"_$E(SP,1,6-PATSSNL)_SP,1,25)
  1.  . . . S TEMP=TEMP_$E(PSRXRX_SP,1,11)
  1.  . . . S TEMP=TEMP_$E(PSRXDRG_SP,1,22)_" "
  1.  . . . S TEMP=TEMP_$E(NVAPROVE_SP,1,20)
  1.  . . . D STORELN(TEMP)
  1.  . . . ;Line 2 (clinic Line)
  1.  . . . S TEMP=$E(SP,1,25)
  1.  . . . I (TPBCLP'=TPBCLE)&(TPBCL) S TEMP=TEMP_"Clinic: Old: "_$E(TPBCLP,1,16)_" New: "_$E(TPBCLE,1,17)
  1.  . . . E  S TEMP=TEMP_"Clinic: "_$E(TPBCLP,1,46)
  1.  . . . D STORELN(TEMP)
  1.  . . . ;Line 3 (Patient status line)
  1.  . . . S TEMP=$E(SP,1,25)
  1.  . . . I PRVPSTAT'=PATSTAT S TEMP=TEMP_"Rx Patient Status: Old: "_$E(PRVPSTAT,1,17)_" New: "_$E(PATSTAT_SP,1,7)
  1.  . . . E  S TEMP=TEMP_"Rx Patient Status: "_$E(PATSTAT_SP,1,25)
  1.  . . . D STORELN(TEMP)
  1.  . . . D STORELN(" ")
  1.  . . . Q
  1.  . . Q
  1.  . ;Print Totals only if End of Division
  1.  . D STORELN("Total: "_PATCNT_" Patients and "_RXCNT_" Prescriptions")
  1.  . D STORELN(" ")
  1.  . D STORELN("* Non-VA Provider has a PROVIDER TYPE")
  1.  . S (PATCNT,RXCNT)=0
  1.  . Q
  1.  ;======================================================================
  1. SEND ;Send Completion E-mail.
  1.  N DIFROM
  1.  ;
  1.  ;Setup Mailman Variables
  1.  S XMSUB="PSO*7*160 - LIST OF PRESCRIPTIONS MARKED AS TPB"
  1.  S XMDUZ="Patch PSO*7*160" D SXMY^PSOTPCUL("PSO TPB GROUP")
  1.  S XMY(DUZ)="",XMTEXT="^XTMP(""PSO160P1"","_$J_",""M"","
  1.  ;
  1.  ;Send E-mail
  1.  D ^XMD
  1.  K XMTEXT,XMSUB,XMDUZ,XMY
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1.  ;======================================================================
  1.  ;Store E-mail line in "M" subscript.
  1. STORELN(LINE) ;
  1.  S EMCNT=EMCNT+1
  1.  S ^XTMP("PSO160P1",$J,"M",EMCNT)=LINE
  1.  Q