source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVMVV1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1ABSVMVV1 ;OAKLANDFO/DPC-VSS MIGRATION;7/9/2002
2 ;;4.0;VOLUNTARY TIMEKEEPING;**31,33**;Jul 1994
3 ;
4 ;
5VALVOL(FLAG,VALRES,START,END) ;Beginning of validation of volunteer data
6 ;FLAG=S Send mode; so, build sort template array in XTMP.
7 N VOLIEN
8 N VOLCNT
9 ;
10 K ^TMP("ABSVM",$J)
11 S VALRES("ERRCNT")=0
12 S VALRES("DA")=$$CRERRLOG^ABSVMUT1("V",$G(FLAG))
13 I VALRES("DA")=0 W !,"There was an error creating VALIDATION RESULTS entry for Volunteers." Q
14 S VOLIEN=$G(START,0),END=$G(END,999999999999999),VOLCNT=0
15 F S VOLIEN=$O(^ABS(503330,VOLIEN)) Q:VOLIEN=""!(VOLIEN>END) D
16 . S VOLCNT=VOLCNT+1
17 . D VOLVAL($G(FLAG),VOLIEN)
18 . Q
19 D ERRCNT^ABSVMUT1(.VALRES)
20 Q
21 ;
22VOLVAL(FLAG,VOLIEN) ;
23 N VOL0,VOLIDEN,ERRS,VOL3
24 N VOLNAME,SSN,AD1,CITY,DOB,LANG,SEX,STPTR,ZIP
25 ;Check if Volunteer had hours. If not, don't process.
26 ;Need to add exception for brand new volunteers (entry < 3 mos.)
27 I '$D(^TMP("ABSVM","VOLWHRS",$J,VOLIEN)) Q
28 S ERRS=0
29 S VOL0=$G(^ABS(503330,VOLIEN,0))
30 S VOL3=$G(^ABS(503330,VOLIEN,3))
31 ;IEN
32 I VOL0="" D ADDERR("Volunteer record #"_VOLIEN_" does not exist",.ERRS) D RECERR^ABSVMUT1(.VALRES,.ERRS) Q
33 ;NAME
34 S VOLNAME=$P(VOL0,U,1)
35 I VOLNAME="" D ADDERR("Volunteer record #"_VOLIEN_" does not have a volunteer name.",.ERRS)
36 S VOLIDEN="Volunteer record #"_VOLIEN_" with Name "_VOLNAME_" "
37 D STDNAME^XLFNAME(.VOLNAME,"C")
38 I VOLNAME("FAMILY")="" D ADDERR(VOLIDEN_"is missing a last name.",.ERRS)
39 I $L(VOLNAME("FAMILY"))>30 D ADDERR(VOLIDEN_"has a last name longer than 30 characters.",.ERRS)
40 I VOLNAME("GIVEN")="" D ADDERR(VOLIDEN_"is missing a first name.",.ERRS)
41 I $L(VOLNAME("GIVEN"))>30 D ADDERR(VOLIDEN_"has a first name longer than 30 characters.",.ERRS)
42 I $L(VOLNAME("MIDDLE"))>20 D ADDERR(VOLIDEN_"has a middle name longer than 20 characters.",.ERRS)
43 I $L(VOLNAME("SUFFIX"))>10 D ADDERR(VOLIDEN_"has a name suffix longer than 10 characters.",.ERRS)
44 ;SSN
45 D
46 . S SSN=$P(VOL0,U,2)
47 . I SSN="" D ADDERR(VOLIDEN_"is missing a Social Security Number.",.ERRS) Q
48 . I SSN'?9N D ADDERR(VOLIDEN_" has an incorrect SSN: "_SSN_".",.ERRS) Q
49 . I $D(^TMP("ABSVM",$J,"SSN",SSN)) D Q
50 .. N ERRORS
51 .. S ERRORS(1)="Warning: "_VOLIDEN_"has a duplicate SSN with record "_^TMP("ABSVM",$J,"SSN",SSN)
52 .. I $G(VALRES("ERRIEN"))="" D
53 ... N ABSIEN
54 ... D ABSIEN^ABSVMUT1 Q:'ABSIEN
55 ... S VALRES("ERRIEN")=ABSIEN
56 ... Q
57 .. D WP^DIE(503339.52,VALRES("DA")_","_VALRES("ERRIEN")_",",4,"A","ERRORS")
58 .. Q
59 . S ^TMP("ABSVM",$J,"SSN",SSN)=VOLIEN
60 ;ADDR #1
61 S AD1=$P(VOL0,U,3)
62 I AD1="" D ADDERR(VOLIDEN_"is missing first line of address.",.ERRS)
63 I $L(AD1)>35 D ADDERR(VOLIDEN_"has a first line of address longer than 35 characters.",.ERRS)
64 ;CITY
65 S CITY=$P(VOL0,U,4)
66 I CITY="" D ADDERR(VOLIDEN_"is missing a city.",.ERRS)
67 I $L(CITY)>30 D ADDERR(VOLIDEN_"has a city longer than 30 characters.",ERRS)
68 ;STATE
69 ;MAY NEED CHECK ABBREVIATION AGAINST AN ACCEPTABLE LIST.
70 S STPTR=$P(VOL0,U,5)
71 I STPTR="" D ADDERR(VOLIDEN_"is missing a state.",.ERRS)
72 I STPTR'="",$L($P($G(^DIC(5,STPTR,0)),U,2))'=2 D ADDERR(VOLIDEN_"has incorrect state data.",.ERRS)
73 ;ZIP
74 S ZIP=$P(VOL0,U,6)
75 I ZIP="" D ADDERR(VOLIDEN_"is missing a zip code.",.ERRS)
76 I $L(ZIP)>10 D ADDERR(VOLIDEN_"has a zip code longer than 10 characters.",.ERRS)
77 ;SEX
78 S SEX=$P(VOL0,U,7)
79 I SEX="" D ADDERR(VOLIDEN_"is missing a gender designation.",.ERRS)
80 I ",M,F,B,G,"'[(","_SEX_",") D ADDERR(VOLIDEN_"has incorrect sex data.",.ERRS)
81 ;DOB
82 D
83 . S DOB=$P(VOL0,U,8)
84 . I DOB="" D ADDERR(VOLIDEN_"is missing a data of birth.",.ERRS) Q
85 . N RES D DT^DILF("",DOB,.RES)
86 . I $L($P(DOB,"."))'=7!(RES=-1) D ADDERR(VOLIDEN_"has incorrect date of birth date.",.ERRS)
87 . Q
88 ;NICK NAME
89 I $L($P(VOL0,U,9))>20 D ADDERR(VOLIDEN_"has a nick name longer than 20 characters.",.ERRS)
90 ;ADDR #2
91 I $L($P(VOL0,U,10))>35 D ADDERR(VOLIDEN_"has a second line of address longer than 35 characters.",.ERRS)
92 ;LANGUAGE
93 S LANG=$P(VOL0,U,11)
94 I LANG'="",",1,2,"'[(","_LANG_",") D ADDERR(VOLIDEN_"has an incorrect preferred language code.",.ERRS)
95 ;PSEUDO SSN
96 I $P(VOL0,U,18)'="P",$P(VOL0,1,18)'="" D ADDERR(VOLIDEN_"has an incorect psuedo SSN indicator",.ERRS)
97 ;CODE
98 I $L($P(VOL0,U,22))>5 D ADDERR(VOLIDEN_"has a Code longer than 5 characters.",.ERRS)
99 ;NOK
100 I $L($P(VOL3,U,1))>30 D ADDERR(VOLIDEN_"has a Next of Kin longer than 30 characters.",.ERRS)
101 ;PHONE
102 I $L($P(VOL3,U,2))>30 D ADDERR(VOLIDEN_"has a Telephone Number longer than 30 characters.",.ERRS)
103 ;NOK RELATIONSHIP
104 I $L($P(VOL3,U,3))>15 D ADDERR(VOLIDEN_"has a Kin's Relationship longer than 15 characters.",.ERRS)
105 ;NOK TELEPHONE
106 I $L($P(VOL3,U,4))>30 D ADDERR(VOLIDEN_"has a Kin's Telephone longer than 30 characters.",.ERRS)
107 ;NOK ALT PHONE
108 I $L($P(VOL3,U,5))>30 D ADDERR(VOLIDEN_"has a Kin's Alternate Phone longer than 30 characters.")
109 ;ALT PHONE
110 I $L($P(VOL3,U,7))>30 D ADDERR(VOLIDEN_"has an Alternate Phone longer than 30 characters.",.ERRS)
111 ;Record errors
112 I ERRS>0 D RECERR^ABSVMUT1(.VALRES,.ERRS)
113 ;If no errors, proceed and add to sort template.
114 I $G(FLAG)["S",'ERRS S ^XTMP("ABSVMVOL","IEN",VOLIEN)=""
115 ;STATION PROFILE
116 D PROF^ABSVMVV2(VOLIEN,VOLIDEN,$G(FLAG),.VALRES)
117 ;COMBINATIONS
118 D COMBVAL^ABSVMVV3(VOLIEN,VOLIDEN,$G(FLAG),.VALRES)
119 ;
120 Q
121 ;
122ADDERR(ERRMSG,ERRS,ABSVIEN) ;
123 S ERRS=ERRS+1
124 S ERRS(ERRS)=ERRMSG
125 Q
Note: See TracBrowser for help on using the repository browser.