source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC08.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRSARC08 ;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 ;
6TRSHFTS(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 ;
45PLACEML(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 ;
77EARLYSH(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 ;
93ISWAGE(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 ;
102ISCMPTR(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 ;
107TOTAL(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 ;
117PARSE(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
Note: See TracBrowser for help on using the repository browser.