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

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

initial load of WorldVistAEHR
File size: 8.0 KB
RevLine 
[613]1DG53P624 ;ALB/CMF - PATCH DG*5.3*624 INSTALL UTILITIES ; 09/30/04 8:14am
2 ;;5.3;Registration;**624**;Aug 13, 1993
3 ;
4ENV ;Main entry point for Environment check point.
5 ;
6 S XPDABORT=""
7 D PROGCHK(.XPDABORT) ;checks programmer variables
8 I XPDABORT="" K XPDABORT
9 Q
10 ;
11 ;
12PRE ;Main entry point for Pre-init items.
13 ;
14 Q
15 ;
16 ;
17POST ;Main entry point for Post-init items.
18 D MAPRS
19 D BULLETIN
20 Q
21 ;
22MAPRS ; set maximum annual pension rate parameters
23 D BMES^XPDUTL("*****")
24 D MES^XPDUTL("Setting Maximum Annual Pension Rate Parameters")
25 ;
26 ;set MAPR rate parameter to 5(%)
27 D SETPARM("DGMT MAPR GLOBAL RATE",1999,5)
28 D SETPARM("DGMT MAPR GLOBAL RATE",2000,5)
29 D SETPARM("DGMT MAPR GLOBAL RATE",2001,5)
30 D SETPARM("DGMT MAPR GLOBAL RATE",2002,5)
31 D SETPARM("DGMT MAPR GLOBAL RATE",2003,5)
32 D SETPARM("DGMT MAPR GLOBAL RATE",2004,5)
33 ;
34 ;set MAPR max values
35 D SETPARM("DGMT MAPR 0 DEPENDENTS",1999,8989)
36 D SETPARM("DGMT MAPR 0 DEPENDENTS",2000,9304)
37 D SETPARM("DGMT MAPR 0 DEPENDENTS",2001,9556)
38 D SETPARM("DGMT MAPR 0 DEPENDENTS",2002,9690)
39 D SETPARM("DGMT MAPR 0 DEPENDENTS",2003,9894)
40 D SETPARM("DGMT MAPR 0 DEPENDENTS",2004,10162)
41 ;
42 D SETPARM("DGMT MAPR 1 DEPENDENTS",1999,11773)
43 D SETPARM("DGMT MAPR 1 DEPENDENTS",2000,12186)
44 D SETPARM("DGMT MAPR 1 DEPENDENTS",2001,12516)
45 D SETPARM("DGMT MAPR 1 DEPENDENTS",2002,12692)
46 D SETPARM("DGMT MAPR 1 DEPENDENTS",2003,12959)
47 D SETPARM("DGMT MAPR 1 DEPENDENTS",2004,13309)
48 ;
49 D SETPARM("DGMT MAPR N DEPENDENTS",1999,1532)
50 D SETPARM("DGMT MAPR N DEPENDENTS",2000,1586)
51 D SETPARM("DGMT MAPR N DEPENDENTS",2001,1630)
52 D SETPARM("DGMT MAPR N DEPENDENTS",2002,1653)
53 D SETPARM("DGMT MAPR N DEPENDENTS",2003,1688)
54 D SETPARM("DGMT MAPR N DEPENDENTS",2004,1734)
55 ;
56 D MES^XPDUTL("...Rates set.")
57 D MES^XPDUTL("*****")
58 Q
59 ;
60SETPARM(DGPARM,DGINST,DGVALU) ;set PACKAGE entity parameters
61 ;
62 ; DBIA: #2263 SUPPORTED PARAMETER TOOL ENTRY POINTS
63 ;
64 ; Input:
65 ; DGPARM - PARAMETER DEFINITION name
66 ; DGINST - parameter instance
67 ; DGVALU - parameter value
68 ;
69 ; Output:
70 ; None
71 ;
72 N DGERR
73 ;
74 D EN^XPAR("PKG",DGPARM,DGINST,DGVALU,.DGERR)
75 I '$G(DGERR) D
76 .D MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", set to "_DGVALU_".")
77 E D
78 .D MES^XPDUTL(DGPARM_" parameter, instance "_DGINST_", FAILED! ("_DGVALU_")")
79 Q
80 ;
81 ;
82PROGCHK(XPDABORT) ;checks for necessary programmer variables
83 ;
84 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
85 .D BMES^XPDUTL("*****")
86 .D MES^XPDUTL("Your programming variables are not set up properly.")
87 .D MES^XPDUTL("Installation aborted.")
88 .D MES^XPDUTL("*****")
89 .S XPDABORT=2
90 Q
91 ;
92BULLETIN ;
93 N ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE
94 S ZTDTH=$H
95 S ZTIO=""
96 S ZTDESC="DG*5.3*624 Post-Install message"
97 S ZTRTN="DQMESS^DG53P624"
98 S ZTSAVE("DUZ")=""
99 S ZTSAVE("JVAL")=$J
100 D ^%ZTLOAD
101 I $G(ZTSK) D BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
102 I '$G(ZTSK) D BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
103 ;
104 I $D(^XTMP("DG",$J,"PATCH 624 ERROR MESSAGE")) DO
105 . D BMES^XPDUTL("PROBLEM SENDING MESSAGE")
106 . D MES^XPDUTL("CHECK FOR ^XTMP(""DG"",$J,""PATCH 624 CLEANUP BULLETIN"") GLOBAL")
107 . D MES^XPDUTL("CHECK FOR ^XTMP(""DG"",$J,""PATCH 624 ERROR MESSAGE"") GLOBAL")
108 D BMES^XPDUTL("Means Test database cleanup has been completed. Check your VA Mailman")
109 D MES^XPDUTL("mailbox for the ""DG*5.3*624 External value cleanup"" message.")
110 D BMES^XPDUTL("If you do not receive an E-mail, remember to check the following globals:")
111 D MES^XPDUTL(" ^XTMP(""DG"",$J,""PATCH 624 CLEANUP BULLETIN"")")
112 D MES^XPDUTL(" ^XTMP(""DG"",$J,""PATCH 624 ERROR MESSAGE"")")
113 Q
114 ;
115DQMESS ;
116 N DGMMLNE
117 ;*Create bulletin head to identify cleanup records
118 K ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN")
119 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",1)="This message indicates the patients in the Income Person file (408.13)"
120 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",2)=" and the Income Relation file (408.22) that have had external values"
121 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",3)=" in the STATE, LIVED WITH PATIENT, and CONTRIBUTED TO SUPPORT"
122 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",4)=" fields converted to internal pointer or set of code values."
123 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",5)=" "
124 S DGMMLNE=6
125 ;
126 ;*Perform cleanup
127 D STATE
128 D CLEAN
129 ;
130 ;*Send message
131 I $O(^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",11))="" DO
132 .S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",11)=" "
133 .S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",12)=" No corrupted records found."
134 .S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",13)=" "
135 ;
136 ;* Queue message to be sent
137 S XMSUB="DG*5.3*624 External value cleanup"
138 S XMDUZ="DG*5.3*624 Install Cleanup"
139 S XMTEXT="^XTMP(""DG"",JVAL,""PATCH 624 CLEANUP BULLETIN"","
140 S XMY(DUZ)=""
141 S XMY(.5)=""
142 S XMY("G.EAS_1_57@FORUM.VA.GOV")=""
143 D ^XMD
144 S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")_U_$G(XMMG)_U_$G(XMZ)
145 S ^XTMP("DG",JVAL,"PATCH 624 ERROR MESSAGE",0)=DGMMLNE
146 S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
147 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",0)=DGMMLNE
148 I '$D(XMMG) K ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN")
149 Q
150 ;
151STATE ;Correct STATE field in 408.13/1.6 with text instead of pointers
152 N DA,STATE,PTR
153 ;* Setup message text
154 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking STATE field (1.6) in the INCOME PERSON file (408.13)..."
155 S DGMMLNE=DGMMLNE+1
156 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
157 S DGMMLNE=DGMMLNE+1
158 ;
159 S DA=0 F S DA=$O(^DGPR(408.13,DA)) Q:'DA D
160 . Q:'$D(^DGPR(408.13,DA,1))
161 . S STATE=$P(^DGPR(408.13,DA,1),"^",6)
162 . Q:(+STATE=STATE) Q:(STATE']"")
163 . S PTR=$O(^DIC(5,"B",STATE,""))
164 . S $P(^DGPR(408.13,DA,1),"^",6)=PTR
165 .;
166 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" State for "_$P(^DGPR(408.13,DA,0),"^",1)_"'s entry "_DA_" has been changed: "
167 . S DGMMLNE=DGMMLNE+1
168 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_STATE_" has been changed to "_PTR_" IEN from STATE file (5)."
169 . S DGMMLNE=DGMMLNE+1
170 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
171 . S DGMMLNE=DGMMLNE+1
172 Q
173 ;
174CLEAN ;Clean up text "YES" and "NO" values in 408.22/.06 and 408.22/.1
175 N DA,LWP,CTS
176 ;*Setup message text
177 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking LIVED WITH PATIENT field (.06) in the INCOME RELATION file (408.22)..."
178 S DGMMLNE=DGMMLNE+1
179 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
180 S DGMMLNE=DGMMLNE+1
181 ;
182 S DA=0 F S DA=$O(^DGMT(408.22,DA)) Q:'DA D
183 . S LWP=$P($G(^DGMT(408.22,DA,0)),"^",6) ;Lived With Patient
184 . Q:(+LWP=LWP) Q:(LWP']"")
185 . S $P(^DGMT(408.22,DA,0),"^",6)=$S(LWP="YES":1,LWP="NO":0,1:"")
186 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" LIVED WITH PATIENT for "_$P($G(^DPT($P($G(^DGMT(408.22,DA,0)),"^",1),0)),"^",1)_"'s entry "_DA_" has been changed: "
187 . S DGMMLNE=DGMMLNE+1
188 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_LWP_" has been changed to "_$S(LWP="YES":1,LWP="NO":0,1:"NULL")_"."
189 . S DGMMLNE=DGMMLNE+1
190 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
191 . S DGMMLNE=DGMMLNE+1
192 .;
193 . S DIK="^DGMT(408.22,"
194 . S DIK(1)=".06"
195 . D EN^DIK
196 . K DIK
197 ;
198 ;
199 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)="Checking CONTRIBUTED TO SUPPORT field (.1) in the INCOME RELATION file (408.22)..."
200 S DGMMLNE=DGMMLNE+1
201 S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
202 S DGMMLNE=DGMMLNE+1
203 ;
204 S DA=0 F S DA=$O(^DGMT(408.22,DA)) Q:'DA D
205 . S CTS=$P($G(^DGMT(408.22,DA,0)),"^",10) ;Contributed To Support
206 . Q:(+CTS=CTS) Q:(CTS']"")
207 . S $P(^DGMT(408.22,DA,0),"^",10)=$S(CTS="YES":1,CTS="NO":0,1:"")
208 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" CONTRIBUTED TO SUPPORT for "_$P($G(^DPT($P($G(^DGMT(408.22,DA,0)),"^",1),0)),"^",1)_"'s entry "_DA_" has been changed: "
209 . S DGMMLNE=DGMMLNE+1
210 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "_CTS_" has been changed to "_$S(CTS="YES":1,CTS="NO":0,1:"NULL")_"."
211 . S DGMMLNE=DGMMLNE+1
212 . S ^XTMP("DG",JVAL,"PATCH 624 CLEANUP BULLETIN",DGMMLNE)=" "
213 . S DGMMLNE=DGMMLNE+1
214 .;
215 . S DIK="^DGMT(408.22,"
216 . S DIK(1)=".06"
217 . D EN^DIK
218 . K DIK
219 Q
Note: See TracBrowser for help on using the repository browser.