PSO160P2 ;BIR/MR-Patch 160 Post Install routine - Part 2 ;11/27/03
;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
;External reference ^SCE( supported by DBIA 402
;
EN N DAT,ENC,TODAY,INACT,DIE,DA,DR,CLI,SORT
;
; - Patient is already TPB Inactive (INACTIVATION OF BENEFIT DATE)
I PSOTIBD'="" Q
;
; - At least one active TPB prescription found, if NOT Quit
I $$ACTRX^PSOTPCUL(PSOTDFN,1) Q
;
S DAT=PSOTDBG-1,(ENC,INACT)=0 D NOW^%DTC S TODAY=%\1
F S DAT=$O(^SCE("ADFN",PSOTDFN,DAT)) Q:'DAT D I INACT Q
. F S ENC=$O(^SCE("ADFN",PSOTDFN,DAT,ENC)) Q:'ENC D I INACT Q
. . ;
. . ; - NOT an Appointment
. . I $$GET1^DIQ(409.68,ENC,.08,"I")'=1 Q
. . ;
. . ; - Appointment is not CHECKED OUT
. . I $$UP^XLFSTR($TR($$GET1^DIQ(409.68,ENC,.12),"- "))'="CHECKEDOUT" Q
. . ;
. . ; - STOP CODE for the Encounter Location not TPB
. . I '$$TPBSC^PSOTPCUL($$GET1^DIQ(409.68,ENC,.04,"I")) Q
. . ;
. . ; - Inactivate TPB benefits for the patient
. . S DIE=52.91,DA=PSOTDFN,DR="2///"_TODAY_";3///1" D ^DIE K DIE,DR,DA
. . ;
. . ; - Set ^XTMP("PSO160P2",$J) for the Mailman Message
. . S CLI=$$GET1^DIQ(409.68,ENC,.04)
. . ;
. . ; - Sets ^TMP global for Mailman Message
. . S SORT=$E(PATNAM,1,23)_"("_PATSSN_")"
. . S ^XTMP("PSO160P2",$J,"T",SORT)=DAT_"^"_CLI
. . S INACT=1
;
Q
;
MAIL ; Sends Mailman message to PSO TPB GROUP mail group with list of
; patients that have been inactivated.
N DFN,XMTEXT,XMDUZ,XMSUB,DASH,LINE,HDR,XMY,CNT,DASH,DATA,DIFROM,TEXT
N PNAM
;
S XMDUZ="PATCH PSO*7*160" D SXMY^PSOTPCUL("PSO TPB GROUP")
S XMY(DUZ)="",XMSUB="PSO*7*160 - LIST OF TPB PATIENTS INACTIVATED"
;
; Mailman Message - Header
S $P(DASH,"-",79)="",LINE=0
D SETLN("The Post-Install process for PSO*7*160 - Part 2 successfully completed.")
D SETLN(" ")
D SETLN("Started on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"START"))))
D SETLN("Finished on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"FINISH"))))
D SETLN(" ")
;
;If no entries created above, skip reporting
I '$D(^XTMP("PSO160P2",$J,"T")) D G SEND
. D SETLN("No patients have been inactivated from TPB (Transitional Pharmacy Benefit).")
;
D SETLN("The following patients had their TPB (Transitional Pharmacy Benefit) benefit")
D SETLN("automatically inactivated because the following appointment was found: ")
D SETLN(" "),SETLN(DASH)
S HDR="PATIENT (LAST4SSN)",$E(HDR,31)="APPOINTMENT DATE"
S $E(HDR,50)="VA CLINIC" D SETLN(HDR),SETLN(DASH)
;
; Mailman Message - Body
S PNAM="",CNT=0
F S PNAM=$O(^XTMP("PSO160P2",$J,"T",PNAM)) Q:PNAM="" D
. S DATA=$G(^XTMP("PSO160P2",$J,"T",PNAM))
. S TEXT=PNAM,$E(TEXT,31)=$$FMTE^XLFDT($P(DATA,"^"))
. S $E(TEXT,50)=$E($P(DATA,"^",2),1,30)
. D SETLN(TEXT) S CNT=CNT+1
;
; Mailman Messae - Footer
D SETLN(" "),SETLN("Total: "_CNT_" Patient(s)")
;
SEND ; - Calls ^XMD to send the message
S XMTEXT="^XTMP(""PSO160P2"",$J,""M""," D ^XMD
K ^XTMP("PSO160P2",$J,"M")
Q
;
SETLN(TXT) ; Sets a line in the XTMP global for the Mailman Message
S LINE=$G(LINE)+1
S ^XTMP("PSO160P2",$J,"M",LINE)=TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO160P2 3115 printed Dec 13, 2024@02:22:40 Page 2
PSO160P2 ;BIR/MR-Patch 160 Post Install routine - Part 2 ;11/27/03
+1 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
+2 ;External reference ^SCE( supported by DBIA 402
+3 ;
EN NEW DAT,ENC,TODAY,INACT,DIE,DA,DR,CLI,SORT
+1 ;
+2 ; - Patient is already TPB Inactive (INACTIVATION OF BENEFIT DATE)
+3 IF PSOTIBD'=""
QUIT
+4 ;
+5 ; - At least one active TPB prescription found, if NOT Quit
+6 IF $$ACTRX^PSOTPCUL(PSOTDFN,1)
QUIT
+7 ;
+8 SET DAT=PSOTDBG-1
SET (ENC,INACT)=0
DO NOW^%DTC
SET TODAY=%\1
+9 FOR
SET DAT=$ORDER(^SCE("ADFN",PSOTDFN,DAT))
if 'DAT
QUIT
Begin DoDot:1
+10 FOR
SET ENC=$ORDER(^SCE("ADFN",PSOTDFN,DAT,ENC))
if 'ENC
QUIT
Begin DoDot:2
+11 ;
+12 ; - NOT an Appointment
+13 IF $$GET1^DIQ(409.68,ENC,.08,"I")'=1
QUIT
+14 ;
+15 ; - Appointment is not CHECKED OUT
+16 IF $$UP^XLFSTR($TRANSLATE($$GET1^DIQ(409.68,ENC,.12),"- "))'="CHECKEDOUT"
QUIT
+17 ;
+18 ; - STOP CODE for the Encounter Location not TPB
+19 IF '$$TPBSC^PSOTPCUL($$GET1^DIQ(409.68,ENC,.04,"I"))
QUIT
+20 ;
+21 ; - Inactivate TPB benefits for the patient
+22 SET DIE=52.91
SET DA=PSOTDFN
SET DR="2///"_TODAY_";3///1"
DO ^DIE
KILL DIE,DR,DA
+23 ;
+24 ; - Set ^XTMP("PSO160P2",$J) for the Mailman Message
+25 SET CLI=$$GET1^DIQ(409.68,ENC,.04)
+26 ;
+27 ; - Sets ^TMP global for Mailman Message
+28 SET SORT=$EXTRACT(PATNAM,1,23)_"("_PATSSN_")"
+29 SET ^XTMP("PSO160P2",$JOB,"T",SORT)=DAT_"^"_CLI
+30 SET INACT=1
End DoDot:2
IF INACT
QUIT
End DoDot:1
IF INACT
QUIT
+31 ;
+32 QUIT
+33 ;
MAIL ; Sends Mailman message to PSO TPB GROUP mail group with list of
+1 ; patients that have been inactivated.
+2 NEW DFN,XMTEXT,XMDUZ,XMSUB,DASH,LINE,HDR,XMY,CNT,DASH,DATA,DIFROM,TEXT
+3 NEW PNAM
+4 ;
+5 SET XMDUZ="PATCH PSO*7*160"
DO SXMY^PSOTPCUL("PSO TPB GROUP")
+6 SET XMY(DUZ)=""
SET XMSUB="PSO*7*160 - LIST OF TPB PATIENTS INACTIVATED"
+7 ;
+8 ; Mailman Message - Header
+9 SET $PIECE(DASH,"-",79)=""
SET LINE=0
+10 DO SETLN("The Post-Install process for PSO*7*160 - Part 2 successfully completed.")
+11 DO SETLN(" ")
+12 DO SETLN("Started on: "_$$FMTE^XLFDT($GET(^XTMP("PSO160DR",$JOB,"START"))))
+13 DO SETLN("Finished on: "_$$FMTE^XLFDT($GET(^XTMP("PSO160DR",$JOB,"FINISH"))))
+14 DO SETLN(" ")
+15 ;
+16 ;If no entries created above, skip reporting
+17 IF '$DATA(^XTMP("PSO160P2",$JOB,"T"))
Begin DoDot:1
+18 DO SETLN("No patients have been inactivated from TPB (Transitional Pharmacy Benefit).")
End DoDot:1
GOTO SEND
+19 ;
+20 DO SETLN("The following patients had their TPB (Transitional Pharmacy Benefit) benefit")
+21 DO SETLN("automatically inactivated because the following appointment was found: ")
+22 DO SETLN(" ")
DO SETLN(DASH)
+23 SET HDR="PATIENT (LAST4SSN)"
SET $EXTRACT(HDR,31)="APPOINTMENT DATE"
+24 SET $EXTRACT(HDR,50)="VA CLINIC"
DO SETLN(HDR)
DO SETLN(DASH)
+25 ;
+26 ; Mailman Message - Body
+27 SET PNAM=""
SET CNT=0
+28 FOR
SET PNAM=$ORDER(^XTMP("PSO160P2",$JOB,"T",PNAM))
if PNAM=""
QUIT
Begin DoDot:1
+29 SET DATA=$GET(^XTMP("PSO160P2",$JOB,"T",PNAM))
+30 SET TEXT=PNAM
SET $EXTRACT(TEXT,31)=$$FMTE^XLFDT($PIECE(DATA,"^"))
+31 SET $EXTRACT(TEXT,50)=$EXTRACT($PIECE(DATA,"^",2),1,30)
+32 DO SETLN(TEXT)
SET CNT=CNT+1
End DoDot:1
+33 ;
+34 ; Mailman Messae - Footer
+35 DO SETLN(" ")
DO SETLN("Total: "_CNT_" Patient(s)")
+36 ;
SEND ; - Calls ^XMD to send the message
+1 SET XMTEXT="^XTMP(""PSO160P2"",$J,""M"","
DO ^XMD
+2 KILL ^XTMP("PSO160P2",$JOB,"M")
+3 QUIT
+4 ;
SETLN(TXT) ; Sets a line in the XTMP global for the Mailman Message
+1 SET LINE=$GET(LINE)+1
+2 SET ^XTMP("PSO160P2",$JOB,"M",LINE)=TXT
+3 QUIT
