source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVMUT1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1ABSVMUT1 ;OAKLANDFO/DPC-VSS MIGRATIOIN;8/3/2002
2 ;;4.0;VOLUNTARY TIMEKEEPING;**31,33**;Jul 1994
3 ;
4BLDVOLLT(FLAG) ;
5 ;
6 ;FLAG="S" -- Only need site data into ABSSITES()
7 N REGIEN,VOLPTR,SITE,REG0,SRTDATE,ENTRY,TERM
8 K ^TMP("ABSVM","VOLWHRS",$J),ABSSITES
9 S REGIEN=0
10 F S REGIEN=$O(^ABS(503331,REGIEN)) Q:'REGIEN D
11 . S REG0=$G(^ABS(503331,REGIEN,0))
12 . I $P(REG0,U,3)<2961001 Q
13 . S VOLPTR=$P(REG0,U)
14 . S SITE=$P(REG0,U,7)
15 . ;check for excluded sites
16 . Q:(VOLPTR="")!(SITE="") Q:$D(EXSITES(SITE))
17 . I $G(FLAG)="S" S ABSSITES(SITE)="" Q
18 . S ^TMP("ABSVM","VOLWHRS",$J,VOLPTR,SITE)=""
19 . Q
20 ;check for new volunteer's, less than 90 days, with no hours
21 S VOLPTR=0,SRTDATE=$$HTFM^XLFDT($$HADD^XLFDT($H,-90))
22 F S VOLPTR=$O(^ABS(503330,VOLPTR)) Q:VOLPTR="" D
23 . S REGIEN=0
24 . F S REGIEN=$O(^ABS(503330,VOLPTR,4,REGIEN)) Q:'REGIEN D
25 .. S REG0=$G(^ABS(503330,VOLPTR,4,REGIEN,0))
26 .. Q:REG0=""
27 .. ;check for excluded sites
28 .. S SITE=$P(REG0,U,12) Q:SITE="" Q:$D(EXSITES(SITE))
29 .. S ENTRY=$P(REG0,U,2),TERM=$P(REG0,U,8)
30 .. I ENTRY>SRTDATE,TERM="",'$D(^TMP("ABSVM","VOLWHRS",$J,VOLPTR,REGIEN)) S ^(REGIEN)=""
31 .. Q
32 Q
33 ;
34EXSITES ;get exclude sites and put in EXSITES array
35 ;
36 N I,J,X
37 K EXSITES
38 ;there should only be one entry at top level
39 S I=$O(^ABS(503339.5,"IN","N",0)),J=0 Q:I=""
40 F S J=$O(^ABS(503339.5,"IN","N",I,J)) Q:J="" D
41 . S X=$P($G(^ABS(503339.5,I,1,J,0)),U)
42 . S:X]"" EXSITES(X)=""
43 Q
44 ;
45ABSIEN ;get the ien of Migration Log file
46 ;returns ABSIEN=IEN or 0 if failed
47 S ABSIEN=0
48 D LIST^DIC(503339.5)
49 I '^TMP("DILIST",$J,0) D Q
50 . W "You must run the Prepare for Transition to VSS option first."
51 . W !,"If you have any questions, contact the System Implementation team."
52 . Q
53 I ^TMP("DILIST",$J,0)>1 D Q
54 . W "You have multiple entries in the Voluntary Migration Log."
55 . W !,"Contact System Implementation."
56 S ABSIEN=^TMP("DILIST",$J,2,1)
57 ;
58SETUPXTP ;
59 ;Sets up 0-nodes in XTMP
60 S ^XTMP("ABSVMORG",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Voluntary Organizations to be migrated."
61 S ^XTMP("ABSVMSERV",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Voluntary Services to be migrated."
62 S ^XTMP("ABSVMOHRS",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Voluntary Occasional Hours to be migrated."
63 S ^XTMP("ABSVMRHRS",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Voluntary Regular Hours to be migrated."
64 S ^XTMP("ABSVMVOL",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Volunteers to be migrated."
65 S ^XTMP("ABSVMVOLP",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Volunteer Profiles to be migrated."
66 S ^XTMP("ABSVMVOLCB",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Volunteer Combination Codes to be migrated."
67 S ^XTMP("ABSVMVOLPK",0)=$$NOW^XLFDT_U_$$HTFM^XLFDT($$HADD^XLFDT($H,30))_U_"Volunteer Parking Stickers to be migrated."
68 Q
69 ;
70CLEANXTP ;
71 ;Empties all the XTMP()s and TMP holding IENs to Export.
72 K ^XTMP("ABSVMSERV"),^XTMP("ABSVMORG")
73 K ^XTMP("ABSVMRHRS"),^XTMP("ABSVMOHRS")
74 K ^XTMP("ABSVMVOL"),^XTMP("ABSVMVOLP")
75 K ^XTMP("ABSVMVOLCB"),^XTMP("ABSVMVOLPK")
76 K ^TMP("ABSVM","VOLWHRS"),^TMP("ABSVM",$J)
77 Q
78 ;
79LDCDS ;
80 ;Call routines that Load codes for orgs, services,
81 ;work schedules and awards into Local arrays.
82 D LDORGS^ABSVMLC1 ;Organizations into OCDS()
83 D LDSRVS^ABSVMLC2 ;Services into SCDS()
84 D LDWKS^ABSVMLC3 ; Work Schedules into WCDS()
85 D LDAWDS^ABSVMLC3 ;Awards into ACDS()
86 Q
87 ;
88CLEANCDS ;
89 ;Kills local arrays of national codes
90 K OCDS,SCDS,WCDS,ACDS
91 Q
92 ;
93CRERRLOG(RUNTYPE,SEND) ;
94 ;Function that creates an entry in the VALIDATION RESULTS multiple.
95 ;Returns the DA of the subentry.
96 N ABSVMFDA,ABSVMIEN,DIERR,ABSIEN
97 ;Get IEN of Migration Log entry.
98 D ABSIEN Q:'ABSIEN
99 ;Set TIME RUN = NOW
100 S ABSVMFDA(503339.52,"+1,"_ABSIEN_",",.01)=$$NOW^XLFDT
101 ;Set VALIDATED DATA = Type passed in.
102 S ABSVMFDA(503339.52,"+1,"_ABSIEN_",",1)=RUNTYPE
103 I $G(SEND)["S" S ABSVMFDA(503339.52,"+1,"_ABSIEN_",",2)="Y"
104 E S ABSVMFDA(503339.52,"+1,"_ABSIEN_",",2)="N"
105 D UPDATE^DIE(,"ABSVMFDA","ABSVMIEN")
106 I $G(DIERR)="" Q ABSVMIEN(1) ;Successful creation
107 D MSG^DIALOG()
108 Q 0
109 ;
110RECERR(VALRESUL,ERRORS) ;
111 ;Records errors in the VALIDATION RESULTS multiple.
112 ;Also, increments the error count.
113 ;Get IEN of Migration Log entry.
114 I $G(VALRESUL("ERRIEN"))="" D
115 . N ABSIEN
116 . D ABSIEN Q:'ABSIEN
117 . S VALRESUL("ERRIEN")=ABSIEN
118 . Q
119 D WP^DIE(503339.52,VALRESUL("DA")_","_VALRESUL("ERRIEN")_",",4,"A","ERRORS")
120 S VALRESUL("ERRCNT")=$G(VALRESUL("ERRCNT"))+1
121 Q
122 ;
123ERRCNT(VALRESUL) ;
124 ;Records the number of errors during a run.
125 N ABSVMFDA,ABSIEN
126 I $G(VALRESUL("ERRIEN"))="" D
127 . D ABSIEN Q:'ABSIEN
128 . S VALRESUL("ERRIEN")=ABSIEN
129 . Q
130 S ABSVMFDA(503339.52,VALRESUL("DA")_","_VALRESUL("ERRIEN")_",",3)=VALRESUL("ERRCNT")
131 D FILE^DIE(,"ABSVMFDA")
132 Q
133 ;
Note: See TracBrowser for help on using the repository browser.