source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53632P.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.3 KB
Line 
1DG53632P ;ALB/LBD - Post install routine for DG*5.3*632; 1 NOV 2004
2 ;;5.3;Registration;**632**; Aug 13, 1993
3 ;
4POST ; Post install entry point
5 D FVINC Q:$G(XPDABORT)=2
6 D UNEMPOW
7 Q
8FVINC ; Add new entry #86 to the INCONSISTENT DATA ELEMENTS file (#38.6)
9 N DGFDA,DGIEN,DGERR,ROOT,DGWP,DGINC
10 K XPDABORT
11 D BMES^XPDUTL(">>> Adding entry #86 to the INCONSISTENT DATA ELEMENTS file (#38.6) <<<")
12 S DGINC="INEL FIL VET SHOULD BE VET='N'"
13 I $D(^DGIN(38.6,86,0)) D Q
14 .D BMES^XPDUTL(" Internal entry #86 already exists in file #38.6")
15 .I $P($G(^DGIN(38.6,86,0)),U)=DGINC D MES^XPDUTL(" Entry matches incoming inconsistency for Filipino Vet - OK") Q
16 .D MES^XPDUTL(" >>> ERROR: Entry #86 needs to be reviewed by EVS!")
17 .D MES^XPDUTL(" Existing entry: "_$P($G(^DGIN(38.6,86,0)),U))
18 .D MES^XPDUTL(" Incoming entry: "_DGINC)
19 .D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>")
20 .S XPDABORT=2
21 S ROOT="DGFDA(38.6,""?+1,"")"
22 S @ROOT@(.01)=DGINC
23 S @ROOT@(2)="INELIGIBLE FILIPINO VETERAN SHOULD HAVE A VETERAN STATUS OF 'NO'"
24 S @ROOT@(3)=3
25 S @ROOT@(50)="DGWP"
26 S DGWP(1,0)="Inconsistency results if a veteran has a Filipino Veteran branch of"
27 S DGWP(2,0)="service (F.COMMONWEALTH, F.GUERILLA, F.SCOUTS NEW, or F.SCOUTS OLD),"
28 S DGWP(3,0)="but is ineligible because of no World War II military service dates"
29 S DGWP(4,0)="or no proof of F.Vet eligibility (for the first three BOS only), and"
30 S DGWP(5,0)="the Veteran Status is set to 'YES'."
31 S DGIEN(1)=86
32 D UPDATE^DIE("","DGFDA","DGIEN","DGERR")
33 I $D(DGERR) D Q
34 .D BMES^XPDUTL(" >>> ERROR: "_DGINC_" not added to file #38.6")
35 .D MES^XPDUTL(" "_DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1))
36 .D BMES^XPDUTL(" <<<< INSTALLATION ABORTED >>>>")
37 .S XPDABORT=2
38 D BMES^XPDUTL(" "_DGINC_" successfully added.")
39 Q
40 ;
41UNEMPOW ; Run update process for Unemployable and POW Veterans
42 D BMES^XPDUTL(">>> Update process for Unemployable and POW Veterans <<<")
43 Q:'$$CHK
44 D QUETASK
45 Q
46QUETASK ; Queue the Unemp/POW Vet update job
47 N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
48 S ZTRTN="EN^DG53632P",ZTIO="",ZTDTH=$$NOW^XLFDT()
49 S ZTDESC="UPDATE PROCESS FOR UNEMPLOYABLE AND POW VETS"
50 D ^%ZTLOAD S ^XTMP("DG53632P",0,"TASK")=$G(ZTSK)
51 S TXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
52 D BMES^XPDUTL(TXT)
53 Q
54 ;
55EN ; Entry point for queued process
56 I $G(ZTSK) S ZTREQ="@"
57 S $P(^XTMP("DG53632P",0,"DATE"),U,1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
58 ; Loop through Patient file "AENRC" x-ref for verified enrollments (2)
59 N DFN
60 S DFN=0
61 F S DFN=$O(^DPT("AENRC",2,DFN)) Q:'DFN D
62 .I $$POW(DFN) D Q
63 ..S ^XTMP("DG53632P","POWTOT")=$G(^XTMP("DG53632P","POWTOT"))+1
64 ..D UPRX(DFN,"POW")
65 .I $$UNEMP(DFN) D
66 ..S ^XTMP("DG53632P","UNEMPTOT")=$G(^XTMP("DG53632P","UNEMPTOT"))+1
67 ..D UPRX(DFN,"UNEMP")
68 S $P(^XTMP("DG53632P",0,"DATE"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
69 S ^XTMP("DG53632P",0,"COMPLETED")=1
70 D SENDMSG
71 Q
72 ;
73POW(DFN) ; Is veteran a POW?
74 I '$G(DFN) Q 0
75 I $P($G(^DPT(DFN,.52)),U,5)="Y" Q 1 ;POW Indicator='Y'
76 I +$G(^DPT(DFN,.36))=18 Q 1 ;Primary Eligibility code = POW
77 I $D(^DPT(DFN,"E",18)) Q 1 ;Secondary Eligibility code = POW
78 Q 0
79 ;
80UNEMP(DFN) ; Is veteran Unemployable Priority 1?
81 N DGENRIEN
82 S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN 0 ;Get current enrollment
83 Q:'$$GET^DGENA(DGENRIEN,.DGENR) 0 ;Get enrollment data
84 Q:$G(DGENR("PRIORITY"))'=1 0 ;Quit if not priority group 1
85 Q:$G(DGENR("ELIG","UNEMPLOY"))'="Y" 0 ;Quit if not unemployable
86 Q:$G(DGENR("ELIG","SCPER"))>49 0 ;Quit if SC % 50-100
87 Q 1
88 ;
89UPRX(DFN,EX) ; Update RX Copay status in Annual Means Test file (#408.31)
90 ; and Billing Patient file (#354)
91 ; INPUT - DFN = Patient IEN
92 ; EX = Exemption type, either POW or UNEMP
93 N REAS,STAT
94 I '$D(^IBA(354,DFN)) Q
95 S STAT=$$GET1^DIQ(354,DFN_",",.04,"E")
96 S REAS=$$GET1^DIQ(354,DFN_",",.05,"E")
97 I REAS[EX Q ;correct exemption type already set
98 I EX="POW",STAT="EXEMPT",REAS'["INCOME" Q
99 D EN^DGMTCOR ;Update RX copay test and IB file #354
100 S ^XTMP("DG53632P",EX_"UP")=$G(^XTMP("DG53632P",EX_"UP"))+1
101 S ^XTMP("DG53632P","VET",DFN)=EX
102 Q
103CHK() ; Check if Unemp Vet update process should be run
104 N CDT,TASK,TXT
105 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
106 I $G(^XTMP("DG53632P",0,"COMPLETED")) D Q 0
107 .S CDT=$P($G(^XTMP("DG53632P",0,"DATE")),U,2)
108 .S TXT(1)="The update process for Unemployable and POW Veterans was completed"
109 .S TXT(2)="on "_CDT
110 .D BMES^XPDUTL(.TXT)
111 S TASK=$G(^XTMP("DG53632P",0,"TASK")) I 'TASK Q 1
112 I $$ACTIVE(TASK) D Q 0
113 .S TXT(1)="Task: "_TASK_" is currently running the update process for unemployable"
114 .S TXT(2)="& POW veterans. A duplicate job cannot be started."
115 .D BMES^XPDUTL(.TXT)
116 Q 1
117ACTIVE(TASK) ; Check if task is running
118 ; Input -- TASK = Task number
119 ; Output -- 1 = Task is running
120 ; 0 = Task is not running
121 N STAT,ZTSK,Y
122 S STAT=0,ZTSK=+$G(TASK) I 'ZTSK Q STAT
123 D STAT^%ZTLOAD
124 S Y=ZTSK(1)
125 I "^1^2^"[(U_Y_U) S STAT=1
126 I "^3^5^"[(U_Y_U) S STAT=0
127 Q STAT
128 ;
129SENDMSG ; Send Mailman bulletin when process completes
130 N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
131 S SITE=$$SITE^VASITE,STATN=$P($G(SITE),U,3),SITENM=$P($G(SITE),U,2)
132 S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
133 S XMDUZ="UNEMPLOYABLE AND POW VETS UPDATE",XMSUB=XMDUZ_" (DG*5.3*632) - "_STATN
134 S (XMY(DUZ),XMY("linda.desmond@med.va.gov"))=""
135 S XMTEXT="MSG("
136 S MSG(1)="The post-install process for patch DG*5.3*632 has completed successfully."
137 S MSG(2)="This process searched for POW and Priority 1 Unemployable Veterans and"
138 S MSG(3)="updated their RX copay status to Exempt in the Billing Patient file #354,"
139 S MSG(3.1)="if necessary."
140 S MSG(4)=""
141 S MSG(5)="Task: "_$G(^XTMP("DG53632P",0,"TASK"))
142 S MSG(6)="Site Station Number: "_STATN
143 S MSG(7)="Site Name: "_SITENM
144 S MSG(8)=""
145 S MSG(9)="Process started : "_$P($G(^XTMP("DG53632P",0,"DATE")),U,1)
146 S MSG(10)="Process completed : "_$P($G(^XTMP("DG53632P",0,"DATE")),U,2)
147 S MSG(10.5)=""
148 S MSG(11)="Total Priority 1 Unemployable Vets : "_+$G(^XTMP("DG53632P","UNEMPTOT"))
149 S MSG(12)="Total RX Copay Status Updates : "_+$G(^XTMP("DG53632P","UNEMPUP"))
150 S MSG(12.5)=""
151 S MSG(13)="Total Former POW Veterans : "_+$G(^XTMP("DG53632P","POWTOT"))
152 S MSG(14)="Total RX Copay Status Updates : "_+$G(^XTMP("DG53632P","POWUP"))
153 D ^XMD
154 Q
Note: See TracBrowser for help on using the repository browser.