Changeset 636 for FOIAVistA/tag/r/PAID-PRS/PRS8MT.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
-
. (copied) (copied from FOIAVistA/trunk/r )
-
PAID-PRS/PRS8MT.m (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/PAID-PRS/PRS8MT.m
r628 r636 1 PRS8MT ;HISC/MRL-DECOMPOSITION, MEALTIME ; 02/21/082 ;;4.0;PAID;**2,40,69,102,109 ,112,116**;Sep 21, 1995;Build 231 PRS8MT ;HISC/MRL-DECOMPOSITION, MEALTIME ;11/22/06 2 ;;4.0;PAID;**2,40,69,102,109**;Sep 21, 1995;Build 5 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 32 32 GETY ; --- this is where Y (placement of mealtime) is defined 33 33 S X=$E(D,V(1),V(2)),D1=$E(D1,V(1),V(2)) 34 N ORIGX,RECESS35 S ORIGX=X ; Original copy of codes in X and36 S RECESS=DAY(MDY,"r")_$G(DAY(MDY,"rN"))37 S RECESS=$E(RECESS,V(1),V(2)) ; load any Recess38 34 I X["5" D 39 35 . N DAYP … … 48 44 .S Y=$E(X,M) 49 45 .I "1235C"[Y,"1235C"[X1 Q ; scheduled work time 50 .I "4OC"[Y,$E(RECESS,M)="r" S Q=0 Q ; Work performed while on Recess (9mo AWS)51 46 .I Y'="O",Y'=X1 S Q=0 Q ; not same type of time, and non-OT 52 .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))'=2) S Q=0 Q ; OT indicatin gnon-holiday worked gets no meal53 .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))=2),"123C"[X1 S Q=0 Q ; OT indicatin gholiday worked and Excused.47 .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))'=2) S Q=0 Q ; OT indicatin' non-holiday worked gets no meal 48 .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))=2),"123C"[X1 S Q=0 Q ; OT indicatin holiday worked and Excused. 54 49 .Q 55 50 I X["0" D 56 .I RECESS'["r" S SPL=$TR(X,"1235"),SPLX=$TR(X,SPL,$TR($J("",$L(SPL))," ")) 57 .I RECESS["r" S SPL=$TR(X,"01235"),SPLX=$TR(X,SPL,$TR($J("",$L(SPL))," ")) 51 .S SPL=$TR(X,"1235"),SPLX=$TR(X,SPL,$TR($J("",$L(SPL))," ")) 58 52 .I SPLX="" S Q=1 59 ; 60 K M 61 ;--- one activity for entire tour 62 I Q S Q=0 D F M=1:1:MT S M(M)=Y+M-1 53 ; --- one activity for entire tour 54 K M I Q S Q=0 D F M=1:1:MT S M(M)=Y+M-1 63 55 .I V(1)>24,V(2)<73 S Y=MID Q ;no premium time involved/ meal in middle 64 56 .S Q=0 D ;check for all premium … … 78 70 ; --- multiple activities per tour 79 71 E D 80 .S Z=$TR(X,"1235"),X=$TR(X,Z,$TR($J("",$L(Z))," ","0")) 81 .; 82 .; if leave posted > or = to tour length + mt (ie didn't post around 83 .; lunch) it was resulting in OT (ZRIK strips HOL, OC, & no tour time) 84 .; 85 .S ZRIK=$TR(Z,"HC0") 86 .I MT>0,$L(ZRIK)'<(($P(DAY(DAY,0),"^",8)*4)+MT) S X="",$P(X,"1",$L(ZRIK)+1)="" 87 .Q:X?1"0"."0"&(RECESS'["r") 88 .S M=0 F A=1,2 Q:M=MT F B=MID,MID+1,MID-1:-1:V(1),MID+2:1:V(2) D Q:M=MT 89 ..Q:'$E(X,B-V(1)+1) 90 ..I A=1,PM,B<25!(B>72&(B<121)) S M=M+1,M(M)=B 91 ..I A=1,'PM,B>24&(B<73)!(B>120) S M=M+1,M(M)=B 92 ..I A=2 S M=M+1,M(M)=B 93 ..Q 94 .Q 72 . S Z=$TR(X,"1235"),X=$TR(X,Z,$TR($J("",$L(Z))," ","0")) 73 . S ZRIK=$TR(Z,"HC") I MT>0,$L(ZRIK)'<(($P(DAY(DAY,0),"^",8)*4)+MT) S X="",$P(X,"1",$L(ZRIK)+1)="" ;if leave posted > or = to tour length + mt (ie didn't post around lunch) it was resulting in OT (ZRIK strips HOL & OC) 74 . Q:X?1"0"."0" 75 . S M=0 F A=1,2 Q:M=MT F B=MID,MID+1,MID-1:-1:V(1),MID+2:1:V(2) D Q:M=MT 76 . . Q:'$E(X,B-V(1)+1) 77 . . I A=1,PM,B<25!(B>72&(B<121)) S M=M+1,M(M)=B 78 . . I A=1,'PM,B>24&(B<73)!(B>120) S M=M+1,M(M)=B 79 . . I A=2 S M=M+1,M(M)=B 80 . . Q 81 . Q 95 82 Q:'$O(M(0)) 96 83 Y ; --- this is where meals get placed in string 97 84 F Y=0:0 S Y=$O(M(Y)) Q:Y'>0 D 98 85 . N ORIGAC ; original activity code 99 . S M=M(Y),(X,ORIGAC)=$E(D,M),X=$S(X="J":"A",X=5:$E(DAY(MDY,"P"),M),1:X) 100 . ; If a 9mo AWS works during Recess don't place meal over that type of time 101 . I +NAWS=9 D ; 9mo AWS nurses 102 . . ; If extra work (UN,OT,CT) was posted over the entire tour including the meal time 103 . . ; don't include meal time in the W node or you will reduce the extra work count. 104 . . ; Set X=0 to reduce the Recess count below. 105 . . I "4OEC"[ORIGAC&($L(ORIGX)=$L($TR(ORIGX,"1235"))) S X=0 Q 106 . . ; 107 . . ; If extra work posted over tour time that wasn't covered by Recess it will 108 . . ; be stored in the r node. If this time exists, add that time back into the 109 . . ; W node instead of the meal time. 110 . . I "1235"[ORIGAC,"4OEC"[$E(RECESS,M-V(1)+1) D Q 111 . . . S D=$E(D,0,M-1)_$E(RECESS,M-V(1)+1)_$E(D,M+1,999) 112 . . . S ORIGX=$E(ORIGX,1,M-V(1)-1)_$E(RECESS,M-V(1)+1)_$E(ORIGX,M-V(1)+2,999) 113 . . ; 114 . . ; For everything else, update D and ORIGX 115 . . S D=$E(D,0,M-1)_"m"_$E(D,M+1,999) 116 . . S ORIGX=$E(ORIGX,M-V(1)-1)_"m"_$E(ORIGX,M-V(1)+2,999) 117 . ; 118 . ; All employees other than 9mo AWS 119 . I +NAWS'=9 S D=$E(D,0,M-1)_"m"_$E(D,M+1,999) 120 . ; 121 . ; The following line has been updated to include a check for Recess as the 48th piece. 122 . ; Recess will be designated as a zero (0). 123 . S X=$S(X'="M":$F("LSWnAR*U************************V********YXFGD*0",X)-1,1:5) 124 . ; 125 . ; Firefighter checks 126 . I "Ff"[TYP,NH'=480!(NH(1)'=NH(2)) S X=32 127 . ;I X'=4,CYA2806>0 S CYA2806=CYA2806-1 ; << ADDED-> DROP LUNCH FROM CY ALSO>> 128 . Q:X'>0 129 . Q:MDY=0&(M(Y)<96)!(MDY=14&(M(Y)>97)) 130 . S W=$S(MDY<8:1,1:2) I MDY=7&(M(Y)>96) S W=2 131 . I $P(WK(W),"^",+X)>0 S $P(WK(W),"^",+X)=$P(WK(W),"^",+X)-1 ;subtract 132 . ; 133 . ; If Military Leave subtract the mealtime out of the WK(3) array. 134 . I ORIGAC="M",$P(WK(3),U,11)>0 S $P(WK(3),U,11)=$P(WK(3),U,11)-1 135 . ;I WPCYA>0 S WPCYA=WPCYA-1 ;lunch from total << AND FROM CA TOTAL >> 86 . S M=M(Y),(X,ORIGAC)=$E(D,M),X=$S(X="J":"A",X=5:$E(DAY(MDY,"P"),M),1:X),D=$E(D,0,M-1)_"m"_$E(D,M+1,999) 87 . S X=$S(X'="M":$F("LSWnAR*U************************V********YXFGD",X)-1,1:5) 88 . I "Ff"[TYP,NH'=480!(NH(1)'=NH(2)) S X=32 89 . ;I X'=4,CYA2806>0 S CYA2806=CYA2806-1 ; << ADDED-> DROP LUNCH FROM CY ALSO>> 90 . Q:X'>0 91 . Q:MDY=0&(M(Y)<96)!(MDY=14&(M(Y)>97)) 92 . S W=$S(MDY<8:1,1:2) I MDY=7&(M(Y)>96) S W=2 93 . I $P(WK(W),"^",+X)>0 S $P(WK(W),"^",+X)=$P(WK(W),"^",+X)-1 ;subtract 94 . ; If Military Leave subtract the mealtime out of the WK(3) array. 95 . I ORIGAC="M",$P(WK(3),U,11)>0 S $P(WK(3),U,11)=$P(WK(3),U,11)-1 96 . ;I WPCYA>0 S WPCYA=WPCYA-1 ;lunch from total << AND FROM CA TOTAL >> 136 97 . ; PRS*4*40 added 8 (U), 44 (F), 45 (G), 46 (D) to following line 137 98 . ; because PRS8AC also increments LU for those types of time 138 . I +X,"^1^2^6^8^44^45^46^"[("^"_+X_"^") S LU=LU-1 ;reduce leave used139 . I +X,"^3^"[("^"_+X_"^"),"P"[TYP S TH=TH+1,TH(W)=TH(W)+1140 . Q99 . I +X,"^1^2^6^8^44^45^46^"[("^"_+X_"^") S LU=LU-1 ;reduce leave used 100 . I +X,"^3^"[("^"_+X_"^"),"P"[TYP S TH=TH+1,TH(W)=TH(W)+1 101 . Q 141 102 S DAY(MDY,"W")=$E(D,1,96) 142 103 S X=$E(D,97,999) I $L(X) D
Note:
See TracChangeset
for help on using the changeset viewer.
