PRSPLVU ;WOIFO/SAB - LEAVE UTILITIES ;3/31/2005
;;4.0;PAID;**93,126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
LOADTOD(PPI,PRSIEN,DAY,TOD,TODD) ; Load Tour of Duty into TOD() Array
; input
; PPI - pay period IEN, file 458
; PRSIEN - employee IEN, file 450
; DAY - day number in PP
; TOD - array, passed by reference, will be initialized
; TODD - array, passed by reference, will be initialized
; output
; TOD - array updated with tour segments in following format
; TOD(tour#-segment#)=
; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
; ^special code
; TODD - array updated with tour data in the following format
; TODD(tour#)=
; earliest regular start d/t (FM)^latest regular end d/t (FM)^
; tour meal length (minutes)^segment # of longest regular tour segment
;
N FLD,NODE,PRSDT,PRSX,TN,TODI,TODY,TSC,TSE,TSI,TSLS,TSS,TST
;
K TOD,TODD ; initialize array
;
S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
Q:'PRSDT
;
; loop thru both tours (#1 and #2) for the day
F TN=1,2 D
. S NODE=$S(TN=1:1,TN=2:4,1:"")
. Q:NODE=""
. S TODY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,NODE))
. S TSLS(0)=0 ; init longest regular segment length (seconds)
. ;
. ; obtain the tour meal time
. S FLD=$S(TN=1:2,1:10.3) ; field number corresponding to tour #1 or #2
. S TODI=$$GET1^DIQ(458.02,DAY_","_PRSIEN_","_PPI_",",FLD,"I") ; tour of duty IEN
. S:TODI $P(TODD(TN),U,3)=$$GET1^DIQ(457.1,TODI,2) ; tour meal (minutes)
. ;
. ; loop thru seven time segments of tour
. F TSI=1:1:7 D
. . S TSS=$P(TODY,U,(TSI-1)*3+1) ; time segment start
. . Q:TSS=""
. . S TSE=$P(TODY,U,(TSI-1)*3+2) ; time segment end
. . Q:TSE=""
. . S TSC=$P(TODY,U,(TSI-1)*3+3) ; time segment special code
. . ; derive type of time
. . S TST=$S(TSC:$P($G(^PRST(457.2,TSC,0)),U,2),1:"RG")
. . ; convert times to FileMan date/time format
. . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
. . Q:$P(PRSX,U)=""
. . S TOD(TN_"-"_TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSC
. . ;
. . ; skip remaining steps if segment is not regular time
. . Q:TST'="RG"
. . ;
. . ; if earliest start time of tour is null, set it from current seg.
. . S:$P($G(TODD(TN)),U)="" $P(TODD(TN),U)=$P(PRSX,U)
. . ;
. . ; if latest end time of tour is null, set it from current seg.
. . S:$P($G(TODD(TN)),U,2)="" $P(TODD(TN),U,2)=$P(PRSX,U,2)
. . ;
. . ; if this segments start time is earlier, update the tour start
. . I $P(PRSX,U)<$P(TODD(TN),U) S $P(TODD(TN),U)=$P(PRSX,U)
. . ;
. . ; if this segments end time is later, update the tour end
. . I $P(PRSX,U,2)>$P(TODD(TN),U,2) S $P(TODD(TN),U,2)=$P(PRSX,U,2)
. . ;
. . ; compute length of the tour segment (seconds)
. . S TSLS=$$FMDIFF^XLFDT($P(PRSX,U,2),$P(PRSX,U,1),2)
. . ; if segment length more than longest found use it as longest found
. . I TSLS>TSLS(0) S TSLS(0)=TSLS,$P(TODD(TN),U,4)=TSI
Q
;
LOADESR(PPI,PRSIEN,DAY,ESR) ; Load ESR into ESR() Array
; input
; PPI - pay period IEN, file 458
; PRSIEN - employee IEN, file 450
; DAY - day number in PP
; ESR - array, passed by reference, will be initialized
; output
; ESR - array updated with tour segments in following format
; ESR(segment #)=
; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
; ^meal (min)
;
N ESRY,PRSDT,PRSX,TSE,TSI,TSM,TSS,TST
;
K ESR ; initialize array
;
S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
Q:'PRSDT
;
S ESRY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
;
; loop thru seven time segments
F TSI=1:1:7 D
. S TSS=$P(ESRY,U,(TSI-1)*5+1) ; time segment start
. Q:TSS=""
. S TSE=$P(ESRY,U,(TSI-1)*5+2) ; time segment end
. Q:TSE=""
. S TST=$P(ESRY,U,(TSI-1)*5+3) ; time segment type of time
. Q:TST=""
. ; convert times to FileMan date/time format
. S PRSX=$$CNVTS(PRSDT,TSS,TSE)
. Q:$P(PRSX,U)=""
. S TSM=$P(ESRY,U,(TSI-1)*5+5) ; time segment meal (min)
. S ESR(TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSM
Q
;
LOADTC(PPI,PRSIEN,DAY,TC) ; Load Time Card into TC() Array
; input
; PPI - pay period IEN, file 458
; PRSIEN - employee IEN, file 450
; DAY - day number in PP
; TC - array, passed by reference, may contain data
; output
; TC - array updated with tour segments in following format
; TC(segment #)=
; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
;
N PRSDT,PRSX,TCY,TSE,TSI,TSS
;
K TC ; initialize array
;
S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
Q:'PRSDT
;
S TCY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,2))
;
; loop thru seven tour segments
F TSI=1:1:7 D
. S TSS=$P(TCY,U,(TSI-1)*4+1) ; time segment start
. Q:TSS=""
. S TSE=$P(TCY,U,(TSI-1)*4+2) ; time segment end
. Q:TSE=""
. S TST=$P(TCY,U,(TSI-1)*4+3) ; time segment type of time
. Q:TST=""
. ; convert times to FileMan date/time format
. S PRSX=$$CNVTS(PRSDT,TSS,TSE)
. Q:$P(PRSX,U)=""
. S TC(TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE
Q
;
OKALVR(LVIEN) ; OK Approve Leave Request
; Called by Supervisory Approvals to see if it is OK to approve a
; leave request
; Input
; LVIEN - Leave Request IEN (file 458.1)
; Result
; string value
; = 1 if OK to approve leave request
; = 0 or 0^PPI if not OK to approve leave request
; where PPI is the Pay Period ien (file 458)
;
N D1,DAY,EPP4Y,LVY0,PP4Y,PPE,PPI,PRSIEN,PRSRET,SPP4Y,Y
;
S PRSRET=1 ; initialize as OK
;
I '$G(LVIEN) S PRSRET=0 Q PRSRET ; required input
;
S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
S PRSIEN=$P(LVY0,U,2) ; employee IEN
;
; if employee has any memos
I $$PTP^PRSPUT3(PRSIEN) D
. ; determine starting and ending pay periods
. S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
. S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
. ;
. ; 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 Q:'PRSRET
. . S PPI=$O(^PRST(458,"AB",PP4Y,0))
. . ;
. . ; skip PP if not covered by memo
. . S D1=$P($G(^PRST(458,PPI,1)),U)
. . Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0 ; PP not covered by memo
. . ;
. . ; skip PP if time card status not = payroll
. . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="P"
. . ;
. . ; can't approve this leave request until time card status changes
. . S PRSRET=0_U_PPI
;
Q PRSRET
;
CNVTS(DATE,START,END) ; Convert Time Segment
; input
; returns string with value =
; Start Date/Time (FileMan internal)^End Date/Time (FileMan internal)
;
N CNX,FMEND,FMSTR,PRSM,PRSRET,X,XMID,Y
S X=START_U_END
D CNV^PRSATIM
S PRSM=Y
S XMID=$S($P(PRSM,U,2)'>$P(PRSM,U):1,1:0)
S FMSTR=$$FMADD^XLFDT(DATE,,,$P(PRSM,U))
S FMEND=$$FMADD^XLFDT(DATE,XMID,,$P(PRSM,U,2))
S PRSRET=FMSTR_"^"_FMEND
;
Q PRSRET
;
FMETA(TIME) ; FileMan to ETA time
N HRS,MIN,PM,PRSRET
S PRSRET=""
S TIME=$$LJ^XLFSTR(TIME,4,"0") ; add trailing 0s to fileman time
I TIME=1200 S PRSRET="NOON"
I TIME=2400 S PRSRET="MID"
I PRSRET="" D
. S PM=0
. S HRS=$E(TIME,1,2)
. S MIN=$E(TIME,3,4)
. I HRS>12 S HRS=HRS-12,PM=1
. S PRSRET=$$RJ^XLFSTR(HRS,2,"0")_":"_$$RJ^XLFSTR(MIN,2,"0")_$S(PM:"P",1:"A")
Q PRSRET
;PRSPLVU
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPLVU 7556 printed Dec 13, 2024@02:28:10 Page 2
PRSPLVU ;WOIFO/SAB - LEAVE UTILITIES ;3/31/2005
+1 ;;4.0;PAID;**93,126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
LOADTOD(PPI,PRSIEN,DAY,TOD,TODD) ; Load Tour of Duty into TOD() Array
+1 ; input
+2 ; PPI - pay period IEN, file 458
+3 ; PRSIEN - employee IEN, file 450
+4 ; DAY - day number in PP
+5 ; TOD - array, passed by reference, will be initialized
+6 ; TODD - array, passed by reference, will be initialized
+7 ; output
+8 ; TOD - array updated with tour segments in following format
+9 ; TOD(tour#-segment#)=
+10 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
+11 ; ^special code
+12 ; TODD - array updated with tour data in the following format
+13 ; TODD(tour#)=
+14 ; earliest regular start d/t (FM)^latest regular end d/t (FM)^
+15 ; tour meal length (minutes)^segment # of longest regular tour segment
+16 ;
+17 NEW FLD,NODE,PRSDT,PRSX,TN,TODI,TODY,TSC,TSE,TSI,TSLS,TSS,TST
+18 ;
+19 ; initialize array
KILL TOD,TODD
+20 ;
+21 SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
+22 if 'PRSDT
QUIT
+23 ;
+24 ; loop thru both tours (#1 and #2) for the day
+25 FOR TN=1,2
Begin DoDot:1
+26 SET NODE=$SELECT(TN=1:1,TN=2:4,1:"")
+27 if NODE=""
QUIT
+28 SET TODY=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,NODE))
+29 ; init longest regular segment length (seconds)
SET TSLS(0)=0
+30 ;
+31 ; obtain the tour meal time
+32 ; field number corresponding to tour #1 or #2
SET FLD=$SELECT(TN=1:2,1:10.3)
+33 ; tour of duty IEN
SET TODI=$$GET1^DIQ(458.02,DAY_","_PRSIEN_","_PPI_",",FLD,"I")
+34 ; tour meal (minutes)
if TODI
SET $PIECE(TODD(TN),U,3)=$$GET1^DIQ(457.1,TODI,2)
+35 ;
+36 ; loop thru seven time segments of tour
+37 FOR TSI=1:1:7
Begin DoDot:2
+38 ; time segment start
SET TSS=$PIECE(TODY,U,(TSI-1)*3+1)
+39 if TSS=""
QUIT
+40 ; time segment end
SET TSE=$PIECE(TODY,U,(TSI-1)*3+2)
+41 if TSE=""
QUIT
+42 ; time segment special code
SET TSC=$PIECE(TODY,U,(TSI-1)*3+3)
+43 ; derive type of time
+44 SET TST=$SELECT(TSC:$PIECE($GET(^PRST(457.2,TSC,0)),U,2),1:"RG")
+45 ; convert times to FileMan date/time format
+46 SET PRSX=$$CNVTS(PRSDT,TSS,TSE)
+47 if $PIECE(PRSX,U)=""
QUIT
+48 SET TOD(TN_"-"_TSI)=$PIECE(PRSX,U)_U_$PIECE(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSC
+49 ;
+50 ; skip remaining steps if segment is not regular time
+51 if TST'="RG"
QUIT
+52 ;
+53 ; if earliest start time of tour is null, set it from current seg.
+54 if $PIECE($GET(TODD(TN)),U)=""
SET $PIECE(TODD(TN),U)=$PIECE(PRSX,U)
+55 ;
+56 ; if latest end time of tour is null, set it from current seg.
+57 if $PIECE($GET(TODD(TN)),U,2)=""
SET $PIECE(TODD(TN),U,2)=$PIECE(PRSX,U,2)
+58 ;
+59 ; if this segments start time is earlier, update the tour start
+60 IF $PIECE(PRSX,U)<$PIECE(TODD(TN),U)
SET $PIECE(TODD(TN),U)=$PIECE(PRSX,U)
+61 ;
+62 ; if this segments end time is later, update the tour end
+63 IF $PIECE(PRSX,U,2)>$PIECE(TODD(TN),U,2)
SET $PIECE(TODD(TN),U,2)=$PIECE(PRSX,U,2)
+64 ;
+65 ; compute length of the tour segment (seconds)
+66 SET TSLS=$$FMDIFF^XLFDT($PIECE(PRSX,U,2),$PIECE(PRSX,U,1),2)
+67 ; if segment length more than longest found use it as longest found
+68 IF TSLS>TSLS(0)
SET TSLS(0)=TSLS
SET $PIECE(TODD(TN),U,4)=TSI
End DoDot:2
End DoDot:1
+69 QUIT
+70 ;
LOADESR(PPI,PRSIEN,DAY,ESR) ; Load ESR into ESR() Array
+1 ; input
+2 ; PPI - pay period IEN, file 458
+3 ; PRSIEN - employee IEN, file 450
+4 ; DAY - day number in PP
+5 ; ESR - array, passed by reference, will be initialized
+6 ; output
+7 ; ESR - array updated with tour segments in following format
+8 ; ESR(segment #)=
+9 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
+10 ; ^meal (min)
+11 ;
+12 NEW ESRY,PRSDT,PRSX,TSE,TSI,TSM,TSS,TST
+13 ;
+14 ; initialize array
KILL ESR
+15 ;
+16 SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
+17 if 'PRSDT
QUIT
+18 ;
+19 SET ESRY=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
+20 ;
+21 ; loop thru seven time segments
+22 FOR TSI=1:1:7
Begin DoDot:1
+23 ; time segment start
SET TSS=$PIECE(ESRY,U,(TSI-1)*5+1)
+24 if TSS=""
QUIT
+25 ; time segment end
SET TSE=$PIECE(ESRY,U,(TSI-1)*5+2)
+26 if TSE=""
QUIT
+27 ; time segment type of time
SET TST=$PIECE(ESRY,U,(TSI-1)*5+3)
+28 if TST=""
QUIT
+29 ; convert times to FileMan date/time format
+30 SET PRSX=$$CNVTS(PRSDT,TSS,TSE)
+31 if $PIECE(PRSX,U)=""
QUIT
+32 ; time segment meal (min)
SET TSM=$PIECE(ESRY,U,(TSI-1)*5+5)
+33 SET ESR(TSI)=$PIECE(PRSX,U)_U_$PIECE(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSM
End DoDot:1
+34 QUIT
+35 ;
LOADTC(PPI,PRSIEN,DAY,TC) ; Load Time Card into TC() Array
+1 ; input
+2 ; PPI - pay period IEN, file 458
+3 ; PRSIEN - employee IEN, file 450
+4 ; DAY - day number in PP
+5 ; TC - array, passed by reference, may contain data
+6 ; output
+7 ; TC - array updated with tour segments in following format
+8 ; TC(segment #)=
+9 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
+10 ;
+11 NEW PRSDT,PRSX,TCY,TSE,TSI,TSS
+12 ;
+13 ; initialize array
KILL TC
+14 ;
+15 SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
+16 if 'PRSDT
QUIT
+17 ;
+18 SET TCY=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,2))
+19 ;
+20 ; loop thru seven tour segments
+21 FOR TSI=1:1:7
Begin DoDot:1
+22 ; time segment start
SET TSS=$PIECE(TCY,U,(TSI-1)*4+1)
+23 if TSS=""
QUIT
+24 ; time segment end
SET TSE=$PIECE(TCY,U,(TSI-1)*4+2)
+25 if TSE=""
QUIT
+26 ; time segment type of time
SET TST=$PIECE(TCY,U,(TSI-1)*4+3)
+27 if TST=""
QUIT
+28 ; convert times to FileMan date/time format
+29 SET PRSX=$$CNVTS(PRSDT,TSS,TSE)
+30 if $PIECE(PRSX,U)=""
QUIT
+31 SET TC(TSI)=$PIECE(PRSX,U)_U_$PIECE(PRSX,U,2)_U_TST_U_TSS_U_TSE
End DoDot:1
+32 QUIT
+33 ;
OKALVR(LVIEN) ; OK Approve Leave Request
+1 ; Called by Supervisory Approvals to see if it is OK to approve a
+2 ; leave request
+3 ; Input
+4 ; LVIEN - Leave Request IEN (file 458.1)
+5 ; Result
+6 ; string value
+7 ; = 1 if OK to approve leave request
+8 ; = 0 or 0^PPI if not OK to approve leave request
+9 ; where PPI is the Pay Period ien (file 458)
+10 ;
+11 NEW D1,DAY,EPP4Y,LVY0,PP4Y,PPE,PPI,PRSIEN,PRSRET,SPP4Y,Y
+12 ;
+13 ; initialize as OK
SET PRSRET=1
+14 ;
+15 ; required input
IF '$GET(LVIEN)
SET PRSRET=0
QUIT PRSRET
+16 ;
+17 ; leave request 0 node
SET LVY0=$GET(^PRST(458.1,LVIEN,0))
+18 ; employee IEN
SET PRSIEN=$PIECE(LVY0,U,2)
+19 ;
+20 ; if employee has any memos
+21 IF $$PTP^PRSPUT3(PRSIEN)
Begin DoDot:1
+22 ; determine starting and ending pay periods
+23 ; based on leave from -1 (use -1 in case of 2-day tour)
SET D1=$$FMADD^XLFDT($PIECE(LVY0,U,3),-1)
DO PP^PRSAPPU
SET SPP4Y=PP4Y
+24 ; based on leave to
SET D1=$PIECE(LVY0,U,5)
DO PP^PRSAPPU
SET EPP4Y=PP4Y
+25 ;
+26 ; loop thru pay periods
+27 ; set initial value to previous PP
SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
+28 FOR
SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
if PP4Y=""!(PP4Y]EPP4Y)
QUIT
Begin DoDot:2
+29 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
+30 ;
+31 ; skip PP if not covered by memo
+32 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
+33 ; PP not covered by memo
if $$MIEN^PRSPUT1(PRSIEN,D1)'>0
QUIT
+34 ;
+35 ; skip PP if time card status not = payroll
+36 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="P"
QUIT
+37 ;
+38 ; can't approve this leave request until time card status changes
+39 SET PRSRET=0_U_PPI
End DoDot:2
if 'PRSRET
QUIT
End DoDot:1
+40 ;
+41 QUIT PRSRET
+42 ;
CNVTS(DATE,START,END) ; Convert Time Segment
+1 ; input
+2 ; returns string with value =
+3 ; Start Date/Time (FileMan internal)^End Date/Time (FileMan internal)
+4 ;
+5 NEW CNX,FMEND,FMSTR,PRSM,PRSRET,X,XMID,Y
+6 SET X=START_U_END
+7 DO CNV^PRSATIM
+8 SET PRSM=Y
+9 SET XMID=$SELECT($PIECE(PRSM,U,2)'>$PIECE(PRSM,U):1,1:0)
+10 SET FMSTR=$$FMADD^XLFDT(DATE,,,$PIECE(PRSM,U))
+11 SET FMEND=$$FMADD^XLFDT(DATE,XMID,,$PIECE(PRSM,U,2))
+12 SET PRSRET=FMSTR_"^"_FMEND
+13 ;
+14 QUIT PRSRET
+15 ;
FMETA(TIME) ; FileMan to ETA time
+1 NEW HRS,MIN,PM,PRSRET
+2 SET PRSRET=""
+3 ; add trailing 0s to fileman time
SET TIME=$$LJ^XLFSTR(TIME,4,"0")
+4 IF TIME=1200
SET PRSRET="NOON"
+5 IF TIME=2400
SET PRSRET="MID"
+6 IF PRSRET=""
Begin DoDot:1
+7 SET PM=0
+8 SET HRS=$EXTRACT(TIME,1,2)
+9 SET MIN=$EXTRACT(TIME,3,4)
+10 IF HRS>12
SET HRS=HRS-12
SET PM=1
+11 SET PRSRET=$$RJ^XLFSTR(HRS,2,"0")_":"_$$RJ^XLFSTR(MIN,2,"0")_$SELECT(PM:"P",1:"A")
End DoDot:1
+12 QUIT PRSRET
+13 ;PRSPLVU
