PSOTPINA.m

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

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