Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRS8MSC0.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8MSC0.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8MSC0.m
r613 r623 1 PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ;4/04/2007 2 ;;4.0;PAID;**22,35,40,56,111,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; for employee on daily tour check if no duty performed during week 6 I TYP["D" D NODUTY^PRS8MSC1 7 ; 8 S B="",Z0="" S $P(B,"B",97)="",$P(Z0,"0",97)="",FLAG=0 9 F X=1:1:PEROWK S Y=$P(PEROWK(X),"^",4),DAT=$P(PEROWK(X),"^",1,3),DY=$P(DAT,"^",1),BEG=$P(DAT,"^",2),END=$P(DAT,"^",3) D 10 .I $L(Y)'<96,TYP'["Ff",$E(ENT,27) D ; slp for 24hr cvg 11 ..S SLMAX=32,(SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3)="" 12 ..I END=96 D 13 ...S SLST=$P($G(PEROWK(X)),"^",4),SL2=$E(SLST,SST,$L(SLST)),SL1=$E(SLST,1,SLMAX-$L(SL2)),SL3=$L(SL2) 14 ...S SLSTR=SL1_SL2 15 ...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB 16 ...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0) 17 ...S SLY=$L($TR(SLSTR,"b0")),SLW=$L($TR(SLSTR,"B0")) 18 ...I SLW>12 Q 19 ...I DY=0 S FLAG=SL3 20 ...S Y=$L(SLSTR)-SLW 21 ...I FLAG>0&(DY=1) S Y=Y-FLAG,FLAG=0 22 ...S D=DY,P=25 D SET Q 23 ..E D 24 ...S SLST=$G(^TMP($J,"PRS8",DY,"W"))_$G(^TMP($J,"PRS8",DY+1,"W")) 25 ...S SLSTR=$E(SLST,1,SST+(SLMAX-1)) 26 ...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB 27 ...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0) 28 ...S SLY=$E(SLSTR,SST,96),SLY1=$E(SLSTR,97,$L(SLSTR)) 29 ...S SLSTR=SLY_SLY1,SLW=$L($TR(SLSTR,"B0")) 30 ...I SLW>12 Q 31 ...S D=DY,Y=$L($TR(SLY,"b0")),P=25 D SET 32 ...Q:DY=0 S D=DY+1,Y=$L($TR(SLY1,"b0")) D SET 33 ...Q 34 ..K BEG,DAT,END,NL,SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3 Q 35 .Q 36 S D="",(H,ROSS)=1 K OT,UN,DA,CT 37 F H=H:ROSS:PEROT D ; calculate CB OT and FF OT/sleep time 38 .S Y=PEROT(H),Z=$P(Y,"^",3) 39 .I "Ff"[TYP D ;K OT,UN,DA D ; FF sleep time 40 ..F M=1:1:$L(Z) D ; following FF OT per Mary Baker 4/1/93 41 ...I D'=+Y+(($P(Y,"^",2)+M-2)\96) D 42 ....S D=+Y+(($P(Y,"^",2)+M-2)\96),HT=0 43 ....Q 44 ...S HT=HT+1 45 ...I $E(Z,H)="E" S CT(D)=$G(CT(D))+1 Q 46 ...I M'>32 S:HT'>32 OT(D)=$G(OT(D))+1 S:HT>32 DA(D)=$G(DA(D))+1 ; FF OT 47 ...I M>32,$L(Z)'<96&(M'>64)!($L(Z)<96) S DA(D)=$G(DA(D))+1 ; FF hrs>8 48 ...I $L(Z)'<96,M>64 D ; FF 2/3 rule 49 ....I M'>96 S UN(D)=$G(UN(D))+1 ; first 8 sleep time 50 ....E S DA(D)=$G(DA(D))+1 ; rest hrs >8 51 ....Q 52 ...Q 53 ..Q 54 .I $L(Z)<8 D ; call back OT at least 2 hrs 55 ..S YY=Y,ZZ=Z N X,Y,START,STOP,T,TT,Z,DD,TL S Y=YY,Z=ZZ 56 ..S CB=$G(^TMP($J,"PRS8",+Y,"CB")) 57 ..;no call back OT today or send bulletin 58 ..Q:(CB="")!($$OTNXTPP(+Y,CB,$P(C0,"^",1),PY,$P(C0,"^",8))) 59 ..S Q=0 F ZZ=1:2 Q:'$P(CB,"^",ZZ) I $P(Y,"^",2)=$P(CB,"^",ZZ) S Q=1 60 ..Q:'Q ; this OT episode not call back 61 ..S OT=Y,START=$P(OT,"^",2),STOP=$P(OT,"^",2)+$L(Z)-1,T=START,TT=$S(T>96:T-96,1:T) 62 ..S W=$G(^TMP($J,"PRS8",+OT,"W")),WEEK=$S(+OT>7:2,1:1) 63 ..S W1=$G(^TMP($J,"PRS8",OT-1,"W")) 64 ..S W2=$G(^TMP($J,"PRS8",OT+1,"W")) 65 ..S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0 66 ...S DD=Z 67 ...I TT-DD>0 S X=$E(W,TT-DD) 68 ...E S X=$E(W1,96+T-DD) 69 ...I "123m"[X,$E($G(^TMP($J,"PRS8",$S(TT-DD>0:+OT,1:OT-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD))=1 S X=0 ; HX becomes time off 70 ...Q 71 ..S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T) 72 ..F Z=1:1:8-(STOP-START+1+ZZ) D Q:X=0 73 ...S DD=STOP-START+1+ZZ+Z 74 ...I T+Z'>96 S X=$E(W,T+Z) 75 ...E S X=$E(W2,T-96+Z) 76 ...I "123m"[X,$E($G(^TMP($J,"PRS8",$S(T+Z'>96:+OT,1:OT+1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z))=1 S X=0 ; HX becomes time off 77 ...Q 78 ..S Z=ZZ+Z-(X=0&Z) 79 ..I STOP-START+1+Z<8 D 80 ...I TYP["W",$E($P(PEROT(H),"^",3))'="E"&($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF"))=0) S TOUR=$G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"TOUR")) 81 ...S D=+OT,P=$S($E($P(PEROT(H),"^",3))'="E":TOUR+19,1:7),Y=8-(STOP-START+1+Z) 82 ...; 83 ...I TYP["P",TYP'["B",P'=7,'+NAWS D 84 ....I $P($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160) S Y=0 Q 85 ....I $P(C0,"^",12)="E" S P=$S($L($TR(W,"0O"))>31&(TH(WEEK)'>160):TOUR+25,1:P) D:Y SET S Y=$S(TH(WEEK)'>160:Y,1:0) S P=9 D:Y SET S Y=0 86 ...I $P(C0,"^",12)="N",P'=7 S P=$S($L($TR(W,"0O"))>31:TOUR+15,1:P) D:Y SET S Y=0 87 ...D:Y&('+NAWS) SET 88 ...; 89 ...I +NAWS D Q ; Checks for just the AWS nurses 90 ....N CNT,HT,I 91 ....S CNT=Y,Y=1,HT=$G(^TMP($J,"PRS8",D,"HT")) 92 ....F I=1:1:CNT D 93 .....I HT'<32 S P=$S(P'=7:TOUR+15,1:P) D SET1 Q ; DA/DE or CE/CT 94 .....I TH($S(+OT>7:2,1:1))'<160 S P=$S(P'=7:TOUR+19,1:P) D SET1 Q ; OA/OE or CE/CT 95 .....I HT<32,TH($S(+OT>7:2,1:1))<160 S P=9 D SET1 Q ; UN/US 96 ..Q 97 .Q 98 F X="OT","DA","UN","CT" D ; store FF OT into WK array 99 .N Y S P=$S(X="OT":TOUR+19,X="DA"&$E(ENT,TOUR+18):TOUR+15,X="DA":TOUR+19,X="CT":TOUR+6,1:9) 100 .F D=0:0 S D=$O(@(X_"("_D_")")) Q:D'>0 S Y=@(X_"("_D_")") D SET 101 .Q 102 ; 103 ; check/adjust night differential granted for leave 104 D LVND 105 Q 106 SET ; Set sleep time into WK array 107 Q:D<1!(D>14) 108 S WEEK=$S(D>7:2,1:1) 109 S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y 110 Q 111 ; 112 SET1 ; Set sleep time into WK array 113 Q:D<1!(D>14) 114 S WEEK=$S(D>7:2,1:1) 115 S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y 116 Q:(HT>32)&(TH(WEEK)<160)&(NH<320)&($E(ENT,19)=1) 117 Q:(HT>32)&(TH(WEEK)<160)&(NH=320)&($E(ENT,19)=1)&($E(AC,2)=2) ; 9month AWS 118 S HT=HT+1,TH(WEEK)=TH(WEEK)+1 119 S ^TMP($J,"PRS8",D,"HT")=^TMP($J,"PRS8",D,"HT")+1 120 Q 121 ; 122 OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ; 123 ;OT or CT connects to a tour of duty in the next pay period. 124 ;JAH-patch PRS*4*22 125 ;If OT or CT are worked in last 2 hours of pay period & 1st day 126 ;of next pay period is missing a tour beginning at midnight, send 127 ;a bulletin warning that call back will be paid unless corrective 128 ;action is taken. 129 ;(i.e a nurse comes in before midnight on last saturday of 130 ;pay period & works for a period less than 2 hrs. before her tour 131 ;that begins at midnight on Sunday, first day of the next pp) 132 ; 133 ; CALLBK = start and stop position in 96 char BCD string. 134 ; RECORD = pointer from employee's tour info to a record 135 ; in tour of duty file. 136 ; DAY = day of the pay period 137 ; D1NXTPP = BOOLEAN; set to true if tour on day 1 of next pay period 138 ; begins at midnight, otherwise false 139 ; NEXTP = next pay period in 97-05 format. 140 ; CURP = current pay period in 99-02 format. 141 ; TLU = 3 digit time & leave unit of employee. 142 N D1NXTPP,RECORD,CURP,NEXTP,XMDUZ,XMB,XMY,XMDUZ 143 S (RTN,D1NXTPP)=0 144 S RECORD=$P($G(^TMP($J,"PRS8",15,0)),"^",2) 145 I RECORD'="" S D1NXTPP=($P($G(^PRST(457.1,RECORD,1)),"^")="MID") 146 I (DAY=14)&($P(CALLBK,"^",2)=96) D 147 . I (D1NXTPP) S RTN=1 148 . E D 149 .. S CURP=$P($G(^PRST(458,PPIEN,0)),"^",1) 150 .. S NXTP=$E($$NXTPP^PRSAPPU(CURP),3,7) 151 ..; Send bulletin to G.PAD 152 .. S XMY("G.PAD@"_^XMB("NETNAME"))="" 153 .. S XMDUZ="DHCP PAID package" 154 .. S XMB="PRS LAST SAT OT/CT" 155 ..; 156 ..; employee name, pay period number, next pay period 157 .. S XMB(1)=EMPNM,XMB(2)=CURP,XMB(3)=NXTP,XMB(4)=TLU 158 .. D ^XMB 159 Q RTN 160 ; 161 LVND ; Leave Night Differential 162 ; back out ND granted for leave if employee took 8 or more hrs of leave 163 ; a non-wage grade employee can receive night differential when 164 ; on leave as long as the employee has taken less than 8 hours of 165 ; leave during the pay period. 166 ; input (note: units are count of 15min time segments): 167 ; LU - leave taken during pay period (set in PRS8AC, PRS8MT) 168 ; WK(#) - piece 10 contains total shift-2 ND for week # 169 ; WKL(#) - ND granted for leave during week # (set in PRS8PP) 170 ; output: 171 ; WK(#) - piece 10 may be modified 172 ; WKL(#) - may be modified 173 N W 174 Q:TYP["W" ; Doesn't apply to Wage Grade 175 Q:LU'>31 ; Didn't take 8hrs of leave 176 F W=1,2 D ; For each week subtract leave ND from total ND 177 . Q:'WKL(W) ; No leave ND to subtract 178 . I +NAWS'=36 S $P(WK(W),"^",10)=$P(WK(W),"^",10)-WKL(W) ; Subtract 179 . ; For 36/40 AWS subtract time from Night Differential-AWS (piece 51) 180 . I +NAWS=36 S $P(WK(W),"^",51)=$P(WK(W),"^",51)-WKL(W) 181 . S WKL(W)=0 ; Reset leave ND amount 182 Q 1 PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ;1/25/2007 2 ;;4.0;PAID;**22,35,40,56,111**;Sep 21, 1995;Build 2 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; for employee on daily tour check if no duty performed during week 6 I TYP["D" D NODUTY^PRS8MSC1 7 ; 8 S B="",Z0="" S $P(B,"B",97)="",$P(Z0,"0",97)="",FLAG=0 9 F X=1:1:PEROWK S Y=$P(PEROWK(X),"^",4),DAT=$P(PEROWK(X),"^",1,3),DY=$P(DAT,"^",1),BEG=$P(DAT,"^",2),END=$P(DAT,"^",3) D 10 .I $L(Y)'<96,TYP'["Ff",$E(ENT,27) D ; slp for 24hr cvg 11 ..S SLMAX=32,(SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3)="" 12 ..I END=96 D 13 ...S SLST=$P($G(PEROWK(X)),"^",4),SL2=$E(SLST,SST,$L(SLST)),SL1=$E(SLST,1,SLMAX-$L(SL2)),SL3=$L(SL2) 14 ...S SLSTR=SL1_SL2 15 ...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB 16 ...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0) 17 ...S SLY=$L($TR(SLSTR,"b0")),SLW=$L($TR(SLSTR,"B0")) 18 ...I SLW>12 Q 19 ...I DY=0 S FLAG=SL3 20 ...S Y=$L(SLSTR)-SLW 21 ...I FLAG>0&(DY=1) S Y=Y-FLAG,FLAG=0 22 ...S D=DY,P=25 D SET Q 23 ..E D 24 ...S SLST=$G(^TMP($J,"PRS8",DY,"W"))_$G(^TMP($J,"PRS8",DY+1,"W")) 25 ...S SLSTR=$E(SLST,1,SST+(SLMAX-1)) 26 ...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB 27 ...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0) 28 ...S SLY=$E(SLSTR,SST,96),SLY1=$E(SLSTR,97,$L(SLSTR)) 29 ...S SLSTR=SLY_SLY1,SLW=$L($TR(SLSTR,"B0")) 30 ...I SLW>12 Q 31 ...S D=DY,Y=$L($TR(SLY,"b0")),P=25 D SET 32 ...Q:DY=0 S D=DY+1,Y=$L($TR(SLY1,"b0")) D SET 33 ...Q 34 ..K BEG,DAT,END,NL,SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3 Q 35 .Q 36 S D="",(H,ROSS)=1 K OT,UN,DA,CT 37 F H=H:ROSS:PEROT D ; calculate CB OT and FF OT/sleep time 38 .S Y=PEROT(H),Z=$P(Y,"^",3) 39 .I "Ff"[TYP D ;K OT,UN,DA D ; FF sleep time 40 ..F M=1:1:$L(Z) D ; following FF OT per Mary Baker 4/1/93 41 ...I D'=+Y+(($P(Y,"^",2)+M-2)\96) D 42 ....S D=+Y+(($P(Y,"^",2)+M-2)\96),HT=0 43 ....Q 44 ...S HT=HT+1 45 ...I $E(Z,H)="E" S CT(D)=$G(CT(D))+1 Q 46 ...I M'>32 S:HT'>32 OT(D)=$G(OT(D))+1 S:HT>32 DA(D)=$G(DA(D))+1 ; FF OT 47 ...I M>32,$L(Z)'<96&(M'>64)!($L(Z)<96) S DA(D)=$G(DA(D))+1 ; FF hrs>8 48 ...I $L(Z)'<96,M>64 D ; FF 2/3 rule 49 ....I M'>96 S UN(D)=$G(UN(D))+1 ; first 8 sleep time 50 ....E S DA(D)=$G(DA(D))+1 ; rest hrs >8 51 ....Q 52 ...Q 53 ..Q 54 .I $L(Z)<8 D ; call back OT at least 2 hrs 55 ..S YY=Y,ZZ=Z N X,Y,START,STOP,T,TT,Z,DD,TL S Y=YY,Z=ZZ 56 ..S CB=$G(^TMP($J,"PRS8",+Y,"CB")) 57 ..;no call back OT today or send bulletin 58 ..Q:(CB="")!($$OTNXTPP(+Y,CB,$P(C0,"^",1),PY,$P(C0,"^",8))) 59 ..S Q=0 F ZZ=1:2 Q:'$P(CB,"^",ZZ) I $P(Y,"^",2)=$P(CB,"^",ZZ) S Q=1 60 ..Q:'Q ; this OT episode not call back 61 ..S OT=Y,START=$P(OT,"^",2),STOP=$P(OT,"^",2)+$L(Z)-1,T=START,TT=$S(T>96:T-96,1:T) 62 ..S W=$G(^TMP($J,"PRS8",+OT,"W")),WEEK=$S(+OT>7:2,1:1) 63 ..S W1=$G(^TMP($J,"PRS8",OT-1,"W")) 64 ..S W2=$G(^TMP($J,"PRS8",OT+1,"W")) 65 ..S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0 66 ...S DD=Z 67 ...I TT-DD>0 S X=$E(W,TT-DD) 68 ...E S X=$E(W1,96+T-DD) 69 ...I "123m"[X,$E($G(^TMP($J,"PRS8",$S(TT-DD>0:+OT,1:OT-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD))=1 S X=0 ; HX becomes time off 70 ...Q 71 ..S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T) 72 ..F Z=1:1:8-(STOP-START+1+ZZ) D Q:X=0 73 ...S DD=STOP-START+1+ZZ+Z 74 ...I T+Z'>96 S X=$E(W,T+Z) 75 ...E S X=$E(W2,T-96+Z) 76 ...I "123m"[X,$E($G(^TMP($J,"PRS8",$S(T+Z'>96:+OT,1:OT+1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z))=1 S X=0 ; HX becomes time off 77 ...Q 78 ..S Z=ZZ+Z-(X=0&Z) 79 ..I STOP-START+1+Z<8 D 80 ...I TYP["W",$E($P(PEROT(H),"^",3))'="E"&($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF"))=0) S TOUR=$G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"TOUR")) 81 ...S D=+OT,P=$S($E($P(PEROT(H),"^",3))'="E":TOUR+19,1:7),Y=8-(STOP-START+1+Z) 82 ...I TYP["P",TYP'["B",P'=7 D 83 ....I $P($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160) S Y=0 Q 84 ....I $P(C0,"^",12)="E" S P=$S($L($TR(W,"0O"))>31&(TH(WEEK)'>160):TOUR+25,1:P) D:Y SET S Y=$S(TH(WEEK)'>160:Y,1:0) S P=9 D:Y SET S Y=0 85 ...I $P(C0,"^",12)="N",P'=7 S P=$S($L($TR(W,"0O"))>31:TOUR+15,1:P) D:Y SET S Y=0 86 ...D:Y SET 87 ..Q 88 .Q 89 F X="OT","DA","UN","CT" D ; store FF OT into WK array 90 .N Y S P=$S(X="OT":TOUR+19,X="DA"&$E(ENT,TOUR+18):TOUR+15,X="DA":TOUR+19,X="CT":TOUR+6,1:9) 91 .F D=0:0 S D=$O(@(X_"("_D_")")) Q:D'>0 S Y=@(X_"("_D_")") D SET 92 .Q 93 ; 94 ; check/adjust night differential granted for leave 95 D LVND 96 Q 97 SET ; Set sleep time into WK array 98 Q:D<1!(D>14) 99 S WEEK=$S(D>7:2,1:1) 100 S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y 101 Q 102 OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ; 103 ;OT or CT connects to a tour of duty in the next pay period. 104 ;JAH-patch PRS*4*22 105 ;If OT or CT are worked in last 2 hours of pay period & 1st day 106 ;of next pay period is missing a tour beginning at midnight, send 107 ;a bulletin warning that call back will be paid unless corrective 108 ;action is taken. 109 ;(i.e a nurse comes in before midnight on last saturday of 110 ;pay period & works for a period less than 2 hrs. before her tour 111 ;that begins at midnight on Sunday, first day of the next pp) 112 ; 113 ; CALLBK = start and stop position in 96 char BCD string. 114 ; RECORD = pointer from employee's tour info to a record 115 ; in tour of duty file. 116 ; DAY = day of the pay period 117 ; D1NXTPP = BOOLEAN; set to true if tour on day 1 of next pay period 118 ; begins at midnight, otherwise false 119 ; NEXTP = next pay period in 97-05 format. 120 ; CURP = current pay period in 99-02 format. 121 ; TLU = 3 digit time & leave unit of employee. 122 N D1NXTPP,RECORD,CURP,NEXTP,XMDUZ,XMB,XMY,XMDUZ 123 S (RTN,D1NXTPP)=0 124 S RECORD=$P($G(^TMP($J,"PRS8",15,0)),"^",2) 125 I RECORD'="" S D1NXTPP=($P($G(^PRST(457.1,RECORD,1)),"^")="MID") 126 I (DAY=14)&($P(CALLBK,"^",2)=96) D 127 . I (D1NXTPP) S RTN=1 128 . E D 129 .. S CURP=$P($G(^PRST(458,PPIEN,0)),"^",1) 130 .. S NXTP=$E($$NXTPP^PRSAPPU(CURP),3,7) 131 ..; Send bulletin to G.PAD 132 .. S XMY("G.PAD@"_^XMB("NETNAME"))="" 133 .. S XMDUZ="DHCP PAID package" 134 .. S XMB="PRS LAST SAT OT/CT" 135 ..; 136 ..; employee name, pay period number, next pay period 137 .. S XMB(1)=EMPNM,XMB(2)=CURP,XMB(3)=NXTP,XMB(4)=TLU 138 .. D ^XMB 139 Q RTN 140 ; 141 LVND ; Leave Night Differential 142 ; back out ND granted for leave if employee took 8 or more hrs of leave 143 ; a non-wage grade employee can receive night differential when 144 ; on leave as long as the employee has taken less than 8 hours of 145 ; leave during the pay period. 146 ; input (note: units are count of 15min time segments): 147 ; LU - leave taken during pay period (set in PRS8AC, PRS8MT) 148 ; WK(#) - piece 10 contains total shift-2 ND for week # 149 ; WKL(#) - ND granted for leave during week # (set in PRS8PP) 150 ; output: 151 ; WK(#) - piece 10 may be modified 152 ; WKL(#) - may be modified 153 N W 154 Q:TYP["W" ; Doesn't apply to Wage Grade 155 Q:LU'>31 ; Didn't take 8hrs of leave 156 F W=1,2 D ; For each week subtract leave ND from total ND 157 . Q:'WKL(W) ; No leave ND to subtract 158 . S $P(WK(W),"^",10)=$P(WK(W),"^",10)-WKL(W) ; Subtract 159 . S WKL(W)=0 ; Reset leave ND amount 160 Q
Note:
See TracChangeset
for help on using the changeset viewer.
