Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRS8SU.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8SU.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8SU.m
r613 r623 1 PRS8SU ;HISC/MRL-DECOMPOSITION, SET-UP ;02/20/08 2 ;;4.0;PAID;**112,116**;Sep 21, 1995;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;This routine sets up various data elements required to process 6 ;a decomp. The ^TMP array is built for each day of the 7 ;pay period (1-14) and includes tour information, exceptions, 8 ;holiday information, etc. All times are converted to 15-minute 9 ;increments in this routine (the number of 15-minute increments 10 ;into the day). Additionally, the credit tour for WG 11 ;employees is determined in this routine. 12 ; 13 ;Called by Routines: PRS8DR 14 ; 15 K ^TMP($J,"PRS8") 16 K D,DAY F DAY=0:1:15 D 17 .I 'CYA,DAY>1,DAY<15,$E($P(PPD,"^",DAY),4,7)="0101" S CYA=DAY 18 .S P=0 I 'DAY S P=+PPD(0),D=14 ;last day of previous pp 19 .I DAY=15 S P=+PPD(15),D=1 ;first day of next pp 20 .I P S ZZ=$S(D=14:0,1:15) 21 .I 'P S P=+PY,(ZZ,D)=+DAY 22 .S W=$S(D<8:1,1:2) K DADRFM S DADRFM=1 23 .S TWO=0 F N=0,1,4,2,10 S Z=$G(^PRST(458,+P,"E",+DFN,"D",+D,N)) D 24 ..S (N14,NDAY,LAST,QT)=0,D(N)=Z,N1=$S(N=2:4,1:3) 25 ..I N=0,$S(ZZ<15:1,1:0) F J=2,13 I +$P(D(0),"^",J) D 26 ...S X=+$P(D(0),"^",$S(J=2:8,1:14)) Q:'X ;normal hours 27 ...I DAY'=0 S X=X\.25 S NH(W)=NH(W)+X ;increment NH 28 ...S Z1=Z,Z=X,D1=D,X="DH"_$S(J=2:1,1:2) D SET S Z=Z1 ;save NH 29 ...S X=+$P(D(0),"^",J) 30 ...S X=+$P($G(^PRST(457.1,+X,0)),"^",3) Q:'X ;mltime 31 ...S X=X\15,MT($S(J=2:1,1:2))=X ;save mltime 32 ...I X S X1=Z,Z=X,D1=D,X="MT"_$S(J=2:1,1:2) D SET S Z=X1 33 ..I "^1^2^4^"[("^"_N_"^") F K=1:N1 S V=$P(Z,"^",K,K+1) Q:QT D 34 ...S X=$P(Z,U,K,999) S:X?1"^"."^"!(X="")!(N14=1) QT=1 I QT!($P(Z,U,K)="") Q 35 ...S:K=1 (NDAY,LAST)=0 F K1=1,2 S X=$P(V,"^",K1),(Y,Y1)=K1-1 I X'="" D 36 ....S FLAG=1 I N=2&(K1=1)&("^HW^"[("^"_$P(Z,"^",K+2)_"^")) S FLAG=$S(NDAY=1!(LAST>96)&("^HW^"[("^"_$P(Z,"^",K+2)_"^"))&((X["A")!(X["MID")):0,1:1),NDAY=0 37 ....S:$P(D(0),"^",14)'=""&(X="MID")&(LAST=96)&(N=2)&(K1=1) FLAG=0 S:N=2&(K1=1)&(FLAG=1) (NDAY,LAST)=0 S Y=K1-1 D 15 38 ....I N=2,"^RG^OT^CT^ON^SB^"'[("^"_$P(Z,"^",K+2)_"^") D 39 .....S Y=+$O(DADRFM("S",(-X-.01))),Y1=+$O(DADRFM("F",(X-.01))) 40 .....I $G(DADRFM("S",Y))'=$G(DADRFM("F",Y1)) S X=X+96 41 .....Q 42 ....S $P(Z,"^",K+(K1-1))=X ;15-minute conversion 43 ....I K1=1,N=1!(N=4) S DADRFM("S",-X)=DADRFM 44 ....I K1=2,N=1!(N=4) S DADRFM("F",X)=DADRFM,DADRFM=DADRFM+1 45 ....I K1=2,X>96,N'=2 S Y=$P(Z,"^",(K+K1)) I Y=""!("12345"'[Y) S X=X-96 D 46 .....I "^0^7^14^"'[("^"_+ZZ_"^") Q 47 .....I $G(^TMP($J,"PRS8",DAY,"MT1"))>1 S X=X-$G(^TMP($J,"PRS8",DAY,"MT1")) 48 .....I ZZ=0!(ZZ=7) S NH($S('ZZ:1,1:2))=NH($S('ZZ:1,1:2))+X 49 .....Q:'ZZ ;already moved previous time to this pp 50 .....S NH($S(D=7:1,1:2))=NH($S(D=7:1,1:2))-X 51 .....Q 52 ....Q 53 ...I N=4,Z?1AN.E!(Z?1"^".AN) D ;2-tour day 54 ....I +D(1)'>+Z S TWO=1_"^"_+Z ;early tour first 55 ....E S TWO=2_"^"_+D(1) ;late tour first 56 ....Q:+TWO=1 ;we're gonna switch 1&4 nodes if necessary now 57 ....S X1=^TMP($J,"PRS8",DAY,1),D1=D,X=1,D(1)=Z D SET ;move 4 node to 1 58 ....S Z=X1,N14=1 K X,X1 ;this will move 1 node to 4 59 ..S D(N)=Z,D1=D,X=N D SET 60 .K DADRFM,MT1,MT2 61 .S Z=TWO,D1=D,X="TWO" D SET 62 .S Z="",$P(Z,"0",97)="",D1=D,X="W" D SET ;activity string 63 .S X="HOL" D SET ;save holiday string 64 .S X="P" D SET ;premium node 65 .S X="r" D SET ;Recess node 66 .S X=D(0),OFF=0 I $P(X,"^",2)=1 S OFF=1 ;day off 67 .S Z=OFF,X="OFF" D SET 68 .I +TWO=2 S MT2=$G(^TMP($J,"PRS8",D1,"MT2")),MT1=$G(^TMP($J,"PRS8",D1,"MT1")),^TMP($J,"PRS8",D1,"MT2")=MT1,^TMP($J,"PRS8",D1,"MT1")=MT2 69 .I TYP["W" D ; -- compute credit tour for WG 70 ..S X=D(0) I DAY=0 S (L,T)=0 71 ..I $P(X,"^",3) S X=$G(^PRST(457.1,+$P(X,"^",4),1)) ;temp tour 72 ..E S X=D(1) ;not temporary 73 ..S S=0 F J=1,4 Q:D(J)="" F I=3:3:28 Q:S!($P(D(J),"^",(I-2))="") D 74 ...I "^6^7^"[("^"_+$P(D(J),"^",I)_"^") S S=+$P(D(J),"^",I)-4 75 ..I 'OFF S:'S S=1 S:(DAY>0)&(DAY<15) L=S ;credit tour 76 ..I DAY>0,DAY<15 D 77 ...I 'T S T=+S 78 ...I S S T=S ;T=credit tour on days off 79 ..S Z=S S:TYP'["W"&(Z>1) Z=1 S D1=DAY,X="TOUR" D SET 80 ..I DAY=7!(DAY=14) S TOUR((DAY\7))=$S(T:T,1:1),T=0 ;save tour 81 I TYP["B" S NH=320,(NH(1),NH(2))=160,TH=192,(TH(1),TH(2))=96 ; Baylor NH=40 hrs to mimic full time, TH = 24 hrs for reality 82 E S TH=NH,TH(1)=NH(1),TH(2)=NH(2) ;total hrs for pp 83 ; 84 ; Update NH for the nurses on the 36/40 AWS 85 I "KM"[$E(AC,1),$E(AC,2)=1,NH=288 S NH=320,(NH(1),NH(2))=160,TH=320,(TH(1),TH(2))=160 86 ; 87 I TYP["W",L>1 S $P(WK(3),"^",3)=L ;last tour (IN) in misc for WG 88 S VALOLD=$G(^PRST(458,+PY,"E",+DFN,5)) ;existing decomp 89 K D,D1,DAY,NDAY,FLAG,J,K,K1,L,LAST,MT,N,N1,N14,P,QT,T,V,W,X,Y,Y1,Z 90 G ^PRS8ST ;start decomp 91 ; 92 15 ; --- convert time to 15-minute increments 93 ; 94 ; Need to conditionally set Y $S(Y=0 mid=00:00, y=1: mid=24:00) 95 ; based on whether exception is within or outside the tour. 96 D MIL^PRSATIM ;convert to military (24hr) time 97 I +Y<1000 S Y=$E("0000",0,4-$L(Y))_Y 98 S X=(+$E(Y,1,2)*4)+($E(Y,3,4)\15) 99 I 'Y1 S X=X+1 ; Add 15 minutes to start time 100 I X<LAST S X=X+96,NDAY=1 ;new day 101 S LAST=X Q 102 ; 103 SET ; --- save value (Z) in ^TMP($J,"PRS8",DAY,X) 104 ; 105 S D1=+ZZ 106 S ^TMP($J,"PRS8",D1,X)=Z Q 107 ; 108 TAL ; --- T&L Unit (whole zeroth node) 109 ; 110 S X=$O(^PRST(455.5,"B",X,0)) 111 S X=$G(^PRST(455.5,+X,0)) I $E(X)="" S X="" 1 PRS8SU ;HISC/MRL-DECOMPOSITION, SET-UP ;7/15/93 10:40 2 ;;4.0;PAID;;Sep 21, 1995 3 ; 4 ;This routine sets up various data elements required to process 5 ;a decomp. The ^TMP array is built for each day of the 6 ;pay period (1-14) and includes tour information, exceptions, 7 ;holiday information, etc. All times are converted to 15-minute 8 ;increments in this routine (the number of 15-minute increments 9 ;into the day). Additionally, the credity tour for WG 10 ;employees is determined in this routine. 11 ; 12 ;Called by Routines: PRS8DR 13 ; 14 K ^TMP($J,"PRS8") 15 K D,DAY F DAY=0:1:15 D 16 .I 'CYA,DAY>1,DAY<15,$E($P(PPD,"^",DAY),4,7)="0101" S CYA=DAY 17 .S P=0 I 'DAY S P=+PPD(0),D=14 ;last day of previous pp 18 .I DAY=15 S P=+PPD(15),D=1 ;first day of next pp 19 .I P S ZZ=$S(D=14:0,1:15) 20 .I 'P S P=+PY,(ZZ,D)=+DAY 21 .S W=$S(D<8:1,1:2) K DADRFM S DADRFM=1 22 .S TWO=0 F N=0,1,4,2,10 S Z=$G(^PRST(458,+P,"E",+DFN,"D",+D,N)) D 23 ..S (N14,NDAY,LAST,QT)=0,D(N)=Z,N1=$S(N=2:4,1:3) 24 ..I N=0,$S(ZZ<15:1,1:0) F J=2,13 I +$P(D(0),"^",J) D 25 ...S X=+$P(D(0),"^",$S(J=2:8,1:14)) Q:'X ;normal hours 26 ...I DAY'=0 S X=X\.25 S NH(W)=NH(W)+X ;increment NH 27 ...S Z1=Z,Z=X,D1=D,X="DH"_$S(J=2:1,1:2) D SET S Z=Z1 ;save NH 28 ...S X=+$P(D(0),"^",J) 29 ...S X=+$P($G(^PRST(457.1,+X,0)),"^",3) Q:'X ;mltime 30 ...S X=X\15,MT($S(J=2:1,1:2))=X ;save mltime 31 ...I X S X1=Z,Z=X,D1=D,X="MT"_$S(J=2:1,1:2) D SET S Z=X1 32 ..I "^1^2^4^"[("^"_N_"^") F K=1:N1 S V=$P(Z,"^",K,K+1) Q:QT D 33 ...S X=$P(Z,U,K,999) S:X?1"^"."^"!(X="")!(N14=1) QT=1 I QT!($P(Z,U,K)="") Q 34 ...S:K=1 (NDAY,LAST)=0 F K1=1,2 S X=$P(V,"^",K1),(Y,Y1)=K1-1 I X'="" D 35 ....S FLAG=1 I N=2&(K1=1)&("^HW^"[("^"_$P(Z,"^",K+2)_"^")) S FLAG=$S(NDAY=1!(LAST>96)&("^HW^"[("^"_$P(Z,"^",K+2)_"^"))&((X["A")!(X["MID")):0,1:1),NDAY=0 36 ....S:$P(D(0),"^",14)'=""&(X="MID")&(LAST=96)&(N=2)&(K1=1) FLAG=0 S:N=2&(K1=1)&(FLAG=1) (NDAY,LAST)=0 S Y=K1-1 D 15 37 ....I N=2,"^RG^OT^CT^ON^SB^HW^"'[("^"_$P(Z,"^",K+2)_"^") D 38 .....S Y=+$O(DADRFM("S",(-X-.01))),Y1=+$O(DADRFM("F",(X-.01))) 39 .....I $G(DADRFM("S",Y))'=$G(DADRFM("F",Y1)) S X=X+96 40 .....Q 41 ....S $P(Z,"^",K+(K1-1))=X ;15-minute conversion 42 ....I K1=1,N=1!(N=4) S DADRFM("S",-X)=DADRFM 43 ....I K1=2,N=1!(N=4) S DADRFM("F",X)=DADRFM,DADRFM=DADRFM+1 44 ....I K1=2,X>96,N'=2 S Y=$P(Z,"^",(K+K1)) I Y=""!("12345"'[Y) S X=X-96 D 45 .....I "^0^7^14^"'[("^"_+ZZ_"^") Q 46 .....I $G(^TMP($J,"PRS8",DAY,"MT1"))>1 S X=X-$G(^TMP($J,"PRS8",DAY,"MT1")) 47 .....I ZZ=0!(ZZ=7) S NH($S('ZZ:1,1:2))=NH($S('ZZ:1,1:2))+X 48 .....Q:'ZZ ;already moved previous time to this pp 49 .....S NH($S(D=7:1,1:2))=NH($S(D=7:1,1:2))-X 50 .....Q 51 ....Q 52 ...I N=4,Z?1AN.E!(Z?1"^".AN) D ;2-tour day 53 ....I +D(1)'>+Z S TWO=1_"^"_+Z ;early tour first 54 ....E S TWO=2_"^"_+D(1) ;late tour first 55 ....Q:+TWO=1 ;we're gonna switch 1&4 nodes if necessary now 56 ....S X1=^TMP($J,"PRS8",DAY,1),D1=D,X=1,D(1)=Z D SET ;move 4 node to 1 57 ....S Z=X1,N14=1 K X,X1 ;this will move 1 node to 4 58 ..S D(N)=Z,D1=D,X=N D SET 59 .K DADRFM,MT1,MT2 60 .S Z=TWO,D1=D,X="TWO" D SET 61 .S Z="",$P(Z,"0",97)="",D1=D,X="W" D SET ;activity string 62 .S X="HOL" D SET ;save holiday string 63 .S X="P" D SET ;premium node 64 .S X=D(0),OFF=0 I $P(X,"^",2)=1 S OFF=1 ;day off 65 .S Z=OFF,X="OFF" D SET 66 .I +TWO=2 S MT2=$G(^TMP($J,"PRS8",D1,"MT2")),MT1=$G(^TMP($J,"PRS8",D1,"MT1")),^TMP($J,"PRS8",D1,"MT2")=MT1,^TMP($J,"PRS8",D1,"MT1")=MT2 67 .I TYP["W" D ; -- compute credit tour for WG 68 ..S X=D(0) I DAY=0 S (L,T)=0 69 ..I $P(X,"^",3) S X=$G(^PRST(457.1,+$P(X,"^",4),1)) ;temp tour 70 ..E S X=D(1) ;not temporary 71 ..S S=0 F J=1,4 Q:D(J)="" F I=3:3:28 Q:S!($P(D(J),"^",(I-2))="") D 72 ...I "^6^7^"[("^"_+$P(D(J),"^",I)_"^") S S=+$P(D(J),"^",I)-4 73 ..I 'OFF S:'S S=1 S:(DAY>0)&(DAY<15) L=S ;credit tour 74 ..I DAY>0,DAY<15 D 75 ...I 'T S T=+S 76 ...I S S T=S ;T=credit tour on days off 77 ..S Z=S S:TYP'["W"&(Z>1) Z=1 S D1=DAY,X="TOUR" D SET 78 ..I DAY=7!(DAY=14) S TOUR((DAY\7))=$S(T:T,1:1),T=0 ;save tour 79 I TYP["B" S NH=320,(NH(1),NH(2))=160,TH=192,(TH(1),TH(2))=96 ; Baylor NH=40 hrs to mimic full time, TH = 24 hrs for reality 80 E S TH=NH,TH(1)=NH(1),TH(2)=NH(2) ;total hrs for pp 81 I TYP["W",L>1 S $P(WK(3),"^",3)=L ;last tour (IN) in misc for WG 82 S VALOLD=$G(^PRST(458,+PY,"E",+DFN,5)) ;existing decomp 83 K D,D1,DAY,NDAY,FLAG,J,K,K1,L,LAST,MT,N,N1,N14,P,QT,T,V,W,X,Y,Y1,Z 84 G ^PRS8ST ;start decomp 85 ; 86 15 ; --- convert time to 15-minute increments 87 ; 88 ; Need to conditionally set Y $S(Y=0 mid=00:00, y=1: mid=24:00) 89 ; based on whether exception is within or outsided tour. 90 D MIL^PRSATIM ;convert to military (24hr) time 91 I +Y<1000 S Y=$E("0000",0,4-$L(Y))_Y 92 S X=(+$E(Y,1,2)*4)+($E(Y,3,4)\15) 93 I 'Y1 S X=X+1 ; Add 15 minutes to start time 94 I X<LAST S X=X+96,NDAY=1 ;new day 95 S LAST=X Q 96 ; 97 SET ; --- save value (Z) in ^TMP($J,"PRS8",DAY,X) 98 ; 99 S D1=+ZZ 100 S ^TMP($J,"PRS8",D1,X)=Z Q 101 ; 102 TAL ; --- T&L Unit (whole zeroth node) 103 ; 104 S X=$O(^PRST(455.5,"B",X,0)) 105 S X=$G(^PRST(455.5,+X,0)) I $E(X)="" S X=""
Note:
See TracChangeset
for help on using the changeset viewer.
