source: FOIAVistA/trunk/r/PAID-PRS/PRSPEAF.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1PRSPEAF ;WOIFO/SAB - Ext. Absence Form ;10/27/2004
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ; This routine is called by the PRSP EXT ABSENCE form (file 458.4)
6 ; within both the enter option and edit option for extended absences.
7 ;
8FRMDOC ; Form PRSP EXT ABSENCE documentation
9 ; input
10 ; PRSEANEW - (optional) true (=1) when extended absence entry is new
11 ; PRSIEN - Employee IEN (file 450)
12 ; DA - Extended Absence IEN (file 458.4)
13 ; DDSPARM - (optional) used by enter option to ask for output
14 ; output
15 ; DDSCHANGE - (optional) used by enter option to determine if signed
16 ;
17FRMPRE ; Form Pre-Action
18 ; input
19 ; PRSEANEW
20 ; output
21 ; PRSFDT(0) - last E-sig From Date
22 ; PRSTDT(0) - last E-sig To Date
23 ; PRSRMK(0) - last E-sig Remarks
24 ;
25 ; load field values that were last E-signed
26 I $G(PRSEANEW) S (PRSFDT(0),PRSTDT(0),PRSRMK(0))=""
27 E D
28 . S PRSFDT(0)=$$GET^DDSVAL(458.4,DA,.01)
29 . S PRSTDT(0)=$$GET^DDSVAL(458.4,DA,1)
30 . S PRSRMK(0)=$$GET^DDSVAL(458.4,DA,6)
31 ;
32 ; if From Date prior to Today, disable edit of From Date
33 I '$G(PRSEANEW),PRSFDT(0)<DT D
34 . D UNED^DDSUTL("FROM DATE",1,1,1,DA_",")
35 . D HLP^DDSUTL("From Date can't be edited because it's prior to Today.")
36 Q
37 ;
38FVAL01 ; Field Validation for From Date (#1) field
39 ; input
40 ; X - current internal value of field
41 ; DDSEXT - current external value of field
42 ; DDSOLD - previous internal value of field
43 ; PRSIEN - Employee IEN (file 450)
44 ; output
45 ; DDSERROR - (optional) set on error to prevent field change
46 ;
47 I X<DT D Q
48 . S DDSERROR=1
49 . D HLP^DDSUTL("From Date must not be prior to Today!")
50 ;
51 I X>$$FMADD^XLFDT(DT,365) D Q
52 . S DDSERROR=1
53 . D HLP^DDSUTL("From Date must not be more than 365 days in Future!")
54 ;
55 I X=DT,$$CHKRG^PRSPEAU(PRSIEN) D Q
56 . S DDSERROR=1
57 . D HLP^DDSUTL("From Date can't be Today because RG already posted on the ESR!")
58 ;
59 ; perform date comparison validation
60 D DTCV(X,$$GET^DDSVAL(458.4,DA,1)) Q:$G(DDSERROR)
61 ;
62 ; if date changed and new date not under memo then warn user
63 I X'=DDSOLD,$$MIEN^PRSPUT1(PRSIEN,X)'>0 D HLP^DDSUTL("Note: New From Date is not covered by a memo.")
64 ;
65 Q
66 ;
67FVAL1 ; Field Validation for To Date (#1) field
68 ; input
69 ; X - current internal value of field
70 ; DDSEXT - current external value of field
71 ; DDSOLD - previous internal value of field
72 ; output
73 ; DDSERROR - (optional) set on error to prevent field change
74 ;
75 ; perform date comparison validation
76 D DTCV($$GET^DDSVAL(458.4,DA,.01),X) Q:$G(DDSERROR)
77 ;
78 I X<DT D Q
79 . S DDSERROR=1
80 . D HLP^DDSUTL("To Date must not be prior to Today!")
81 ;
82 I X=DT,$$CHKRG^PRSPEAU(PRSIEN) D Q
83 . S DDSERROR=1
84 . D HLP^DDSUTL("To Date can't be Today because RG already posted on the ESR!")
85 ;
86 ; if date changed and new date not under memo then warn user
87 I X'=DDSOLD,$$MIEN^PRSPUT1(PRSIEN,X)'>0 D HLP^DDSUTL("Note: New To Date is not covered by a memo.")
88 ;
89 Q
90 ;
91FRMVAL ; Form Validation
92 ; input
93 ; PRSFDT(0) - last E-sig From Date
94 ; PRSTDT(0) - last E-sig To Date
95 ; PRSRMK(0) - last E-sig Remarks
96 ; output
97 ; PRSFDT(1) - current From Date
98 ; PRSTDT(1) - current To Date
99 ; PRSRMK(1) - current Remarks
100 ; PRSLCK( - array of locked pay periods
101 ; DDSERROR - (optional) set on error to prevent save
102 ;
103 ; get current values of fields
104 S PRSFDT(1)=$$GET^DDSVAL(458.4,DA,.01) ; From Date
105 S PRSTDT(1)=$$GET^DDSVAL(458.4,DA,1) ; To Date
106 S PRSRMK(1)=$$GET^DDSVAL(458.4,DA,6) ; Remarks
107 ;
108 ; Skip validation if no changes since last E-Sig
109 Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))&(PRSRMK(1)=PRSRMK(0))
110 ;
111 ; ask for electronic signature
112 D Q:$G(DDSERROR)
113 . N X1
114 . D SIG^XUSESIG
115 . S:X1="" DDSERROR=1
116 ;
117 ; skip remaining step if dates did not change (i.e. only remarks edited)
118 Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))
119 ;
120 ; lock timecards for applicable opened pay periods
121 D TCLCK^PRSPAPU(PRSIEN,PRSFDT(0),PRSTDT(0),PRSFDT(1),PRSTDT(1),.PRSLCK,.PRSLCKE)
122 ;
123 ; if some time cards couldn't be locked then don't accept changes
124 I $D(PRSLCKE) D
125 . N PRSTXT
126 . S DDSERROR=1
127 . D TCULCK^PRSPAPU(PRSIEN,.PRSLCK) ; remove any locks
128 . D RLCKE^PRSPAPU(.PRSLCKE,0,"PRSTXT")
129 . D HLP^DDSUTL(.PRSTXT)
130 . K PRSLCKE
131 ;
132 Q
133 ;
134FRMPSV ; Form Post Save
135 ; input
136 ; - previous signed values x(0) and new signed values x(1)
137 ; - array of locked pay periods
138 ;
139 ; Skip post save if no changes
140 Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))&(PRSRMK(1)=PRSRMK(0))
141 ;
142 N PRSFDA
143 ;
144 ; Update Extended Absence
145 I PRSFDT(0)="" D
146 . S PRSFDA(458.4,DA_",",3)=$$NOW^XLFDT() ; d/t entered
147 . S PRSFDA(458.4,DA_",",5)="A" ; status = active
148 E S PRSFDA(458.4,DA_",",4)=$$NOW^XLFDT() ; d/t updated
149 D FILE^DIE("","PRSFDA") D MSG^DIALOG()
150 ;
151 ; Update signed remark value
152 S PRSRMK(0)=PRSRMK(1)
153 ;
154 ; skip remaining step if dates did not change (i.e. only remarks edited)
155 Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))
156 ;
157 ; Update ESRs for new date range
158 D:'PRSFDT(0) PEA^PRSPEAA(PRSIEN,PRSFDT(1),PRSTDT(1))
159 ; Update ESRs for changed date range
160 D:PRSFDT(0) CEA^PRSPEAA(PRSIEN,PRSFDT(0),PRSTDT(0),PRSFDT(1),PRSTDT(1))
161 ;
162 ; remove time card locks
163 D TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
164 ;
165 ; Update signed date values
166 S PRSFDT(0)=PRSFDT(1)
167 S PRSTDT(0)=PRSTDT(1)
168 Q
169 ;
170FRMPST ; Form Post-Action
171 K PRSFDT(0),PRSFDT(1),PRSRMK(0),PRSRMK(1),PRSTDT(0),PRSTDT(1)
172 Q
173 ;
174DTCV(FDT,TDT) ; Date Compare Validation on FROM DATE and TO DATE fields
175 Q:FDT=""!(TDT="")
176 ;
177 N PRSX
178 ;
179 I FDT>TDT D Q
180 . S DDSERROR=1
181 . D HLP^DDSUTL("From Date must not be later than To Date!")
182 ;
183 I $$FMDIFF^XLFDT(TDT,FDT)>180 D Q
184 . S DDSERROR=1
185 . D HLP^DDSUTL("Difference between From Date and To Date must not exceed 180 days!")
186 ;
187 ; check period for conflict with other EAs
188 S PRSX=$$CONFLICT^PRSPEAU(PRSIEN,FDT,TDT,DA)
189 I PRSX'="" D Q
190 . N PRSTXT
191 . S DDSERROR=1
192 . D RCON^PRSPEAU(PRSX,0,"PRSTXT")
193 . D HLP^DDSUTL(.PRSTXT)
194 ;
195 Q
196 ;
197 ;PRSPEAF
Note: See TracBrowser for help on using the repository browser.