PSOTPINA ;BIR/MR - Driver to Inactivate TPB patients ;12/01/03
;;7.0;OUTPATIENT PHARMACY;**160,227**;DEC 1997
;
EN Q ;placed out of order by PSO*7*227
N PSOSDHL,PSOSDOE,TODAY,%,DIE,DA,DR,DO,PSOINA,X
; - Patient not defined
I '$D(^DPT(+$G(DFN),0)) Q
;
; - Patient not in the TPB ELIGIBILITY file (#52.91)
I '$D(^PS(52.91,DFN)) Q
;
; - Patient TPB's Benefit is INACTIVE
I $$GET1^DIQ(52.91,DFN,2,"I") Q
;
; - At least ONE active TPB prescription found
I $$ACTRX^PSOTPCUL(DFN,1) Q
;
; - Checking the OUTPATIENT ENCOUNTER
S (PSOSDHL,PSOSDOE)="",PSOINA=0 D NOW^%DTC S TODAY=%\1
F S PSOSDHL=$O(^TMP("SDEVT",$J,PSOSDHL)) Q:'PSOSDHL D I PSOINA Q
. F S PSOSDOE=$O(^TMP("SDEVT",$J,PSOSDHL,1,"SDOE",PSOSDOE)) Q:'PSOSDOE D I PSOINA Q
. . ;
. . ; - Appointment is not CHECKED OUT
. . I $$UP^XLFSTR($TR($$GET1^DIQ(409.68,PSOSDOE,.12),"- "))'="CHECKEDOUT" Q
. . ;
. . ; - STOP CODE for the Encounter Location not TPB
. . I '$$TPBSC^PSOTPCUL($$GET1^DIQ(409.68,PSOSDOE,.04,"I")) Q
. . ;
. . ; Inactivate TPB benefits for the patient
. . S DIE=52.91,DA=DFN,DR="2///"_TODAY_";3///1" D ^DIE S PSOINA=1
. . ;
. . ; - Send Mailman Message about TPB inactivation for Patient
. . D MAIL(DFN,PSOSDOE)
;
Q
;
MAIL(DFN,ENC) ; - Create/Send Mailman Message about Inactivation to
; PSO TPB GROUP (Mail Group)
;
N XMTEXT,XMDUZ,XMSUB,XMY,VADM,CNAM,PNAM,DAT,MSG,DIFROM,X
;
D DEM^VADPT S PNAM=$P(VADM(1),"^")_" ("_$P($P(VADM(2),"^",2),"-",3)_")"
S DAT=$$GET1^DIQ(409.68,ENC,.01),CNAM=$$GET1^DIQ(409.68,ENC,.04)
;
S XMDUZ="PHARMACY TPB SCHEDULING MONITOR"
D SXMY^PSOTPCUL("PSO TPB GROUP")
S XMSUB="TPB PATIENT BENEFIT INACTIVATION"
;
S MSG(1)="The following patient had the TPB (Transitional Pharmacy Benefit) benefit"
S MSG(2)="automatically inactivated because the following appointment was found: "
S MSG(3)=" "
S MSG(4)=" Patient : "_PNAM
S MSG(5)=" VA Clinic : "_CNAM
S MSG(6)=" Appointment Date: "_DAT
;
S XMTEXT="MSG(" D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTPINA 2054 printed Sep 23, 2025@20:12:22 Page 2
PSOTPINA ;BIR/MR - Driver to Inactivate TPB patients ;12/01/03
+1 ;;7.0;OUTPATIENT PHARMACY;**160,227**;DEC 1997
+2 ;
EN ;placed out of order by PSO*7*227
QUIT
+1 NEW PSOSDHL,PSOSDOE,TODAY,%,DIE,DA,DR,DO,PSOINA,X
+2 ; - Patient not defined
+3 IF '$DATA(^DPT(+$GET(DFN),0))
QUIT
+4 ;
+5 ; - Patient not in the TPB ELIGIBILITY file (#52.91)
+6 IF '$DATA(^PS(52.91,DFN))
QUIT
+7 ;
+8 ; - Patient TPB's Benefit is INACTIVE
+9 IF $$GET1^DIQ(52.91,DFN,2,"I")
QUIT
+10 ;
+11 ; - At least ONE active TPB prescription found
+12 IF $$ACTRX^PSOTPCUL(DFN,1)
QUIT
+13 ;
+14 ; - Checking the OUTPATIENT ENCOUNTER
+15 SET (PSOSDHL,PSOSDOE)=""
SET PSOINA=0
DO NOW^%DTC
SET TODAY=%\1
+16 FOR
SET PSOSDHL=$ORDER(^TMP("SDEVT",$JOB,PSOSDHL))
if 'PSOSDHL
QUIT
Begin DoDot:1
+17 FOR
SET PSOSDOE=$ORDER(^TMP("SDEVT",$JOB,PSOSDHL,1,"SDOE",PSOSDOE))
if 'PSOSDOE
QUIT
Begin DoDot:2
+18 ;
+19 ; - Appointment is not CHECKED OUT
+20 IF $$UP^XLFSTR($TRANSLATE($$GET1^DIQ(409.68,PSOSDOE,.12),"- "))'="CHECKEDOUT"
QUIT
+21 ;
+22 ; - STOP CODE for the Encounter Location not TPB
+23 IF '$$TPBSC^PSOTPCUL($$GET1^DIQ(409.68,PSOSDOE,.04,"I"))
QUIT
+24 ;
+25 ; Inactivate TPB benefits for the patient
+26 SET DIE=52.91
SET DA=DFN
SET DR="2///"_TODAY_";3///1"
DO ^DIE
SET PSOINA=1
+27 ;
+28 ; - Send Mailman Message about TPB inactivation for Patient
+29 DO MAIL(DFN,PSOSDOE)
End DoDot:2
IF PSOINA
QUIT
End DoDot:1
IF PSOINA
QUIT
+30 ;
+31 QUIT
+32 ;
MAIL(DFN,ENC) ; - Create/Send Mailman Message about Inactivation to
+1 ; PSO TPB GROUP (Mail Group)
+2 ;
+3 NEW XMTEXT,XMDUZ,XMSUB,XMY,VADM,CNAM,PNAM,DAT,MSG,DIFROM,X
+4 ;
+5 DO DEM^VADPT
SET PNAM=$PIECE(VADM(1),"^")_" ("_$PIECE($PIECE(VADM(2),"^",2),"-",3)_")"
+6 SET DAT=$$GET1^DIQ(409.68,ENC,.01)
SET CNAM=$$GET1^DIQ(409.68,ENC,.04)
+7 ;
+8 SET XMDUZ="PHARMACY TPB SCHEDULING MONITOR"
+9 DO SXMY^PSOTPCUL("PSO TPB GROUP")
+10 SET XMSUB="TPB PATIENT BENEFIT INACTIVATION"
+11 ;
+12 SET MSG(1)="The following patient had the TPB (Transitional Pharmacy Benefit) benefit"
+13 SET MSG(2)="automatically inactivated because the following appointment was found: "
+14 SET MSG(3)=" "
+15 SET MSG(4)=" Patient : "_PNAM
+16 SET MSG(5)=" VA Clinic : "_CNAM
+17 SET MSG(6)=" Appointment Date: "_DAT
+18 ;
+19 SET XMTEXT="MSG("
DO ^XMD
+20 QUIT
