PRSPEAF ;WOIFO/SAB - Ext. Absence Form ;10/27/2004
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
; This routine is called by the PRSP EXT ABSENCE form (file 458.4)
; within both the enter option and edit option for extended absences.
;
FRMDOC ; Form PRSP EXT ABSENCE documentation
; input
; PRSEANEW - (optional) true (=1) when extended absence entry is new
; PRSIEN - Employee IEN (file 450)
; DA - Extended Absence IEN (file 458.4)
; DDSPARM - (optional) used by enter option to ask for output
; output
; DDSCHANGE - (optional) used by enter option to determine if signed
;
FRMPRE ; Form Pre-Action
; input
; PRSEANEW
; output
; PRSFDT(0) - last E-sig From Date
; PRSTDT(0) - last E-sig To Date
; PRSRMK(0) - last E-sig Remarks
;
; load field values that were last E-signed
I $G(PRSEANEW) S (PRSFDT(0),PRSTDT(0),PRSRMK(0))=""
E D
. S PRSFDT(0)=$$GET^DDSVAL(458.4,DA,.01)
. S PRSTDT(0)=$$GET^DDSVAL(458.4,DA,1)
. S PRSRMK(0)=$$GET^DDSVAL(458.4,DA,6)
;
; if From Date prior to Today, disable edit of From Date
I '$G(PRSEANEW),PRSFDT(0)<DT D
. D UNED^DDSUTL("FROM DATE",1,1,1,DA_",")
. D HLP^DDSUTL("From Date can't be edited because it's prior to Today.")
Q
;
FVAL01 ; Field Validation for From Date (#1) field
; input
; X - current internal value of field
; DDSEXT - current external value of field
; DDSOLD - previous internal value of field
; PRSIEN - Employee IEN (file 450)
; output
; DDSERROR - (optional) set on error to prevent field change
;
I X<DT D Q
. S DDSERROR=1
. D HLP^DDSUTL("From Date must not be prior to Today!")
;
I X>$$FMADD^XLFDT(DT,365) D Q
. S DDSERROR=1
. D HLP^DDSUTL("From Date must not be more than 365 days in Future!")
;
I X=DT,$$CHKRG^PRSPEAU(PRSIEN) D Q
. S DDSERROR=1
. D HLP^DDSUTL("From Date can't be Today because RG already posted on the ESR!")
;
; perform date comparison validation
D DTCV(X,$$GET^DDSVAL(458.4,DA,1)) Q:$G(DDSERROR)
;
; if date changed and new date not under memo then warn user
I X'=DDSOLD,$$MIEN^PRSPUT1(PRSIEN,X)'>0 D HLP^DDSUTL("Note: New From Date is not covered by a memo.")
;
Q
;
FVAL1 ; Field Validation for To Date (#1) field
; input
; X - current internal value of field
; DDSEXT - current external value of field
; DDSOLD - previous internal value of field
; output
; DDSERROR - (optional) set on error to prevent field change
;
; perform date comparison validation
D DTCV($$GET^DDSVAL(458.4,DA,.01),X) Q:$G(DDSERROR)
;
I X<DT D Q
. S DDSERROR=1
. D HLP^DDSUTL("To Date must not be prior to Today!")
;
I X=DT,$$CHKRG^PRSPEAU(PRSIEN) D Q
. S DDSERROR=1
. D HLP^DDSUTL("To Date can't be Today because RG already posted on the ESR!")
;
; if date changed and new date not under memo then warn user
I X'=DDSOLD,$$MIEN^PRSPUT1(PRSIEN,X)'>0 D HLP^DDSUTL("Note: New To Date is not covered by a memo.")
;
Q
;
FRMVAL ; Form Validation
; input
; PRSFDT(0) - last E-sig From Date
; PRSTDT(0) - last E-sig To Date
; PRSRMK(0) - last E-sig Remarks
; output
; PRSFDT(1) - current From Date
; PRSTDT(1) - current To Date
; PRSRMK(1) - current Remarks
; PRSLCK( - array of locked pay periods
; DDSERROR - (optional) set on error to prevent save
;
; get current values of fields
S PRSFDT(1)=$$GET^DDSVAL(458.4,DA,.01) ; From Date
S PRSTDT(1)=$$GET^DDSVAL(458.4,DA,1) ; To Date
S PRSRMK(1)=$$GET^DDSVAL(458.4,DA,6) ; Remarks
;
; Skip validation if no changes since last E-Sig
Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))&(PRSRMK(1)=PRSRMK(0))
;
; ask for electronic signature
D Q:$G(DDSERROR)
. N X1
. D SIG^XUSESIG
. S:X1="" DDSERROR=1
;
; skip remaining step if dates did not change (i.e. only remarks edited)
Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))
;
; lock timecards for applicable opened pay periods
D TCLCK^PRSPAPU(PRSIEN,PRSFDT(0),PRSTDT(0),PRSFDT(1),PRSTDT(1),.PRSLCK,.PRSLCKE)
;
; if some time cards couldn't be locked then don't accept changes
I $D(PRSLCKE) D
. N PRSTXT
. S DDSERROR=1
. D TCULCK^PRSPAPU(PRSIEN,.PRSLCK) ; remove any locks
. D RLCKE^PRSPAPU(.PRSLCKE,0,"PRSTXT")
. D HLP^DDSUTL(.PRSTXT)
. K PRSLCKE
;
Q
;
FRMPSV ; Form Post Save
; input
; - previous signed values x(0) and new signed values x(1)
; - array of locked pay periods
;
; Skip post save if no changes
Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))&(PRSRMK(1)=PRSRMK(0))
;
N PRSFDA
;
; Update Extended Absence
I PRSFDT(0)="" D
. S PRSFDA(458.4,DA_",",3)=$$NOW^XLFDT() ; d/t entered
. S PRSFDA(458.4,DA_",",5)="A" ; status = active
E S PRSFDA(458.4,DA_",",4)=$$NOW^XLFDT() ; d/t updated
D FILE^DIE("","PRSFDA") D MSG^DIALOG()
;
; Update signed remark value
S PRSRMK(0)=PRSRMK(1)
;
; skip remaining step if dates did not change (i.e. only remarks edited)
Q:(PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))
;
; Update ESRs for new date range
D:'PRSFDT(0) PEA^PRSPEAA(PRSIEN,PRSFDT(1),PRSTDT(1))
; Update ESRs for changed date range
D:PRSFDT(0) CEA^PRSPEAA(PRSIEN,PRSFDT(0),PRSTDT(0),PRSFDT(1),PRSTDT(1))
;
; remove time card locks
D TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
;
; Update signed date values
S PRSFDT(0)=PRSFDT(1)
S PRSTDT(0)=PRSTDT(1)
Q
;
FRMPST ; Form Post-Action
K PRSFDT(0),PRSFDT(1),PRSRMK(0),PRSRMK(1),PRSTDT(0),PRSTDT(1)
Q
;
DTCV(FDT,TDT) ; Date Compare Validation on FROM DATE and TO DATE fields
Q:FDT=""!(TDT="")
;
N PRSX
;
I FDT>TDT D Q
. S DDSERROR=1
. D HLP^DDSUTL("From Date must not be later than To Date!")
;
I $$FMDIFF^XLFDT(TDT,FDT)>180 D Q
. S DDSERROR=1
. D HLP^DDSUTL("Difference between From Date and To Date must not exceed 180 days!")
;
; check period for conflict with other EAs
S PRSX=$$CONFLICT^PRSPEAU(PRSIEN,FDT,TDT,DA)
I PRSX'="" D Q
. N PRSTXT
. S DDSERROR=1
. D RCON^PRSPEAU(PRSX,0,"PRSTXT")
. D HLP^DDSUTL(.PRSTXT)
;
Q
;
;PRSPEAF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPEAF 6136 printed Sep 23, 2025@20:04:21 Page 2
PRSPEAF ;WOIFO/SAB - Ext. Absence Form ;10/27/2004
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ; This routine is called by the PRSP EXT ABSENCE form (file 458.4)
+5 ; within both the enter option and edit option for extended absences.
+6 ;
FRMDOC ; Form PRSP EXT ABSENCE documentation
+1 ; input
+2 ; PRSEANEW - (optional) true (=1) when extended absence entry is new
+3 ; PRSIEN - Employee IEN (file 450)
+4 ; DA - Extended Absence IEN (file 458.4)
+5 ; DDSPARM - (optional) used by enter option to ask for output
+6 ; output
+7 ; DDSCHANGE - (optional) used by enter option to determine if signed
+8 ;
FRMPRE ; Form Pre-Action
+1 ; input
+2 ; PRSEANEW
+3 ; output
+4 ; PRSFDT(0) - last E-sig From Date
+5 ; PRSTDT(0) - last E-sig To Date
+6 ; PRSRMK(0) - last E-sig Remarks
+7 ;
+8 ; load field values that were last E-signed
+9 IF $GET(PRSEANEW)
SET (PRSFDT(0),PRSTDT(0),PRSRMK(0))=""
+10 IF '$TEST
Begin DoDot:1
+11 SET PRSFDT(0)=$$GET^DDSVAL(458.4,DA,.01)
+12 SET PRSTDT(0)=$$GET^DDSVAL(458.4,DA,1)
+13 SET PRSRMK(0)=$$GET^DDSVAL(458.4,DA,6)
End DoDot:1
+14 ;
+15 ; if From Date prior to Today, disable edit of From Date
+16 IF '$GET(PRSEANEW)
IF PRSFDT(0)<DT
Begin DoDot:1
+17 DO UNED^DDSUTL("FROM DATE",1,1,1,DA_",")
+18 DO HLP^DDSUTL("From Date can't be edited because it's prior to Today.")
End DoDot:1
+19 QUIT
+20 ;
FVAL01 ; Field Validation for From Date (#1) field
+1 ; input
+2 ; X - current internal value of field
+3 ; DDSEXT - current external value of field
+4 ; DDSOLD - previous internal value of field
+5 ; PRSIEN - Employee IEN (file 450)
+6 ; output
+7 ; DDSERROR - (optional) set on error to prevent field change
+8 ;
+9 IF X<DT
Begin DoDot:1
+10 SET DDSERROR=1
+11 DO HLP^DDSUTL("From Date must not be prior to Today!")
End DoDot:1
QUIT
+12 ;
+13 IF X>$$FMADD^XLFDT(DT,365)
Begin DoDot:1
+14 SET DDSERROR=1
+15 DO HLP^DDSUTL("From Date must not be more than 365 days in Future!")
End DoDot:1
QUIT
+16 ;
+17 IF X=DT
IF $$CHKRG^PRSPEAU(PRSIEN)
Begin DoDot:1
+18 SET DDSERROR=1
+19 DO HLP^DDSUTL("From Date can't be Today because RG already posted on the ESR!")
End DoDot:1
QUIT
+20 ;
+21 ; perform date comparison validation
+22 DO DTCV(X,$$GET^DDSVAL(458.4,DA,1))
if $GET(DDSERROR)
QUIT
+23 ;
+24 ; if date changed and new date not under memo then warn user
+25 IF X'=DDSOLD
IF $$MIEN^PRSPUT1(PRSIEN,X)'>0
DO HLP^DDSUTL("Note: New From Date is not covered by a memo.")
+26 ;
+27 QUIT
+28 ;
FVAL1 ; Field Validation for To Date (#1) field
+1 ; input
+2 ; X - current internal value of field
+3 ; DDSEXT - current external value of field
+4 ; DDSOLD - previous internal value of field
+5 ; output
+6 ; DDSERROR - (optional) set on error to prevent field change
+7 ;
+8 ; perform date comparison validation
+9 DO DTCV($$GET^DDSVAL(458.4,DA,.01),X)
if $GET(DDSERROR)
QUIT
+10 ;
+11 IF X<DT
Begin DoDot:1
+12 SET DDSERROR=1
+13 DO HLP^DDSUTL("To Date must not be prior to Today!")
End DoDot:1
QUIT
+14 ;
+15 IF X=DT
IF $$CHKRG^PRSPEAU(PRSIEN)
Begin DoDot:1
+16 SET DDSERROR=1
+17 DO HLP^DDSUTL("To Date can't be Today because RG already posted on the ESR!")
End DoDot:1
QUIT
+18 ;
+19 ; if date changed and new date not under memo then warn user
+20 IF X'=DDSOLD
IF $$MIEN^PRSPUT1(PRSIEN,X)'>0
DO HLP^DDSUTL("Note: New To Date is not covered by a memo.")
+21 ;
+22 QUIT
+23 ;
FRMVAL ; Form Validation
+1 ; input
+2 ; PRSFDT(0) - last E-sig From Date
+3 ; PRSTDT(0) - last E-sig To Date
+4 ; PRSRMK(0) - last E-sig Remarks
+5 ; output
+6 ; PRSFDT(1) - current From Date
+7 ; PRSTDT(1) - current To Date
+8 ; PRSRMK(1) - current Remarks
+9 ; PRSLCK( - array of locked pay periods
+10 ; DDSERROR - (optional) set on error to prevent save
+11 ;
+12 ; get current values of fields
+13 ; From Date
SET PRSFDT(1)=$$GET^DDSVAL(458.4,DA,.01)
+14 ; To Date
SET PRSTDT(1)=$$GET^DDSVAL(458.4,DA,1)
+15 ; Remarks
SET PRSRMK(1)=$$GET^DDSVAL(458.4,DA,6)
+16 ;
+17 ; Skip validation if no changes since last E-Sig
+18 if (PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))&(PRSRMK(1)=PRSRMK(0))
QUIT
+19 ;
+20 ; ask for electronic signature
+21 Begin DoDot:1
+22 NEW X1
+23 DO SIG^XUSESIG
+24 if X1=""
SET DDSERROR=1
End DoDot:1
if $GET(DDSERROR)
QUIT
+25 ;
+26 ; skip remaining step if dates did not change (i.e. only remarks edited)
+27 if (PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))
QUIT
+28 ;
+29 ; lock timecards for applicable opened pay periods
+30 DO TCLCK^PRSPAPU(PRSIEN,PRSFDT(0),PRSTDT(0),PRSFDT(1),PRSTDT(1),.PRSLCK,.PRSLCKE)
+31 ;
+32 ; if some time cards couldn't be locked then don't accept changes
+33 IF $DATA(PRSLCKE)
Begin DoDot:1
+34 NEW PRSTXT
+35 SET DDSERROR=1
+36 ; remove any locks
DO TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
+37 DO RLCKE^PRSPAPU(.PRSLCKE,0,"PRSTXT")
+38 DO HLP^DDSUTL(.PRSTXT)
+39 KILL PRSLCKE
End DoDot:1
+40 ;
+41 QUIT
+42 ;
FRMPSV ; Form Post Save
+1 ; input
+2 ; - previous signed values x(0) and new signed values x(1)
+3 ; - array of locked pay periods
+4 ;
+5 ; Skip post save if no changes
+6 if (PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))&(PRSRMK(1)=PRSRMK(0))
QUIT
+7 ;
+8 NEW PRSFDA
+9 ;
+10 ; Update Extended Absence
+11 IF PRSFDT(0)=""
Begin DoDot:1
+12 ; d/t entered
SET PRSFDA(458.4,DA_",",3)=$$NOW^XLFDT()
+13 ; status = active
SET PRSFDA(458.4,DA_",",5)="A"
End DoDot:1
+14 ; d/t updated
IF '$TEST
SET PRSFDA(458.4,DA_",",4)=$$NOW^XLFDT()
+15 DO FILE^DIE("","PRSFDA")
DO MSG^DIALOG()
+16 ;
+17 ; Update signed remark value
+18 SET PRSRMK(0)=PRSRMK(1)
+19 ;
+20 ; skip remaining step if dates did not change (i.e. only remarks edited)
+21 if (PRSFDT(1)=PRSFDT(0))&(PRSTDT(1)=PRSTDT(0))
QUIT
+22 ;
+23 ; Update ESRs for new date range
+24 if 'PRSFDT(0)
DO PEA^PRSPEAA(PRSIEN,PRSFDT(1),PRSTDT(1))
+25 ; Update ESRs for changed date range
+26 if PRSFDT(0)
DO CEA^PRSPEAA(PRSIEN,PRSFDT(0),PRSTDT(0),PRSFDT(1),PRSTDT(1))
+27 ;
+28 ; remove time card locks
+29 DO TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
+30 ;
+31 ; Update signed date values
+32 SET PRSFDT(0)=PRSFDT(1)
+33 SET PRSTDT(0)=PRSTDT(1)
+34 QUIT
+35 ;
FRMPST ; Form Post-Action
+1 KILL PRSFDT(0),PRSFDT(1),PRSRMK(0),PRSRMK(1),PRSTDT(0),PRSTDT(1)
+2 QUIT
+3 ;
DTCV(FDT,TDT) ; Date Compare Validation on FROM DATE and TO DATE fields
+1 if FDT=""!(TDT="")
QUIT
+2 ;
+3 NEW PRSX
+4 ;
+5 IF FDT>TDT
Begin DoDot:1
+6 SET DDSERROR=1
+7 DO HLP^DDSUTL("From Date must not be later than To Date!")
End DoDot:1
QUIT
+8 ;
+9 IF $$FMDIFF^XLFDT(TDT,FDT)>180
Begin DoDot:1
+10 SET DDSERROR=1
+11 DO HLP^DDSUTL("Difference between From Date and To Date must not exceed 180 days!")
End DoDot:1
QUIT
+12 ;
+13 ; check period for conflict with other EAs
+14 SET PRSX=$$CONFLICT^PRSPEAU(PRSIEN,FDT,TDT,DA)
+15 IF PRSX'=""
Begin DoDot:1
+16 NEW PRSTXT
+17 SET DDSERROR=1
+18 DO RCON^PRSPEAU(PRSX,0,"PRSTXT")
+19 DO HLP^DDSUTL(.PRSTXT)
End DoDot:1
QUIT
+20 ;
+21 QUIT
+22 ;
+23 ;PRSPEAF
