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

DG53632P.m

Go to the documentation of this file. 
  1. DG53632P ;ALB/LBD - Post install routine for DG*5.3*632; 1 NOV 2004
  1.  ;;5.3;Registration;**632,1015**; Aug 13, 1993;Build 21
  1.  ;
  1. POST ; Post install entry point
  1.  D FVINC Q:$G(XPDABORT)=2
  1.  D UNEMPOW
  1.  Q
  1. FVINC ; Add new entry #86 to the INCONSISTENT DATA ELEMENTS file (#38.6)
  1.  N DGFDA,DGIEN,DGERR,ROOT,DGWP,DGINC
  1.  K XPDABORT
  1.  D BMES^XPDUTL(">>> Adding entry #86 to the INCONSISTENT DATA ELEMENTS file (#38.6) <<<")
  1.  S DGINC="INEL FIL VET SHOULD BE VET='N'"
  1.  I $D(^DGIN(38.6,86,0)) D  Q
  1.  .D BMES^XPDUTL("   Internal entry #86 already exists in file #38.6")
  1.  .I $P($G(^DGIN(38.6,86,0)),U)=DGINC D MES^XPDUTL("   Entry matches incoming inconsistency for Filipino Vet - OK") Q
  1.  .D MES^XPDUTL("    >>> ERROR: Entry #86 needs to be reviewed by EVS!")
  1.  .D MES^XPDUTL("        Existing entry: "_$P($G(^DGIN(38.6,86,0)),U))
  1.  .D MES^XPDUTL("        Incoming entry: "_DGINC)
  1.  .D BMES^XPDUTL("        <<<<   INSTALLATION ABORTED   >>>>")
  1.  .S XPDABORT=2
  1.  S ROOT="DGFDA(38.6,""?+1,"")"
  1.  S @ROOT@(.01)=DGINC
  1.  S @ROOT@(2)="INELIGIBLE FILIPINO VETERAN SHOULD HAVE A VETERAN STATUS OF 'NO'"
  1.  S @ROOT@(3)=3
  1.  S @ROOT@(50)="DGWP"
  1.  S DGWP(1,0)="Inconsistency results if a veteran has a Filipino Veteran branch of"
  1.  S DGWP(2,0)="service (F.COMMONWEALTH, F.GUERILLA, F.SCOUTS NEW, or F.SCOUTS OLD),"
  1.  S DGWP(3,0)="but is ineligible because of no World War II military service dates"
  1.  S DGWP(4,0)="or no proof of F.Vet eligibility (for the first three BOS only), and"
  1.  S DGWP(5,0)="the Veteran Status is set to 'YES'."
  1.  S DGIEN(1)=86
  1.  D UPDATE^DIE("","DGFDA","DGIEN","DGERR")
  1.  I $D(DGERR) D  Q
  1.  .D BMES^XPDUTL("   >>> ERROR: "_DGINC_" not added to file #38.6")
  1.  .D MES^XPDUTL("     "_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1))
  1.  .D BMES^XPDUTL("                <<<<   INSTALLATION ABORTED  >>>>")
  1.  .S XPDABORT=2
  1.  D BMES^XPDUTL("    "_DGINC_" successfully added.")
  1.  Q
  1.  ;
  1. UNEMPOW ; Run update process for Unemployable and POW Veterans
  1.  D BMES^XPDUTL(">>> Update process for Unemployable and POW Veterans <<<")
  1.  Q:'$$CHK
  1.  D QUETASK
  1.  Q
  1. QUETASK ; Queue the Unemp/POW Vet update job
  1.  N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
  1.  S ZTRTN="EN^DG53632P",ZTIO="",ZTDTH=$$NOW^XLFDT()
  1.  S ZTDESC="UPDATE PROCESS FOR UNEMPLOYABLE AND POW VETS"
  1.  D ^%ZTLOAD S ^XTMP("DG53632P",0,"TASK")=$G(ZTSK)
  1.  S TXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
  1.  D BMES^XPDUTL(TXT)
  1.  Q
  1.  ;
  1. EN ; Entry point for queued process
  1.  I $G(ZTSK) S ZTREQ="@"
  1.  S $P(^XTMP("DG53632P",0,"DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
  1.  ; Loop through Patient file "AENRC" x-ref for verified enrollments (2)
  1.  N DFN
  1.  S DFN=0
  1.  F  S DFN=$O(^DPT("AENRC",2,DFN)) Q:'DFN  D
  1.  .I $$POW(DFN) D  Q
  1.  ..S ^XTMP("DG53632P","POWTOT")=$G(^XTMP("DG53632P","POWTOT"))+1
  1.  ..D UPRX(DFN,"POW")
  1.  .I $$UNEMP(DFN) D
  1.  ..S ^XTMP("DG53632P","UNEMPTOT")=$G(^XTMP("DG53632P","UNEMPTOT"))+1
  1.  ..D UPRX(DFN,"UNEMP")
  1.  S $P(^XTMP("DG53632P",0,"DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
  1.  S ^XTMP("DG53632P",0,"COMPLETED")=1
  1.  D SENDMSG
  1.  Q
  1.  ;
  1. POW(DFN) ; Is veteran a POW?
  1.  I '$G(DFN) Q 0
  1.  I $P($G(^DPT(DFN,.52)),U,5)="Y" Q 1  ;POW Indicator='Y'
  1.  I +$G(^DPT(DFN,.36))=18 Q 1 ;Primary Eligibility code = POW
  1.  I $D(^DPT(DFN,"E",18)) Q 1  ;Secondary Eligibility code = POW
  1.  Q 0
  1.  ;
  1. UNEMP(DFN) ; Is veteran Unemployable Priority 1?
  1.  N DGENRIEN
  1.  S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN 0  ;Get current enrollment
  1.  Q:'$$GET^DGENA(DGENRIEN,.DGENR) 0  ;Get enrollment data
  1.  Q:$G(DGENR("PRIORITY"))'=1 0  ;Quit if not priority group 1
  1.  Q:$G(DGENR("ELIG","UNEMPLOY"))'="Y" 0  ;Quit if not unemployable
  1.  Q:$G(DGENR("ELIG","SCPER"))>49 0  ;Quit if SC % 50-100
  1.  Q 1
  1.  ;
  1. UPRX(DFN,EX) ; Update RX Copay status in Annual Means Test file (#408.31)
  1.  ; and Billing Patient file (#354)
  1.  ; INPUT - DFN = Patient IEN
  1.  ;         EX = Exemption type, either POW or UNEMP
  1.  N REAS,STAT
  1.  I '$D(^IBA(354,DFN)) Q
  1.  S STAT=$$GET1^DIQ(354,DFN_",",.04,"E")
  1.  S REAS=$$GET1^DIQ(354,DFN_",",.05,"E")
  1.  I REAS[EX Q  ;correct exemption type already set
  1.  I EX="POW",STAT="EXEMPT",REAS'["INCOME" Q
  1.  D EN^DGMTCOR  ;Update RX copay test and IB file #354
  1.  S ^XTMP("DG53632P",EX_"UP")=$G(^XTMP("DG53632P",EX_"UP"))+1
  1.  S ^XTMP("DG53632P","VET",DFN)=EX
  1.  Q
  1. CHK() ; Check if Unemp Vet update process should be run
  1.  N CDT,TASK,TXT
  1.  I '$D(^XTMP("DG53632P",0)) S ^XTMP("DG53632P",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"DG*5.3*632 POST-INSTALL UPDATE FOR POW & UNEMP VETS" Q 1
  1.  I $G(^XTMP("DG53632P",0,"COMPLETED")) D  Q 0
  1.  .S CDT=$P($G(^XTMP("DG53632P",0,"DATE")),U,2)
  1.  .S TXT(1)="The update process for Unemployable and POW Veterans was completed"
  1.  .S TXT(2)="on "_CDT
  1.  .D BMES^XPDUTL(.TXT)
  1.  S TASK=$G(^XTMP("DG53632P",0,"TASK")) I 'TASK Q 1
  1.  I $$ACTIVE(TASK) D  Q 0
  1.  .S TXT(1)="Task: "_TASK_" is currently running the update process for unemployable"
  1.  .S TXT(2)="& POW veterans.  A duplicate job cannot be started."
  1.  .D BMES^XPDUTL(.TXT)
  1.  Q 1
  1. ACTIVE(TASK) ; Check if task is running
  1.  ; Input  -- TASK = Task number
  1.  ; Output -- 1 = Task is running
  1.  ;           0 = Task is not running
  1.  N STAT,ZTSK,Y
  1.  S STAT=0,ZTSK=+$G(TASK) I 'ZTSK Q STAT
  1.  D STAT^%ZTLOAD
  1.  S Y=ZTSK(1)
  1.  I "^1^2^"[(U_Y_U) S STAT=1
  1.  I "^3^5^"[(U_Y_U) S STAT=0
  1.  Q STAT
  1.  ;
  1. SENDMSG ; Send Mailman bulletin when process completes
  1.  N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
  1.  S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3),SITENM=$P($G(SITE),U,2)
  1.  S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
  1.  S XMDUZ="UNEMPLOYABLE AND POW VETS UPDATE",XMSUB=XMDUZ_" (DG*5.3*632) - "_STATN
  1.  S (XMY(DUZ),XMY("linda.desmond@med.va.gov"))=""
  1.  S XMTEXT="MSG("
  1.  S MSG(1)="The post-install process for patch DG*5.3*632 has completed successfully."
  1.  S MSG(2)="This process searched for POW and Priority 1 Unemployable Veterans and"
  1.  S MSG(3)="updated their RX copay status to Exempt in the Billing Patient file #354,"
  1.  S MSG(3.1)="if necessary."
  1.  S MSG(4)=""
  1.  S MSG(5)="Task: "_$G(^XTMP("DG53632P",0,"TASK"))
  1.  S MSG(6)="Site Station Number: "_STATN
  1.  S MSG(7)="Site Name: "_SITENM
  1.  S MSG(8)=""
  1.  S MSG(9)="Process started   : "_$P($G(^XTMP("DG53632P",0,"DATE")),U,1)
  1.  S MSG(10)="Process completed : "_$P($G(^XTMP("DG53632P",0,"DATE")),U,2)
  1.  S MSG(10.5)=""
  1.  S MSG(11)="Total Priority 1 Unemployable Vets  : "_+$G(^XTMP("DG53632P","UNEMPTOT"))
  1.  S MSG(12)="Total RX Copay Status Updates       : "_+$G(^XTMP("DG53632P","UNEMPUP"))
  1.  S MSG(12.5)=""
  1.  S MSG(13)="Total Former POW Veterans           : "_+$G(^XTMP("DG53632P","POWTOT"))
  1.  S MSG(14)="Total RX Copay Status Updates       : "_+$G(^XTMP("DG53632P","POWUP"))
  1.  D ^XMD
  1.  Q