source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVMHV1.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: 6.6 KB
Line 
1ABSVMHV1 ;OAKLANDFO/DPC-VSS MIGRATION;7/26/2002
2 ;;4.0;VOLUNTARY TIMEKEEPING;**31,33,35**;Jul 1994
3 ;
4OHRSVAL(FLAG,VALRES,START,END) ;
5 ;Validate occasional hours data.
6 N OCCIEN,OCC0,OCCIDEN
7 N DATE,ORGPTR,SRVPTR
8 S VALRES("ERRCNT")=0
9 S VALRES("DA")=$$CRERRLOG^ABSVMUT1("O",$G(FLAG))
10 I VALRES("DA")=0 W !,"There was an error creating VALIDATION RESULTS entry for Occasional Hours." Q
11 S OCCIEN=$G(START,0)
12 F S OCCIEN=$O(^ABS(503336,OCCIEN)) Q:'OCCIEN D
13 . N ERRS S ERRS=0
14 . S OCC0=$G(^ABS(503336,OCCIEN,0))
15 . I $P(OCC0,U,3)]"" Q:$D(EXSITES($P(OCC0,U,3))) ;check for excluded sites
16 . S OCCIDEN="Occasional Vol Time Sheet rec #"_OCCIEN_" at "_$P(OCC0,U,3)
17 . I OCC0="" D ADDERR^ABSVMVV1(OCCIDEN_" does not exist.",.ERRS) Q
18 . ;DATE
19 . S DATE=$P($P(OCC0,U,8),".")
20 . I DATE<2961001 Q ;too early
21 . I $L(DATE)'=7!('+$E(DATE,4,5))!('+$E(DATE,6,7)) D ADDERR^ABSVMVV1(OCCIDEN_" has an improper Date field.",.ERRS) Q
22 . ;TRANSMISSION STATUS
23 . I $P(OCC0,U,9)=0 D ADDERR^ABSVMVV1(OCCIDEN_" has a transmission status of SUSPENDED.",.ERRS) Q
24 . I $P(OCC0,U,9)=2 D ADDERR^ABSVMVV1(OCCIDEN_" has a transmission status of ERROR - NOT TRANSMITTED.",.ERRS) Q
25 . ;FACILITY
26 . I $P(OCC0,U,3)="" D ADDERR^ABSVMVV1(OCCIDEN_" is missing a Facility.",.ERRS)
27 . I $L($P(OCC0,U,3))>7 D ADDERR^ABSVMVV1(OCCIDEN_" has a Facility Number longer than 7 characters.",.ERRS)
28 . ;NAME/ORG NAME
29 . I $L($P(OCC0,U,14))>40 D ADDERR^ABSVMVV1(OCCIDEN_" has a Name Or Organization Name longer than 40 characters.",.ERRS)
30 . ;SERVICE
31 . S SRVPTR=$P(OCC0,U,5)
32 . I SRVPTR="" D ADDERR^ABSVMVV1(OCCIDEN_" is missing a Service.",.ERRS)
33 . I SRVPTR'="",'$D(SCDS(SRVPTR)) D ADDERR^ABSVMVV1(OCCIDEN_" has an incorrect Service Code.",.ERRS)
34 . ;ORG
35 . S ORGPTR=$P(OCC0,U,4)
36 . I ORGPTR'="",'$D(OCDS(ORGPTR)) D ADDERR^ABSVMVV1(OCCIDEN_" has an incorrect Organization Code.",.ERRS)
37 . ;GROUP
38 . I $P(OCC0,U,6)="" D ADDERR^ABSVMVV1(OCCIDEN_" is missing the Number In Group.",.ERRS)
39 . I $P(OCC0,U,6)'?.N D ADDERR^ABSVMVV1(OCCIDEN_" has an invalid Number in Group.",ERRS)
40 . ;HOURS
41 . I $P(OCC0,U,7)="" D ADDERR^ABSVMVV1(OCCIDEN_" is missing Total Hours.",.ERRS)
42 . I $P(OCC0,U,7)'?.N D ADDERR^ABSVMVV1(OCCIDEN_" has an invalid Total Hours.",.ERRS)
43 . I ERRS>0 D RECERR^ABSVMUT1(.VALRES,.ERRS) Q
44 . I $G(FLAG)["S" S ^XTMP("ABSVMOHRS","IEN",OCCIEN)=""
45 . Q
46 D ERRCNT^ABSVMUT1(.VALRES)
47 Q
48 ;
49RHRSVAL(FLAG,VALRES,START,END) ;
50 ;Validate regular volunteer hours data.
51 N REGIEN,REG0,REGIDEN
52 N DATE,ORGPTR,SRVPTR,VOLPTR,SCHD
53 S VALRES("ERRCNT")=0
54 S VALRES("DA")=$$CRERRLOG^ABSVMUT1("R",$G(FLAG))
55 I VALRES("DA")=0 W !,"There was an error creating VALIDATION RESULTS entry for Regular Hours." Q
56 S REGIEN=$G(START,0)
57 F S REGIEN=$O(^ABS(503331,REGIEN)) Q:'REGIEN D
58 . N ERRS S ERRS=0
59 . S REG0=$G(^ABS(503331,REGIEN,0))
60 . I $P(REG0,U,7)]"" Q:$D(EXSITES($P(REG0,U,7))) ;check for excluded sites
61 . S REGIDEN="Vol Daily Time rec #"_REGIEN_" at "_$P(REG0,U,7)
62 . I REG0="" D ADDERR^ABSVMVV1(REGIDEN_" does not exist.",.ERRS) Q
63 . ;DATE
64 . S DATE=$P($P(REG0,U,3),".")
65 . I DATE<2961001 Q ;too early
66 . I $L(DATE)'=7!('+$E(DATE,4,5))!('+$E(DATE,6,7)) D ADDERR^ABSVMVV1(REGIDEN_" has an improper Date field.",.ERRS) Q
67 . ;FACILITY
68 . I $P(REG0,U,7)="" D ADDERR^ABSVMVV1(REGIDEN_" is missing a Facility.",.ERRS)
69 . I $L($P(REG0,U,7))>7 D ADDERR^ABSVMVV1(REGIDEN_" has a Facility Number longer than 7 characters.",.ERRS)
70 . ;VOLUNTEER
71 . S VOLPTR=$P(REG0,U)
72 . I VOLPTR="" D ADDERR^ABSVMVV1(REGIDEN_" is missing a Volunteer.",.ERRS)
73 . I VOLPTR'="",$G(FLAG)["S",'$D(^XTMP("ABSVMVOL","IEN",VOLPTR)) Q ;D ADDERR^ABSVMVV1(REGIDEN_" has an incorrect Volunteer pointer.",.ERRS)
74 . I VOLPTR'="",$G(FLAG)'["S",$G(^ABS(503330,VOLPTR,0))="" D ADDERR^ABSVMVV1(REGIDEN_" has an incorrect Volunteer pointer.",.ERRS)
75 . ;SERVICE
76 . S SRVPTR=$P(REG0,U,8)
77 . I SRVPTR="" D ADDERR^ABSVMVV1(REGIDEN_" is missing a Service.",.ERRS)
78 . I SRVPTR'="",'$D(SCDS(SRVPTR)) D ADDERR^ABSVMVV1(REGIDEN_" has an incorrect Service Code.",.ERRS)
79 . ;ORG
80 . S ORGPTR=$P(REG0,U,4)
81 . I ORGPTR="" D ADDERR^ABSVMVV1(REGIDEN_" is missing an Organization Code.",.ERRS)
82 . I ORGPTR'="",'$D(OCDS(ORGPTR)) D ADDERR^ABSVMVV1(REGIDEN_" has an incorrect Organization Code.",.ERRS)
83 . ;SCHEDULE
84 . S SCHD=$E($P(REG0,U,6),4)
85 . I SCHD="" D ADDERR^ABSVMVV1(REGIDEN_" is missing a Work Schedule Code in its Combination Code.",.ERRS)
86 . I SCHD'="",'$D(WCDS("CD",SCHD)) D ADDERR^ABSVMVV1(REGIDEN_" has an incorrect Work Schedule Code.",.ERRS)
87 . ;HOURS
88 . I $P(REG0,U,5)="" D ADDERR^ABSVMVV1(REGIDEN_" is missing Total Hours.",.ERRS)
89 . I $P(REG0,U,5)'?.N D ADDERR^ABSVMVV1(REGIDEN_" has an invalid Total Hours.",.ERRS)
90 . I ERRS>0 D RECERR^ABSVMUT1(.VALRES,.ERRS) Q
91 . I $G(FLAG)["S" D
92 . . ;Putting data into FY Quarters arrays in prep for sending.
93 . . I DATE<2970101 S ^XTMP("ABSVMRHRS","IEN","97Q1",REGIEN)="" Q
94 . . I DATE<2970401 S ^XTMP("ABSVMRHRS","IEN","97Q2",REGIEN)="" Q
95 . . I DATE<2970701 S ^XTMP("ABSVMRHRS","IEN","97Q3",REGIEN)="" Q
96 . . I DATE<2971001 S ^XTMP("ABSVMRHRS","IEN","97Q4",REGIEN)="" Q
97 . . I DATE<2980101 S ^XTMP("ABSVMRHRS","IEN","98Q1",REGIEN)="" Q
98 . . I DATE<2980401 S ^XTMP("ABSVMRHRS","IEN","98Q2",REGIEN)="" Q
99 . . I DATE<2980701 S ^XTMP("ABSVMRHRS","IEN","98Q3",REGIEN)="" Q
100 . . I DATE<2981001 S ^XTMP("ABSVMRHRS","IEN","98Q4",REGIEN)="" Q
101 . . I DATE<2990101 S ^XTMP("ABSVMRHRS","IEN","99Q1",REGIEN)="" Q
102 . . I DATE<2990401 S ^XTMP("ABSVMRHRS","IEN","99Q2",REGIEN)="" Q
103 . . I DATE<2990701 S ^XTMP("ABSVMRHRS","IEN","99Q3",REGIEN)="" Q
104 . . I DATE<2991001 S ^XTMP("ABSVMRHRS","IEN","99Q4",REGIEN)="" Q
105 . . I DATE<3000101 S ^XTMP("ABSVMRHRS","IEN","00Q1",REGIEN)="" Q
106 . . I DATE<3000401 S ^XTMP("ABSVMRHRS","IEN","00Q2",REGIEN)="" Q
107 . . I DATE<3000701 S ^XTMP("ABSVMRHRS","IEN","00Q3",REGIEN)="" Q
108 . . I DATE<3001001 S ^XTMP("ABSVMRHRS","IEN","00Q4",REGIEN)="" Q
109 . . I DATE<3010101 S ^XTMP("ABSVMRHRS","IEN","01Q1",REGIEN)="" Q
110 . . I DATE<3010401 S ^XTMP("ABSVMRHRS","IEN","01Q2",REGIEN)="" Q
111 . . I DATE<3010701 S ^XTMP("ABSVMRHRS","IEN","01Q3",REGIEN)="" Q
112 . . I DATE<3011001 S ^XTMP("ABSVMRHRS","IEN","01Q4",REGIEN)="" Q
113 . . I DATE<3020101 S ^XTMP("ABSVMRHRS","IEN","02Q1",REGIEN)="" Q
114 . . I DATE<3020401 S ^XTMP("ABSVMRHRS","IEN","02Q2",REGIEN)="" Q
115 . . I DATE<3020701 S ^XTMP("ABSVMRHRS","IEN","02Q3",REGIEN)="" Q
116 . . I DATE<3021001 S ^XTMP("ABSVMRHRS","IEN","02Q4",REGIEN)="" Q
117 . . I DATE<3030101 S ^XTMP("ABSVMRHRS","IEN","03Q1",REGIEN)="" Q
118 . . I DATE<3030401 S ^XTMP("ABSVMRHRS","IEN","03Q2",REGIEN)="" Q
119 . . I DATE<3030701 S ^XTMP("ABSVMRHRS","IEN","03Q3",REGIEN)="" Q
120 . . I DATE<3031001 S ^XTMP("ABSVMRHRS","IEN","03Q4",REGIEN)="" Q
121 . . I DATE<3040101 S ^XTMP("ABSVMRHRS","IEN","04Q1",REGIEN)="" Q
122 . . Q
123 . Q
124 D ERRCNT^ABSVMUT1(.VALRES)
125 Q
126 ;
Note: See TracBrowser for help on using the repository browser.