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