| 1 | PRSARC08 ;WOIFO/JAH - Tour hours procedure calls ;12/19/06
|
|---|
| 2 | ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | TRSHFTS(TOURIEN) ; return two piece ^ string with EARLIEST shift special
|
|---|
| 7 | ; indicator for a tour
|
|---|
| 8 | ;
|
|---|
| 9 | N TOUR,TODSHFT,TOMSHFT,TSEGS,TWODAYTR,I
|
|---|
| 10 | N DONE,CROSS,BEG,END,SPIND,BEG24,END24
|
|---|
| 11 | Q:$G(TOURIEN)'>0 "^"
|
|---|
| 12 | S (TODSHFT,TOMSHFT)="4"
|
|---|
| 13 | S TOUR=$G(^PRST(457.1,TOURIEN,0))
|
|---|
| 14 | S TSEGS=$G(^PRST(457.1,TOURIEN,1))
|
|---|
| 15 | S TWODAYTR=$P(TOUR,U,5)="Y"
|
|---|
| 16 | S (DONE,CROSS)=0
|
|---|
| 17 | F I=1:3:18 D Q:DONE
|
|---|
| 18 | . S BEG=$P(TSEGS,U,I)
|
|---|
| 19 | . I BEG="" S DONE=1 Q
|
|---|
| 20 | . S END=$P(TSEGS,U,I+1)
|
|---|
| 21 | . S SPIND=$P(TSEGS,U,I+2) I SPIND="" S SPIND=1
|
|---|
| 22 | . S SPIND=$TR(SPIND,"67","23")
|
|---|
| 23 | . Q:"^1^2^3^"'[("^"_SPIND_"^")
|
|---|
| 24 | . ; convert beg and end to twenty four hr to determine if one is
|
|---|
| 25 | . ; less than other and hence crosses midnight. You've also
|
|---|
| 26 | . ; crossed midnight if a segment other than first starts at
|
|---|
| 27 | . ; midnight.
|
|---|
| 28 | . ; Set CROSS to true so any remaining segments get recorded to
|
|---|
| 29 | . ; tomorrow.
|
|---|
| 30 | . S BEG24=$$TWENTY4^PRSPESR2(BEG)
|
|---|
| 31 | . S END24=$$TWENTY4^PRSPESR2(END)
|
|---|
| 32 | . I 'CROSS&((BEG24'<END24)!((I>1)&(BEG24=2400))) D
|
|---|
| 33 | .. S CROSS=1
|
|---|
| 34 | .. I SPIND<TODSHFT S TODSHFT=SPIND
|
|---|
| 35 | .. I SPIND<TOMSHFT S TOMSHFT=SPIND
|
|---|
| 36 | . E D
|
|---|
| 37 | .. I CROSS D
|
|---|
| 38 | ... I SPIND<TOMSHFT S TOMSHFT=SPIND
|
|---|
| 39 | .. E D
|
|---|
| 40 | ... I SPIND<TODSHFT S TODSHFT=SPIND
|
|---|
| 41 | I TODSHFT=4 S TODSHFT=""
|
|---|
| 42 | I TOMSHFT=4 S TOMSHFT=""
|
|---|
| 43 | Q TODSHFT_"^"_TOMSHFT
|
|---|
| 44 | ;
|
|---|
| 45 | PLACEML(S1,S2,M) ; Remove meal from hrs on 2 day tour. Put meal in middle and
|
|---|
| 46 | ; remove from today S1 or tomorrow S2. Function considers only amount
|
|---|
| 47 | ; of hrs worked, to indicate in which hr of total hrs meal
|
|---|
| 48 | ; would begin. It doesn't consider where hrs are placed in day.
|
|---|
| 49 | ; INPUT:
|
|---|
| 50 | ; S1 = HRS ON DAY 1 (DECIMAL 8.0, 8.5, ETC)
|
|---|
| 51 | ; S2 = HRS ON DAY 2
|
|---|
| 52 | ; M = LENGTH OF MEAL IN DECIMAL FORM .25 HRS, .5 HRS ETC
|
|---|
| 53 | ;
|
|---|
| 54 | ; ETA deals with quarter hrs so (\.25*.25) will round
|
|---|
| 55 | ; down result to quarter hr.
|
|---|
| 56 | ;
|
|---|
| 57 | I (M>60)!(M<15)!((M#15)'=0) Q S1_"^"_S2
|
|---|
| 58 | ; Convert minutes meal to decimal
|
|---|
| 59 | N X S X=M D MEALIN^PRSPESR2 S M=.25*X
|
|---|
| 60 | N MEALHR,NS1,NS2
|
|---|
| 61 | S MEALHR=(S1+S2)/2-(M/2)\.25*.25
|
|---|
| 62 | Q:MEALHR'>0 S1_"^"_S2
|
|---|
| 63 | ;
|
|---|
| 64 | ; pull meal from S1, S2 or both
|
|---|
| 65 | I MEALHR<S1 D
|
|---|
| 66 | . I (MEALHR+M)'>S1 D
|
|---|
| 67 | .. S NS2=S2
|
|---|
| 68 | .. S NS1=S1-M
|
|---|
| 69 | . E D
|
|---|
| 70 | .. S NS1=S1-(S1-MEALHR)
|
|---|
| 71 | .. S NS2=S2-(M-(S1-MEALHR))
|
|---|
| 72 | E D
|
|---|
| 73 | . S NS1=S1
|
|---|
| 74 | . S NS2=S2-M
|
|---|
| 75 | Q NS1_"^"_NS2
|
|---|
| 76 | ;
|
|---|
| 77 | EARLYSH(TH,WAGER) ; LOOP THROUGH ARRAY TO FIND EARLIEST SHIFT
|
|---|
| 78 | ;
|
|---|
| 79 | N EARLIEST,HRS,SHIFT,TOURDAY
|
|---|
| 80 | I WAGER D
|
|---|
| 81 | . S EARLIEST=0
|
|---|
| 82 | E D
|
|---|
| 83 | . S EARLIEST=4
|
|---|
| 84 | . S TOURDAY=0
|
|---|
| 85 | . F S TOURDAY=$O(TH(TOURDAY)) Q:TOURDAY'>0 D
|
|---|
| 86 | .. S HRS=$P($G(TH(TOURDAY)),U,2)
|
|---|
| 87 | .. Q:HRS'>0
|
|---|
| 88 | .. S SHIFT=$P($G(TH(TOURDAY)),U)
|
|---|
| 89 | .. I SHIFT<EARLIEST S EARLIEST=SHIFT
|
|---|
| 90 | I EARLIEST=4 S EARLIEST=""
|
|---|
| 91 | Q EARLIEST
|
|---|
| 92 | ;
|
|---|
| 93 | ISWAGE(PRSIEN) ; return true for wage grade
|
|---|
| 94 | I $G(PRSIEN)'>0 Q "0^undefined employee"
|
|---|
| 95 | N PAYPLAN,ISWAGE
|
|---|
| 96 | S ISWAGE=1
|
|---|
| 97 | I '$D(^PRSPC(PRSIEN,0)) Q "0^undefined employee"
|
|---|
| 98 | S PAYPLAN=$P($G(^PRSPC(PRSIEN,0)),U,21)
|
|---|
| 99 | I "0123456789GU"'[PAYPLAN S ISWAGE=0
|
|---|
| 100 | Q ISWAGE
|
|---|
| 101 | ;
|
|---|
| 102 | ISCMPTR(PPI,PRSIEN) ; return true for compressed tours
|
|---|
| 103 | ;
|
|---|
| 104 | N ISCT S ISCT=0 I $P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,6)="C" S ISCT=1
|
|---|
| 105 | Q ISCT
|
|---|
| 106 | ;
|
|---|
| 107 | TOTAL(TH,WKS) ; array loop tallis hrs
|
|---|
| 108 | ; INPUT : WKS (optional) 1 for week one total, 2 for week 2 total,
|
|---|
| 109 | ; otherwise full pay period total.
|
|---|
| 110 | N LASTDAY,TOURDAY,TOTAL S TOTAL=0
|
|---|
| 111 | S TOURDAY=$S($G(WKS)=2:7,1:0)
|
|---|
| 112 | S LASTDAY=$S($G(WKS)=1:7,1:14)
|
|---|
| 113 | F S TOURDAY=$O(TH(TOURDAY)) Q:TOURDAY>LASTDAY!(TOURDAY'>0) D
|
|---|
| 114 | . S TOTAL=TOTAL+$P($G(TH(TOURDAY)),U,2)
|
|---|
| 115 | Q TOTAL
|
|---|
| 116 | ;
|
|---|
| 117 | PARSE(VALMNOD,BEG,END) ; -- Copy from VALM2 split out pre-answers from user
|
|---|
| 118 | N Y,J,L,X
|
|---|
| 119 | S Y=$TR($P($P(VALMNOD,U,4),"=",2),"/\; .",",,,,,")
|
|---|
| 120 | 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_","
|
|---|
| 121 | Q Y
|
|---|
