source: FOIAVistA/tag/r/PAID-PRS/PRS8AC.m@ 1495

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

WorldVistAEHR overlayed on FOIAVistA
File size: 6.9 KB
Line 
1PRS8AC ;HISC/MRL-DECOMPOSITION, ACTIVITY STRING ;01/22/04
2 ;;4.0;PAID;**40,45,54,52,69,75,90,96**;Sep 21, 1995
3 ;
4 ;The primary purpose of this routine is to create the activity
5 ;string [the "W" node] for each day of activity. While creating
6 ;this string certain counts will also be tallied. These include
7 ;Standby, On-Call and the various absence categories. Actual
8 ;Call Back hrs are also counted in this routine for the purpose
9 ;of reducing the OC later on in the process.
10 ;
11 ;Called by Routines: PRS8EX, PRS8ST.
12 ;
13 Q:VAR=""
14 I $S($P(V,"^",1)="":1,$P(V,"^",2)="":1,1:0) Q ;no times
15 S Q=0
16 I DY>0,DY<15 D G END:Q
17 .I DAY(DY,"OFF"),"LSWARUHFGD"[VAR S Q=1 ;exc invalid day off VAR
18 K OC,FLAG
19 ;
20 S DAYZ=DAY(DY,"W")_$G(DAY(DY,"N")),MTM=0
21 S DAYH=$G(DAY(DY,"HOL"))_$G(DAY(DY+1,"HOL")) ;holiday node
22 ;
23 ;P 45 FIREFIGHTERS F NODE TO TRACK ADDITIONAL FF HRS
24 S DAYF=$G(DAY(DY,"F"))
25 ;
26 F T=+V:1:+$P(V,"^",2) D
27 .I +VAR,$E(DAYH,T),$E(DAYZ,T)?1A Q ;no override holiday
28 .I VAR="A"&(JURY=1) S VAR="J"
29 .S VAR1=VAR Q:VAR1="" S DAYZ(1)=$E(DAYZ,T)
30 .I "HhJLSARWMNUnVXYTFGD"[VAR1,$E(DAYZ,T)="m" Q
31 .I T=+V,"12345E"[VAR1 S DAY(DY,"DWK")=1 ;count days worked
32 .I T=+V,"Vh"[VAR1,TYP["I" S DAY(DY,"DWK")=1 ;count days worked for cop
33 .I "JLSWNnARUXYFGD"[VAR1,T'>96,'$E(DAYZ,T) Q ;invalid outside tour
34 .I "EOPQT4"[VAR1,T'>96,$E(DAYZ,T) Q ;can't earn ct/use ot during work
35 .I "OE"[VAR1,"BC"[DAYZ(1),$L(DAYZ(1)) D ; Change OT or CT to CB/SB OT
36 ..S VAR1=$C($A($E(DAYZ,T))+32)
37 ..I $E(DAYZ,T)="C",VAR="E" S VAR1="t" ; Comp time on on-call = "t"
38 .I "BC"[VAR1,DAYZ(1)="O",$L(DAYZ(1)) D ; Change CB/SB to CB/SB OT
39 ..S VAR1=$C($A($E(VAR1))+32)
40 .I "Hh"[VAR1 D Q:VAR1="H"
41 ..S DAYH=$E(DAYH,0,T-1)_$S(VAR1="H":1,$E(DAYZ,T)&($E(DAYZ,T)'=4)!(TYP["I")!(TYP["P"&(TYP["N"!(TYP["H")))!(VAR1="h"):2,1:0)_$E(DAYH,T+1,999) ;holiday node
42 ..I VAR1="h" S VAR1="O" ;convert HW to OT
43 ..I VAR="h",$E(DAYZ,T)=5 S FLAG=5
44 .I $E(DAYZ,T)=5,"ALSRUFGD"[VAR1 S VAR1=$E(DAYZ,T)
45 .I $E(DAYZ,T)="-","BbCctes"[VAR1 Q ;unavail for oc/sb or sch ot/ct
46 .S DAYZ=$E(DAYZ,0,T-1)_VAR1_$E(DAYZ,T+1,999) I $E($G(DAY(DY-1,"N")),T)'="",VAR1'=$E($G(DAY(DY-1,"N")),T) S DAY(DY-1,"N")=$E(DAY(DY-1,"N"),0,T-1)_VAR1_$E(DAY(DY-1,"N"),T+1,999) ;save VAR
47 .I VAR1="J" S Y=5 D SET ;set authorized absence for jury duty
48 .I VAR1="M" S Y=5 D SET ; authorized absence for ML
49 .;ot on non-premium T&L
50 .I ("Eocb"[VAR1!(VAR1="O"&'$E(DAYH,T)))&("^^10^11^12^13^15^16^"[("^"_$P(V,"^",4)_"^"))!(VAR1=5&("ALSRUFGD"[VAR))!(VAR1=4&(TYP["P"!(TYP["I"&(TYP["N"!(TYP["H"!($$HYBRID^PRSAENT1($G(DFN)))))))&("^7^9^11^12^14^"[("^"_$P(V,"^",4)_"^"))) D
51 ..Q:$E(DAY(DY,"P"),T)=5&("ALSRUFGD"'[VAR)
52 ..I $D(FLAG) S FLAG=VAR1,VAR1=5
53 ..N CODE D
54 ...I "^7^8^12^"[("^"_$P(V,"^",4)_"^")&(TYP["N"!(TYP["H")!($$HYBRID^PRSAENT1($G(DFN)))) S CODE="N" Q
55 ...I "^7^8^12^"[("^"_$P(V,"^",4)_"^")&(PMP'="")&("^S^T^U^V^"[(U_PMP_U)) S CODE="N" Q
56 ...I $P(V,"^",4)=11,($$HYBRID^PRSAENT1($G(DFN))) S CODE="N" Q
57 ...I $P(V,"^",4)=11&(PMP'="")&("^S^T^U^V^"[(U_PMP_U)) S CODE="N" Q
58 ...I "^7^8^9^11^"[("^"_$P(V,"^",4)_"^")&(TYP'["N")&(TYP'["H")&('$$HYBRID^PRSAENT1($G(DFN))) S CODE="n" Q
59 ...I "^7^8^9^11^"[("^"_$P(V,"^",4)_"^")&("^S^T^U^V^"'[(U_PMP_U)) S CODE="n" Q
60 ...I VAR1=5 S CODE=VAR Q
61 ...S CODE=1
62 ..S DAY(DY,"P")=$E(DAY(DY,"P"),0,T-1)_CODE_$E(DAY(DY,"P"),T+1,999)
63 .I "ALSRUFGD"[VAR,VAR1=5 S VAR1=VAR
64 .I $D(FLAG) S VAR1=FLAG K FLAG
65 .;
66FOPTHR .; part time hrs (PT/PH 8b codes) for CODE O firefighters
67 .I +VAR1,"Ff"[TYP,PMP="O",(NH=448!(NH>320&(NH(1)'=NH(2)))) S Y=32 D SET
68 .;
69FRCPTHR .; part time hrs (PT/PH 8b codes) for code R & C firefighters
70 .; don't include UNSCHEDULED REGULAR (var1=4)
71 .I +VAR1,VAR1'=4,"Ff"[TYP,"RC"[PMP S Y=32 D SET
72 .;
73 .;patch 45 & 54
74 .; Set non pay hrs in the basic tour for firefighters with premium
75 .;pay indicator of C.
76 .I "nW"[VAR1,"Ff"[TYP,"C"=PMP D
77 ..;
78 ..; Y designates location in WK array where NT/NH will be stored.
79 ..; F node was set to 1 for periods of addtl ff hrs during 1st pass
80 ..; thru scheduled ToD. Count NT/NH if this is not addtl ff hrs.
81 ..;
82 ..I '$E(DAY(DY,"F"),T) S Y=47 D SET
83 .S S="LSWnAREUP HYXOVQTFGD" I S[VAR1&(DY>0&(DY<15)!(DY=0&(T>96))) D ;save in WK array
84 ..S S(1)=$F(S,VAR1)-1
85 ..S S=$P("1^2^3^4^5^6^0^8^0^9^24^42^43^0^33^0^19^44^45^46","^",S(1)) ;WK location
86 ..Q:S=0
87 ..; Patch *40 removed A (authorized absence) from leave counted in LU.
88 ..; LU is only used to determine if night differential granted for
89 ..; leave should be backed out.
90 ..I TYP'["D","LSRUFGD"[VAR1 S LU=LU+1 ;increment leave counter
91 ..I TYP'["D","LSRUFGD"[VAR1,(DY=0!(DY=14)&(T>96)),LU>0 S LU=LU-1
92 ..S Y=S D SET S:TYP["D" Q=1
93 ..K S,VAR1
94 ;
95 ;
96 S DAY(DY,"W")=$E(DAYZ,1,96) ;todays activity
97 S DAY(DY,"N")=$E(DAYZ,97,999) ;tomorrows activity from today/if any
98 S:$E(DAY(DY,"P"),97,999)'="" DAY(DY,"P1")=$E(DAY(DY,"P"),97,999) ;non-prem ot for next day
99 S DAY(DY,"P")=$E(DAY(DY,"P"),1,96) ;non-prem ot for today
100 I DAY(DY,"N")?1"0"."0" S DAY(DY,"N")=""
101 S DAY(DY,"HOL")=$E(DAYH,1,96)
102 ;
103 ;P 45 FIREFIGHTER ADDITIONAL FIREFIGHTER HRS NODE FOR THIS DAY
104 I $G(PRS8AFFH) D
105 . N PRSFFHR,PRSF1,PRSF2,PRSF3,SEG1,SEG2
106 .;
107 .;GET THE POSITIONAL START AND STOPS FOR THIS SEGMENT
108 . S SEG1=$P(V,U,1),SEG2=$P(V,U,2)
109 .;EXISTING PORTION OF F NODE UP TO CURRENT SEGMENT
110 . S PRSF1=$E(DAYF,1,SEG1-1)
111 .;CURRENT SEGMENT UP TO END OF DAY
112 . S PRSF2=$E(DAYZ,SEG1,SEG2)
113 .;CURRENT F NODE PAST CURRENT SEGMENT TO END OF THE TOUR WHICH
114 .;MAY FALL IN TODAY OR NEXT DAY.
115 .S PRSF3=$E(DAYF,SEG2+1,999)
116 .;
117 .;UPDATE THE DAY ARRAY AND THE TMP GLOBAL WITH WORK STRING.
118 .;EACH CHAR THAT IS SET TO 1 REPRESENTS A 15 MIN SEGMENT THAT
119 .;THE FIREFIGHTER WAS SCHEDULED FOR ADDITIONAL FF HRS.
120 .;FOR TOURS CROSSING MIDNIGHT THIS STRING WILL BE LONGER THAN 96
121 .;CHARACTERS. CHARACTERS IN POSITIONS PAST 96 REPRESENT TIMES PAST
122 .;MIDNIGHT OF THE CURRENT DAY (TOMORROW).
123 .S PRSFFHR=PRSF1_PRSF2_PRSF3
124 .S DAY(DY,"F")=PRSFFHR
125 .S ^TMP($J,"PRS8",DY,"F")=PRSFFHR
126 ;
127 I DY<15 S X=$E(DAYH,97,999) I X'?."0" S ^TMP($J,"PRS8",DY+1,"HOL")=X_$E($G(^TMP($J,"PRS8",DY+1,"HOL")),$L(X)+1,999),DAY(DY+1,"HOL")=X
128 ;
129MOVE ; --- entry point for just moving previous days hrs to today
130 I $D(DAY(DY-1,"N")),$L(DAY(DY-1,"N")) D
131 .S X=DAY(DY-1,"N")_$E(DAY(DY,"W"),$L(DAY(DY-1,"N"))+1,96)
132 .S DAY(DY,"W")=X
133 I $D(DAY(DY-1,"P1")),$L(DAY(DY-1,"P1")) D
134 .S X=DAY(DY-1,"P1")_$E(DAY(DY,"P"),$L(DAY(DY-1,"P1"))+1,96)
135 .S DAY(DY,"P")=X
136 ;
137END ; --- all done here
138 K CNT,OC,Q,S,SB,SL,SLP,T,VAR1,X,Y Q
139 ;
140SET ; --- set WK variable
141 I (DY=0&(T<97))!(DY=14&(T>96))!(DY>14) Q
142 S ZZ=WK,WK=$S(DY>7:2,1:1)
143 I TYP'["D",DY=7,T>96 S WK=2
144 S $P(WK(WK),"^",Y)=$P(WK(WK),"^",Y)+1
145 ;
146 ; The passing of Public Law 106-554 allows taking ML in hours.
147 ; ML will now be recorded in 15 minute segments in the WK(3) array
148 ; for employees entitled to take ML in hours. PRS*4.0*69
149 ;
150 I VAR1="M",$$MLINHRS^PRSAENT(DFN) D
151 . S WK=3,Y=11
152 . S $P(WK(WK),"^",Y)=$P(WK(WK),"^",Y)+1
153 ;
154 ; IF a part-time employee and they have either LWOP or Non-Pay
155 ; THEN decrement total hours for the week and the pay period.
156 ; PRS*4.0*52.
157 ;
158 I "Wn"[VAR1,TYP["P" S TH=TH-1,TH(WK)=TH(WK)-1
159 S WK=ZZ Q
Note: See TracBrowser for help on using the repository browser.