source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVM.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 8.9 KB
Line 
1ABSVM ;OAKLANDFO/DPC - VSS MIGRATION;8/23/2002
2 ;;4.0;VOLUNTARY TIMEKEEPING;**31,33**;Jul 1994
3 ;
4 ;
5PREP ;
6 ;Entry point for the Prepare For Transition option.
7 ;Accomplishes the initial setup.
8 N ABSSITE,SITENUM,DIR,I,DIERR,ABSFDA,ABSIEN
9 N ABSSITES ;This array is created in BLDVOLLT^ABSVMUT1.
10 W @IOF
11 ;Check for existing entries.
12 D LIST^DIC(503339.5)
13 I ^TMP("DILIST",$J,0) D Q
14 . W !!,"This option has already been run. The Migration Process is started."
15 . W !,"Continue the Migration process with another option."
16 . W !,"Contact the System Implementation team if you need additional instructions."
17 . Q
18 ;
19 W "You are starting the process that will move "
20 W !,"Voluntary Timekeeping data to the new "
21 W !,"Voluntary Service System application."
22 W !!,"First, information about your site will be collected."
23 ;this get the Station Number from Institution file
24 S ABSSITE=$P($G(^DIC(4,+$$KSP^XUPARAM("INST"),99)),U)
25 I ABSSITE="" W !!,"There is no Station Number for your site, Contact System Implementation team!!!" Q
26 W !,"Your Volunteer Daily Time file will be scanned to find "
27 W !,"all sites referenced. This will take some time.",!
28 D BLDVOLLT^ABSVMUT1("S")
29 W !,"Done."
30 W !!,"Your primary site number is "_ABSSITE_"."
31 W !,"Volunteer Hours are recorded for the following sites:"
32 S SITENUM=0
33 F I=0:1 S SITENUM=$O(ABSSITES(SITENUM)) Q:SITENUM="" W !,?20,SITENUM
34 W !!,"The next section will allow you to designate which of the above sites",!,"you want data sent from. Your primary site will default to 'YES' ",!
35 I I W "Any Games site,(700, 701, 702, or 575W), will default to 'NO'.",!
36 S DIR(0)="Y"
37 S DIR("A")="Do you want to continue"
38 S DIR("??")="If the information is not correct, answer NO. The preparation process will be stopped for now."
39 D ^DIR
40 W !!
41 I 'Y W "CONTACT THE IMPLEMENTATION TEAM. PROCESS STOPPED FOR NOW." Q
42 W "Making an entry in the Voluntary Migration Log file."
43 S ABSFDA(503339.5,"+1,",.01)=ABSSITE,SITENUM=0
44 F I=2:1 S SITENUM=$O(ABSSITES(SITENUM)) Q:SITENUM="" D
45 . S ABSFDA(503339.51,"+"_I_",+1,",.01)=SITENUM
46 . ;setup games site for no sending of data
47 . S:"^700^701^702^575W^"[(U_SITENUM_U) ABSFDA(503339.51,"+"_I_",+1,",.02)="N"
48 D UPDATE^DIE("E","ABSFDA","ABSIEN")
49 I $D(DIERR) W ! D MSG^DIALOG() Q
50 D SITEINFO(ABSIEN(1))
51 W !
52 D SENDMSG(ABSIEN(1))
53 Q
54 ;
55SITEINFO(ABSIEN) ;
56 ;User Inputs data for sites
57 N ABSROOT,I,DIE,DA,DR,DIERR,SITENUM
58 D LIST^DIC(503339.51,","_ABSIEN_",",1,,,,,,,,"ABSROOT")
59 I $D(DIERR) W ! D MSG^DIALOG() Q
60 F I=1:1:+ABSROOT("DILIST",0) D
61 . S DIE="^ABS(503339.5,"_ABSIEN_",1,",SITENUM=ABSROOT("DILIST",1,I)
62 . S DA=ABSROOT("DILIST",2,I),DA(1)=ABSIEN
63 . D
64 .. ;check for primary or games site
65 .. I SITENUM=ABSSITE S DR="W ""Send this Station's Data?: YES"";.02///YES;1:11" Q
66 .. I "^700^701^702^575W^"[(U_SITENUM_U) S DR="W ""Send this Station's Data?: NO"";.02///NO" Q
67 .. S DR=".02//YES;S:X=""N"" Y=0;1:11"
68 .. Q
69 . S DIE("NO^")="BACK"
70 . W !!,?20,"Add information for Station Number "_SITENUM,!
71 . D ^DIE
72 . Q
73 ;save codes
74 W !!,"Saving information...",!
75 D SAVE^ABSVMLC1,SAVE^ABSVMLC2
76 Q
77 ;
78SENDMSG(NEWIEN) ;
79 N ABSMSG,OUT,ABSRECIP,DIR,DIRUT,X,Y
80 N MSGNUM,ABSSUBJ,ABSMSG,ABSRECIP
81 S OUT=0
82 W !,"Sending a message containing information about your site."
83 F Q:OUT D
84 . S DIR(0)="FAO"
85 . S DIR("A")="Enter a Recipient of the Institution Creation message: "
86 . S DIR("?")="See the Install Instructions for the recipients e-mail address."
87 . S DIR("?",1)="Network e-mail addresses must contain '@'."
88 . D ^DIR
89 . I $G(DIRUT) D
90 . . I $D(ABSRECIP) S OUT=1 Q ;At least 1 recipient selected.
91 . . N DIR,X,Y,DIRUT,DIK,DA
92 . . W !!,"You must enter at least one recipient of the message."
93 . . W !,"If you do not, you will need to run the Preparation option again"
94 . . W !,"and re-enter all information.",!
95 . . S DIR(0)="Y"
96 . . S DIR("A")="Do you want to exit the Preparation option and run it again later"
97 . . S DIR("B")="No"
98 . . D ^DIR
99 . . I Y D
100 . . . W !!,"Rerun Preparation later. BYE."
101 . . . ;Delete entry in Migration Log.
102 . . . S DIK="^ABS(503339.5,",DA=NEWIEN
103 . . . D ^DIK
104 . . . S OUT=1
105 . . . Q
106 . . Q
107 . E S ABSRECIP(X)=""
108 . Q
109 I '$D(ABSRECIP) Q ;No recipients selected.
110 S ABSSUBJ="VSS: Institution Creation Message from: "_$P($G(^DIC(4,+$$KSP^XUPARAM("INST"),99)),U)
111 D BLDMSG(.ABSMSG,NEWIEN)
112 D SENDMSG^XMXAPI(DUZ,ABSSUBJ,"ABSMSG",.ABSRECIP,,.MSGNUM)
113 W !,"Message sent. Message number: "_MSGNUM
114 Q
115 ;
116BLDMSG(MSGBODY,NEWIEN) ;
117 N I,LNCNT,TEXT
118 S LNCNT=0
119 S TEXT="This is a VSS migration message."
120 D ADDLN(TEXT,.MSGBODY,.LNCNT)
121 S TEXT="It contains information needed to create an entry in the VtkInstitutions table."
122 D ADDLN(TEXT,.MSGBODY,.LNCNT,1)
123 S TEXT="The message is sent from Station Number: "_$P($G(^DIC(4,+$$KSP^XUPARAM("INST"),99)),U)_"."
124 D ADDLN(TEXT,.MSGBODY,.LNCNT,1)
125 S TEXT="The sender is "_$$GET1^DIQ(200,DUZ_",",.01)_" (DUZ= "_DUZ_")."
126 D ADDLN(TEXT,.MSGBODY,.LNCNT)
127 ;GET the list of station numbers.
128 N FLDNUM,ABSIEN,VALUE,FIELD
129 D LIST^DIC(503339.51,","_NEWIEN_",",1,,,"X",,"SN",,,"ABSROOT")
130 I $D(DIERR) W ! D MSG^DIALOG() Q
131 ;Assemble the message for each site.
132 F I=1:1:+ABSROOT("DILIST",0) D
133 . S TEXT=" INFORMATION FOR STATION NUMBER: "_ABSROOT("DILIST","ID",I,.01)
134 . D ADDLN(TEXT,.MSGBODY,.LNCNT,1)
135 . S ABSIEN=ABSROOT("DILIST",2,I)_","_NEWIEN_","
136 . ;Fieldnames and values are obtained for Voluntary Migration Log.
137 . ;Note changes to the DD will require changes to this code.
138 . F FLDNUM=1:1:11 D
139 . . S FIELD=$$GET1^DID(503339.51,FLDNUM,,"LABEL")
140 . . S VALUE=$$GET1^DIQ(503339.51,ABSIEN,FLDNUM)
141 . . S TEXT=FIELD_": "_VALUE
142 . . D ADDLN(TEXT,.MSGBODY,.LNCNT,1)
143 . . Q
144 . Q
145 Q
146 ;
147ADDLN(LINE,BODY,COUNT,SKIP) ;
148 I $G(SKIP) S COUNT=COUNT+1,BODY(COUNT)=" "
149 S COUNT=COUNT+1
150 S BODY(COUNT)=LINE
151 Q
152 ;
153VAL ;
154 ;Entry point for Validate Existing Data Option
155 ;Checks all data that will be migrated and creates log entries
156 ;containing entries with problems.
157 ;Optionally, you can print results.
158 N DIR,Y,ABSRES,ABSRESDA,ABSIEN,EXSITES
159 W @IOF
160 ;Check to assure entry exists in Migration Log file.
161 D ABSIEN^ABSVMUT1 Q:'ABSIEN
162 W "Data that will be moved to the new Voluntary Service System database"
163 W !," will now be checked for consistency."
164 W !!,"The result will be recorded in the Voluntary Migration Log File."
165 W !,"You will have the opportunity to print these results."
166 W !!
167 ;
168 S DIR(0)="Y"
169 S DIR("A")="Do you want to proceed"
170 S DIR("??")="If you answer NO, you can check the data at a later time."
171 D ^DIR
172 I 'Y W !!,"Data checking can be done at a later time. Bye." Q
173 ;
174 W !!,"Creating list of all Volunteers with hours after Sept. 30, 1996."
175 D EXSITES^ABSVMUT1
176 D BLDVOLLT^ABSVMUT1()
177 W !,"Done."
178 ;
179 W !!,"Creating lists of valid Organization, Service, Schedule, and Award Codes."
180 D LDCDS^ABSVMUT1
181 W !,"Done."
182 ;
183 W !!,"Validating entries in the Volunteer Organization Codes File."
184 D ORGVAL^ABSVMRV1(,.ABSRES)
185 W !,"Errors Found in Organization Codes: "_ABSRES("ERRCNT")
186 S ABSRESDA(ABSRES("DA"))=""
187 ;
188 W !!,"Validating entries in the Service Assignment Codes File."
189 D SRVVAL^ABSVMRV1(,.ABSRES)
190 W !,"Errors found in Service Assignment Codes: "_ABSRES("ERRCNT")
191 S ABSRESDA(ABSRES("DA"))=""
192 ;
193 W !!,"Validating Occasional Hours."
194 D OHRSVAL^ABSVMHV1(,.ABSRES)
195 W !,"Errors found in Occasional Hours: "_ABSRES("ERRCNT")
196 S ABSRESDA(ABSRES("DA"))=""
197 ;
198 W !!,"Validating Regular Hours."
199 W !,"THIS WILL TAKE SOME TIME."
200 D RHRSVAL^ABSVMHV1(,.ABSRES)
201 W !,"Errors found in Regular Hours: "_ABSRES("ERRCNT")
202 S ABSRESDA(ABSRES("DA"))=""
203 ;
204 W !!,"Validating Volunteer data."
205 W !,"THIS WILL TAKE SOME TIME."
206 D VALVOL^ABSVMVV1(,.ABSRES)
207 W !,"Errors found in Volunteer data: "_ABSRES("ERRCNT")
208 S ABSRESDA(ABSRES("DA"))=""
209 ;
210 W !!,"The data checking on your system is complete!"
211 D CLEANCDS^ABSVMUT1 ;Kills arrays of National Codes
212 ;
213 W !!
214 S DIR(0)="Y"
215 S DIR("A")="Do you want to print the results now"
216 S DIR("??")="If you answer NO, you can print the results later."
217 D ^DIR
218 I Y D PRINTRES(.ABSRESDA,ABSIEN)
219 Q
220 ;
221PRINT ;
222 ;Prints entries from the VALIDATION RESULTS multiple of Voluntary Migration Log file.
223 N DIC,Y,DA
224 N ABSI,ABSVDA,DIR,ABSIEN
225 N OUT S OUT=0
226 W @IOF
227 ;Check to assure entry exists in Migration Log file.
228 D ABSIEN^ABSVMUT1 Q:'ABSIEN
229 W "You can print results of the Examination of Existing Data "
230 W !,"by selecting the date/time that the examination was done."
231 W !
232 F ABSI=1:1 D Q:OUT
233 . S DIC="^ABS(503339.5,"_ABSIEN_",2,"
234 . S DIC(0)="AE"
235 . D ^DIC
236 . I Y=-1 S OUT=1 Q
237 . S ABSVDA(+Y)=""
238 . W !
239 . S DIR(0)="Y"
240 . S DIR("A")="Do you want to select another result to print"
241 . D ^DIR
242 . I 'Y S OUT=1 Q
243 . W !
244 . Q
245 I $D(ABSVDA) D PRINTRES(.ABSVDA,ABSIEN)
246 Q
247 ;
248PRINTRES(ABSVMDA,ABSMIEN) ;
249 ;Prints preselected subentries in the VALIDATION RESULTS multiple
250 ;passed in by the input parameter (passed by reference).
251 N ABSI,POP,DA,DIC
252 D ^%ZIS
253 Q:$G(POP)
254 U IO
255 S ABSI=0
256 F S ABSI=$O(ABSVMDA(ABSI)) Q:ABSI="" D
257 . W @IOF
258 . W "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
259 . S DIC="^ABS(503339.5,"_ABSMIEN_",2,"
260 . S DA(1)=1
261 . S DA=ABSI
262 . D EN^DIQ
263 . Q
264 D ^%ZISC
265 Q
266 ;
Note: See TracBrowser for help on using the repository browser.