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