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

PSO160P2.m

Go to the documentation of this file. 
  1. PSO160P2 ;BIR/MR-Patch 160 Post Install routine - Part 2 ;11/27/03
  1.  ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
  1.  ;External reference ^SCE( supported by DBIA 402
  1.  ;
  1. EN N DAT,ENC,TODAY,INACT,DIE,DA,DR,CLI,SORT
  1.  ;
  1.  ; - Patient is already TPB Inactive (INACTIVATION OF BENEFIT DATE)
  1.  I PSOTIBD'="" Q
  1.  ;   
  1.  ; - At least one active TPB prescription found, if NOT Quit
  1.  I $$ACTRX^PSOTPCUL(PSOTDFN,1) Q
  1.  ;
  1.  S DAT=PSOTDBG-1,(ENC,INACT)=0 D NOW^%DTC S TODAY=%\1
  1.  F  S DAT=$O(^SCE("ADFN",PSOTDFN,DAT)) Q:'DAT  D  I INACT Q
  1.  . F  S ENC=$O(^SCE("ADFN",PSOTDFN,DAT,ENC)) Q:'ENC  D  I INACT Q
  1.  . . ;
  1.  . . ; - NOT an Appointment
  1.  . . I $$GET1^DIQ(409.68,ENC,.08,"I")'=1 Q
  1.  . . ;
  1.  . . ; - Appointment is not CHECKED OUT
  1.  . . I $$UP^XLFSTR($TR($$GET1^DIQ(409.68,ENC,.12),"- "))'="CHECKEDOUT" Q
  1.  . . ;
  1.  . . ; - STOP CODE for the Encounter Location not TPB
  1.  . . I '$$TPBSC^PSOTPCUL($$GET1^DIQ(409.68,ENC,.04,"I")) Q
  1.  . . ;
  1.  . . ; - Inactivate TPB benefits for the patient
  1.  . . S DIE=52.91,DA=PSOTDFN,DR="2///"_TODAY_";3///1" D ^DIE K DIE,DR,DA
  1.  . . ;
  1.  . . ; - Set ^XTMP("PSO160P2",$J) for the Mailman Message
  1.  . . S CLI=$$GET1^DIQ(409.68,ENC,.04)
  1.  . . ;
  1.  . . ; - Sets ^TMP global for Mailman Message
  1.  . . S SORT=$E(PATNAM,1,23)_"("_PATSSN_")"
  1.  . . S ^XTMP("PSO160P2",$J,"T",SORT)=DAT_"^"_CLI
  1.  . . S INACT=1
  1.  ;
  1.  Q
  1.  ;
  1. MAIL ; Sends Mailman message to PSO TPB GROUP mail group with list of
  1.  ; patients that have been inactivated.
  1.  N DFN,XMTEXT,XMDUZ,XMSUB,DASH,LINE,HDR,XMY,CNT,DASH,DATA,DIFROM,TEXT
  1.  N PNAM
  1.  ;
  1.  S XMDUZ="PATCH PSO*7*160" D SXMY^PSOTPCUL("PSO TPB GROUP")
  1.  S XMY(DUZ)="",XMSUB="PSO*7*160 - LIST OF TPB PATIENTS INACTIVATED"
  1.  ;
  1.  ; Mailman Message - Header
  1.  S $P(DASH,"-",79)="",LINE=0
  1.  D SETLN("The Post-Install process for PSO*7*160 - Part 2 successfully completed.")
  1.  D SETLN(" ")
  1.  D SETLN("Started on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"START"))))
  1.  D SETLN("Finished on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"FINISH"))))
  1.  D SETLN(" ")
  1.  ;
  1.  ;If no entries created above, skip reporting
  1.  I '$D(^XTMP("PSO160P2",$J,"T")) D  G SEND
  1.  . D SETLN("No patients have been inactivated from TPB (Transitional Pharmacy Benefit).")
  1.  ;
  1.  D SETLN("The following patients had their TPB (Transitional Pharmacy Benefit) benefit")
  1.  D SETLN("automatically inactivated because the following appointment was found: ")
  1.  D SETLN(" "),SETLN(DASH)
  1.  S HDR="PATIENT (LAST4SSN)",$E(HDR,31)="APPOINTMENT DATE"
  1.  S $E(HDR,50)="VA CLINIC" D SETLN(HDR),SETLN(DASH)
  1.  ;
  1.  ; Mailman Message - Body
  1.  S PNAM="",CNT=0
  1.  F  S PNAM=$O(^XTMP("PSO160P2",$J,"T",PNAM)) Q:PNAM=""  D
  1.  . S DATA=$G(^XTMP("PSO160P2",$J,"T",PNAM))
  1.  . S TEXT=PNAM,$E(TEXT,31)=$$FMTE^XLFDT($P(DATA,"^"))
  1.  . S $E(TEXT,50)=$E($P(DATA,"^",2),1,30)
  1.  . D SETLN(TEXT) S CNT=CNT+1
  1.  ;
  1.  ; Mailman Messae - Footer
  1.  D SETLN(" "),SETLN("Total: "_CNT_" Patient(s)")
  1.  ;
  1. SEND ; - Calls ^XMD to send the message
  1.  S XMTEXT="^XTMP(""PSO160P2"",$J,""M""," D ^XMD
  1.  K ^XTMP("PSO160P2",$J,"M")
  1.  Q
  1.  ;
  1. SETLN(TXT)   ; Sets a line in the XTMP global for the Mailman Message
  1.  S LINE=$G(LINE)+1
  1.  S ^XTMP("PSO160P2",$J,"M",LINE)=TXT
  1.  Q