source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVMVV2.m@ 738

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1ABSVMVV2 ;OAKLANDFO/DPC-VSS MIGRATION;7/18/2002
2 ;;4.0;VOLUNTARY TIMEKEEPING;**31,33,35**;Jul 1994
3 ;
4PROF(VOLIEN,VOLIDEN,FLAG,VALRESP) ;
5 ;
6 N PROFIEN,PROF0,ERRS,OUT
7 N AWARD,AWCDPTR,ENTRY,STATION,STATPTR,TERM
8 S PROFIEN=0
9 F S PROFIEN=$O(^ABS(503330,VOLIEN,4,PROFIEN)) Q:PROFIEN="" D
10 . N ERRS S ERRS=0
11 . S OUT=0
12 . S PROF0=$G(^ABS(503330,VOLIEN,4,PROFIEN,0))
13 . ; if no zero node, clean up children nodes and 'B' cross-ref
14 . I PROF0="" K ^ABS(503330,VOLIEN,4,"B",PROFIEN,PROFIEN),^ABS(503330,VOLIEN,4,PROFIEN) Q
15 . ;STATION NUMBER
16 . D
17 . . S STATPTR=$P(PROF0,U)
18 . . I STATPTR="" D ADDERR^ABSVMVV1(VOLIDEN_"is missing Station information.",.ERRS,VOLIEN) S OUT=1 Q
19 . . S STATION=$P($G(^ABS(503338,STATPTR,0)),U,9)
20 . . Q:$D(EXSITES(STATION)) ;check for excluded sites
21 . . I $L(STATION)>7!(STATION="") D ADDERR^ABSVMVV1(VOLIDEN_"has incorrect Station Number information.",.ERRS,VOLIEN) S OUT=1 Q
22 . . ; if no station number, then set it. This field should alway be there, it is set in a trigger on .01 field
23 . . I $P(PROF0,U,12)="" S $P(PROF0,U,12)=STATION,^ABS(503330,VOLIEN,4,PROFIEN,0)=PROF0 Q
24 . ;ENTRY DATE, if no error then do
25 . D:'OUT
26 . . N DA,DIK
27 . . S ENTRY=$P(PROF0,U,2),DIK="^ABS(503330,"_VOLIEN_",4,"
28 . . ;if no entry date, then delete this station multiple
29 . . I ENTRY="" S DA=PROFIEN,DA(1)=VOLIEN D ^DIK S OUT=1 Q
30 . . ;D ADDERR^ABSVMVV1(VOLIDEN_"is missing Entry Date information.",.ERRS,VOLIEN) Q
31 . . ;Check if hours recorded for that station. Ok if entry date new.
32 . . I '$D(^TMP("ABSVM","VOLWHRS",$J,VOLIEN,STATION))&(+ENTRY<$$HTFM^XLFDT($$HADD^XLFDT($H,-90))) S OUT=1 Q
33 . . N RES D DT^DILF("",ENTRY,.RES)
34 . . I $L($P(ENTRY,"."))'=7!(RES=-1) D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect Entry Date.",.ERRS,VOLIDEN)
35 . ;If OUT, Station Profile should not be sent, record error and QUIT
36 . I OUT D:ERRS>0 RECERR^ABSVMUT1(.VALRESP,.ERRS) Q
37 . ;YEARS
38 . I $P(PROF0,U,3)'?.N D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect value for Years At Station.",ERRS,VOLIEN)
39 . ;PRIOR HOURS
40 . I $P(PROF0,U,20)'?.N D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect value for Prior Years Hours Served.",.ERRS,VOLIEN)
41 . ;CURRENT HOURS
42 . I $P(PROF0,U,21)'?.N D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect value for Current Year Hours Served.",.ERRS,VOLIEN)
43 . ;LAST AWARD HOURS
44 . I $P(PROF0,U,5)'?.N D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect value for Hours Last Award.",.ERRS,VOLIEN)
45 . ;LAST AWARD DATE
46 . S AWARD=$P(PROF0,U,6)
47 . D:AWARD'=""
48 . . N RES D DT^DILF("",AWARD,.RES)
49 . . I $L($P(AWARD,"."))'=7!(RES=-1) D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect Last Award Date.",.ERRS,VOLIDEN)
50 . ;AWARD CODE
51 . S AWCDPTR=$P(PROF0,U,7)
52 . I AWCDPTR'="",'$D(ACDS(AWCDPTR)) D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect Award Code.",.ERRS,.VOLIEN)
53 . ;TERM DATE
54 . S TERM=$P(PROF0,U,8)
55 . D:TERM'=""
56 . . N RES D DT^DILF("",TERM,.RES)
57 . . I $L($P(TERM,"."))'=7!(RES=-1) D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect Termination Date.",.ERRS,VOLIDEN)
58 . ;REMARKS
59 . ;Only 160 characters can be sent. See ABSVM VOLREMARKS function.
60 . D
61 .. N D0,D1,REM,ERRORS
62 .. S D0=VOLIEN,D1=PROFIEN,REM=$$GETREM()
63 .. I $L(REM)>160 D
64 ... S ERRORS(1)="Warning: "_VOLIDEN_"has Remarks greater than 160 characters."
65 ... I $G(VALRES("ERRIEN"))="" D
66 .... N ABSIEN
67 .... D ABSIEN^ABSVMUT1 Q:'ABSIEN
68 .... S VALRES("ERRIEN")=ABSIEN
69 ... D WP^DIE(503339.52,VALRES("DA")_","_VALRES("ERRIEN")_",",4,"A","ERRORS")
70 . ;MEALS?
71 . I ",,0,1,"'[(","_$P(PROF0,U,24)_",") D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect Eligible For Meals code.",.ERRS,VOLIEN)
72 . ;TRANSPORT
73 . I ",,1,2,3,4,"'[(","_$P(PROF0,U,23)_",") D ADDERR^ABSVMVV1(VOLIDEN_"has an incorrect Method of Transportation code.",.ERRS,VOLIEN)
74 . ; Check for errors
75 . I ERRS>0 D RECERR^ABSVMUT1(.VALRESP,.ERRS) Q
76 . ; No errors and got this far; add to send list if FLAG=S
77 . I $G(FLAG)["S" S ^XTMP("ABSVMVOLP","IEN",VOLIEN)=""
78 . ;PARKING STICKERS
79 . D PARKVAL^ABSVMVV3(VOLIEN,PROFIEN,VOLIDEN,$G(FLAG),.VALRESP)
80 Q
81 ;
82GETREM() ;Function to return Remarks field from Voluntary Master
83 N MYIENS,MYROOT,WPREM,REMARKS,I
84 S MYIENS=D1_","_D0_","
85 S MYROOT=$$GET1^DIQ(503330.01,MYIENS,18,,"WPREM")
86 I MYROOT="" Q ""
87 S I=0,REMARKS=""
88 F S I=$O(WPREM(I)) Q:I="" D
89 . ;Avoid string too long error.
90 . I $L(REMARKS)+$L(WPREM(I))>511 S I=99999 Q
91 . S REMARKS=REMARKS_$S($L(REMARKS)>0:" ",1:"")_WPREM(I)
92 Q REMARKS
93 ;
Note: See TracBrowser for help on using the repository browser.