PRSPAPU ;WOIFO/SAB-WOIFO/SAB - AUTO POST UTILITIES FOR EA & LV ;10/30/2004
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
TCLCK(PRSIEN,S1,E1,S2,E2,PPLCK,PPLCKE) ; Time Card Lock for Date Range Change
; This API attempts to lock employee timecards for pay periods that
; are impacted by a change to a date range. Only existing pay periods
; that are covered by a PTP memo will be locked.
;
; Input
; PRSIEN - Employee IEN (file 450)
; S1 - Old Start Date (FileMan internal)
; E1 - Old End Date (Fileman internal)
; S2 - New Start Date (FileMan internal)
; E2 - New End Date (Fileman internal)
; PPLCK() - Array of Locked Pay Periods passed by reference
; PPLCKE() - Array of Pay Periods with Lock Error passed by reference
; Note that both these arrays are initialized by this API.
; Output
; PPLCK() - Array of Locked Pay Periods may be updated
; format PPLCK(pay period IEN file 458)=""
; PPLCKE() - Array of Pay Periods with Lock Error may be updated
; format PPLCKE(pay period IEN file 458)=""
;
K PPLCK,PPLCKE
;
;if S1 and E1 have values and S2 and E2 are null then lock from S1 to E1
I S1,E1,'S2,'E2 D LCK(PRSIEN,S1,E1,.PPLCK,.PPLCKE)
;
;if S1 and E1 are null and S2 and E2 have values then lock from S2 to E2
I 'S1,'E1,S2,E2 D LCK(PRSIEN,S2,E2,.PPLCK,.PPLCKE)
;
;if S1, E1, S2, and E2 have values then lock impacted ranges
I S1,E1,S2,E2 D
. N X1,X2
. ; if new start is less than old start then days from new start to
. ; lesser of new end and old start-1 were changed from not covered to
. ; covered.
. I S2<S1 D
. . S X1=S2
. . S X2=$S(E2<(S1-1):E2,1:S1-1)
. . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
. ;
. ; if new start is greater than old start then days from old start to
. ; lesser of old end and new start-1 were changed from covered to not
. ; covered.
. I S2>S1 D
. . S X1=S1
. . S X2=$S(E1<(S2-1):E1,1:S2-1)
. . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
. ;
. ; if new end is greater than old end then days from greater of old
. ; end+1 and new start to new end were changed from not covered to
. ; covered.
. I E2>E1 D
. . S X1=$S(E1+1>S2:E1+1,1:S2)
. . S X2=E2
. . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
. ;
. ; if new end is less than old end then days from greater of new end+1
. ; and old start to old end were changed from covered to not covered.
. I E2<E1 D
. . S X1=$S(E2+1>S1:E2+1,1:S1)
. . S X2=E1
. . D LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
;
Q
;
LCK(PRSIEN,PERSTR,PEREND,PPLCK,PPLCKE) ; Lock Time Cards for a Date Range
; This API attempts to lock the employee timecards for a date range.
; Only existing pay periods that are covered by a PTP memo are locked.
;
; Input
; PRSIEN - Employee IEN (file 450)
; PERSTR - Period Start (FileMan internal)
; PEREND - Period End (Fileman internal)
; PPLCK() - Array of Locked Pay Periods passed by reference
; format PPLCK(pay period IEN file 458)=""
; PPLCKE() - Array of Pay Periods with Lock Error passed by reference
; format PPLCKE(pay period IEN file 458)=""
; Note that these arrays are not initialized by this API and may
; contain information about already locked timecards.
; Output
; PPLCK() - Array of Locked Pay Periods may be updated
; PPLCKE() - Array of Pay Periods with Lock Error may be updated
;
Q:('$G(PRSIEN))!($G(PERSTR)'?7N)!($G(PEREND)'?7N) ; required inputs
;
N D1,DAY,EPP4Y,PP4Y,PPE,PPI,SPP4Y,Y
;
; determine starting and ending pay periods
S D1=PERSTR D PP^PRSAPPU S SPP4Y=PP4Y
S D1=PEREND D PP^PRSAPPU S EPP4Y=PP4Y
Q:SPP4Y=""
Q:EPP4Y=""
;
; loop thru pay periods
S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
. S PPI=$O(^PRST(458,"AB",PP4Y,0))
. ; quit if pay period not covered by memo
. S D1=$P($G(^PRST(458,PPI,1)),U)
. Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0
. ;
. Q:$D(PPLCK(PPI)) ; already in lock array
. Q:$D(PPLCKE(PPI)) ; already in lock error array
. ;
. ; lock timecard
. L +^PRST(458,PPI,"E",PRSIEN):2
. S:'$T PPLCKE(PPI)=""
. S:$T PPLCK(PPI)=""
;
Q
;
;
TCULCK(PRSIEN,PPLCK) ; Time Card Unlock
; This API unlocks a list of employee timecards.
;
; Input
; PRSIEN - Employee IEN (file 450)
; PPLCK( - Array of Locked Pay Periods passed by reference
; format PPLCK(pay period IEN file 458)=""
; Output
; PPLCK( - Input array is killed since pay periods are unlocked
;
Q:'$G(PRSIEN) ; required input
;
N PPI
;
; loop thru pay periods and unlock time card
S PPI="" F S PPI=$O(PPLCK(PPI)) Q:'PPI L -^PRST(458,PPI,"E",PRSIEN)
;
; init lock array
K PPLCK
;
Q
;
RLCKE(PPLCKE,WRITE,PRSARRN) ; Report Lock Errors
; This API writes a list of timecards that could not be locked.
;
; Input
; PPLCKE( - Array of Pay Periods with Lock Error passed by reference
; format PPLCKE(pay period IEN file 458)=""
; WRITE - (optional) true (=1) if text should be written (default)
; false (=0) if array should be returned instead
; PRSARRN - (optional) array name, default value is "PRSARR"
; output
; If WRITE is True, the input array name (or "PRSARR" if not
; specified) will be killed.
; If WRITE is False, the input array name will contain the text
;
N LN,PPI
;
S PRSARRN=$G(PRSARRN,"PRSARR")
S WRITE=$G(WRITE,1)
;
S @PRSARRN@(1)="Unable to make changes because the time card for the following"
S @PRSARRN@(2)="pay period(s) are being edited by another user!"
S LN=2
; loop thru pay periods
S PPI="" F S PPI=$O(PPLCKE(PPI)) Q:'PPI D
. S LN=LN+1
. S @PRSARRN@(LN)=" Pay Period: "_$P($G(^PRST(458,PPI,0)),U)
;
; if not WRITE then quit (returns text in array to caller)
Q:'WRITE
;
; otherwise write text to current device and then kill array of text
S LN=0 F S LN=$O(@PRSARRN@(LN)) Q:'LN D
. W !,@PRSARRN@(LN)
K @PRSARRN
;
Q
;
;PRSPAPU
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPAPU 6197 printed Apr 09, 2024@21:28:56 Page 2
PRSPAPU ;WOIFO/SAB-WOIFO/SAB - AUTO POST UTILITIES FOR EA & LV ;10/30/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 ;
TCLCK(PRSIEN,S1,E1,S2,E2,PPLCK,PPLCKE) ; Time Card Lock for Date Range Change
+1 ; This API attempts to lock employee timecards for pay periods that
+2 ; are impacted by a change to a date range. Only existing pay periods
+3 ; that are covered by a PTP memo will be locked.
+4 ;
+5 ; Input
+6 ; PRSIEN - Employee IEN (file 450)
+7 ; S1 - Old Start Date (FileMan internal)
+8 ; E1 - Old End Date (Fileman internal)
+9 ; S2 - New Start Date (FileMan internal)
+10 ; E2 - New End Date (Fileman internal)
+11 ; PPLCK() - Array of Locked Pay Periods passed by reference
+12 ; PPLCKE() - Array of Pay Periods with Lock Error passed by reference
+13 ; Note that both these arrays are initialized by this API.
+14 ; Output
+15 ; PPLCK() - Array of Locked Pay Periods may be updated
+16 ; format PPLCK(pay period IEN file 458)=""
+17 ; PPLCKE() - Array of Pay Periods with Lock Error may be updated
+18 ; format PPLCKE(pay period IEN file 458)=""
+19 ;
+20 KILL PPLCK,PPLCKE
+21 ;
+22 ;if S1 and E1 have values and S2 and E2 are null then lock from S1 to E1
+23 IF S1
IF E1
IF 'S2
IF 'E2
DO LCK(PRSIEN,S1,E1,.PPLCK,.PPLCKE)
+24 ;
+25 ;if S1 and E1 are null and S2 and E2 have values then lock from S2 to E2
+26 IF 'S1
IF 'E1
IF S2
IF E2
DO LCK(PRSIEN,S2,E2,.PPLCK,.PPLCKE)
+27 ;
+28 ;if S1, E1, S2, and E2 have values then lock impacted ranges
+29 IF S1
IF E1
IF S2
IF E2
Begin DoDot:1
+30 NEW X1,X2
+31 ; if new start is less than old start then days from new start to
+32 ; lesser of new end and old start-1 were changed from not covered to
+33 ; covered.
+34 IF S2<S1
Begin DoDot:2
+35 SET X1=S2
+36 SET X2=$SELECT(E2<(S1-1):E2,1:S1-1)
+37 DO LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
End DoDot:2
+38 ;
+39 ; if new start is greater than old start then days from old start to
+40 ; lesser of old end and new start-1 were changed from covered to not
+41 ; covered.
+42 IF S2>S1
Begin DoDot:2
+43 SET X1=S1
+44 SET X2=$SELECT(E1<(S2-1):E1,1:S2-1)
+45 DO LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
End DoDot:2
+46 ;
+47 ; if new end is greater than old end then days from greater of old
+48 ; end+1 and new start to new end were changed from not covered to
+49 ; covered.
+50 IF E2>E1
Begin DoDot:2
+51 SET X1=$SELECT(E1+1>S2:E1+1,1:S2)
+52 SET X2=E2
+53 DO LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
End DoDot:2
+54 ;
+55 ; if new end is less than old end then days from greater of new end+1
+56 ; and old start to old end were changed from covered to not covered.
+57 IF E2<E1
Begin DoDot:2
+58 SET X1=$SELECT(E2+1>S1:E2+1,1:S1)
+59 SET X2=E1
+60 DO LCK(PRSIEN,X1,X2,.PPLCK,.PPLCKE)
End DoDot:2
End DoDot:1
+61 ;
+62 QUIT
+63 ;
LCK(PRSIEN,PERSTR,PEREND,PPLCK,PPLCKE) ; Lock Time Cards for a Date Range
+1 ; This API attempts to lock the employee timecards for a date range.
+2 ; Only existing pay periods that are covered by a PTP memo are locked.
+3 ;
+4 ; Input
+5 ; PRSIEN - Employee IEN (file 450)
+6 ; PERSTR - Period Start (FileMan internal)
+7 ; PEREND - Period End (Fileman internal)
+8 ; PPLCK() - Array of Locked Pay Periods passed by reference
+9 ; format PPLCK(pay period IEN file 458)=""
+10 ; PPLCKE() - Array of Pay Periods with Lock Error passed by reference
+11 ; format PPLCKE(pay period IEN file 458)=""
+12 ; Note that these arrays are not initialized by this API and may
+13 ; contain information about already locked timecards.
+14 ; Output
+15 ; PPLCK() - Array of Locked Pay Periods may be updated
+16 ; PPLCKE() - Array of Pay Periods with Lock Error may be updated
+17 ;
+18 ; required inputs
if ('$GET(PRSIEN))!($GET(PERSTR)'?7N)!($GET(PEREND)'?7N)
QUIT
+19 ;
+20 NEW D1,DAY,EPP4Y,PP4Y,PPE,PPI,SPP4Y,Y
+21 ;
+22 ; determine starting and ending pay periods
+23 SET D1=PERSTR
DO PP^PRSAPPU
SET SPP4Y=PP4Y
+24 SET D1=PEREND
DO PP^PRSAPPU
SET EPP4Y=PP4Y
+25 if SPP4Y=""
QUIT
+26 if EPP4Y=""
QUIT
+27 ;
+28 ; loop thru pay periods
+29 ; set initial value to previous PP
SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
+30 FOR
SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
if PP4Y=""!(PP4Y]EPP4Y)
QUIT
Begin DoDot:1
+31 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
+32 ; quit if pay period not covered by memo
+33 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
+34 if $$MIEN^PRSPUT1(PRSIEN,D1)'>0
QUIT
+35 ;
+36 ; already in lock array
if $DATA(PPLCK(PPI))
QUIT
+37 ; already in lock error array
if $DATA(PPLCKE(PPI))
QUIT
+38 ;
+39 ; lock timecard
+40 LOCK +^PRST(458,PPI,"E",PRSIEN):2
+41 if '$TEST
SET PPLCKE(PPI)=""
+42 if $TEST
SET PPLCK(PPI)=""
End DoDot:1
+43 ;
+44 QUIT
+45 ;
+46 ;
TCULCK(PRSIEN,PPLCK) ; Time Card Unlock
+1 ; This API unlocks a list of employee timecards.
+2 ;
+3 ; Input
+4 ; PRSIEN - Employee IEN (file 450)
+5 ; PPLCK( - Array of Locked Pay Periods passed by reference
+6 ; format PPLCK(pay period IEN file 458)=""
+7 ; Output
+8 ; PPLCK( - Input array is killed since pay periods are unlocked
+9 ;
+10 ; required input
if '$GET(PRSIEN)
QUIT
+11 ;
+12 NEW PPI
+13 ;
+14 ; loop thru pay periods and unlock time card
+15 SET PPI=""
FOR
SET PPI=$ORDER(PPLCK(PPI))
if 'PPI
QUIT
LOCK -^PRST(458,PPI,"E",PRSIEN)
+16 ;
+17 ; init lock array
+18 KILL PPLCK
+19 ;
+20 QUIT
+21 ;
RLCKE(PPLCKE,WRITE,PRSARRN) ; Report Lock Errors
+1 ; This API writes a list of timecards that could not be locked.
+2 ;
+3 ; Input
+4 ; PPLCKE( - Array of Pay Periods with Lock Error passed by reference
+5 ; format PPLCKE(pay period IEN file 458)=""
+6 ; WRITE - (optional) true (=1) if text should be written (default)
+7 ; false (=0) if array should be returned instead
+8 ; PRSARRN - (optional) array name, default value is "PRSARR"
+9 ; output
+10 ; If WRITE is True, the input array name (or "PRSARR" if not
+11 ; specified) will be killed.
+12 ; If WRITE is False, the input array name will contain the text
+13 ;
+14 NEW LN,PPI
+15 ;
+16 SET PRSARRN=$GET(PRSARRN,"PRSARR")
+17 SET WRITE=$GET(WRITE,1)
+18 ;
+19 SET @PRSARRN@(1)="Unable to make changes because the time card for the following"
+20 SET @PRSARRN@(2)="pay period(s) are being edited by another user!"
+21 SET LN=2
+22 ; loop thru pay periods
+23 SET PPI=""
FOR
SET PPI=$ORDER(PPLCKE(PPI))
if 'PPI
QUIT
Begin DoDot:1
+24 SET LN=LN+1
+25 SET @PRSARRN@(LN)=" Pay Period: "_$PIECE($GET(^PRST(458,PPI,0)),U)
End DoDot:1
+26 ;
+27 ; if not WRITE then quit (returns text in array to caller)
+28 if 'WRITE
QUIT
+29 ;
+30 ; otherwise write text to current device and then kill array of text
+31 SET LN=0
FOR
SET LN=$ORDER(@PRSARRN@(LN))
if 'LN
QUIT
Begin DoDot:1
+32 WRITE !,@PRSARRN@(LN)
End DoDot:1
+33 KILL @PRSARRN
+34 ;
+35 QUIT
+36 ;
+37 ;PRSPAPU
