PSO160P1 ;BIR/BHW-Patch 160 Post Install routine - Part 1 ;11/24/03
;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
;
EN ;Begin Processing. Entry point for PSO160DR
N PSRX,PSRXLDT,PSOTCNT,PSRXPROV,NVAPROV,PSRXDIV,PSORXTPB,PRVPSTAT
N NVAPROVE,PSRXDRG,PROVTYPE,PSRXRX,DIE,DR,DA
;
;If Date of Pharmacy Benefit = Inactivation of Benefit Date Don't Process
I PSOTDBG="" Q
I PSOTDBG=PSOTIBD Q
;
S PSOTCNT=0
F S PSOTCNT=$O(^PS(55,PSOTDFN,"P",PSOTCNT)) Q:'PSOTCNT D
. ;Get Prescription Number
. S PSRX=$G(^PS(55,PSOTDFN,"P",PSOTCNT,0)) Q:'$L(PSRX)
. S PSRXLDT=$$GET1^DIQ(52,PSRX,21,"I") ;Get LOGIN DATE
. S PSRXLDT=$P(PSRXLDT,".",1) Q:'PSRXLDT
. ;
. ;Determine if Login Date within Benefit Range, If not Don't Process
. I (PSRXLDT<PSOTDBG)!((PSOTIBD'="")&(PSRXLDT>PSOTIBD)) Q
. ;
. ;Get PRESCRIPTION (#52) field TPB (#201), If already set, Don't Process
. S PSRXTPB=$$GET1^DIQ(52,PSRX,201,"I") Q:PSRXTPB
. ;
. ;Get Provider, If not defined OR not an NVA provider, Don't Process
. S PSRXPROV=$$GET1^DIQ(52,PSRX,4,"I") Q:'PSRXPROV
. S NVAPROV=$$GET1^DIQ(200,PSRXPROV,53.91,"I") Q:'NVAPROV
. ;
. ;Get Previous PATIENT STATUS (#3) prior to setting to NON-VA
. S PRVPSTAT=$$GET1^DIQ(52,PSRX,3)
. ;
. ;**********************************************************************
. ;Set TPB (#201) ="YES" & PATIENT STATUS (#3) = NON-VA in PRESCRIPTION (#52)
. S DIE="^PSRX(",DA=PSRX,DR="201///YES"
. S:$G(PATSTATC)'="" DR=DR_";3///"_PATSTATC
. D ^DIE K DIE,DA,DR
. ;
. ;If Unique TPB Clinic, Reset RX CLINIC to that clinic (Save Previous value)
. I TPBCL S DIE="^PSRX(",DA=PSRX,DR="5///"_TPBCLE D ^DIE K DIE,DA,DR
. ;
. ;**********************************************************************
. ;
. ;Get display fields and Set Temporary DB for E-mail Report
. S TPBCLP=$$GET1^DIQ(52,PSRX,5) ;Get Clinic
. S PSRXDRG=$$GET1^DIQ(52,PSRX,6) ;Get Drug (External Form)
. S PSRXRX=$$GET1^DIQ(52,PSRX,.01) ;Get Rx Number (External Form)
. I '$L(PSRXRX) S PSRXRX=PSRX
. S NVAPROVE=$$GET1^DIQ(200,PSRXPROV,.01) ;Get Provider Name (External Form)
. S PROVTYPE=$$GET1^DIQ(200,PSRXPROV,53.6) ;Get Provider type (External Form)
. S PSRXDIV=$$GET1^DIQ(52,PSRX,20) ;Get Division (External Form)
. I '$L(PSRXDIV) S PSRXDIV="Unknown Division"
. I $L(PROVTYPE) S NVAPROVE="*"_NVAPROVE
. ;
. ;Create Temporary global for E-mail Message
. S TEMP=PATSSN_U_PSRXDRG_U_NVAPROVE_U_TPBCLP_U_TPBCLE_U_PRVPSTAT_U_"NON-VA"_U_TPBCL
. S ^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX)=TEMP
. Q
Q
;
;======================================================================
;Loop Temporary Global and Format for E-mail
MAIL ;
N PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE,EMCNT,PATCNT,RXCNT,DASH
N DIVFLAG,PNAM,RXSTS,TEMP,TPBRX,RX,L,DATA,PATSSNL
S (PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE)="",EMCNT=1
S (PATCNT,RXCNT,DIVFLAG,PATSSNL)=0,$P(DASH,"-",80)=""
;
;Create Header for Mail Report
D STORELN("The Post-Install process for PSO*7*160 - Part 1 successfully completed.")
D STORELN(" ")
D STORELN("Started on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"START"))))
D STORELN("Finished on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"FINISH"))))
D STORELN(" ")
;
;If no entries created above, skip reporting
I '$L($O(^XTMP("PSO160P1",$J,"T",""))) D G SEND
. D STORELN("No prescriptions have been marked as TPB (Transitional Pharmacy).")
. Q
;
D STORELN("The following Prescriptions have been marked as TPB (Transitional Pharmacy")
D STORELN("Benefits) prescription by the post-install process.")
D STORELN(" ")
;
F S PSRXDIV=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV)) Q:'$L(PSRXDIV) D
. ;Check if Division Changed
. I DIVFLAG'=PSRXDIV D
. . ;Print Sub-Header
. . D STORELN("DIVISION: "_PSRXDIV)
. . D STORELN(DASH)
. . D STORELN($E("Patient Name (LAST4SSN)"_SP,1,25)_$E("Rx#"_SP,1,10)_$E("DRUG"_SP,1,24)_$E("PROVIDER"_SP,1,20))
. . D STORELN(DASH)
. . Q
. E S DIVFLAG=PSRXDIV
. ;
. S PATNAM=""
. F S PATNAM=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM)) Q:'$L(PATNAM) D
. . S PSRXRX="",PATCNT=PATCNT+1
. . ;
. . F S PSRXRX=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX)) Q:'$L(PSRXRX) D
. . . S DATA=$G(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX))
. . . S PATSSN=$P(DATA,U,1),PSRXDRG=$P(DATA,U,2),NVAPROVE=$P(DATA,U,3),TPBCLP=$P(DATA,U,4)
. . . S TPBCLE=$P(DATA,U,5),PRVPSTAT=$P(DATA,U,6),PATSTAT=$P(DATA,U,7),TPBCL=$P(DATA,U,8)
. . . ;Line 1
. . . S TEMP="",RXCNT=RXCNT+1
. . . S TEMP=$E(PATNAM_SP,1,20)
. . . S TEMP=$E($E(PATNAM,1,16)_" ("_$E(PATSSN,1,5)_")"_$E(SP,1,6-PATSSNL)_SP,1,25)
. . . S TEMP=TEMP_$E(PSRXRX_SP,1,11)
. . . S TEMP=TEMP_$E(PSRXDRG_SP,1,22)_" "
. . . S TEMP=TEMP_$E(NVAPROVE_SP,1,20)
. . . D STORELN(TEMP)
. . . ;Line 2 (clinic Line)
. . . S TEMP=$E(SP,1,25)
. . . I (TPBCLP'=TPBCLE)&(TPBCL) S TEMP=TEMP_"Clinic: Old: "_$E(TPBCLP,1,16)_" New: "_$E(TPBCLE,1,17)
. . . E S TEMP=TEMP_"Clinic: "_$E(TPBCLP,1,46)
. . . D STORELN(TEMP)
. . . ;Line 3 (Patient status line)
. . . S TEMP=$E(SP,1,25)
. . . I PRVPSTAT'=PATSTAT S TEMP=TEMP_"Rx Patient Status: Old: "_$E(PRVPSTAT,1,17)_" New: "_$E(PATSTAT_SP,1,7)
. . . E S TEMP=TEMP_"Rx Patient Status: "_$E(PATSTAT_SP,1,25)
. . . D STORELN(TEMP)
. . . D STORELN(" ")
. . . Q
. . Q
. ;Print Totals only if End of Division
. D STORELN("Total: "_PATCNT_" Patients and "_RXCNT_" Prescriptions")
. D STORELN(" ")
. D STORELN("* Non-VA Provider has a PROVIDER TYPE")
. S (PATCNT,RXCNT)=0
. Q
;======================================================================
SEND ;Send Completion E-mail.
N DIFROM
;
;Setup Mailman Variables
S XMSUB="PSO*7*160 - LIST OF PRESCRIPTIONS MARKED AS TPB"
S XMDUZ="Patch PSO*7*160" D SXMY^PSOTPCUL("PSO TPB GROUP")
S XMY(DUZ)="",XMTEXT="^XTMP(""PSO160P1"","_$J_",""M"","
;
;Send E-mail
D ^XMD
K XMTEXT,XMSUB,XMDUZ,XMY
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
;======================================================================
;Store E-mail line in "M" subscript.
STORELN(LINE) ;
S EMCNT=EMCNT+1
S ^XTMP("PSO160P1",$J,"M",EMCNT)=LINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO160P1 6224 printed Sep 23, 2025@19:58:48 Page 2
PSO160P1 ;BIR/BHW-Patch 160 Post Install routine - Part 1 ;11/24/03
+1 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
+2 ;
EN ;Begin Processing. Entry point for PSO160DR
+1 NEW PSRX,PSRXLDT,PSOTCNT,PSRXPROV,NVAPROV,PSRXDIV,PSORXTPB,PRVPSTAT
+2 NEW NVAPROVE,PSRXDRG,PROVTYPE,PSRXRX,DIE,DR,DA
+3 ;
+4 ;If Date of Pharmacy Benefit = Inactivation of Benefit Date Don't Process
+5 IF PSOTDBG=""
QUIT
+6 IF PSOTDBG=PSOTIBD
QUIT
+7 ;
+8 SET PSOTCNT=0
+9 FOR
SET PSOTCNT=$ORDER(^PS(55,PSOTDFN,"P",PSOTCNT))
if 'PSOTCNT
QUIT
Begin DoDot:1
+10 ;Get Prescription Number
+11 SET PSRX=$GET(^PS(55,PSOTDFN,"P",PSOTCNT,0))
if '$LENGTH(PSRX)
QUIT
+12 ;Get LOGIN DATE
SET PSRXLDT=$$GET1^DIQ(52,PSRX,21,"I")
+13 SET PSRXLDT=$PIECE(PSRXLDT,".",1)
if 'PSRXLDT
QUIT
+14 ;
+15 ;Determine if Login Date within Benefit Range, If not Don't Process
+16 IF (PSRXLDT<PSOTDBG)!((PSOTIBD'="")&(PSRXLDT>PSOTIBD))
QUIT
+17 ;
+18 ;Get PRESCRIPTION (#52) field TPB (#201), If already set, Don't Process
+19 SET PSRXTPB=$$GET1^DIQ(52,PSRX,201,"I")
if PSRXTPB
QUIT
+20 ;
+21 ;Get Provider, If not defined OR not an NVA provider, Don't Process
+22 SET PSRXPROV=$$GET1^DIQ(52,PSRX,4,"I")
if 'PSRXPROV
QUIT
+23 SET NVAPROV=$$GET1^DIQ(200,PSRXPROV,53.91,"I")
if 'NVAPROV
QUIT
+24 ;
+25 ;Get Previous PATIENT STATUS (#3) prior to setting to NON-VA
+26 SET PRVPSTAT=$$GET1^DIQ(52,PSRX,3)
+27 ;
+28 ;**********************************************************************
+29 ;Set TPB (#201) ="YES" & PATIENT STATUS (#3) = NON-VA in PRESCRIPTION (#52)
+30 SET DIE="^PSRX("
SET DA=PSRX
SET DR="201///YES"
+31 if $GET(PATSTATC)'=""
SET DR=DR_";3///"_PATSTATC
+32 DO ^DIE
KILL DIE,DA,DR
+33 ;
+34 ;If Unique TPB Clinic, Reset RX CLINIC to that clinic (Save Previous value)
+35 IF TPBCL
SET DIE="^PSRX("
SET DA=PSRX
SET DR="5///"_TPBCLE
DO ^DIE
KILL DIE,DA,DR
+36 ;
+37 ;**********************************************************************
+38 ;
+39 ;Get display fields and Set Temporary DB for E-mail Report
+40 ;Get Clinic
SET TPBCLP=$$GET1^DIQ(52,PSRX,5)
+41 ;Get Drug (External Form)
SET PSRXDRG=$$GET1^DIQ(52,PSRX,6)
+42 ;Get Rx Number (External Form)
SET PSRXRX=$$GET1^DIQ(52,PSRX,.01)
+43 IF '$LENGTH(PSRXRX)
SET PSRXRX=PSRX
+44 ;Get Provider Name (External Form)
SET NVAPROVE=$$GET1^DIQ(200,PSRXPROV,.01)
+45 ;Get Provider type (External Form)
SET PROVTYPE=$$GET1^DIQ(200,PSRXPROV,53.6)
+46 ;Get Division (External Form)
SET PSRXDIV=$$GET1^DIQ(52,PSRX,20)
+47 IF '$LENGTH(PSRXDIV)
SET PSRXDIV="Unknown Division"
+48 IF $LENGTH(PROVTYPE)
SET NVAPROVE="*"_NVAPROVE
+49 ;
+50 ;Create Temporary global for E-mail Message
+51 SET TEMP=PATSSN_U_PSRXDRG_U_NVAPROVE_U_TPBCLP_U_TPBCLE_U_PRVPSTAT_U_"NON-VA"_U_TPBCL
+52 SET ^XTMP("PSO160P1",$JOB,"T",PSRXDIV,PATNAM,PSRXRX)=TEMP
+53 QUIT
End DoDot:1
+54 QUIT
+55 ;
+56 ;======================================================================
+57 ;Loop Temporary Global and Format for E-mail
MAIL ;
+1 NEW PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE,EMCNT,PATCNT,RXCNT,DASH
+2 NEW DIVFLAG,PNAM,RXSTS,TEMP,TPBRX,RX,L,DATA,PATSSNL
+3 SET (PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE)=""
SET EMCNT=1
+4 SET (PATCNT,RXCNT,DIVFLAG,PATSSNL)=0
SET $PIECE(DASH,"-",80)=""
+5 ;
+6 ;Create Header for Mail Report
+7 DO STORELN("The Post-Install process for PSO*7*160 - Part 1 successfully completed.")
+8 DO STORELN(" ")
+9 DO STORELN("Started on: "_$$FMTE^XLFDT($GET(^XTMP("PSO160DR",$JOB,"START"))))
+10 DO STORELN("Finished on: "_$$FMTE^XLFDT($GET(^XTMP("PSO160DR",$JOB,"FINISH"))))
+11 DO STORELN(" ")
+12 ;
+13 ;If no entries created above, skip reporting
+14 IF '$LENGTH($ORDER(^XTMP("PSO160P1",$JOB,"T","")))
Begin DoDot:1
+15 DO STORELN("No prescriptions have been marked as TPB (Transitional Pharmacy).")
+16 QUIT
End DoDot:1
GOTO SEND
+17 ;
+18 DO STORELN("The following Prescriptions have been marked as TPB (Transitional Pharmacy")
+19 DO STORELN("Benefits) prescription by the post-install process.")
+20 DO STORELN(" ")
+21 ;
+22 FOR
SET PSRXDIV=$ORDER(^XTMP("PSO160P1",$JOB,"T",PSRXDIV))
if '$LENGTH(PSRXDIV)
QUIT
Begin DoDot:1
+23 ;Check if Division Changed
+24 IF DIVFLAG'=PSRXDIV
Begin DoDot:2
+25 ;Print Sub-Header
+26 DO STORELN("DIVISION: "_PSRXDIV)
+27 DO STORELN(DASH)
+28 DO STORELN($EXTRACT("Patient Name (LAST4SSN)"_SP,1,25)_$EXTRACT("Rx#"_SP,1,10)_$EXTRACT("DRUG"_SP,1,24)_$EXTRACT("PROVIDER"_SP,1,20))
+29 DO STORELN(DASH)
+30 QUIT
End DoDot:2
+31 IF '$TEST
SET DIVFLAG=PSRXDIV
+32 ;
+33 SET PATNAM=""
+34 FOR
SET PATNAM=$ORDER(^XTMP("PSO160P1",$JOB,"T",PSRXDIV,PATNAM))
if '$LENGTH(PATNAM)
QUIT
Begin DoDot:2
+35 SET PSRXRX=""
SET PATCNT=PATCNT+1
+36 ;
+37 FOR
SET PSRXRX=$ORDER(^XTMP("PSO160P1",$JOB,"T",PSRXDIV,PATNAM,PSRXRX))
if '$LENGTH(PSRXRX)
QUIT
Begin DoDot:3
+38 SET DATA=$GET(^XTMP("PSO160P1",$JOB,"T",PSRXDIV,PATNAM,PSRXRX))
+39 SET PATSSN=$PIECE(DATA,U,1)
SET PSRXDRG=$PIECE(DATA,U,2)
SET NVAPROVE=$PIECE(DATA,U,3)
SET TPBCLP=$PIECE(DATA,U,4)
+40 SET TPBCLE=$PIECE(DATA,U,5)
SET PRVPSTAT=$PIECE(DATA,U,6)
SET PATSTAT=$PIECE(DATA,U,7)
SET TPBCL=$PIECE(DATA,U,8)
+41 ;Line 1
+42 SET TEMP=""
SET RXCNT=RXCNT+1
+43 SET TEMP=$EXTRACT(PATNAM_SP,1,20)
+44 SET TEMP=$EXTRACT($EXTRACT(PATNAM,1,16)_" ("_$EXTRACT(PATSSN,1,5)_")"_$EXTRACT(SP,1,6-PATSSNL)_SP,1,25)
+45 SET TEMP=TEMP_$EXTRACT(PSRXRX_SP,1,11)
+46 SET TEMP=TEMP_$EXTRACT(PSRXDRG_SP,1,22)_" "
+47 SET TEMP=TEMP_$EXTRACT(NVAPROVE_SP,1,20)
+48 DO STORELN(TEMP)
+49 ;Line 2 (clinic Line)
+50 SET TEMP=$EXTRACT(SP,1,25)
+51 IF (TPBCLP'=TPBCLE)&(TPBCL)
SET TEMP=TEMP_"Clinic: Old: "_$EXTRACT(TPBCLP,1,16)_" New: "_$EXTRACT(TPBCLE,1,17)
+52 IF '$TEST
SET TEMP=TEMP_"Clinic: "_$EXTRACT(TPBCLP,1,46)
+53 DO STORELN(TEMP)
+54 ;Line 3 (Patient status line)
+55 SET TEMP=$EXTRACT(SP,1,25)
+56 IF PRVPSTAT'=PATSTAT
SET TEMP=TEMP_"Rx Patient Status: Old: "_$EXTRACT(PRVPSTAT,1,17)_" New: "_$EXTRACT(PATSTAT_SP,1,7)
+57 IF '$TEST
SET TEMP=TEMP_"Rx Patient Status: "_$EXTRACT(PATSTAT_SP,1,25)
+58 DO STORELN(TEMP)
+59 DO STORELN(" ")
+60 QUIT
End DoDot:3
+61 QUIT
End DoDot:2
+62 ;Print Totals only if End of Division
+63 DO STORELN("Total: "_PATCNT_" Patients and "_RXCNT_" Prescriptions")
+64 DO STORELN(" ")
+65 DO STORELN("* Non-VA Provider has a PROVIDER TYPE")
+66 SET (PATCNT,RXCNT)=0
+67 QUIT
End DoDot:1
+68 ;======================================================================
SEND ;Send Completion E-mail.
+1 NEW DIFROM
+2 ;
+3 ;Setup Mailman Variables
+4 SET XMSUB="PSO*7*160 - LIST OF PRESCRIPTIONS MARKED AS TPB"
+5 SET XMDUZ="Patch PSO*7*160"
DO SXMY^PSOTPCUL("PSO TPB GROUP")
+6 SET XMY(DUZ)=""
SET XMTEXT="^XTMP(""PSO160P1"","_$JOB_",""M"","
+7 ;
+8 ;Send E-mail
+9 DO ^XMD
+10 KILL XMTEXT,XMSUB,XMDUZ,XMY
+11 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+12 QUIT
+13 ;
+14 ;======================================================================
+15 ;Store E-mail line in "M" subscript.
STORELN(LINE) ;
+1 SET EMCNT=EMCNT+1
+2 SET ^XTMP("PSO160P1",$JOB,"M",EMCNT)=LINE
+3 QUIT
