- PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ;4/04/2007
- ;;4.0;PAID;**22,35,40,56,111,112**;Sep 21, 1995;Build 54
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; for employee on daily tour check if no duty performed during week
- I TYP["D" D NODUTY^PRS8MSC1
- ;
- S B="",Z0="" S $P(B,"B",97)="",$P(Z0,"0",97)="",FLAG=0
- 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
- .I $L(Y)'<96,TYP'["Ff",$E(ENT,27) D ; slp for 24hr cvg
- ..S SLMAX=32,(SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3)=""
- ..I END=96 D
- ...S SLST=$P($G(PEROWK(X)),"^",4),SL2=$E(SLST,SST,$L(SLST)),SL1=$E(SLST,1,SLMAX-$L(SL2)),SL3=$L(SL2)
- ...S SLSTR=SL1_SL2
- ...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB
- ...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0)
- ...S SLY=$L($TR(SLSTR,"b0")),SLW=$L($TR(SLSTR,"B0"))
- ...I SLW>12 Q
- ...I DY=0 S FLAG=SL3
- ...S Y=$L(SLSTR)-SLW
- ...I FLAG>0&(DY=1) S Y=Y-FLAG,FLAG=0
- ...S D=DY,P=25 D SET Q
- ..E D
- ...S SLST=$G(^TMP($J,"PRS8",DY,"W"))_$G(^TMP($J,"PRS8",DY+1,"W"))
- ...S SLSTR=$E(SLST,1,SST+(SLMAX-1))
- ...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB
- ...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0)
- ...S SLY=$E(SLSTR,SST,96),SLY1=$E(SLSTR,97,$L(SLSTR))
- ...S SLSTR=SLY_SLY1,SLW=$L($TR(SLSTR,"B0"))
- ...I SLW>12 Q
- ...S D=DY,Y=$L($TR(SLY,"b0")),P=25 D SET
- ...Q:DY=0 S D=DY+1,Y=$L($TR(SLY1,"b0")) D SET
- ...Q
- ..K BEG,DAT,END,NL,SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3 Q
- .Q
- S D="",(H,ROSS)=1 K OT,UN,DA,CT
- F H=H:ROSS:PEROT D ; calculate CB OT and FF OT/sleep time
- .S Y=PEROT(H),Z=$P(Y,"^",3)
- .I "Ff"[TYP D ;K OT,UN,DA D ; FF sleep time
- ..F M=1:1:$L(Z) D ; following FF OT per Mary Baker 4/1/93
- ...I D'=+Y+(($P(Y,"^",2)+M-2)\96) D
- ....S D=+Y+(($P(Y,"^",2)+M-2)\96),HT=0
- ....Q
- ...S HT=HT+1
- ...I $E(Z,H)="E" S CT(D)=$G(CT(D))+1 Q
- ...I M'>32 S:HT'>32 OT(D)=$G(OT(D))+1 S:HT>32 DA(D)=$G(DA(D))+1 ; FF OT
- ...I M>32,$L(Z)'<96&(M'>64)!($L(Z)<96) S DA(D)=$G(DA(D))+1 ; FF hrs>8
- ...I $L(Z)'<96,M>64 D ; FF 2/3 rule
- ....I M'>96 S UN(D)=$G(UN(D))+1 ; first 8 sleep time
- ....E S DA(D)=$G(DA(D))+1 ; rest hrs >8
- ....Q
- ...Q
- ..Q
- .I $L(Z)<8 D ; call back OT at least 2 hrs
- ..S YY=Y,ZZ=Z N X,Y,START,STOP,T,TT,Z,DD,TL S Y=YY,Z=ZZ
- ..S CB=$G(^TMP($J,"PRS8",+Y,"CB"))
- ..;no call back OT today or send bulletin
- ..Q:(CB="")!($$OTNXTPP(+Y,CB,$P(C0,"^",1),PY,$P(C0,"^",8)))
- ..S Q=0 F ZZ=1:2 Q:'$P(CB,"^",ZZ) I $P(Y,"^",2)=$P(CB,"^",ZZ) S Q=1
- ..Q:'Q ; this OT episode not call back
- ..S OT=Y,START=$P(OT,"^",2),STOP=$P(OT,"^",2)+$L(Z)-1,T=START,TT=$S(T>96:T-96,1:T)
- ..S W=$G(^TMP($J,"PRS8",+OT,"W")),WEEK=$S(+OT>7:2,1:1)
- ..S W1=$G(^TMP($J,"PRS8",OT-1,"W"))
- ..S W2=$G(^TMP($J,"PRS8",OT+1,"W"))
- ..S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0
- ...S DD=Z
- ...I TT-DD>0 S X=$E(W,TT-DD)
- ...E S X=$E(W1,96+T-DD)
- ...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
- ...Q
- ..S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T)
- ..F Z=1:1:8-(STOP-START+1+ZZ) D Q:X=0
- ...S DD=STOP-START+1+ZZ+Z
- ...I T+Z'>96 S X=$E(W,T+Z)
- ...E S X=$E(W2,T-96+Z)
- ...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
- ...Q
- ..S Z=ZZ+Z-(X=0&Z)
- ..I STOP-START+1+Z<8 D
- ...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"))
- ...S D=+OT,P=$S($E($P(PEROT(H),"^",3))'="E":TOUR+19,1:7),Y=8-(STOP-START+1+Z)
- ...;
- ...I TYP["P",TYP'["B",P'=7,'+NAWS D
- ....I $P($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160) S Y=0 Q
- ....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
- ...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
- ...D:Y&('+NAWS) SET
- ...;
- ...I +NAWS D Q ; Checks for just the AWS nurses
- ....N CNT,HT,I
- ....S CNT=Y,Y=1,HT=$G(^TMP($J,"PRS8",D,"HT"))
- ....F I=1:1:CNT D
- .....I HT'<32 S P=$S(P'=7:TOUR+15,1:P) D SET1 Q ; DA/DE or CE/CT
- .....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
- .....I HT<32,TH($S(+OT>7:2,1:1))<160 S P=9 D SET1 Q ; UN/US
- ..Q
- .Q
- F X="OT","DA","UN","CT" D ; store FF OT into WK array
- .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)
- .F D=0:0 S D=$O(@(X_"("_D_")")) Q:D'>0 S Y=@(X_"("_D_")") D SET
- .Q
- ;
- ; check/adjust night differential granted for leave
- D LVND
- Q
- SET ; Set sleep time into WK array
- Q:D<1!(D>14)
- S WEEK=$S(D>7:2,1:1)
- S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
- Q
- ;
- SET1 ; Set sleep time into WK array
- Q:D<1!(D>14)
- S WEEK=$S(D>7:2,1:1)
- S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
- Q:(HT>32)&(TH(WEEK)<160)&(NH<320)&($E(ENT,19)=1)
- Q:(HT>32)&(TH(WEEK)<160)&(NH=320)&($E(ENT,19)=1)&($E(AC,2)=2) ; 9month AWS
- S HT=HT+1,TH(WEEK)=TH(WEEK)+1
- S ^TMP($J,"PRS8",D,"HT")=^TMP($J,"PRS8",D,"HT")+1
- Q
- ;
- OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ;
- ;OT or CT connects to a tour of duty in the next pay period.
- ;JAH-patch PRS*4*22
- ;If OT or CT are worked in last 2 hours of pay period & 1st day
- ;of next pay period is missing a tour beginning at midnight, send
- ;a bulletin warning that call back will be paid unless corrective
- ;action is taken.
- ;(i.e a nurse comes in before midnight on last saturday of
- ;pay period & works for a period less than 2 hrs. before her tour
- ;that begins at midnight on Sunday, first day of the next pp)
- ;
- ; CALLBK = start and stop position in 96 char BCD string.
- ; RECORD = pointer from employee's tour info to a record
- ; in tour of duty file.
- ; DAY = day of the pay period
- ; D1NXTPP = BOOLEAN; set to true if tour on day 1 of next pay period
- ; begins at midnight, otherwise false
- ; NEXTP = next pay period in 97-05 format.
- ; CURP = current pay period in 99-02 format.
- ; TLU = 3 digit time & leave unit of employee.
- N D1NXTPP,RECORD,CURP,NEXTP,XMDUZ,XMB,XMY,XMDUZ
- S (RTN,D1NXTPP)=0
- S RECORD=$P($G(^TMP($J,"PRS8",15,0)),"^",2)
- I RECORD'="" S D1NXTPP=($P($G(^PRST(457.1,RECORD,1)),"^")="MID")
- I (DAY=14)&($P(CALLBK,"^",2)=96) D
- . I (D1NXTPP) S RTN=1
- . E D
- .. S CURP=$P($G(^PRST(458,PPIEN,0)),"^",1)
- .. S NXTP=$E($$NXTPP^PRSAPPU(CURP),3,7)
- ..; Send bulletin to G.PAD
- .. S XMY("G.PAD@"_^XMB("NETNAME"))=""
- .. S XMDUZ="DHCP PAID package"
- .. S XMB="PRS LAST SAT OT/CT"
- ..;
- ..; employee name, pay period number, next pay period
- .. S XMB(1)=EMPNM,XMB(2)=CURP,XMB(3)=NXTP,XMB(4)=TLU
- .. D ^XMB
- Q RTN
- ;
- LVND ; Leave Night Differential
- ; back out ND granted for leave if employee took 8 or more hrs of leave
- ; a non-wage grade employee can receive night differential when
- ; on leave as long as the employee has taken less than 8 hours of
- ; leave during the pay period.
- ; input (note: units are count of 15min time segments):
- ; LU - leave taken during pay period (set in PRS8AC, PRS8MT)
- ; WK(#) - piece 10 contains total shift-2 ND for week #
- ; WKL(#) - ND granted for leave during week # (set in PRS8PP)
- ; output:
- ; WK(#) - piece 10 may be modified
- ; WKL(#) - may be modified
- N W
- Q:TYP["W" ; Doesn't apply to Wage Grade
- Q:LU'>31 ; Didn't take 8hrs of leave
- F W=1,2 D ; For each week subtract leave ND from total ND
- . Q:'WKL(W) ; No leave ND to subtract
- . I +NAWS'=36 S $P(WK(W),"^",10)=$P(WK(W),"^",10)-WKL(W) ; Subtract
- . ; For 36/40 AWS subtract time from Night Differential-AWS (piece 51)
- . I +NAWS=36 S $P(WK(W),"^",51)=$P(WK(W),"^",51)-WKL(W)
- . S WKL(W)=0 ; Reset leave ND amount
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8MSC0 7994 printed Feb 18, 2025@23:49:17 Page 2
- PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ;4/04/2007
- +1 ;;4.0;PAID;**22,35,40,56,111,112**;Sep 21, 1995;Build 54
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; for employee on daily tour check if no duty performed during week
- +5 IF TYP["D"
- DO NODUTY^PRS8MSC1
- +6 ;
- +7 SET B=""
- SET Z0=""
- SET $PIECE(B,"B",97)=""
- SET $PIECE(Z0,"0",97)=""
- SET FLAG=0
- +8 FOR X=1:1:PEROWK
- SET Y=$PIECE(PEROWK(X),"^",4)
- SET DAT=$PIECE(PEROWK(X),"^",1,3)
- SET DY=$PIECE(DAT,"^",1)
- SET BEG=$PIECE(DAT,"^",2)
- SET END=$PIECE(DAT,"^",3)
- Begin DoDot:1
- +9 ; slp for 24hr cvg
- IF $LENGTH(Y)'<96
- IF TYP'["Ff"
- IF $EXTRACT(ENT,27)
- Begin DoDot:2
- +10 SET SLMAX=32
- SET (SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3)=""
- +11 IF END=96
- Begin DoDot:3
- +12 SET SLST=$PIECE($GET(PEROWK(X)),"^",4)
- SET SL2=$EXTRACT(SLST,SST,$LENGTH(SLST))
- SET SL1=$EXTRACT(SLST,1,SLMAX-$LENGTH(SL2))
- SET SL3=$LENGTH(SL2)
- +13 SET SLSTR=SL1_SL2
- +14 ; if PPC = W then OC = SB
- IF DOUB
- SET SLSTR=$TRANSLATE(SLSTR,"Cct","Bbb")
- +15 SET SLSTR=$TRANSLATE(SLSTR,$TRANSLATE(SLSTR,"Bb"),Z0)
- +16 SET SLY=$LENGTH($TRANSLATE(SLSTR,"b0"))
- SET SLW=$LENGTH($TRANSLATE(SLSTR,"B0"))
- +17 IF SLW>12
- QUIT
- +18 IF DY=0
- SET FLAG=SL3
- +19 SET Y=$LENGTH(SLSTR)-SLW
- +20 IF FLAG>0&(DY=1)
- SET Y=Y-FLAG
- SET FLAG=0
- +21 SET D=DY
- SET P=25
- DO SET
- QUIT
- End DoDot:3
- +22 IF '$TEST
- Begin DoDot:3
- +23 SET SLST=$GET(^TMP($JOB,"PRS8",DY,"W"))_$GET(^TMP($JOB,"PRS8",DY+1,"W"))
- +24 SET SLSTR=$EXTRACT(SLST,1,SST+(SLMAX-1))
- +25 ; if PPC = W then OC = SB
- IF DOUB
- SET SLSTR=$TRANSLATE(SLSTR,"Cct","Bbb")
- +26 SET SLSTR=$TRANSLATE(SLSTR,$TRANSLATE(SLSTR,"Bb"),Z0)
- +27 SET SLY=$EXTRACT(SLSTR,SST,96)
- SET SLY1=$EXTRACT(SLSTR,97,$LENGTH(SLSTR))
- +28 SET SLSTR=SLY_SLY1
- SET SLW=$LENGTH($TRANSLATE(SLSTR,"B0"))
- +29 IF SLW>12
- QUIT
- +30 SET D=DY
- SET Y=$LENGTH($TRANSLATE(SLY,"b0"))
- SET P=25
- DO SET
- +31 if DY=0
- QUIT
- SET D=DY+1
- SET Y=$LENGTH($TRANSLATE(SLY1,"b0"))
- DO SET
- +32 QUIT
- End DoDot:3
- +33 KILL BEG,DAT,END,NL,SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3
- QUIT
- End DoDot:2
- +34 QUIT
- End DoDot:1
- +35 SET D=""
- SET (H,ROSS)=1
- KILL OT,UN,DA,CT
- +36 ; calculate CB OT and FF OT/sleep time
- FOR H=H:ROSS:PEROT
- Begin DoDot:1
- +37 SET Y=PEROT(H)
- SET Z=$PIECE(Y,"^",3)
- +38 ;K OT,UN,DA D ; FF sleep time
- IF "Ff"[TYP
- Begin DoDot:2
- +39 ; following FF OT per Mary Baker 4/1/93
- FOR M=1:1:$LENGTH(Z)
- Begin DoDot:3
- +40 IF D'=+Y+(($PIECE(Y,"^",2)+M-2)\96)
- Begin DoDot:4
- +41 SET D=+Y+(($PIECE(Y,"^",2)+M-2)\96)
- SET HT=0
- +42 QUIT
- End DoDot:4
- +43 SET HT=HT+1
- +44 IF $EXTRACT(Z,H)="E"
- SET CT(D)=$GET(CT(D))+1
- QUIT
- +45 ; FF OT
- IF M'>32
- if HT'>32
- SET OT(D)=$GET(OT(D))+1
- if HT>32
- SET DA(D)=$GET(DA(D))+1
- +46 ; FF hrs>8
- IF M>32
- IF $LENGTH(Z)'<96&(M'>64)!($LENGTH(Z)<96)
- SET DA(D)=$GET(DA(D))+1
- +47 ; FF 2/3 rule
- IF $LENGTH(Z)'<96
- IF M>64
- Begin DoDot:4
- +48 ; first 8 sleep time
- IF M'>96
- SET UN(D)=$GET(UN(D))+1
- +49 ; rest hrs >8
- IF '$TEST
- SET DA(D)=$GET(DA(D))+1
- +50 QUIT
- End DoDot:4
- +51 QUIT
- End DoDot:3
- +52 QUIT
- End DoDot:2
- +53 ; call back OT at least 2 hrs
- IF $LENGTH(Z)<8
- Begin DoDot:2
- +54 SET YY=Y
- SET ZZ=Z
- NEW X,Y,START,STOP,T,TT,Z,DD,TL
- SET Y=YY
- SET Z=ZZ
- +55 SET CB=$GET(^TMP($JOB,"PRS8",+Y,"CB"))
- +56 ;no call back OT today or send bulletin
- +57 if (CB="")!($$OTNXTPP(+Y,CB,$PIECE(C0,"^",1),PY,$PIECE(C0,"^",8)))
- QUIT
- +58 SET Q=0
- FOR ZZ=1:2
- if '$PIECE(CB,"^",ZZ)
- QUIT
- IF $PIECE(Y,"^",2)=$PIECE(CB,"^",ZZ)
- SET Q=1
- +59 ; this OT episode not call back
- if 'Q
- QUIT
- +60 SET OT=Y
- SET START=$PIECE(OT,"^",2)
- SET STOP=$PIECE(OT,"^",2)+$LENGTH(Z)-1
- SET T=START
- SET TT=$SELECT(T>96:T-96,1:T)
- +61 SET W=$GET(^TMP($JOB,"PRS8",+OT,"W"))
- SET WEEK=$SELECT(+OT>7:2,1:1)
- +62 SET W1=$GET(^TMP($JOB,"PRS8",OT-1,"W"))
- +63 SET W2=$GET(^TMP($JOB,"PRS8",OT+1,"W"))
- +64 SET (Z,X)=0
- FOR Z=1:1:8-(STOP-START+1)
- Begin DoDot:3
- +65 SET DD=Z
- +66 IF TT-DD>0
- SET X=$EXTRACT(W,TT-DD)
- +67 IF '$TEST
- SET X=$EXTRACT(W1,96+T-DD)
- +68 ; HX becomes time off
- IF "123m"[X
- IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(TT-DD>0:+OT,1:OT-1),"HOL")),$SELECT(TT-DD>0:TT-DD,1:96+T-DD))=1
- SET X=0
- +69 QUIT
- End DoDot:3
- if X=0
- QUIT
- +70 SET ZZ=Z
- if X=0&Z
- SET ZZ=ZZ-1
- SET X=0
- SET T=STOP
- SET TT=$SELECT(T>96:T-96,1:T)
- +71 FOR Z=1:1:8-(STOP-START+1+ZZ)
- Begin DoDot:3
- +72 SET DD=STOP-START+1+ZZ+Z
- +73 IF T+Z'>96
- SET X=$EXTRACT(W,T+Z)
- +74 IF '$TEST
- SET X=$EXTRACT(W2,T-96+Z)
- +75 ; HX becomes time off
- IF "123m"[X
- IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(T+Z'>96:+OT,1:OT+1),"HOL")),$SELECT(T+Z'>96:T+Z,1:T-96+Z))=1
- SET X=0
- +76 QUIT
- End DoDot:3
- if X=0
- QUIT
- +77 SET Z=ZZ+Z-(X=0&Z)
- +78 IF STOP-START+1+Z<8
- Begin DoDot:3
- +79 IF TYP["W"
- IF $EXTRACT($PIECE(PEROT(H),"^",3))'="E"&($GET(^TMP($JOB,"PRS8",$PIECE(PEROT(H),"^",1),"OFF"))=0)
- SET TOUR=$GET(^TMP($JOB,"PRS8",$PIECE(PEROT(H),"^",1),"TOUR"))
- +80 SET D=+OT
- SET P=$SELECT($EXTRACT($PIECE(PEROT(H),"^",3))'="E":TOUR+19,1:7)
- SET Y=8-(STOP-START+1+Z)
- +81 ;
- +82 IF TYP["P"
- IF TYP'["B"
- IF P'=7
- IF '+NAWS
- Begin DoDot:4
- +83 IF $PIECE($GET(^TMP($JOB,"PRS8",$PIECE(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160)
- SET Y=0
- QUIT
- +84 IF $PIECE(C0,"^",12)="E"
- SET P=$SELECT($LENGTH($TRANSLATE(W,"0O"))>31&(TH(WEEK)'>160):TOUR+25,1:P)
- if Y
- DO SET
- SET Y=$SELECT(TH(WEEK)'>160:Y,1:0)
- SET P=9
- if Y
- DO SET
- SET Y=0
- End DoDot:4
- +85 IF $PIECE(C0,"^",12)="N"
- IF P'=7
- SET P=$SELECT($LENGTH($TRANSLATE(W,"0O"))>31:TOUR+15,1:P)
- if Y
- DO SET
- SET Y=0
- +86 if Y&('+NAWS)
- DO SET
- +87 ;
- +88 ; Checks for just the AWS nurses
- IF +NAWS
- Begin DoDot:4
- +89 NEW CNT,HT,I
- +90 SET CNT=Y
- SET Y=1
- SET HT=$GET(^TMP($JOB,"PRS8",D,"HT"))
- +91 FOR I=1:1:CNT
- Begin DoDot:5
- +92 ; DA/DE or CE/CT
- IF HT'<32
- SET P=$SELECT(P'=7:TOUR+15,1:P)
- DO SET1
- QUIT
- +93 ; OA/OE or CE/CT
- IF TH($SELECT(+OT>7:2,1:1))'<160
- SET P=$SELECT(P'=7:TOUR+19,1:P)
- DO SET1
- QUIT
- +94 ; UN/US
- IF HT<32
- IF TH($SELECT(+OT>7:2,1:1))<160
- SET P=9
- DO SET1
- QUIT
- End DoDot:5
- End DoDot:4
- QUIT
- End DoDot:3
- +95 QUIT
- End DoDot:2
- +96 QUIT
- End DoDot:1
- +97 ; store FF OT into WK array
- FOR X="OT","DA","UN","CT"
- Begin DoDot:1
- +98 NEW Y
- SET P=$SELECT(X="OT":TOUR+19,X="DA"&$EXTRACT(ENT,TOUR+18):TOUR+15,X="DA":TOUR+19,X="CT":TOUR+6,1:9)
- +99 FOR D=0:0
- SET D=$ORDER(@(X_"("_D_")"))
- if D'>0
- QUIT
- SET Y=@(X_"("_D_")")
- DO SET
- +100 QUIT
- End DoDot:1
- +101 ;
- +102 ; check/adjust night differential granted for leave
- +103 DO LVND
- +104 QUIT
- SET ; Set sleep time into WK array
- +1 if D<1!(D>14)
- QUIT
- +2 SET WEEK=$SELECT(D>7:2,1:1)
- +3 SET $PIECE(WK(WEEK),"^",P)=$PIECE(WK(WEEK),"^",P)+Y
- +4 QUIT
- +5 ;
- SET1 ; Set sleep time into WK array
- +1 if D<1!(D>14)
- QUIT
- +2 SET WEEK=$SELECT(D>7:2,1:1)
- +3 SET $PIECE(WK(WEEK),"^",P)=$PIECE(WK(WEEK),"^",P)+Y
- +4 if (HT>32)&(TH(WEEK)<160)&(NH<320)&($EXTRACT(ENT,19)=1)
- QUIT
- +5 ; 9month AWS
- if (HT>32)&(TH(WEEK)<160)&(NH=320)&($EXTRACT(ENT,19)=1)&($EXTRACT(AC,2)=2)
- QUIT
- +6 SET HT=HT+1
- SET TH(WEEK)=TH(WEEK)+1
- +7 SET ^TMP($JOB,"PRS8",D,"HT")=^TMP($JOB,"PRS8",D,"HT")+1
- +8 QUIT
- +9 ;
- OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ;
- +1 ;OT or CT connects to a tour of duty in the next pay period.
- +2 ;JAH-patch PRS*4*22
- +3 ;If OT or CT are worked in last 2 hours of pay period & 1st day
- +4 ;of next pay period is missing a tour beginning at midnight, send
- +5 ;a bulletin warning that call back will be paid unless corrective
- +6 ;action is taken.
- +7 ;(i.e a nurse comes in before midnight on last saturday of
- +8 ;pay period & works for a period less than 2 hrs. before her tour
- +9 ;that begins at midnight on Sunday, first day of the next pp)
- +10 ;
- +11 ; CALLBK = start and stop position in 96 char BCD string.
- +12 ; RECORD = pointer from employee's tour info to a record
- +13 ; in tour of duty file.
- +14 ; DAY = day of the pay period
- +15 ; D1NXTPP = BOOLEAN; set to true if tour on day 1 of next pay period
- +16 ; begins at midnight, otherwise false
- +17 ; NEXTP = next pay period in 97-05 format.
- +18 ; CURP = current pay period in 99-02 format.
- +19 ; TLU = 3 digit time & leave unit of employee.
- +20 NEW D1NXTPP,RECORD,CURP,NEXTP,XMDUZ,XMB,XMY,XMDUZ
- +21 SET (RTN,D1NXTPP)=0
- +22 SET RECORD=$PIECE($GET(^TMP($JOB,"PRS8",15,0)),"^",2)
- +23 IF RECORD'=""
- SET D1NXTPP=($PIECE($GET(^PRST(457.1,RECORD,1)),"^")="MID")
- +24 IF (DAY=14)&($PIECE(CALLBK,"^",2)=96)
- Begin DoDot:1
- +25 IF (D1NXTPP)
- SET RTN=1
- +26 IF '$TEST
- Begin DoDot:2
- +27 SET CURP=$PIECE($GET(^PRST(458,PPIEN,0)),"^",1)
- +28 SET NXTP=$EXTRACT($$NXTPP^PRSAPPU(CURP),3,7)
- +29 ; Send bulletin to G.PAD
- +30 SET XMY("G.PAD@"_^XMB("NETNAME"))=""
- +31 SET XMDUZ="DHCP PAID package"
- +32 SET XMB="PRS LAST SAT OT/CT"
- +33 ;
- +34 ; employee name, pay period number, next pay period
- +35 SET XMB(1)=EMPNM
- SET XMB(2)=CURP
- SET XMB(3)=NXTP
- SET XMB(4)=TLU
- +36 DO ^XMB
- End DoDot:2
- End DoDot:1
- +37 QUIT RTN
- +38 ;
- LVND ; Leave Night Differential
- +1 ; back out ND granted for leave if employee took 8 or more hrs of leave
- +2 ; a non-wage grade employee can receive night differential when
- +3 ; on leave as long as the employee has taken less than 8 hours of
- +4 ; leave during the pay period.
- +5 ; input (note: units are count of 15min time segments):
- +6 ; LU - leave taken during pay period (set in PRS8AC, PRS8MT)
- +7 ; WK(#) - piece 10 contains total shift-2 ND for week #
- +8 ; WKL(#) - ND granted for leave during week # (set in PRS8PP)
- +9 ; output:
- +10 ; WK(#) - piece 10 may be modified
- +11 ; WKL(#) - may be modified
- +12 NEW W
- +13 ; Doesn't apply to Wage Grade
- if TYP["W"
- QUIT
- +14 ; Didn't take 8hrs of leave
- if LU'>31
- QUIT
- +15 ; For each week subtract leave ND from total ND
- FOR W=1,2
- Begin DoDot:1
- +16 ; No leave ND to subtract
- if 'WKL(W)
- QUIT
- +17 ; Subtract
- IF +NAWS'=36
- SET $PIECE(WK(W),"^",10)=$PIECE(WK(W),"^",10)-WKL(W)
- +18 ; For 36/40 AWS subtract time from Night Differential-AWS (piece 51)
- +19 IF +NAWS=36
- SET $PIECE(WK(W),"^",51)=$PIECE(WK(W),"^",51)-WKL(W)
- +20 ; Reset leave ND amount
- SET WKL(W)=0
- End DoDot:1
- +21 QUIT