PRSARC08 ;WOIFO/JAH - Tour hours procedure calls ;12/19/06
;;4.0;PAID;**112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
TRSHFTS(TOURIEN) ; return two piece ^ string with EARLIEST shift special
; indicator for a tour
;
N TOUR,TODSHFT,TOMSHFT,TSEGS,TWODAYTR,I
N DONE,CROSS,BEG,END,SPIND,BEG24,END24
Q:$G(TOURIEN)'>0 "^"
S (TODSHFT,TOMSHFT)="4"
S TOUR=$G(^PRST(457.1,TOURIEN,0))
S TSEGS=$G(^PRST(457.1,TOURIEN,1))
S TWODAYTR=$P(TOUR,U,5)="Y"
S (DONE,CROSS)=0
F I=1:3:18 D Q:DONE
. S BEG=$P(TSEGS,U,I)
. I BEG="" S DONE=1 Q
. S END=$P(TSEGS,U,I+1)
. S SPIND=$P(TSEGS,U,I+2) I SPIND="" S SPIND=1
. S SPIND=$TR(SPIND,"67","23")
. Q:"^1^2^3^"'[("^"_SPIND_"^")
. ; convert beg and end to twenty four hr to determine if one is
. ; less than other and hence crosses midnight. You've also
. ; crossed midnight if a segment other than first starts at
. ; midnight.
. ; Set CROSS to true so any remaining segments get recorded to
. ; tomorrow.
. S BEG24=$$TWENTY4^PRSPESR2(BEG)
. S END24=$$TWENTY4^PRSPESR2(END)
. I 'CROSS&((BEG24'<END24)!((I>1)&(BEG24=2400))) D
.. S CROSS=1
.. I SPIND<TODSHFT S TODSHFT=SPIND
.. I SPIND<TOMSHFT S TOMSHFT=SPIND
. E D
.. I CROSS D
... I SPIND<TOMSHFT S TOMSHFT=SPIND
.. E D
... I SPIND<TODSHFT S TODSHFT=SPIND
I TODSHFT=4 S TODSHFT=""
I TOMSHFT=4 S TOMSHFT=""
Q TODSHFT_"^"_TOMSHFT
;
PLACEML(S1,S2,M) ; Remove meal from hrs on 2 day tour. Put meal in middle and
; remove from today S1 or tomorrow S2. Function considers only amount
; of hrs worked, to indicate in which hr of total hrs meal
; would begin. It doesn't consider where hrs are placed in day.
; INPUT:
; S1 = HRS ON DAY 1 (DECIMAL 8.0, 8.5, ETC)
; S2 = HRS ON DAY 2
; M = LENGTH OF MEAL IN DECIMAL FORM .25 HRS, .5 HRS ETC
;
; ETA deals with quarter hrs so (\.25*.25) will round
; down result to quarter hr.
;
I (M>60)!(M<15)!((M#15)'=0) Q S1_"^"_S2
; Convert minutes meal to decimal
N X S X=M D MEALIN^PRSPESR2 S M=.25*X
N MEALHR,NS1,NS2
S MEALHR=(S1+S2)/2-(M/2)\.25*.25
Q:MEALHR'>0 S1_"^"_S2
;
; pull meal from S1, S2 or both
I MEALHR<S1 D
. I (MEALHR+M)'>S1 D
.. S NS2=S2
.. S NS1=S1-M
. E D
.. S NS1=S1-(S1-MEALHR)
.. S NS2=S2-(M-(S1-MEALHR))
E D
. S NS1=S1
. S NS2=S2-M
Q NS1_"^"_NS2
;
EARLYSH(TH,WAGER) ; LOOP THROUGH ARRAY TO FIND EARLIEST SHIFT
;
N EARLIEST,HRS,SHIFT,TOURDAY
I WAGER D
. S EARLIEST=0
E D
. S EARLIEST=4
. S TOURDAY=0
. F S TOURDAY=$O(TH(TOURDAY)) Q:TOURDAY'>0 D
.. S HRS=$P($G(TH(TOURDAY)),U,2)
.. Q:HRS'>0
.. S SHIFT=$P($G(TH(TOURDAY)),U)
.. I SHIFT<EARLIEST S EARLIEST=SHIFT
I EARLIEST=4 S EARLIEST=""
Q EARLIEST
;
ISWAGE(PRSIEN) ; return true for wage grade
I $G(PRSIEN)'>0 Q "0^undefined employee"
N PAYPLAN,ISWAGE
S ISWAGE=1
I '$D(^PRSPC(PRSIEN,0)) Q "0^undefined employee"
S PAYPLAN=$P($G(^PRSPC(PRSIEN,0)),U,21)
I "0123456789GU"'[PAYPLAN S ISWAGE=0
Q ISWAGE
;
ISCMPTR(PPI,PRSIEN) ; return true for compressed tours
;
N ISCT S ISCT=0 I $P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,6)="C" S ISCT=1
Q ISCT
;
TOTAL(TH,WKS) ; array loop tallis hrs
; INPUT : WKS (optional) 1 for week one total, 2 for week 2 total,
; otherwise full pay period total.
N LASTDAY,TOURDAY,TOTAL S TOTAL=0
S TOURDAY=$S($G(WKS)=2:7,1:0)
S LASTDAY=$S($G(WKS)=1:7,1:14)
F S TOURDAY=$O(TH(TOURDAY)) Q:TOURDAY>LASTDAY!(TOURDAY'>0) D
. S TOTAL=TOTAL+$P($G(TH(TOURDAY)),U,2)
Q TOTAL
;
PARSE(VALMNOD,BEG,END) ; -- Copy from VALM2 split out pre-answers from user
N Y,J,L,X
S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
I Y["-" S X=Y,Y="" F I=1:1 S J=$P(X,",",I) Q:J']"" I +J>(BEG-1),+J<(END+1) S:J'["-" Y=Y_J_"," I J["-",+J,+J<+$P(J,"-",2) F L=+J:1:+$P(J,"-",2) I L>(BEG-1),L<(END+1) S Y=Y_L_","
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARC08 3987 printed Sep 23, 2025@20:00:34 Page 2
PRSARC08 ;WOIFO/JAH - Tour hours procedure calls ;12/19/06
+1 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
TRSHFTS(TOURIEN) ; return two piece ^ string with EARLIEST shift special
+1 ; indicator for a tour
+2 ;
+3 NEW TOUR,TODSHFT,TOMSHFT,TSEGS,TWODAYTR,I
+4 NEW DONE,CROSS,BEG,END,SPIND,BEG24,END24
+5 if $GET(TOURIEN)'>0
QUIT "^"
+6 SET (TODSHFT,TOMSHFT)="4"
+7 SET TOUR=$GET(^PRST(457.1,TOURIEN,0))
+8 SET TSEGS=$GET(^PRST(457.1,TOURIEN,1))
+9 SET TWODAYTR=$PIECE(TOUR,U,5)="Y"
+10 SET (DONE,CROSS)=0
+11 FOR I=1:3:18
Begin DoDot:1
+12 SET BEG=$PIECE(TSEGS,U,I)
+13 IF BEG=""
SET DONE=1
QUIT
+14 SET END=$PIECE(TSEGS,U,I+1)
+15 SET SPIND=$PIECE(TSEGS,U,I+2)
IF SPIND=""
SET SPIND=1
+16 SET SPIND=$TRANSLATE(SPIND,"67","23")
+17 if "^1^2^3^"'[("^"_SPIND_"^")
QUIT
+18 ; convert beg and end to twenty four hr to determine if one is
+19 ; less than other and hence crosses midnight. You've also
+20 ; crossed midnight if a segment other than first starts at
+21 ; midnight.
+22 ; Set CROSS to true so any remaining segments get recorded to
+23 ; tomorrow.
+24 SET BEG24=$$TWENTY4^PRSPESR2(BEG)
+25 SET END24=$$TWENTY4^PRSPESR2(END)
+26 IF 'CROSS&((BEG24'<END24)!((I>1)&(BEG24=2400)))
Begin DoDot:2
+27 SET CROSS=1
+28 IF SPIND<TODSHFT
SET TODSHFT=SPIND
+29 IF SPIND<TOMSHFT
SET TOMSHFT=SPIND
End DoDot:2
+30 IF '$TEST
Begin DoDot:2
+31 IF CROSS
Begin DoDot:3
+32 IF SPIND<TOMSHFT
SET TOMSHFT=SPIND
End DoDot:3
+33 IF '$TEST
Begin DoDot:3
+34 IF SPIND<TODSHFT
SET TODSHFT=SPIND
End DoDot:3
End DoDot:2
End DoDot:1
if DONE
QUIT
+35 IF TODSHFT=4
SET TODSHFT=""
+36 IF TOMSHFT=4
SET TOMSHFT=""
+37 QUIT TODSHFT_"^"_TOMSHFT
+38 ;
PLACEML(S1,S2,M) ; Remove meal from hrs on 2 day tour. Put meal in middle and
+1 ; remove from today S1 or tomorrow S2. Function considers only amount
+2 ; of hrs worked, to indicate in which hr of total hrs meal
+3 ; would begin. It doesn't consider where hrs are placed in day.
+4 ; INPUT:
+5 ; S1 = HRS ON DAY 1 (DECIMAL 8.0, 8.5, ETC)
+6 ; S2 = HRS ON DAY 2
+7 ; M = LENGTH OF MEAL IN DECIMAL FORM .25 HRS, .5 HRS ETC
+8 ;
+9 ; ETA deals with quarter hrs so (\.25*.25) will round
+10 ; down result to quarter hr.
+11 ;
+12 IF (M>60)!(M<15)!((M#15)'=0)
QUIT S1_"^"_S2
+13 ; Convert minutes meal to decimal
+14 NEW X
SET X=M
DO MEALIN^PRSPESR2
SET M=.25*X
+15 NEW MEALHR,NS1,NS2
+16 SET MEALHR=(S1+S2)/2-(M/2)\.25*.25
+17 if MEALHR'>0
QUIT S1_"^"_S2
+18 ;
+19 ; pull meal from S1, S2 or both
+20 IF MEALHR<S1
Begin DoDot:1
+21 IF (MEALHR+M)'>S1
Begin DoDot:2
+22 SET NS2=S2
+23 SET NS1=S1-M
End DoDot:2
+24 IF '$TEST
Begin DoDot:2
+25 SET NS1=S1-(S1-MEALHR)
+26 SET NS2=S2-(M-(S1-MEALHR))
End DoDot:2
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 SET NS1=S1
+29 SET NS2=S2-M
End DoDot:1
+30 QUIT NS1_"^"_NS2
+31 ;
EARLYSH(TH,WAGER) ; LOOP THROUGH ARRAY TO FIND EARLIEST SHIFT
+1 ;
+2 NEW EARLIEST,HRS,SHIFT,TOURDAY
+3 IF WAGER
Begin DoDot:1
+4 SET EARLIEST=0
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET EARLIEST=4
+7 SET TOURDAY=0
+8 FOR
SET TOURDAY=$ORDER(TH(TOURDAY))
if TOURDAY'>0
QUIT
Begin DoDot:2
+9 SET HRS=$PIECE($GET(TH(TOURDAY)),U,2)
+10 if HRS'>0
QUIT
+11 SET SHIFT=$PIECE($GET(TH(TOURDAY)),U)
+12 IF SHIFT<EARLIEST
SET EARLIEST=SHIFT
End DoDot:2
End DoDot:1
+13 IF EARLIEST=4
SET EARLIEST=""
+14 QUIT EARLIEST
+15 ;
ISWAGE(PRSIEN) ; return true for wage grade
+1 IF $GET(PRSIEN)'>0
QUIT "0^undefined employee"
+2 NEW PAYPLAN,ISWAGE
+3 SET ISWAGE=1
+4 IF '$DATA(^PRSPC(PRSIEN,0))
QUIT "0^undefined employee"
+5 SET PAYPLAN=$PIECE($GET(^PRSPC(PRSIEN,0)),U,21)
+6 IF "0123456789GU"'[PAYPLAN
SET ISWAGE=0
+7 QUIT ISWAGE
+8 ;
ISCMPTR(PPI,PRSIEN) ; return true for compressed tours
+1 ;
+2 NEW ISCT
SET ISCT=0
IF $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),U,6)="C"
SET ISCT=1
+3 QUIT ISCT
+4 ;
TOTAL(TH,WKS) ; array loop tallis hrs
+1 ; INPUT : WKS (optional) 1 for week one total, 2 for week 2 total,
+2 ; otherwise full pay period total.
+3 NEW LASTDAY,TOURDAY,TOTAL
SET TOTAL=0
+4 SET TOURDAY=$SELECT($GET(WKS)=2:7,1:0)
+5 SET LASTDAY=$SELECT($GET(WKS)=1:7,1:14)
+6 FOR
SET TOURDAY=$ORDER(TH(TOURDAY))
if TOURDAY>LASTDAY!(TOURDAY'>0)
QUIT
Begin DoDot:1
+7 SET TOTAL=TOTAL+$PIECE($GET(TH(TOURDAY)),U,2)
End DoDot:1
+8 QUIT TOTAL
+9 ;
PARSE(VALMNOD,BEG,END) ; -- Copy from VALM2 split out pre-answers from user
+1 NEW Y,J,L,X
+2 SET Y=$TRANSLATE($PIECE($PIECE(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
+3 IF Y["-"
SET X=Y
SET Y=""
FOR I=1:1
SET J=$PIECE(X,",",I)
if J']""
QUIT
IF +J>(BEG-1)
IF +J<(END+1)
if J'["-"
SET Y=Y_J_","
IF J["-"
IF +J
IF +J<+$PIECE(J,"-",2)
FOR L=+J:1:+$PIECE(J,"-",2)
IF L>(BEG-1)
IF L<(END+1)
SET Y=Y_L_","
+4 QUIT Y
