Changeset 636 for FOIAVistA/tag/r/PAID-PRS
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 36 edited
- 1 copied
-
. (copied) (copied from FOIAVistA/trunk/r )
-
PAID-PRS/PRS8AC.m (modified) (8 diffs)
-
PAID-PRS/PRS8CR.m (modified) (2 diffs)
-
PAID-PRS/PRS8DR.m (modified) (3 diffs)
-
PAID-PRS/PRS8EX.m (modified) (4 diffs)
-
PAID-PRS/PRS8HD.m (modified) (2 diffs)
-
PAID-PRS/PRS8HR.m (modified) (5 diffs)
-
PAID-PRS/PRS8HRSV.m (modified) (5 diffs)
-
PAID-PRS/PRS8MSC0.m (modified) (4 diffs)
-
PAID-PRS/PRS8MT.m (modified) (4 diffs)
-
PAID-PRS/PRS8OC.m (modified) (7 diffs)
-
PAID-PRS/PRS8PP.m (modified) (3 diffs)
-
PAID-PRS/PRS8ST.m (modified) (9 diffs)
-
PAID-PRS/PRS8SU.m (modified) (6 diffs)
-
PAID-PRS/PRS8VW.m (modified) (6 diffs)
-
PAID-PRS/PRS8VW1.m (modified) (4 diffs)
-
PAID-PRS/PRS8VW2.m (modified) (6 diffs)
-
PAID-PRS/PRS8WE2.m (modified) (5 diffs)
-
PAID-PRS/PRSACED2.m (modified) (2 diffs)
-
PAID-PRS/PRSACED5.m (modified) (3 diffs)
-
PAID-PRS/PRSACED6.m (modified) (1 diff)
-
PAID-PRS/PRSAENT.m (modified) (2 diffs)
-
PAID-PRS/PRSAENX.m (modified) (2 diffs)
-
PAID-PRS/PRSALVS.m (modified) (3 diffs)
-
PAID-PRS/PRSAOTT.m (modified) (2 diffs)
-
PAID-PRS/PRSAPPH.m (modified) (3 diffs)
-
PAID-PRS/PRSAPPO.m (modified) (3 diffs)
-
PAID-PRS/PRSASR.m (modified) (6 diffs)
-
PAID-PRS/PRSASR1.m (modified) (2 diffs)
-
PAID-PRS/PRSATE.m (modified) (11 diffs)
-
PAID-PRS/PRSATE0.m (modified) (3 diffs)
-
PAID-PRS/PRSATP.m (modified) (2 diffs)
-
PAID-PRS/PRSATP1.m (modified) (2 diffs)
-
PAID-PRS/PRSATPE.m (modified) (7 diffs)
-
PAID-PRS/PRSAUDP.m (modified) (1 diff)
-
PAID-PRS/PRSDSERV.m (modified) (4 diffs)
-
PAID-PRS/PRSPUT3.m (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/PAID-PRS/PRS8AC.m
r628 r636 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. 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 4 3 ; 5 4 ;The primary purpose of this routine is to create the activity … … 16 15 S Q=0 17 16 I DY>0,DY<15 D G END:Q 18 .I DAY(DY,"OFF"),"LSWARUHFGD r"[VAR S Q=1 ;exc invalid day off VAR17 .I DAY(DY,"OFF"),"LSWARUHFGD"[VAR S Q=1 ;exc invalid day off VAR 19 18 K OC,FLAG 20 19 ; 21 20 S DAYZ=DAY(DY,"W")_$G(DAY(DY,"N")),MTM=0 22 21 S DAYH=$G(DAY(DY,"HOL"))_$G(DAY(DY+1,"HOL")) ;holiday node 23 N DAYR24 S DAYR=DAY(DY,"r")_$G(DAY(DY,"rN")) ; Recess25 22 ; 26 23 ;P 45 FIREFIGHTERS F NODE TO TRACK ADDITIONAL FF HRS … … 29 26 F T=+V:1:+$P(V,"^",2) D 30 27 .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 Recess33 28 .I VAR="A"&(JURY=1) S VAR="J" 34 29 .S VAR1=VAR Q:VAR1="" S DAYZ(1)=$E(DAYZ,T) … … 37 32 .I T=+V,"Vh"[VAR1,TYP["I" S DAY(DY,"DWK")=1 ;count days worked for cop 38 33 .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 34 .I "EOPQT4"[VAR1,T'>96,$E(DAYZ,T) Q ;can't earn ct/use ot during work 45 35 .I "OE"[VAR1,"BC"[DAYZ(1),$L(DAYZ(1)) D ; Change OT or CT to CB/SB OT 46 36 ..S VAR1=$C($A($E(DAYZ,T))+32) … … 54 44 .I $E(DAYZ,T)=5,"ALSRUFGD"[VAR1 S VAR1=$E(DAYZ,T) 55 45 .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 .; 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 78 47 .I VAR1="J" S Y=5 D SET ;set authorized absence for jury duty 79 48 .I VAR1="M" S Y=5 D SET ; authorized absence for ML 80 49 .;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)_"^"))) D50 .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 82 51 ..Q:$E(DAY(DY,"P"),T)=5&("ALSRUFGD"'[VAR) 83 52 ..I $D(FLAG) S FLAG=VAR1,VAR1=5 … … 89 58 ...I "^7^8^9^11^"[("^"_$P(V,"^",4)_"^")&(TYP'["N")&(TYP'["H")&('$$HYBRID^PRSAENT1($G(DFN))) S CODE="n" Q 90 59 ...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 premiums92 60 ...I VAR1=5 S CODE=VAR Q 93 61 ...S CODE=1 … … 125 93 ..K S,VAR1 126 94 ; 95 ; 127 96 S DAY(DY,"W")=$E(DAYZ,1,96) ;todays activity 128 97 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 Recess130 S DAY(DY,"rN")=$E(DAYR,97,999) ; Tomorrow's Recess/if any131 98 S:$E(DAY(DY,"P"),97,999)'="" DAY(DY,"P1")=$E(DAY(DY,"P"),97,999) ;non-prem ot for next day 132 99 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")=""100 I DAY(DY,"N")?1"0"."0" S DAY(DY,"N")="" 134 101 S DAY(DY,"HOL")=$E(DAYH,1,96) 135 102 ; … … 167 134 .S X=DAY(DY-1,"P1")_$E(DAY(DY,"P"),$L(DAY(DY-1,"P1"))+1,96) 168 135 .S DAY(DY,"P")=X 169 I $D(DAY(DY-1,"rN")),$L(DAY(DY-1,"rN")) D170 .S X=DAY(DY-1,"rN")_$E(DAY(DY,"r"),$L(DAY(DY-1,"rN"))+1,96)171 .S DAY(DY,"r")=X172 136 ; 173 137 END ; --- all done here -
FOIAVistA/tag/r/PAID-PRS/PRS8CR.m
r628 r636 1 PRS8CR ;HISC/MRL-DECOMPOSITION, CREATE STRING ;01/17/07 2 ;;4.0;PAID;**2,6,45,69,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8CR ;HISC/MRL-DECOMPOSITION, CREATE STRING ;8/23/01 2 ;;4.0;PAID;**2,6,45,69**;Sep 21, 1995 4 3 ; 5 4 ;This routine take the information contained in the WK array … … 17 16 N MLINHRS 18 17 S MLINHRS=$$MLINHRS^PRSAENT(DFN) 19 S S="33333333333333333333333333333333344362323333333 3333"20 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEA EB TATCFAFCADNT RSSRSDND"21 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSEC ED TBTDFBFDAFNH RNSSSHNU"18 S S="33333333333333333333333333333333344362323333333" 19 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEA EB TATCFAFCADNT" 20 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSEC ED TBTDFBFDAFNH" 22 21 S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" 23 22 K V S V="" F I=1,2,3 S V(I)="" 24 23 ; 25 24 ;Next section gets Week 1 and Week 2 data and stores in V(WK) 26 F J=1,2 F I=1:1:38,40,42:1:51 S X=+$P(WK(J),"^",I) I X]"" D 27 .; Don't report PT/PT for nurses on AWS schedules 28 .Q:$E(AC,2)=1&($P(C0,U,16)=72)&(I=32) ; 36/40 AWS 29 .Q:$E(AC,2)=2&($P(C0,U,16)=80)&(I=32) ; 9month AWS 30 .; 25 F J=1,2 F I=1:1:38,40,42,43,44,45,46,47 S X=+$P(WK(J),"^",I) I X]"" D 31 26 .I TYP'["D",I'=38,I'=40 D QH 32 27 .I TYP["D" S X=+X_"0" -
FOIAVistA/tag/r/PAID-PRS/PRS8DR.m
r628 r636 1 PRS8DR ;HISC/MRL,JAH/WCIOFO-DECOMPOSITION, DRIVER ; 4/09/20072 ;;4.0;PAID;**22,29,56,90,111 ,112**;Sep 21, 1995;Build 541 PRS8DR ;HISC/MRL,JAH/WCIOFO-DECOMPOSITION, DRIVER ;1/25/2007 2 ;;4.0;PAID;**22,29,56,90,111**;Sep 21, 1995;Build 2 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; 5 5 ;This routine determines whether or not the parameters necessary 6 ;to decompose time are in exist ence. The majority of variables6 ;to decompose time are in existance. The majority of variables 7 7 ;involving processing an individual employee are defined in this 8 8 ;routine. … … 20 20 K WK F I=1,2,3 S WK(I)="" ;weekly totals (wk3=misc data) 21 21 D ^PRSAENT S VAL="" ;get entitlement (ENT) 22 I PP="S" G END ; Manila citizen/don't decompose/no stub22 I PP="S" G END ;manilla citizen/don't decompose/no stub 23 23 I $G(PB)["$" G STUB^PRS8CR ;don't decompose stipend/create stub 24 ; Set NAWS to type of AWS25 N NAWS26 S NAWS=027 I "KM"[$E(AC,1),$E(AC,2)=1,NH=72 S NAWS="36/40 AWS"28 I $E(AC,1)="M",$E(AC,2)=2,NH=80 S NAWS="9Mo AWS"29 ;30 24 I "^P^X^"[(U_$P($G(^PRST(458,+PY,"E",DFN,0)),"^",2)_U) S RESTORE=1 31 25 D AUTOPINI^PRS8(+PY,+DFN,$G(RESTORE),.PRVAL) ; remove auto-posted data 32 26 S DOUB=0 I $E(ENT,26),$E(ENT,29) S DOUB=1 ;count standby & oncall same 33 27 S FLX="" S FLX=$P($G(^PRST(458,+PY,"E",DFN,0)),"^",6) 34 I +NAWS=36 S FLX="C"35 28 S (SST,TAL)="",X=$P(C0,"^",8) I X'="" D ;T&L Unit 36 29 .S X=$O(^PRST(455.5,"B",X,0)) ;get ien … … 53 46 I $E($G(AC),2)=3 S TYP=TYP_"I" ;intermittent 54 47 I NH>320 S TYP=TYP_"F" I NH'>448 S TYP=TYP_"f" ;firefighter 55 ; Nurses on the 9month AWS will be treated as FT employees during the 9 months 56 ; that they are working. Prevent a "P" from being added to TYP. 57 I NH,NH'>319,$E(AC,2)'=1 S TYP=TYP_"P" ;part-time 48 I NH,NH'>319 S TYP=TYP_"P" ;part-time 58 49 I PP="L",$E(AC,2)=2 S TYP=TYP_"d" ;doctor 59 50 I PP="L",$E(AC,2)=1 S TYP=TYP_"dR" ;doctor/resident or intern -
FOIAVistA/tag/r/PAID-PRS/PRS8EX.m
r628 r636 1 PRS8EX ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;1/ 31/20072 ;;4.0;PAID;**2,40,56,69,111 ,112**;Sep 21, 1995;Build 541 PRS8EX ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;1/25/2007 2 ;;4.0;PAID;**2,40,56,69,111**;Sep 21, 1995;Build 2 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 27 27 ..Q 28 28 .Q 29 S X="^AL^SL^WP^NP^AA^RL^CU^CT^CP^HX^ML^TR^TV^OT^RG^TT^SB^ON^NL^HW^CB^AD^DL ^RS" ;code29 S X="^AL^SL^WP^NP^AA^RL^CU^CT^CP^HX^ML^TR^TV^OT^RG^TT^SB^ON^NL^HW^CB^AD^DL" ;code 30 30 S X=($F(X,"^"_TT)\3)+4,(X,TT(1))=$P($T(ACT+X),";;",2) ;parameters 31 31 S GO=0 I '+X!($E(ENT,+X)) S GO=1 ;entitlement exists-continue … … 76 76 I TT'="UN" S VAR=$P(X,"^",3) ;increment time code 77 77 I '$S(VAR'="W":1,'CYA:1,DY<CYA:1,1:0) D 78 .S WPCY=1 ;flag to save WOP in hours from 1/1 for cal endar year adjustment78 .S WPCY=1 ;flag to save WOP in hours from 1/1 for calander year adjustment 79 79 I TYP'["D" D G END ;process hourly people and quit 80 80 .; The following 2 lines commented out because for Employees that are … … 144 144 ;;31^Adoption^G^45 145 145 ;;35^Donor Leave^D^46 146 ;;5^Recess^r^48 -
FOIAVistA/tag/r/PAID-PRS/PRS8HD.m
r628 r636 1 PRS8HD ;HISC/MGD-DECOMPOSITION, DETERMINE HOLIDAYS ; 12/07/20072 ;;4.0;PAID;**4,33,72,88,94,98,113 ,118**;Sep 21, 1995;Build 11 PRS8HD ;HISC/MGD-DECOMPOSITION, DETERMINE HOLIDAYS ;01/3/2007 2 ;;4.0;PAID;**4,33,72,88,94,98,113**;Sep 21, 1995;Build 3 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 160 160 ;;3040611^President Reagan Funeral^FRIDAY^PRS*4*94 161 161 ;;3070102^President Ford Funeral^TUESDAY^PRS*4*113 162 ;;3071224^Extra Christmas Day^MONDAY^PRS*4*118163 162 ; 164 163 ;--------------------------------------------------------------------- -
FOIAVistA/tag/r/PAID-PRS/PRS8HR.m
r628 r636 1 PRS8HR ;HISC/MRL,WCIOFO/JAH-DECOMPOSITION, HOURS ;06/25/07 2 ;;4.0;PAID;**2,22,29,42,52,102,108,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8HR ;HISC/MRL,WCIOFO/JAH-DECOMPOSITION, HOURS ;05/05/06 2 ;;4.0;PAID;**2,22,29,42,52,102,108**;Sep 21, 1995 4 3 ; 5 4 ;This routine is called by ^PRS8PP (premium pay calculator) … … 68 67 I TYP["I",$E(AC,1)="L",TH=320,"4OosEe"[VAL Q 69 68 ; 70 ; IF type of time is anything but Leave Without Pay "W" or Non-Pay "n" 71 ; THEN increment total hrs HT & increment HTP. Also update 72 ; ^TMP global for reference during the processing of On-Call (PRS8OC). 73 ; 74 I "Wn"'[VAL S HT=HT+1,HTP=HTP+1,^TMP($J,"PRS8",DAY,"HT")=HT 69 ; IF type of time is anything but (leave w/out pay, comp time) 70 ; THEN increment total hrs(HT) & increment HTP if type of 71 ; time not non pay or leave w/out pay. 72 ; 73 ; Update daily counter - *102 added non-pay back into daily count 74 ; 75 S HT=HT+1,HTP=HTP+1 75 76 ; 76 77 ;--------------------------------------------------------- … … 93 94 ; 94 95 ; Check for FT Compressed 95 I $E(AC,2)=1,NH>319,FLX="C",("OoseE4"[VAL) S GO=196 I NH>319,FLX="C",("OoseE4"[VAL) S GO=1 96 97 ; 97 98 ; Check for week … … 137 138 ; Check employees with Normal hours less than 80. (Baylor NH=320) 138 139 ; 139 I NH'>319 !(($E(AC,2)=2)&(NH=320))D TH^PRS8HRSV D Q140 I NH'>319 D TH^PRS8HRSV D Q 140 141 .I FLX="C" D Q:X 141 142 ..; … … 186 187 .S X=$S("Ee"'[VAL:TOUR+19,(TH(W)'>160)&(HT'>32):9,1:7) 187 188 .I TYP["P",VAL[4,TH(W)'>160,HT'>32 S X=9 188 .I TYP["P",VAL="O",TH(W)'>160,HT'>32 S X=9189 189 .D CHK^PRS8HRSV 190 190 Q 191 ; 192 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 193 ; ### DELETE UNLESS EARLIER CHECK WAS RESTORED 194 CT2DAY() ;Determine if comptime eligible including 2 day tour. 195 ; 196 N TOUREC,TWODAY 197 S (RTN,TWODAY)=0 198 ; 199 ; IF time segment contains Scheduled or unscheduled comptime 200 ; or overtime and there is some time in tour hours worked THEN 201 ; check if it's a 2 day tour. For 2 day tours some of time worked 202 ; won't be in HT variable since it occured on other day of two 203 ; day tour, it's not valid to simply check the HT variable for 204 ; 8 hours of work. (patch PRS*4*22) 205 ; 206 I "OosEe4"[VAL,(HT>0),(NH>319) D 207 .S TOUREC=$P($G(DAY(DAY,0)),"^",2) 208 .I TOUREC>0 S TWODAY=$P($G(^PRST(457.1,TOUREC,0)),"^",5) 209 .I TWODAY="Y" S RTN=1 210 Q RTN -
FOIAVistA/tag/r/PAID-PRS/PRS8HRSV.m
r628 r636 1 PRS8HRSV ;WCIOFO/JAH-HOLIDAY FLAG, TIME CHECKER, WK() SET; 04/05/07 2 ;;4.0;PAID;**29,52,102,108,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; Set up variable for holiday worked or holiday excused 1 PRS8HRSV ;WCIOFO/JAH-HOLIDAY FLAG, TIME CHECKER, WK() SET; 05/02/06 2 ;;4.0;PAID;**29,52,102,108**;Sep 21, 1995 3 ; Set up variable for holiday worked or holiday exused 5 4 ; Holiday worked coded 2 in DAY array 6 ; Holiday ex cused coded 1 in DAY array5 ; Holiday exused coded 1 in DAY array 7 6 ; A NON holiday is coded as all zero's in day array. 8 7 ; … … 61 60 I X,Y=2,$E(ENT,+Y)'="H" S X=$S(TYP'["B":0,1:9) 62 61 ; 63 ; IF 36/40 AWS with WP determine eligibility for OT/CT64 ; Skip this check if time is HW (X=29) or OT on Hol (X=24)65 ;66 I "KM"[$E(AC,1),$E(AC,2)=1,$P(C0,U,16)=72,X'=32,X'=29,X'=24 D67 . I HT>32 S X=$S(VAL="O":TOUR+15,VAL="e":7,1:X) Q68 . I TH(W)>160 S X=$S(VAL="O":TOUR+19,VAL="e":7,1:X) Q69 . I HT'>32,TH(W)'>160 S X=970 ;71 62 ; If X is hours in excess of 8/day & > 40/week & type of time 72 63 ; is compensatory time X = 0 … … 112 103 ..I X'=32,$E(ENT,25),'HOLWKD D 113 104 ...S ZZ=X 114 ...; for 36/40 AWS w/ WP or NP report OT on Holiday as (OK/OS)115 ...; For 9mo AWS w/ Recess report OT on Holiday as (OK/OS)116 ...I +NAWS,VAL["O",$E(DAY(DAY,"HOL"),M)=0 S X=24 D SET S X=0 Q117 ...;118 105 ...S X=$S(TYP["P"!(TYP["I"):TOUR+28,1:24) D SET 119 106 ...I TYP["P"!(TYP["I") S X=9 D SET … … 167 154 SET ; --- Set value into WK array 168 155 ; 169 ; Nurses on the 36/40 AWS are FT with Normal Hours of 72. Nurses on the 9 month170 ; AWS are PT with Normal Hours of 80. Neither will not have Part Time Hours171 ; counted in their 8B string.172 ;173 Q:$E(AC,2)=1&($P(C0,U,16)=72)&(X=32) ; 36/40 AWS174 Q:$E(AC,2)=2&(NH=320)&(X=32) ; 9month AWS before any Recess processed175 ;176 156 ; Full time employee & part time hours & normal hours WK1 + WK2 177 157 ; = biweekly normal hours. … … 198 178 I $S(VAL=4:1,"osEe"[VAL!(VAL="O"&('HOLWKD)):1,1:0) D 199 179 . Q:(HT>32)&(TH(W)<160)&(NH<320)&($E(ENT,19)=1) 200 . Q:(HT>32)&(TH(W)<160)&(NH=320)&($E(ENT,19)=1)&($E(AC,2)=2) ; 9month AWS201 180 . S TH=TH+1,TH(W)=TH(W)+1 202 181 Q -
FOIAVistA/tag/r/PAID-PRS/PRS8MSC0.m
r628 r636 1 PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ; 4/04/20072 ;;4.0;PAID;**22,35,40,56,111 ,112**;Sep 21, 1995;Build 541 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 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 80 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 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 82 ...I TYP["P",TYP'["B",P'=7 D 84 83 ....I $P($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160) S Y=0 Q 85 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 86 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 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 86 ...D:Y SET 96 87 ..Q 97 88 .Q … … 109 100 S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y 110 101 Q 111 ;112 SET1 ; Set sleep time into WK array113 Q:D<1!(D>14)114 S WEEK=$S(D>7:2,1:1)115 S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y116 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 AWS118 S HT=HT+1,TH(WEEK)=TH(WEEK)+1119 S ^TMP($J,"PRS8",D,"HT")=^TMP($J,"PRS8",D,"HT")+1120 Q121 ;122 102 OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ; 123 103 ;OT or CT connects to a tour of duty in the next pay period. … … 176 156 F W=1,2 D ; For each week subtract leave ND from total ND 177 157 . 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) 158 . S $P(WK(W),"^",10)=$P(WK(W),"^",10)-WKL(W) ; Subtract 181 159 . S WKL(W)=0 ; Reset leave ND amount 182 160 Q -
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 -
FOIAVistA/tag/r/PAID-PRS/PRS8OC.m
r628 r636 1 PRS8OC ;HISC/MGD-DECOMPOSITION, ON-CALL ;02/27/07 2 ;;4.0;PAID;**63,92,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8OC ;HISC/MGD-DECOMPOSITION, ON-CALL ;02/17/04 2 ;;4.0;PAID;**63,92**;Sep 21, 1995 4 3 ; 5 4 ;The following MUMPS code is used to credit the appropriate … … 34 33 OCS ; --- set On-Call minimum hours 35 34 ;set YA/YE for PPI="W" or "V" else set OT 36 I +NAWS=0 S Y=$S(CC:7,'DOUB:TOUR+19,1:23) 37 I +NAWS S Y=$S(CC:7,1:TOUR+19) 38 ; 35 S Y=$S(CC:7,'DOUB:TOUR+19,1:23) 39 36 N X,Z,DD,TT,CCCNT,NEXTT,OCCNT,TIMECNT 40 37 S TT=$S(T>96:T-96,1:T),TIMECNT=0 … … 83 80 ..I OC+CNTR'>8 D 84 81 ...S Y(1)=$S(X=1:OC,1:8-CNTR) 85 ...I +NAWS=0 D CHOL ; Process everyone but AWS nurses 86 ...I +NAWS D CHOL1 ; Process AWS nurses 82 ...D CHOL 87 83 ...S (OC,OC(D),CC,CC(D))=0,FG=1 88 84 ..Q … … 98 94 ..I OC+CNTR'>8 D 99 95 ...S Y(1)=$S(X=1:OC,1:8-CNTR) 100 ...I +NAWS=0 D CHOL ; Process everyone but AWS nurses 101 ...I +NAWS D CHOL1 ; Process AWS nurses 96 ...D CHOL 102 97 ...S (OC,OC(D),CC,CC(D))=0,FG=1 103 98 ..Q … … 118 113 ...; 119 114 ..S Y(1)=$S(X=2:CC(I)+CCCNT,X:CC(I),OC(I)>7:CC(I),1:4),Y=7 120 ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses 121 ..I +NAWS D CHOL1 ; Process AWS nurses 115 ..D CHOL 122 116 ..S Y(1)=$S(X=2:OC(I)-CC(I)+OCCNT,X:OC(I)-CC(I),OC(I)>7:OC(I)-CC(I),1:4) 123 117 ..S Y=$S('DOUB:TOUR+19,1:23) 124 ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses 125 ..I +NAWS D CHOL1 ; Process AWS nurses 118 ..D CHOL 126 119 ..Q 127 120 .Q … … 132 125 ...I T=96,"ct"'[$E(DAY(DAY+1,"W"),1) S OC(I)=8-TIMECNT 133 126 ..S Y(1)=$S(X:OC(I),OC(I)>7:OC(I),1:8) 134 ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses 135 ..I +NAWS D CHOL1 ; Process AWS nurses 127 ..D CHOL 136 128 ..Q 137 129 .Q … … 155 147 E S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+Y(1) 156 148 Q 157 ;158 CHOL1 ; Checks for AWS nurses159 N HT,J,K,T2ADD160 S K=0,TMP=Y,Y=0161 S T2ADD=$S(CC:Y(1)-CC,1:Y(1)-OC-CC)162 ; Apply normal checks for OT on Hol and Hol Callback163 I TMP'=7,$E(ENT,25),$$HOLIDAY^PRS8UT(PY,DFN,+D) S Y=24 ;ot on actual hol164 I 'Y,$E($G(DAY(I,"HOL")),$S(T>96:(T-96),1:T)) S Y=TOUR+28 ;holiday callback165 I 'Y S Y=TMP166 I Y=24!(Y=(TOUR+28)) D SET Q167 ; If not OT on Hol or Hol Callback Determine if we are setting OT or CT168 S K=$S(Y=7:CC,1:OC)169 F J=1:1:K D AWSWK ; Update actual time worked170 F J=1:1:T2ADD D AWSWK ; Update time added to reach 2 hour min171 Q172 ;173 AWSWK ; Determine what type of time to add based on 8/day and 40/wk174 S HT=+$G(^TMP($J,"PRS8",D,"HT"))175 I HT'<32 S Y=$S(Y'=7:TOUR+15,1:Y) D SET1 Q176 I TH(W)'<160 S Y=$S(Y'=7:TOUR+19,1:Y) D SET1 Q177 I HT<32,TH(W)<160 S Y=9 D SET1178 Q179 ;180 SET1 ; Set WK array for AWS nurses181 S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+1182 Q:HT'<32183 S TH=TH+1,TH(WK)=TH(WK)+1184 S ^TMP($J,"PRS8",DAY,"HT")=HT+1185 Q -
FOIAVistA/tag/r/PAID-PRS/PRS8PP.m
r628 r636 1 PRS8PP ;HISC/MRL,WIRMFO/MGD-DECOMP, PREMIUM PAYS ;05/10/07 2 ;;4.0;PAID;**22,40,75,92,96,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8PP ;HISC/MRL,WIRMFO/MGD-DECOMP, PREMIUM PAYS ;02/27/04 2 ;;4.0;PAID;**22,40,75,92,96**;Sep 21, 1995 4 3 ; 5 4 ;This routine is the entry point for determining certain premium … … 98 97 . . S DAT=$G(^TMP($J,"PRS8",DAYN,2)) D Q:FND 99 98 . . . ; loop thru tour segments in exceptions 100 . . . F TS=1:1:7 Q:$P(DAT,U,(TS-1)* 4+1)="" D Q:FND99 . . . F TS=1:1:7 Q:$P(DAT,U,(TS-1)*3+1)="" D Q:FND 101 100 . . . . ; check if time contained in exception segment 102 . . . . I M1'<$P(DAT,U,(TS-1)*4+1),M1'>$P(DAT,U,(TS-1)*4+2) D 103 . . . . . S TOT=$P(DAT,U,(TS-1)*4+3) 104 . . . . . ; On-Call and Recess are the only types of exceptions 105 . . . . . ; where OT, CT and RG can be posted for the same 15 minute 106 . . . . . ; segment of time, so don't stop searching if you find these. 107 . . . . . I TOT="ON"!(TOT="RS") S TOT="" Q 108 . . . . . S FND=1,SC=$P(DAT,U,(TS-1)*4+4) 109 . . . . . Q 110 . Q:TOT="OT"&("^11^12^17^"'[(U_SC_U)) ; Pre-Scheduled & Tour Coverage & OT/CT With Premiums 111 . Q:TOT="CT"&("^12^17^"'[(U_SC_U)) ; Tour Coverage & OT/CT With Premiums 112 . ; Code 17 - OT/CT with premiums only get ND for 6p-6a 113 . Q:TOT="OT"!(TOT="CT")!(TOT="RG")&(SC=17)&((M'<25)&(M'>72)) 114 . Q:TOT="RG"&(SC'=7)&(SC'=17) ; Shift Coverage & OT/CT With Premiums 115 . S X=10 116 . ; for 36/40 AWS, premium time resulting from their tour 117 . ; will be mapped to Night Differential-AWS (ND/NU) and 118 . ; Paid at the AAC with the 1872 divisor for the hourly rate (36*52) 119 . I +NAWS=36,("OEc"'[VAL!(TOT="HW")) S X=51 120 . D SET 101 . . . . I M1'<$P(DAT,U,(TS-1)*3+1),M1'>$P(DAT,U,(TS-1)*3+2) D 102 . . . . . S FND=1,TOT=$P(DAT,U,(TS-1)*3+3),SC=$P(DAT,U,(TS-1)*3+4) 103 . Q:TOT="OT"&("^11^12^"'[(U_SC_U)) ; Pre-Scheduled & Tour Coverage 104 . Q:TOT="CT"&(SC'=12) ; Tour Coverage 105 . Q:TOT="RG"&(SC'=7) ; Shift Coverage 106 . S X=10 D SET 121 107 . ; keep leave count since it may need to be backed out by PRS8MSC0 122 108 . I "LSRUFGD"[VAL S WKL(WK)=WKL(WK)+1 … … 157 143 . . ; grant ND (unless meal-time, etc.), keep count of leave since it 158 144 . . ; may need to be backed out by PRS8MSC0 159 . . I AV[$E(D,J) D 160 . . . S X=10 161 . . . ; For 36/46 AWS nurses ND for Holiday Worked (HA/HL) and normal 162 . . . ; tour time will be reported as Night Differential-AWS (ND/NU) 163 . . . I +NAWS=36 D 164 . . . . I $E(DAY(DAY,"HOL"),J)=2 S X=51 Q ; Holiday Worked 165 . . . . I "OEc"'[VAL S X=51 ; Tour time 166 . . . D SET 167 . . . S:"LSRUFGD"[$E(D,J) WKL(WK)=WKL(WK)+1 145 . . I AV[$E(D,J) S X=10 D SET S:"LSRUFGD"[$E(D,J) WKL(WK)=WKL(WK)+1 168 146 ; 169 147 Q -
FOIAVistA/tag/r/PAID-PRS/PRS8ST.m
r628 r636 1 PRS8ST ;HISC/MGD-DECOMPOSITION, START-UP ;05/09/07 2 ;;4.0;PAID;**45,92,102,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8ST ;HISC/MGD-DECOMPOSITION, START-UP ;12/12/05 2 ;;4.0;PAID;**45,92,102**;Sep 21, 1995 4 3 ; 5 4 ;This routine is the one which actually gets everything moving. … … 15 14 .S LP=$S(DAY=1:"0,1,2",1:(DAY+1)),JURY=0 16 15 .F II=1:1 S DY=$P(LP,",",II) Q:DY="" D 17 ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W" ,"r"D16 ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W" D 18 17 ...S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J)) 19 18 ...; … … 26 25 ..S WK=$S(DY<8:1,1:2) 27 26 ..S TOUR=$S(TYP'["W":1,+DAY(DY,"TOUR"):+DAY(DY,"TOUR"),1:+TOUR(WK)) 28 ..D MOVE^PRS8AC 29 ..S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week 27 ..D MOVE^PRS8AC S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week 30 28 ..I N["UN" S X1="UN" D 2 ;unavailable 31 29 ..I N["HX" S X1="HX" D 2 ;holiday excused 32 30 ..I N["ON" S X1="ON" D 2 ;on-call 33 31 ..I N["SB" S X1="SB" D 2 ;standby 34 ..; Process the scheduled tours35 32 ..S N=DAY(DY,1),DH=DAY(DY,"DH1"),NN=1 D I DAY(DY,"TWO") S N=DAY(DY,4),DH=DAY(DY,"DH2"),NN=4 D 36 33 ...S QT=0 F PRS8=1:3 S V=$P(N,"^",PRS8,PRS8+2) Q:QT D … … 51 48 .....F J=4,8,12,16,20,24,28 S:$P(JURY,"^",J)=6 JURY=1 Q 52 49 ....D ^PRS8AC ;build "W" node 53 ..; Process the exceptions54 50 ..S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week 55 ..S QT=0 56 ..; If there are Recess exceptions, process them first 57 ..I N["RS" D 58 ...; Since Recess will reduce hours worked in the week add P to TYP 59 ...I TYP'["P" S TYP=TYP_"P" 60 ...F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT D 61 ....Q:$P(V,"^",3)='"RS" 62 ....I TYP["D",$P(V,"^",3)="" S QT=1 Q ;doctor 63 ....I TYP'["D",'+V,$P(V,"^",3)="" S QT=1 Q ;all others 64 ....S X=$P(V,"^",3) 65 ....I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX 66 ...; 67 ...; Process all other types of exceptions 68 ..S QT=0 69 ..F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT D 70 ...Q:$P(V,"^",3)="RS" 51 ..S QT=0 F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT D 71 52 ...I TYP["D",$P(V,"^",3)="" S QT=1 Q ;doctor 72 53 ...I TYP'["D",'+V,$P(V,"^",3)="" S QT=1 Q ;all others 73 ...S X=$P(V,"^",3) 74 ...I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX 75 ..; 54 ...S X=$P(V,"^",3) I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX 76 55 ..S ^TMP($J,"PRS8",DY,"W")=DAY(DY,"W") ;save in ^TMP 77 56 ..S ^TMP($J,"PRS8",DY,"P")=DAY(DY,"P") ;save non-prem ot in ^TMP 78 57 ..S ^TMP($J,"PRS8",DY,"HOL")=DAY(DY,"HOL") ;holiday 79 ..S ^TMP($J,"PRS8",DY,"r")=DAY(DY,"r") ; Recess for 9mo AWS nurse80 58 .S WK=$S(DAY<8:1,1:2),OFF=+DAY(DAY,"OFF") ;week/day off 81 59 .S TOUR=$S(TYP'["W":1,+DAY(DAY,"TOUR"):+DAY(DAY,"TOUR"),1:+TOUR(WK)) … … 86 64 .Q 87 65 ; 88 ;make DAY array available for prior, current, and next day89 66 F DAY=1:1:14 D 90 .; I AWS Nurse check to see if hour counts need to be adjusted 91 .S WK=$S(DAY<8:1,1:2) 92 .; For each week, TYP should not contain "P" unless: 93 .; 36/40 AWS has NP or WP 94 .; 9mo AWS has Recess 95 .I +NAWS,(DAY=1!(DAY=8)) S TYP=$TR(TYP,"P","") D NAWS 96 .; 67 .;make DAY array available for prior, current, and next day 97 68 .K DAY(DAY-2) 98 69 .S LP=$S(DAY=1:"0,1,2",1:(DAY+1)) 99 70 .F II=1:1 S DY=$P(LP,",",II) Q:DY="" D 100 ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","F" ,"r"S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J))71 ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","F" S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J)) 101 72 .; 102 73 .S WK=$S(DAY<8:1,1:2),OFF=+DAY(DAY,"OFF") ;week/day off … … 104 75 .; 105 76 .I ((TYP["I")!(TYP["P")),DAY>0,DAY<15 D ;FOR CY 106 ..I $S('CYA:1,DAY<CYA:1,1:0) Q ;quit if no cal endar year adjustment77 ..I $S('CYA:1,DAY<CYA:1,1:0) Q ;quit if no calander year adjustment 107 78 ..S IIX=0 I $E(ENT,2)'="D" F II=1:1:$L(DAY(DAY,"W")) D 108 79 ...I "4E"[$E(DAY(DAY,"W"),II) S IIX=IIX+1 … … 119 90 ...I T=96!("BbCct"'[$E(DAY(DAY,"W"),T+1)) S OK=T 120 91 ...I DOUB D ^PRS8OC,^PRS8SB Q ;Prem. Pay of "W" or "V" 121 ...I VAR1'=""&("Cct"[VAR1) D ^PRS8OC Q ;comp ute on-call/2hr minimum92 ...I VAR1'=""&("Cct"[VAR1) D ^PRS8OC Q ;compte on-call/2hr minimum 122 93 ...I "Bb"[VAR1 D ^PRS8SB ;standby 123 94 .I $G(SBY) D UP^PRS8SB … … 141 112 I '$E(ENT,$P("12^28^^29^26^^^29","^",+X)) S Q=1 ;entitlement string 142 113 ;PATCH 45: ADD CHECK FOR FIRE FIGHTER ADDITIONAL HOURS 143 ;SINCE THIS TYPE OF TIME IS NOT IN THE ENTITL EMENT TABLE114 ;SINCE THIS TYPE OF TIME IS NOT IN THE ENTITLMENT TABLE 144 115 ;IT IS SET UP WITH TOUR IND. WITH CODE 9 145 116 I "Ff"[TYP,X=9 S Q=0 … … 150 121 F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+2) Q:$P(V,"^",1)="" D 151 122 .S X=$P(V,"^",3) I X=X1 D ^PRS8EX 152 K PRS8,X,V 153 Q 154 ; 155 NAWS ; NAWS Nurse Alternate Work Schedules 156 ; If any NP or WP has been incurred for a nurse on the 36/40 AWS, 157 ; adjust their hours worked counts. 40 hrs/wk will now be used to 158 ; determine their qualification for OT and CT. Check piece 16 of 159 ; 0 node as NH will have been updated to 320 in PRS8SU. 160 ; 161 I +NAWS=36 D 162 .Q:$P(WK(WK),U,3)=""&($P(WK(WK),U,4)="") 163 .S TH(WK)=144-($P(WK(WK),U,3)+$P(WK(WK),U,4)) ; Adjust Total Hours per week 164 .S TH=TH(1)+TH(2) ; Adjust Total Hours per pay period 165 .S NH(WK)=144,NH=288 ; Adjust Normal Hours 166 .I TYP'["P" S TYP=TYP_"P" ; Make them into a PT employee 167 .S $E(ENT,2)=1 ; Make employee eligible for UN/US 168 ; 169 ; If any Recess has occurred for a nurse on the 9month AWS, adjust 170 ; their hours worked counts. These employees will be treated as PT 171 ; in determining the eligibility for OT/CT. 172 ; 173 I +NAWS=9 D 174 .Q:$P(WK(WK),U,48)="" 175 .S TH(WK)=TH(WK)-$P(WK(WK),U,48) ; Adjust total hours per week 176 .S TH=TH(1)+TH(2) ; Adjust Total Hours 177 .I TYP'["P" S TYP=TYP_"P" ; Adjust TYP to represent a PT employee 178 Q 123 K PRS8,X,V Q -
FOIAVistA/tag/r/PAID-PRS/PRS8SU.m
r628 r636 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. 1 PRS8SU ;HISC/MRL-DECOMPOSITION, SET-UP ;7/15/93 10:40 2 ;;4.0;PAID;;Sep 21, 1995 4 3 ; 5 4 ;This routine sets up various data elements required to process … … 8 7 ;holiday information, etc. All times are converted to 15-minute 9 8 ;increments in this routine (the number of 15-minute increments 10 ;into the day). Additionally, the credit tour for WG9 ;into the day). Additionally, the credity tour for WG 11 10 ;employees is determined in this routine. 12 11 ; … … 36 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 37 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 38 ....I N=2,"^RG^OT^CT^ON^SB^ "'[("^"_$P(Z,"^",K+2)_"^") D37 ....I N=2,"^RG^OT^CT^ON^SB^HW^"'[("^"_$P(Z,"^",K+2)_"^") D 39 38 .....S Y=+$O(DADRFM("S",(-X-.01))),Y1=+$O(DADRFM("F",(X-.01))) 40 39 .....I $G(DADRFM("S",Y))'=$G(DADRFM("F",Y1)) S X=X+96 … … 63 62 .S X="HOL" D SET ;save holiday string 64 63 .S X="P" D SET ;premium node 65 .S X="r" D SET ;Recess node66 64 .S X=D(0),OFF=0 I $P(X,"^",2)=1 S OFF=1 ;day off 67 65 .S Z=OFF,X="OFF" D SET … … 81 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 82 80 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 AWS85 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))=16086 ;87 81 I TYP["W",L>1 S $P(WK(3),"^",3)=L ;last tour (IN) in misc for WG 88 82 S VALOLD=$G(^PRST(458,+PY,"E",+DFN,5)) ;existing decomp … … 93 87 ; 94 88 ; 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 thetour.89 ; based on whether exception is within or outsided tour. 96 90 D MIL^PRSATIM ;convert to military (24hr) time 97 91 I +Y<1000 S Y=$E("0000",0,4-$L(Y))_Y -
FOIAVistA/tag/r/PAID-PRS/PRS8VW.m
r628 r636 1 PRS8VW ;HISC/MRL-DECOMPOSITION, VIEW RESULTS ;03/22/07 2 ;;4.0;PAID;**2,6,27,45,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8VW ;HISC/MRL-DECOMPOSITION, VIEW RESULTS ;11/4/97 2 ;;4.0;PAID;**2,6,27,45**;Sep 21, 1995 4 3 ; 5 4 ;This routine is used to view the results of the decomposition. … … 11 10 ;Called by Routines: PRS8, PRS8DR 12 11 S (NEW,VAL)=$G(VAL),(OLD,VALOLD)=$G(VALOLD) 13 N DASH1,DASH214 S $P(DASH1,"-",79)="-",$P(DASH2,"=",79)="="15 12 I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ; 33rd position because CP field 16 13 I +$E(OLD,2,4) S OLD=$E(VALOLD,33,999) ;is added(either "C","F"or" ") … … 26 23 S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1) 27 24 D CTID 28 W ! ,DASH225 W ! F I=1:1:79 W "=" 29 26 W !,"Loc.",?10,"Data Element",?44,"Code",?52,"Old Value",?67,"New Value" 30 27 W !,"----",?10,"------------",?44,"----",?52,"---------",?67,"---------" … … 33 30 D STUB 34 31 I "C"'[$E(IOST) D 35 .W ! ,DASH132 .W ! F I=1:1:79 W "-" 36 33 .W !,TR 37 34 D ONE^PRS8CV,^%ZISC Q 38 35 ; 39 36 CERT ; entry point to show supervisor result of decomp before certifying 40 N DASH1,DASH241 S $P(DASH1,"-",79)="-",$P(DASH2,"=",79)="="42 37 S (NEW,VAL)=$G(VAL) 43 38 I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ;because CP field is added to STUB … … 51 46 .S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X 52 47 S H="PAY PERIOD SUMMARY" W !,$J(H,40+($L(H)/2)),! 53 S X=$P(C0,"^",1)_" [SSN: "_$ E($P(C0,"^",9))_"XXXX"_$E($P(C0,"^",9),6,9)_"]" W !,X48 S X=$P(C0,"^",1)_" [SSN: "_$P(C0,"^",9)_"]" W !,X 54 49 S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1) 55 50 D CTID 56 W ! ,DASH251 W ! F I=1:1:79 W "=" 57 52 W ! 58 53 K I,L,X,USED 59 54 D ^PRS8VW2 60 55 I "C"'[$E(IOST) D 61 .W ! ,DASH156 .W ! F I=1:1:79 W "-" 62 57 .W !,TR 63 58 K H,R,Z Q 64 59 E2 ; --- create E array 65 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT RSSRSDND"66 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH RNSSSHNU"60 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT" 61 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH" 67 62 S E(3)="NLDWMLCAPCCYFE" Q 68 63 STUB ; --- show stub record … … 74 69 ; 75 70 E ; --- create E array 76 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT RSSRSDND"77 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH RNSSSHNU"71 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT" 72 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH" 78 73 S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" Q 79 74 CTID ; compressed tour indicator display -
FOIAVistA/tag/r/PAID-PRS/PRS8VW1.m
r628 r636 1 PRS8VW1 ;HISC/MRL-DECOMPOSITION, VIEW RESULTS, CONT. ;01/23/07 2 ;;4.0;PAID;**6,35,45,69,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8VW1 ;HISC/MRL-DECOMPOSITION, VIEW RESULTS, CONT. ;8/23/01 2 ;;4.0;PAID;**6,35,45,69**;Sep 21, 1995 4 3 ; 5 4 ;This routine is used to view the results of the decomposition. … … 18 17 S E=E(3),W="Misc",LOC=0 D SHOW 19 18 I 'CHECK,"C"'[$E(IOST) D 20 .W ! ,DASH119 .W ! F I=1:1:79 W "-" 21 20 .W !,TR 22 21 K %,CHECK,D,E,I,L,LOC,USED,W,X,Y Q … … 31 30 ..S FOUND(LOC(1))=$G(FOUND(LOC(1))) 32 31 ..S $P(FOUND(LOC(1)),"^",$S(LOC<2:1,1:4))=X 33 .S Y=$P($T(@ ($E(X)_"^PRS8VW2")),";;",2)32 .S Y=$P($T(@$E(X)),";;",2) 34 33 .S Y(1)=$F(Y,$E(X,2)_":") 35 34 .S Y=$P($E(Y,Y(1),999),":",1,2) … … 55 54 I 'S,LOC'=1 K FOUND(LOC(1)) 56 55 Q 56 ; 57 ; This internal table stores types of time codes and their 58 ; corresponding descriptions and TT8B value field lengths. Each 59 ; single char line label below is the 1st char of a type of time code. 60 ; The text on the corresponding line contains '^' delimited 61 ; pieces. The 1st char of those pieces is the 2nd char of a type of 62 ; time. The text description for that time code is given by the 63 ; the number in the 2nd ':' delimited piece. That number indicates 64 ; the line number below the label TYP in routine PRS8VW2. The 3rd 65 ; ':' delimited piece is the length of the time code's value in the 66 ; TT8B String. 67 ; 68 A ;;N:1:3^U:5:3^L:1:3^B:5:3^D:63:3^F:63:3 69 C ;;E:7:3^U:8:3^T:7:3^O:8:3^L:34:4^A:55:4^Y:57:3^D:60:6 70 D ;;A:16:3^B:17:3^C:18:3^E:16:3^F:17:3^G:18:3^W:45:2^T:48:6 71 E ;;A:38:5^B:40:5^C:38:5^D:40:5 72 F ;;F:59:4^A:61:3^B:61:3^C:62:3^D:62:3^E:64:6 73 H ;;A:29:3^B:30:3^C:31:3^L:29:3^M:30:3^N:31:3^D:36:3^O:36:3 74 I ;;N:46:1 75 L ;;U:48:4^N:49:4^D:50:4^A:53:1 76 M ;;L:54:4 77 N ;;O:4:3^A:10:3^B:11:3^P:4:3^R:10:3^S:11:3^L:44:2^T:65:3^H:65:3 78 O ;;A:20:3^B:21:3^C:22:3^K:24:3^M:25:3^N:34:4^E:20:3^F:21:3^G:22:3^S:24:3^U:25:3 79 P ;;T:32:3^A:33:3^H:32:3^B:33:3^C:56:2 80 R ;;T:6:3^A:26:3^B:27:3^C:28:3^L:6:3^E:26:3^F:27:3^G:28:3^R:58:1 81 S ;;K:2:3^P:12:3^A:13:3^B:14:3^C:15:3^L:2:3^Q:12:3^E:13:3^F:14:3^G:15:3 82 T ;;F:19:3^A:42:3^C:43:3^G:19:3^B:42:3^D:43:3^L:47:3^O:52:1 83 U ;;N:9:3^S:9:3 84 V ;;C:37:6^S:37:6 85 W ;;D:3:3^P:3:3 86 Y ;;A:23:3^D:35:4^E:23:3^H:35:4 87 Q -
FOIAVistA/tag/r/PAID-PRS/PRS8VW2.m
r628 r636 1 PRS8VW2 ;HISC/MRL,RTK-DECOMPOSITION, VIEW RESULTS ;03/28/07 2 ;;4.0;PAID;**6,32,34,45,69,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRS8VW2 ;HISC/MRL,RTK-DECOMPOSITION, VIEW RESULTS ;09/27/01 2 ;;4.0;PAID;**6,32,34,45,69**;Sep 21, 1995 4 3 ; 5 4 ; This routine is used to show the results of the decomp to … … 17 16 S E=E(3),W="Misc",LOC=0 D SHOW 18 17 I 'CHECK,"C"'[$E(IOST) D 19 .W ! ,DASH118 .W ! F I=1:1:79 W "-" 20 19 .W !,TR 21 20 K %,CHECK,D,E,I,L,LOC,USED,W,X,Y Q … … 48 47 Q 49 48 ; 50 ; This internal table stores types of time codes and their 51 ; corresponding descriptions and TT8B value field lengths. Each 52 ; single char line label below is the 1st char of a type of time code. 53 ; The text on the corresponding line contains '^' delimited 54 ; pieces. The 1st char of those pieces is the 2nd char of a type of 55 ; time. The text description for that time code is given by the 56 ; the number in the 2nd ':' delimited piece. That number indicates 57 ; the line number below the label TYP in routine PRS8VW2. The 3rd 58 ; ':' delimited piece is the length of the time code's value in the 59 ; TT8B String. 49 ; See description of similar table in routine PRS8VW1 for 50 ; explanation of table below. 60 51 ; 61 52 A ;;N:1:3^U:5:3^L:1:3^B:5:3^D:63:3^F:63:3 … … 65 56 F ;;F:59:4^A:61:3^B:61:3^C:62:3^D:62:3^E:64:6 66 57 H ;;A:29:3^B:30:3^C:31:3^L:29:3^M:30:3^N:31:3^D:36:3^O:36:3 67 I ;;N:46:1 68 L ;;U:48:4^N:49:4^D:50:4^A:53:1 58 I ;;N:46:1 59 L ;;U:48:4^N:49:4^D:50:4^A:53:1 69 60 M ;;L:54:4 70 N ;;O:4:3^A:10:3^B:11:3^P:4:3^R:10:3^S:11:3^L:44:2^T:65:3^H:65:3 ^D:69:3^U:69:361 N ;;O:4:3^A:10:3^B:11:3^P:4:3^R:10:3^S:11:3^L:44:2^T:65:3^H:65:3 71 62 O ;;A:20:3^B:21:3^C:22:3^K:24:3^M:25:3^N:34:4^E:20:3^F:21:3^G:22:3^S:24:3^U:25:3 72 63 P ;;T:32:3^A:33:3^H:32:3^B:33:3^C:56:2 73 R ;;T:6:3^A:26:3^B:27:3^C:28:3^L:6:3^E:26:3^F:27:3^G:28:3^R:58:1 ^S:66:3^N:66:374 S ;;K:2:3^P:12:3^A:13:3^B:14:3^C:15:3^L:2:3^Q:12:3^E:13:3^F:14:3^G:15:3 ^R:67:3^S:67:3^D:68:3^H:68:364 R ;;T:6:3^A:26:3^B:27:3^C:28:3^L:6:3^E:26:3^F:27:3^G:28:3^R:58:1 65 S ;;K:2:3^P:12:3^A:13:3^B:14:3^C:15:3^L:2:3^Q:12:3^E:13:3^F:14:3^G:15:3 75 66 T ;;F:19:3^A:42:3^C:43:3^G:19:3^B:42:3^D:43:3^L:47:3^O:52:1 76 67 U ;;N:9:3^S:9:3 … … 79 70 Y ;;A:23:3^D:35:4^E:23:3^H:35:4 80 71 ; 81 TYP ; literal values of ac tivities (actual name)72 TYP ; literal values of acitivites (actual name) 82 73 ;;Annual Leave 83 74 ;;Sick Leave … … 145 136 ;;Fee Basis 146 137 ;;Base Tour Non Pay Hours 147 ;;Recess148 ;;Saturday Premium-AWS149 ;;Sunday Premium-AWS150 ;;Night Differential-AWS -
FOIAVistA/tag/r/PAID-PRS/PRS8WE2.m
r628 r636 1 PRS8WE2 ;WCIOFO/MGD-DECOMPOSITION, WEEKEND PREMIUM PART 2 ; 3/23/072 ;;4.0;PAID;**90,92,96 ,112**;Sep 21, 1995;Build 543 ; ;Per VHA Directive 2004-038, this routine should not be modified.1 PRS8WE2 ;WCIOFO/MGD-DECOMPOSITION, WEEKEND PREMIUM PART 2 ;10/22/04 2 ;;4.0;PAID;**90,92,96**;Sep 21, 1995 3 ; 4 4 COUNT(DAYN,SEG) ; Increase count of premium for tour 5 5 ; input … … 41 41 . . . Q:TOURS=1!(TOURS=4) ; If on a Tour it counts as Premium 42 42 . . . S RC=$P(TOUR,"^",POST+3) 43 . . . ; Remarks Code must be OT/CT on Premium (#9), Tour Coverage (#12) ,44 . . . ; CB - Premium T&L (#14) or OT/CT With Premiums (#17) to qualify for Premium pay.45 . . . I "^9^12^14^ 17^"'[("^"_RC_"^") S NOTELG=143 . . . ; Remarks Code must be OT/CT on Premium (#9), Tour Coverage (#12) 44 . . . ; or CB - Premium T&L (#14) to qualify for Premium pay. 45 . . . I "^9^12^14^"'[("^"_RC_"^") S NOTELG=1 46 46 . Q:FND 47 47 . ; … … 61 61 . . . Q:TOURS=1!(TOURS=4) ; If on a Tour it counts as Premium 62 62 . . . S RC=$P(TOUR,"^",POST+3) 63 . . . ; Remarks Code must be OT/CT on Premium (#9), Tour Coverage (#12) ,64 . . . ; CB - Premium T&L (#14) or OT/CT With Premiumsto qualify for premium pay.65 . . . I "^9^12^14^ 17^"'[("^"_RC_"^") S NOTELG=163 . . . ; Remarks Code must be OT/CT on Premium (#9), Tour Coverage (#12) 64 . . . ; or CB - Premium T&L (#14) to qualify for premium pay. 65 . . . I "^9^12^14^"'[("^"_RC_"^") S NOTELG=1 66 66 ; 67 67 I $E(H(DAYN),SEG)=1!($E(P(DAYN),SEG)=5) Q … … 85 85 . . . . . . I "^2^3^"[(U_SHIFT_U) S FND=1 86 86 ; 87 ;Set shift 2 for 36/40 AWS nurses with premium time outside tour88 ;for this time segment i.e. overtime(O), comp time(C) or called in from89 ;on-call(c)90 I +NAWS=36,"cOE"[$E(D(DAYN),SEG) S SHIFT=291 87 ; add to count 92 88 S CNT(DAYN,SHIFT)=$G(CNT(DAYN,SHIFT))+1 … … 105 101 . . S AMT=CNT(DAYN,SHIFT) 106 102 . . S PC=$S(TP="SAT":0,1:SHIFT)+12 107 . . ;Shift 2 used for 36/40 nurses premium time within tour using the 2080 divisor (40*52).108 . . ;Saturday Premium-AWS (SR/SS) and Sunday Premium-AWS (SD/SH)109 . . ;Paid at the AAC with the 1872 divisor for the hourly rate (36*52)110 . . ;for time outside the tour.111 . . S:+NAWS=36 PC=$S(SHIFT=2:$S(TP="SAT":12,1:13),TP="SAT":49,1:50)112 103 . . S $P(WK(WEEK),U,PC)=$P(WK(WEEK),U,PC)+AMT 113 104 Q -
FOIAVistA/tag/r/PAID-PRS/PRSACED2.m
r628 r636 1 1 PRSACED2 ; HISC/FPT-T&A Edits ;11/24/1999 2 ;;4.0;PAID;**45,54,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;4.0;PAID;**45,54**;Sep 21, 1995 4 3 ; 5 4 ; initialize array that stores 8b values. This array is used … … 36 35 E2 I NOR=112,DUT=1,'$P(C0,"^",42)!('$P(C1,"^",24)) S ERR=67 D ERR^PRSACED 37 36 I E(9),'$P(C1,"^",46),E(9)'=+NOR S ERR=65 D ERR^PRSACED 38 ;exclude 9/3 month employee 39 I DUT=2,'(NOR="01"&("LMN"[PAY)),'(NOR="80"&(PAY="M")),$P(C0,"^",42)=""!($P(C1,"^",24)="") S ERR=66 D ERR^PRSACED 37 I DUT=2,'(NOR="01"&("LMN"[PAY)),$P(C0,"^",42)=""!($P(C1,"^",24)="") S ERR=66 D ERR^PRSACED 40 38 G ^PRSACED3 41 39 OA ; -
FOIAVistA/tag/r/PAID-PRS/PRSACED5.m
r628 r636 1 PRSACED5 ; HISC/REL/FPT/PLT-T&A Cross-Edits ;11/20/06 12:53 2 ;;4.0;PAID;**102,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 1 PRSACED5 ; HISC/REL/FPT-T&A Cross-Edits ;02/07/06 12:53 2 ;;4.0;PAID;**102**;Sep 21, 1995 5 3 G D1:DUT=1,D2:DUT=2,D3:DUT=3 Q 6 4 D1 G:+NOR N1 … … 13 11 I LVG=5 I E(1)+E(2)+$P(C1,"^",30)>14 S ERR=160 D ERR^PRSACED 14 12 Q 15 ;36/40 employee has 8b normal hour = 72 16 N1 I '(NOR=48!(NOR=72)&("KM"[PAY)),NOR<80 S ERR=153 D ERR^PRSACED 13 N1 I '(NOR=48&("KM"[PAY)),NOR<80 S ERR=153 D ERR^PRSACED 17 14 I '(PAY="W"&(LVG=0)),"123"'[LVG S ERR=154 D ERR^PRSACED 18 15 S E(1)=0 F K=13:1:18,20,43 S X=$P(C0,"^",K),E(1)=E(1)+$E(X,1,2)+($E(X,3)*.25) … … 27 24 I CWK="C",E(1)+E(2)>80 S ERR=166 D ERR^PRSACED 28 25 Q 29 ;exclude 9/3 month employee 30 D2 I PAY'="M"!(FLSA'="E"),NOR<1!(NOR>79) S ERR=155 D ERR^PRSACED 26 D2 I NOR<1!(NOR>79) S ERR=155 D ERR^PRSACED 31 27 I "0123"'[LVG S ERR=156 D ERR^PRSACED 32 28 I "ABCGLMNRU0123456789PQT"'[PAY S ERR=157 D ERR^PRSACED 33 ;exclude 9/3 month employee 34 QUIT:"123"'[LVG!(NOR="80"&(PAY="M")) 29 Q:"123"'[LVG 35 30 S E(1)=0 F K=13:1:18,20,43 S X=$P(C0,"^",K),E(1)=E(1)+$E(X,1,2)+($E(X,3)*.25) 36 31 S E(2)=0 F K=48:1:53 S X=$P(C0,"^",K),E(2)=E(2)+$E(X,1,2)+($E(X,3)*.25) -
FOIAVistA/tag/r/PAID-PRS/PRSACED6.m
r628 r636 1 1 PRSACED6 ; HISC/FPT-T&A Cross-Edits ;11/27/95 10:01 2 ;;4.0;PAID;**6,45,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;4.0;PAID;**6,45**;Sep 21, 1995 4 3 CODES ; Set variables T0 and T1 with 8B code list 5 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 674 ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 6 5 ; 7 6 S T0="AN SK WD NO AU RT CE CU UN NA NB SP DA SA SB SC OA OB OC OK DB OM RA RB RC HA HB HC HD PT PA ON VC EA EB AL SL WP NP AB RL FA FB FC FD AD AF FE",N1=60 8 S T1="CT CO US NR NS DC TF SE SF SG OE OF OG OS TA OU RE RF RG HL HM HN HO PH PB CL VS EC ED NL DW IN TL LU LN LD TO LA ML CA PC TC CY RR SQ FF DE DF YA DG TG YD YE TB DT YH TD NT NH RS RN ND NU SR SS SD SH",N2=677 S T1="CT CO US NR NS DC TF SE SF SG OE OF OG OS TA OU RE RF RG HL HM HN HO PH PB CL VS EC ED NL DW IN TL LU LN LD TO LA ML CA PC TC CY RR SQ FF DE DF YA DG TG YD YE TB DT YH TD NT NH",N2=59 9 8 Q 10 9 STUB ; parse out 'stub' variables from 8b record -
FOIAVistA/tag/r/PAID-PRS/PRSAENT.m
r628 r636 1 1 PRSAENT ;HISC/MGD-Entitlement String ;10/21/04 2 ;;4.0;PAID;**6,21,45,69,75,76,90,96,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;4.0;PAID;**6,21,45,69,75,76,90,96**;Sep 21, 1995 4 3 ; 5 4 ;VARS: … … 102 101 S LVG=$P(C0,"^",15) S:LVG=5 AC=AC_"*" Q 103 102 M I $E(AC,2)=1,NH=48 S AC=AC_"B" Q 104 I $E(AC,2)=2,NH=80 S AC=AC_"R" Q105 103 I $E(AC,2)=2 S PB=$P(C0,"^",20) I PB=0 S AC=AC_"0" Q 106 104 I $E(AC,2)=3 S PB=$P(C0,"^",20) I PB=2 S AC=AC_"2" Q -
FOIAVistA/tag/r/PAID-PRS/PRSAENX.m
r628 r636 1 1 PRSAENX ; HISC/REL-List Entitlement ;3/12/93 12:58 2 ;;4.0;PAID;**34,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;4.0;PAID;**34**;Sep 21, 1995 4 3 K DIC S DIC="^PRST(457.5,",DIC(0)="AEQM" W ! D ^DIC G:Y<1 EX S ENT=^PRST(457.5,+Y,1),NAM=$P(Y,"^",2) 5 4 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX … … 19 18 1 ;;Regular Scheduled 20 19 2 ;;Regular Unscheduled 21 3 ;; FF Reg. Sch. Hrs. Over 5322 4 ;;Re served for future use23 5 ;;Re cess Periods20 3 ;;Reg. Hrs. at OT Rate - Day 21 4 ;;Reg. Hrs. at OT Rate - 2 22 5 ;;Reg. Hrs. at OT Rate - 3 24 23 6 ;;Night Differential - 2 25 24 7 ;;Night Differential - 3 -
FOIAVistA/tag/r/PAID-PRS/PRSALVS.m
r628 r636 1 PRSALVS ;HISC/REL-Display Leave Request ;11/21/06 2 ;;4.0;PAID;**9,69,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRSALVS ;HISC/REL-Display Leave Request ;09/21/01 2 ;;4.0;PAID;**9,69**;Sep 21, 1995 4 3 S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) 5 4 I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX … … 48 47 S EDT=$P($G(^PRST(458.1,DA,0)),"^",5) I EDT'>SDT G B3 49 48 S X1=EDT,X2=SDT D ^%DTC S INC=X+13\14*$S(Z="AL":AINC,1:SINC) 50 I NH=80,DB=2 S X1=EDT,X2=X+13\14*14-X D C^%DTC S INC=INC-$$RT(X,SDT) S:INC<0 INC=051 49 I PRT W !,Z," Estimated Earnings: ",$J(INC,8,3) 52 50 S LST=9999999-SDT,CNT=0 53 51 F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>LST) F RDA=0:0 S RDA=$O(^PRST(458.1,"AD",DFN,DTI,RDA)) Q:RDA="" I $G(^(RDA))'>EDT D 54 52 .S Z1=$G(^PRST(458.1,RDA,0)) S X1=$P(Z1,"^",7) S:"CB AD"[X1 X1="SL" Q:X1'=Z Q:"AR"'[$P(Z1,"^",9) 55 .I NH=72,DB=1 S $P(Z1,U,15)=$$LC($P(Z1,U,15))56 53 .S CNT=CNT+$P(Z1,"^",15) 57 54 .I $P(Z1,"^",3)'<SDT,$P(Z1,"^",5)'>EDT Q … … 66 63 HDR ; Display Header 67 64 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?32,"LEAVE REQUESTS" 68 S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?50, "XXX-XX-",$E(X,6,9) Q65 S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?50,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) Q 69 66 H1 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1 I 'QT W @IOF,! 70 67 Q 71 68 EX G KILL^XUSCLEAN 72 ;Multiply leave request by 1.111 and round down to the quarter hour73 ;for 36/40 nurses74 LC(X) S X=X*1.111\.25*.25 Q X75 ;Calculate number of Recess hours scheduled for a 9-month AWS Nurse76 ;before the date leave has been requested for77 RT(EDT,SDT) N SFY,EFY,T,WK78 S SFY=$E($P($$GETFSCYR^PRSARC04(SDT),U,2),3,6),EFY=$E($P($$GETFSCYR^PRSARC04(EDT),U,2),3,6)79 D RES^PRSARC05(.WK,DFN,SFY,EFY,SDT,EDT) S (I,T)=0 F S I=$O(WK(I)) Q:I="" S T=T+WK(I)80 ;Calculate the number of hours of leave that would have been81 ;accumulated for the time the nurse was on recess.82 Q T/80*$S(Z="AL":AINC,1:SINC)\.25*.25 -
FOIAVistA/tag/r/PAID-PRS/PRSAOTT.m
r628 r636 1 PRSAOTT ;WCIOFO/JAH/PLT- 8B CODES ARRAY. COMPARE OT (8B-vs-APPROVED). ;11/29/2006 2 ;;4.0;PAID;**37,43,54,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRSAOTT ;WCIOFO/JAH- 8B CODES ARRAY. COMPARE OT (8B-vs-APPROVED). ;11/29/1999 2 ;;4.0;PAID;**37,43,54**;Sep 21, 1995 4 3 ; 5 4 ;Function & subroutine Index for this routine. … … 227 226 ; 228 227 Q:$G(WEEK)="" 0 229 Q:WEEK=1 "AN SK WD NO AU RT CE CU UN NA NB SP SA SB SC DA DB DC TF OA OB OC YA OK OM RA RB RC HA HB HC PT PA ON YD HD VC EA EB TA TC FA FC AD NT RS ND SR SD"230 ; 231 Q:WEEK=2 "AL SL WP NP AB RL CT CO US NR NS SQ SE SF SG DE DF DG TG OE OF OG YE OS OU RE RF RG HL HM HN PH PB CL YH HO VS EC ED TB TD FB FD AF NH RN NU SS SH"228 Q:WEEK=1 "AN SK WD NO AU RT CE CU UN NA NB SP SA SB SC DA DB DC TF OA OB OC YA OK OM RA RB RC HA HB HC PT PA ON YD HD VC EA EB TA TC FA FC AD" 229 ; 230 Q:WEEK=2 "AL SL WP NP AB RL CT CO US NR NS SQ SE SF SG DE DF DG TG OE OF OG YE OS OU RE RF RG HL HM HN PH PB CL YH HO VS EC ED TB TD FB FD AF" 232 231 ; 233 232 Q:WEEK=3 "NL DW IN TL LU LN LD DT TO LA ML CA PC CY RR FF FE CD" -
FOIAVistA/tag/r/PAID-PRS/PRSAPPH.m
r628 r636 1 PRSAPPH ; WOIFO/JAH - Holiday Utilities ;12/07/072 ;;4.0;PAID;**33,66,113 ,112,116**;Sep 21, 1995;Build 231 PRSAPPH ; HISC/REL-Holiday Utilities ;01/03/07 2 ;;4.0;PAID;**33,66,113**;Sep 21, 1995;Build 3 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 K HOL S PDT=$G(^PRST(458,PPI,1)) Q:PDT="" S X1=$P(PDT,"^",1),X2=-6 D C^%DTC … … 14 14 E0 ; Find Benefit Day 15 15 Q:DAY=15 I DAY>0,DAY<15 G P0 16 Q:DB'=1 Q:NH=48 !(NH=72)G P1:DAY<0,P3:DAY>1416 Q:DB'=1 Q:NH=48 G P1:DAY<0,P3:DAY>14 17 17 P0 S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2) Q:'TC 18 18 I (TC=3)!(TC=4) G U1 … … 21 21 I TC=2!$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",8)!$P($G(^(0)),"^",14),'$P($G(^(0)),"^",12) G S0 22 22 Q:$P($G(^(0)),"^",12)=LLL&(TT="HX") 23 G U1:DB=2!(NH=72)I FLX'="C" G EF:(DAY#7=1),EB:(DAY#7=0)23 G:DB=2 U1 I FLX'="C" G EF:(DAY#7=1),EB:(DAY#7=0) 24 24 S C=0 F X1=$S(DAY<8:1,1:8):1:DAY I '$P($G(^PRST(458,PPI,"E",DFN,"D",X1,0)),"^",8),'$P($G(^(0)),"^",14) S C=C+1 25 25 I FLX'="C" G EF:C<2,EB -
FOIAVistA/tag/r/PAID-PRS/PRSAPPO.m
r628 r636 1 PRSAPPO ; HISC/MGD - Open New Pay Period ;0 7/30/072 ;;4.0;PAID;**93 ,112**;Sep 21, 1995;Build 541 PRSAPPO ; HISC/MGD - Open New Pay Period ;03/15/06 2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 S PPI=$P(^PRST(458,0),"^",3),PPE=$P(^PRST(458,PPI,0),"^",1) … … 27 27 .I $P($G(^PRSPC(DFN,1)),"^",20)="Y" Q 28 28 .I $P($G(^PRSPC(DFN,1)),"^",33)'="N" Q 29 .S C0=^PRSPC(DFN,0)30 .I $P(C0,U,10)=2,$P(C0,U,16)=80 S NAWS="9Mo AWS",CT9=$G(CT9)+131 .I $P(C0,U,10)=1,$P(C0,U,16)=72 S NAWS="36/40 AWS",CT36=$G(CT36)+132 29 .S PRSIEN=DFN,MDAT=$P(PDT,U,1) 33 30 .S MIEN=$$MIEN^PRSPUT1(PRSIEN,MDAT) … … 37 34 .I $G(MIEN) D PLPP^PRSPLVA(PRSIEN,PPI) 38 35 .; 39 .; Call to Autopost PT Phy Extended Absence36 .; Call to autopost PT Phy Extended Absence 40 37 .I $G(MIEN) D PEAPP^PRSPEAA(PRSIEN,PPI) 41 38 .S N=N+1 W:N#100=0 "." Q 42 ;SEND A MESSAGE WHEN A 9 MONTH AWS NURSE IS ACTIVATED AT A SITE43 I +$G(NAWS) D44 .I $G(CT9) S TMP(1)=CT9_" 9 month AWS nurse(s) set up"45 .I $G(CT36) S TMP(2)=CT36_" 36/40 AWS nurse(s) set up"46 .S S=$$KSP^XUPARAM("INST")_"," D FIND^DIC(456,,,"Q",+S)47 .S IND=$S($D(^TMP("DILIST",$J,0)):+^(0),1:$O(^PRST(456,0)))48 .S CM9=$$GET1^DIQ(456,IND,2),CM36=$$GET1^DIQ(456,IND,4)49 .S MAX=$$GET1^DIQ(456,IND,3) N FDA,DIERR50 .I $G(CT9),CM9<MAX S FDA(456,IND_",",2)=CM9+151 .I $G(CT36),CM36<MAX S FDA(456,IND_",",4)=CM36+152 .Q:'$D(FDA) D FILE^DIE("","FDA"),MSG^DIALOG()53 .S S=$$GET1^DIQ(4,+S,99)_" "_$$GET1^DIQ(4,+S,100),XMTEXT="TMP("54 .S TMP(3)="At "_S,XMDUZ=.5,XMY("VHAOIPAIDETANAWSBULLETIN@VA.GOV")=""55 .S XMSUB=+S_" 36/40, 9 month AWS nurse(s) deployed PRS*4.0*112"56 .D ^XMD K TMP57 39 S $P(^PRST(458,PPI,"E",0),"^",3,4)=N_"^"_N W !!,N," Employee Records created.",! 58 40 EX G KILL^XUSCLEAN -
FOIAVistA/tag/r/PAID-PRS/PRSASR.m
r628 r636 1 PRSASR ;HISC/MGD,WOIFO/JAH /PLT- Supervisor Certification ;02/05/20052 ;;4.0;PAID;**2,7,8,22,37,43,82,93 ,112**;Sep 21, 1995;Build 541 PRSASR ;HISC/MGD,WOIFO/JAH - Supervisor Certification ;02/05/2005 2 ;;4.0;PAID;**2,7,8,22,37,43,82,93**;Sep 21, 1995;Build 7 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 79 79 ; --------------------------------------------------- 80 80 CHK ; Check for needed approvals 81 N PRSENT,PRSWOC82 81 S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I "PX"[STAT Q 83 82 I USR=DFN Q:'$D(^XUSEC("PRSA SIGN",DUZ)) 84 83 E I CKS S SSN=$P($G(^PRSPC(DFN,0)),"^",9) I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) Q:$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE 85 S HDR=0 D HDR ,^PRSAENT S PRSENT=ENT84 S HDR=0 D HDR 86 85 ; 87 86 ;Loop to display tour, exceptions(leave, etc..) & errors. … … 111 110 . D WARNSUP^PRSAOTT(PPE,DFN,VAL,WK,.OTERR,.O8,.OA) 112 111 . I OTERR S ^TMP($J,"OT",DFN,WK)=O8_"^"_OA 113 ;114 ;warning message for rs/rn and on type of time115 I $E(PRSENT,5) D116 . I @($TR($$CD8B^PRSU1B2(VAL,"RS^3^RN^3",1),U,"+")_"-("_$TR($$RSHR^PRSU1B2(DFN,PPI),U,"+")_")") W !,?3,"WARNING: The total scheduled recess hours for this pay period does not match the total RS/RN posted."117 . I $G(PRSWOC)]"" W !,?3,"Warning: The entire tour for day# ",PRSWOC," is posted RECESS. The On-Call will be paid unless posted UNAVAILABLE."118 . QUIT119 112 ; 120 113 LD ; Check for changes to the Labor Distribution Codes made during the pay … … 170 163 HDR ; Display Header 171 164 I HDR S QT=$$ASK^PRSLIB00() Q:QT 172 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X ),"XX-XX-",$E(X,6,9) S HDR=1165 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) S HDR=1 173 166 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF 174 167 W !?3 F I=1:1:72 W "-" … … 178 171 N HOLD 179 172 S HOLD=$$ASK^PRSLIB00(1) 180 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X ),"XX-XX-",$E(X,6,9)173 S X=$G(^PRSPC(DFN,0)) W !,@IOF,?3,$P(X,"^",1) S X=$P(X,"^",9) I X W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) 181 174 W !,?6,"Date",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF 182 175 W !?3 F I=1:1:72 W "-" … … 193 186 Q 194 187 ; 195 ; 188 ;==================================================================== 196 189 ;These extrinsic functions simply remove lengthy code from long, 197 190 ;single line, nested loop. -
FOIAVistA/tag/r/PAID-PRS/PRSASR1.m
r628 r636 1 PRSASR1 ; WCIOFO/JAH - Display VCS, Fee, ED ;02/20/082 ;;4.0;PAID;**6,21,82,93 ,116**;Sep 21, 1995;Build 231 PRSASR1 ;HISC/MGD - Display VCS, Fee, ED ;04/19/05 2 ;;4.0;PAID;**6,21,82,93**;Sep 21, 1995;Build 7 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 VCS ; Display VCS Sales/Fee Basis … … 93 93 W !,@IOF,?3,$P(X,"^",1) 94 94 S X=$P(X,"^",9) 95 I X W ?68,$E(X ),"XX-XX-",$E(X,6,9)95 I X W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) 96 96 W !,DASH 97 97 D LDHDR -
FOIAVistA/tag/r/PAID-PRS/PRSATE.m
r628 r636 1 1 PRSATE ;WCIOFO/JAH - Enter/Edit Employee (emp) Tour of Duty (ToD) ;03/15/2005 2 ;;4.0;PAID;**8,11,27,45,55,93 ,112**;Sep 21, 1995;Build 542 ;;4.0;PAID;**8,11,27,45,55,93**;Sep 21, 1995;Build 7 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 N PPI,PPE,PRSTLV,TLI,TLE,DFN … … 46 46 ; Display header/Ask pp (NOL^PRSATE2 returns SRT = Current, Next, Last) 47 47 ; 48 D NOW^%DTC S NOW=% K %48 D NOW^%DTC S NOW=% 49 49 W:$E(IOST,1,2)="C-" @IOF 50 50 W !?26,"VA TIME & ATTENDANCE SYSTEM" … … 97 97 ... E D 98 98 .... S NOERROR=1 99 K NOWQ99 Q 100 100 ;======================= 101 101 ; … … 120 120 ; ask TK about all others. 121 121 ; 122 S DB=$P(C0,U,10) I FLX="C"!("KM"[PP&(DB=1)&(NH=72))D122 I FLX="C" D 123 123 . D VAR 124 124 E D … … 128 128 .. D VAR 129 129 . E D FX 130 K DBQ130 Q 131 131 ;======================= 132 132 ; … … 147 147 . W " ... done" D:HRS'=NH ERROR(2,NH,HRS) 148 148 . D T2,^PRSATE5 149 D HOL,RS K HRS,STR149 D HOL,RS 150 150 Q 151 151 ;======================= … … 205 205 S $P(^PRST(458,PPI,"E",DFN,0),U,$S(SRT="N":7,1:6))=Y 206 206 I $D(^PRST(458,"ATC",DFN)) D UPD^PRSASAL 207 K PAY,ZENTQ207 Q 208 208 ;======================= 209 209 ; … … 268 268 ; 269 269 D S1 270 K OLD,SCHQ270 Q 271 271 ;======================= 272 272 ; … … 298 298 Q:'$D(HOL) 299 299 S TT="HX",DUP=1 300 D E^PRSAPPH K DUP,HOL,TT300 D E^PRSAPPH 301 301 Q 302 302 ;======================= … … 332 332 S DIR("?",1)="Fixed tours are Monday - Friday with the same hours." 333 333 D ^DIR 334 Q $S(Y=1:"Y",Y=0:"N",1:"^") 334 S RESP=$S(Y=1:"Y",Y=0:"N",1:"^") 335 Q RESP 335 336 ;======================= 336 337 ; … … 343 344 S DIR("?")="Enter ^ to escape and cancel this tour change." 344 345 D ^DIR 345 Q $S(Y=1:"Y",Y=0:"N",1:"^") 346 ;======================= 347 ; 346 S RESP=$S(Y=1:"Y",Y=0:"N",1:"^") 347 Q RESP 348 ;======================= 349 ; -
FOIAVistA/tag/r/PAID-PRS/PRSATE0.m
r628 r636 1 1 PRSATE0 ; HISC/REL-Edit Variable Tours ;5/30/95 14:37 2 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;4.0;PAID;;Sep 21, 1995 4 3 S TOLD="" F K=1:1:14 S Z=$P($G(^PRST(458,PPI,"E",DFN,"D",K,0)),"^",2),$P(TOLD,"^",K)=Z I SRT="N",$P($G(^(0)),"^",3) S $P(TOLD,"^",K)=$P(^(0),"^",4) 5 K KS ^PRST(458,PPI,"E",DFN,"T")=TOLD D DT^PRSATE24 S ^PRST(458,PPI,"E",DFN,"T")=TOLD D DT^PRSATE2 6 5 K DDSFILE,DA,DR,PRSAERR S DDSFILE=458,DDSFILE(1)=458.01,DA(1)=PPI,DA=DFN 7 6 S DR="[PRSA TE EDIT]" D ^DDS K DS Q:$D(PRSAERR) … … 9 8 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14" 10 9 F DAY=1:1:14 S TD=$P(TNEW,"^",DAY) I TD>0 D S1 11 K TNEW,TOLDQ10 Q 12 11 S1 ; Set Tour if necessary 13 12 I TD=$P(TOLD,"^",DAY),$G(^PRST(457.1,+TD,1))=$G(^PRST(457.1,+$P(TOLD,"^",DAY),1)) Q … … 21 20 Q 22 21 VAL ; Validate Tour 23 N NAWS,SNAWS,TDT S (ZENT,STR)="" K PRSAERR D OT^PRSATP S DB=$P(C0,U,10) I "KM"[PP,DB=1,NH=72 S NAWS=1 24 S (HRS,TRS,TDT)=0 F DAY=1:1:14 D I STR'="" G V1 25 .S TD=$$GET^DDSVAL(DIE,.DA,DAY+200),Z=$P($G(^PRST(457.1,+TD,0)),"^",6) S:Z HRS=HRS+Z S Y=$G(^(1)) 26 .I DAY=7!(DAY=14)&'TDT S TDT=$P($G(^PRST(457.1,+TD,0)),U,5)="Y" 27 .I $D(NAWS) S:Z'=12&Z NAWS=0 S $P(SNAWS,U,DAY)=TD I Z=12 S NAWS(DAY-1\7+1)=$G(NAWS(DAY-1\7+1))+1 28 .D VS S:TRG TRS=TRS+1 22 S (ZENT,STR)="" K PRSAERR D OT^PRSATP 23 S (HRS,TRS)=0 F DAY=1:1:14 S TD=$$GET^DDSVAL(DIE,.DA,DAY+200) S Z=$P($G(^PRST(457.1,+TD,0)),"^",6) S:Z HRS=HRS+Z S Y=$G(^(1)) D VS S:TRG TRS=TRS+1 I STR'="" G V1 29 24 I FLX="C",TRS>9 S STR="Warning: Compressed Schedule has more than 9 Tours!" D HLP^DDSUTL(.STR) 30 25 I NH'=HRS,NH'=112 S STR="Warning: Normal Hours are "_NH_"; Tour Hours are "_HRS D HLP^DDSUTL(.STR) 31 I $D(NAWS) D 32 .I $G(NAWS(1))'=3!($G(NAWS(2))'=3)!'NAWS S STR=$P($T(NAWS1),";",3) D HLP^DDSUTL(.STR) 33 .D TOURHRS^PRSARC07(.HRS,PPI,DFN,SNAWS) 34 .I $G(HRS("W1"))'=36!($G(HRS("W2"))'=36) S STR=$P($T(NAWS2),";",3) D HLP^DDSUTL(.STR) 35 .I $G(TDT) S STR=$P($T(NAWS3),";",3) D HLP^DDSUTL(.STR) 36 K K,STR,TRG,TRS Q 37 V1 S (DDSERROR,PRSAERR)=1 D HLP^DDSUTL(.STR) K DDSERROR Q 38 NAWS1 ;;Warning: There are not three 12 hour tours in week 1 and/or week 2 for this AWS 36/40 Nurse 39 NAWS2 ;;Warning: Hours in week 1 and/or week 2 are not 36 for this AWS 36/40 Nurse. 40 NAWS3 ;;Warning: Tour overlaps two administrative work weeks for this 36/40 Nurse. 26 Q 27 V1 S (DDSERROR,PRSAERR)=1 D HLP^DDSUTL(.STR) Q -
FOIAVistA/tag/r/PAID-PRS/PRSATP.m
r628 r636 1 PRSATP ;HISC/REL,WIRMFO/MGD /PLT - Timekeeper Post Time ;11/21/062 ;;4.0;PAID;**22,57,69,92,102,93 ,112**;Sep 21, 1995;Build 541 PRSATP ;HISC/REL,WIRMFO/MGD - Timekeeper Post Time ;3/21/06 2 ;;4.0;PAID;**22,57,69,92,102,93**;Sep 21, 1995;Build 7 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; input (from calling option) … … 86 86 ; ML to list if they are. Added to be compliant with Public Law 87 87 ; 106-554. 88 S:$E(ENT,34) Z1=Z1_" 34",Z2=Z2_" ML"89 ;9/3 month employee entitled RS with recess hours in file# 458.890 S:$E(ENT,5)&$P($$RSHR^PRSU1B2(DFN,PPE),U,DAY>7+1) Z1=Z1_" 5",Z2=Z2_" RS"91 F K=1:1:$L(Z1," ") I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" "92 QUIT93 88 ; 89 I $E(ENT,34) D 90 . S Z1=Z1_" 34",Z2=Z2_" ML" 91 . F K=1:1:14 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " 92 ; 93 I '$E(ENT,34) D 94 . F K=1:1:13 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " 95 Q 94 96 OT ; Get entitled out-of-tour types of time 95 97 S Z1="12 28 26",Z2="OT CT ON" F K=1:1:3 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " I ZENT'["UN" S ZENT=ZENT_"UN " -
FOIAVistA/tag/r/PAID-PRS/PRSATP1.m
r628 r636 1 PRSATP1 ; HISC/REL,WOIFO/PLT - Daily Post verification ;11/28/2006 2 ;;4.0;PAID;**34,57,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRSATP1 ; HISC/REL-Daily Post verification ;2/28/2000 2 ;;4.0;PAID;**34,57**;Sep 21, 1995 4 3 ;routine is called to validate data entered during the 5 4 ;screenman posting of an employees pay period … … 12 11 .I Z2>2880 D E5 Q 13 12 .I $P(Z,"^",K+2)="" D E9 Q 14 .;check duplicate start time if no rs-type of time in exception string z for node 2 15 .I Z'["^RS",'(Z["HX"&("ON HW"[$P(Z,"^",K+2))),'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")),$D(T(Z1)) D E3 Q 13 .I '(Z["HX"&("ON HW"[$P(Z,"^",K+2))),'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")),$D(T(Z1)) D E3 Q 16 14 .I $P(Z,"^",K+2)="HW",Z'["HX",'$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D E7 Q 17 .I $P(Z,"^",K+2)'="" S T(Z1 )=$G(T(Z1))_$P(Z,U,K+2)_U,T(Z1,K)=Z2_"^"_$P(Z,"^",K,K+3)15 .I $P(Z,"^",K+2)'="" S T(Z1,K)=Z2_"^"_$P(Z,"^",K,K+3) 18 16 .Q 19 17 I '$D(T) Q 20 ;check duplicate start time if rs in exception string z for node 2. 21 S Z1="" I Z["^RS",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) F S Z1=$O(T(Z1)) QUIT:Z1="" QUIT:Z["HX"&("^ON^HW^"[T(Z1)) I $L(T(Z1),U)>2 D QUIT:Z1="*" 22 . N A 23 . S A=T(Z1),A=U_A 24 . I $L(A,U)>4 S Z1="*" QUIT 25 . I A'["^RS^" S A=$P(A,"^ON")_$P(A,"^ON",2) S:A="" A="^ON" I "^CT^"'[A,"^OT^"'[A,Z'["^HX"!("^HW^"'[A) S Z1="*" QUIT 26 . I A["^RS^" S A=$P(A,"^RS")_$P(A,"^RS",2) S:A="" A="^RS" I "^CT^OT^RG^ON^HW^"'[A S Z1="*" QUIT 27 . QUIT 28 G:Z1="*" E3 29 ;exclude rs with ct, ot, rg, on, hw for error e2 check 30 I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) S Z1="" F S Z1=$O(T(Z1)) Q:Z1="" G:Z1'<T(Z1,$O(T(Z1,0))) E1 S Y=$O(T(Z1)) I Y,T(Z1,$O(T(Z1,0)))>Y G E2:'(T(Z1)["RS^"&("^CT^OT^RG^ON^HW^"[T(Y)))&'("^CT^OT^RG^ON^HW^"[T(Z1)&(T(Y)["RS^")) 18 I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) S Z1="" F S Z1=$O(T(Z1)) Q:Z1="" G:Z1'<T(Z1,$O(T(Z1,0))) E1 S Y=$O(T(Z1)) I Y,T(Z1,$O(T(Z1,0)))>Y G E2 31 19 S Z1="",LL=1 F S Z1=$O(T(Z1)) Q:Z1="" F K=0:0 S K=$O(T(Z1,K)) Q:K<1 D 32 20 .S $P(ZS,"^",LL)=$P(T(Z1,K),"^",2),$P(ZS,"^",LL+1)=$P(T(Z1,K),"^",3),$P(ZS,"^",LL+2)=$P(T(Z1,K),"^",4) S:$P(T(Z1,K),"^",5)'="" $P(ZS,"^",LL+3)=$P(T(Z1,K),"^",5) -
FOIAVistA/tag/r/PAID-PRS/PRSATPE.m
r628 r636 1 PRSATPE ;WOIFO/PLT - Find Exceptions ;12/3/07 2 ;;4.0;PAID;**26,34,69,102,112,116**;Sep 21, 1995;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRSATPE ;HISC/REL-Find Exceptions ;12/08/05 2 ;;4.0;PAID;**26,34,69,102**;Sep 21, 1995 4 3 K ER S (ECNT,FATAL)=0,X0=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),STAT=$P($G(^(10)),"^",1) 5 4 N MLTIME S MLTIME=0 6 5 S TC=$P(X0,"^",2) I 'TC S ER(1)=$P($T(ERTX+1),";;",2),FATAL=1 G EX 7 ;8 ;ensure Normal Hrs = tour hrs for hourly employees9 I DAY=14 I '$$HRSMATCH(PPI,DFN) S FATAL=1,ERR=21 D ERR3640 G EX10 ;11 6 I "1 3 4"'[TC,STAT="" S ER(1)=$P($T(ERTX+2),";;",2),FATAL=1 G EX 12 ; 13 ; Validate NAWS 36/40 nurse tours--can't certify if errors 14 N NAWSERR S NAWSERR=0 15 I DAY=7!(DAY=14),$$NAWS3640(DFN,PPI) D 16 . I $$SAT2DAY(DAY/7,DFN,PPI) D 17 .. S FATAL=1 S ERR=16 D ERR3640 S ERR=17 D ERR3640 18 .. S NAWSERR=1 19 . I $$THREE12(DAY/7,DFN,PPI) D 20 .. S FATAL=1 I 'NAWSERR S ERR=16 D ERR3640 21 .. S ERR=$S(DAY=7:19,1:20) D ERR3640 22 I DAY=1,$$NAWS3640(DFN,PPI),$$CARRYOVR(DFN,PPI) D 23 . S FATAL=1 S ERR=16 D ERR3640 S ERR=18 D ERR3640 24 ; 25 S X2=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) G:X2="" EX S X1=$G(^(1)),X4=$G(^(4)),K=$P($G(^(10)),U,4) 26 ;check recess entire day having un-unavailable posted for all scheduled on-on call 27 I $E($G(PRSENT),5),K=2,X2["^RS" D 28 . F K=1:3 QUIT:$P(X1,U,K,999)="" S Z=$P(X1,U,K+2) I Z,$P($G(^PRST(457.2,Z,0)),"^",2)="ON",X2'[($P(X1,U,K,K+1)_"^UN") S PRSWOC=$G(PRSWOC)_DAY_"," QUIT 29 . I $G(PRSWOC)'[(DAY_",") F K=1:3 QUIT:$P(X4,U,K,999)="" S Z=$P(X4,U,K+2) I Z,$P($G(^PRST(457.2,Z,0)),"^",2)="ON",X2'[($P(X4,U,K,K+1)_"^UN") S PRSWOC=$G(PRSWOC)_DAY_"," QUIT 30 . QUIT 31 ; 7 S X2=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) G:X2="" EX S X1=$G(^(1)),X4=$G(^(4)) 32 8 K TM I X2["OT"!(X2["CT") D TM 33 K T ,TRSF K=1:3 Q:$P(X1,"^",K)="" S Z=$P(X1,"^",K+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") D9 K T F K=1:3 Q:$P(X1,"^",K)="" S Z=$P(X1,"^",K+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") D 34 10 .S X=$P(X1,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0 35 11 .I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q … … 40 16 .S T(Z1)="",T(Z2)="*" Q 41 17 ; 42 ;find rs-type of time segments of trs array in x2 posted string43 I X2["^RS" F K=1:4:25 QUIT:$P(X2,U,K,999)="" S X=$P(X2,"^",K,K+1) I "^"'[X,$P(X2,"^",K+2)="RS" D44 . S TT=$P(X2,"^",K+2) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V145 . I Z1'="",$G(TRS(Z1))="*" K TRS(Z1) S TRS(Z2)="*" QUIT46 . S TRS(Z1)="",TRS(Z2)="*"47 . QUIT48 18 ; Checks for Daily employees 49 19 I "^"[$P(X2,"^",1,2) S TT=$P(X2,"^",3),K=1,DN=0,Y0="" G L0 50 20 F K=1:4:25 S X=$P(X2,"^",K,K+1) I "^"'[X D 51 . N Z3,Z4 52 . S TT=$P(X2,"^",K+2) 53 . D CNV^PRSATIM S Y0=Y,Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1 S TIM=Z2-Z1/60 54 . S Z3=Z1,Z4=Z2 55 . I TT="ML" S MLTIME=MLTIME+TIM 56 . S Z1=$O(T(Z1)) S:Z1'="" Z1=T(Z1) 57 . S Z2=$O(T(Z2-1)) S:Z2'="" Z2=T(Z2) 58 . ;trs=1 if absolute outside rs, 2 if absolute inside rs, 3 if overlap (in/outside) rs and inside tour of duty 59 . ;if exception segment start/ending time outside tour of duty, reset z3 and z4 60 . I Z1]""!(Z2]""),X2["^RS" S:Z1=""&(Z2="*") Z3=$O(T(Z3)) S:Z1="*"&(Z2="") Z4=$O(T(Z3)) S Z3=$O(TRS(Z3)) S:Z3]"" Z3=TRS(Z3) S Z4=$O(TRS(Z4-1)) S:Z4]"" Z4=TRS(Z4) S TRS=$S(Z3=""&(Z4=""):1,Z3="*"&(Z4="*"):2,1:3) 61 . I TT="UN" D UN^PRSATPH QUIT 62 . I "CT OT ON SB RG"[TT D OT QUIT 63 . D LV QUIT 21 .S TT=$P(X2,"^",K+2) 22 .D CNV^PRSATIM S Y0=Y,Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1 S TIM=Z2-Z1/60 23 .I TT="ML" S MLTIME=MLTIME+TIM 24 .S Z1=$O(T(Z1)) S:Z1'="" Z1=T(Z1) 25 .S Z2=$O(T(Z2-1)) S:Z2'="" Z2=T(Z2) 26 .I TT="UN" D UN^PRSATPH Q 27 .I "CT OT ON SB RG"[TT D OT Q 28 .D LV Q 64 29 ; 65 30 ; Check for a minimum of 1 hour ML … … 95 60 I TT="ON"&(X2["HX") Q 96 61 ;I "OT CT"[TT,TIM'>1 Q 97 ;none-leave hours are inside tour hours, but quit if inside rs hours 98 QUIT:$G(TRS)=2!(TT="HW"&(X2["^RS")) S ERR=6 QUIT 62 S ERR=6 Q 99 63 TM ; Get OT,CT request,approve times 100 64 S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY),DA=0 Q:'DTI … … 108 72 I TC=3!(TC=4) Q 109 73 I TC=1,TT="HW" Q 110 ;leave hours are (overlap) outside tour hours or (overlap) inside recess hours 111 I ($G(TRS)'=1&(TT="HW")&$G(TRS)) QUIT 112 I Z1'="*"!(Z2'="*")!($G(TRS)'=1&(TT'="RS")&$G(TRS)) S ERR=5,FATAL=1 D ERR 74 I Z1'="*"!(Z2'="*") S ERR=5,FATAL=1 D ERR 113 75 ; 114 76 L0 N REMARK S REMARK=$P(X2,"^",K+3) 115 77 Q:REMARK&(REMARK'=15&(REMARK'=16)) 116 78 I "HX"[TT D HENCAP 117 ;no leave request for non-leave hour and rs types 118 QUIT:"RG CP NP HX HW TR TV RS"[TT 79 Q:"RG CP NP HX HW TR TV"[TT 119 80 S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY) Q:'DTI S (DT1,DT2)=DTI 120 81 I DN D D2 S:DN=2 DT1=DT2 … … 142 103 S ERR=15 D ERR Q ; Holiday in current PP 143 104 Q 144 NAWS3640(PRSEMP,PPI) ; return true if NAWS 36/40 Nurse for this PPI145 N EMPNODE,PAYPLAN,DTYBASIS,NORMHRS,S8146 S S8=$G(^PRST(458,PPI,"E",PRSEMP,5))147 I S8'="",($E(S8,26,27)'=72!("KM"'[$E(S8,28))!($E(S8,29)'=1)) Q 0148 S EMPNODE=$G(^PRSPC(PRSEMP,0))149 S PAYPLAN=$P(EMPNODE,U,21)150 S DTYBASIS=$P(EMPNODE,U,10)151 S NORMHRS=$P(EMPNODE,U,16)152 Q "KM"[PAYPLAN&(DTYBASIS=1)&(NORMHRS=72)153 SAT2DAY(WK,PRSIEN,PPI) ;154 N HRS,SUNTRHRS,SAT2DAY,PRSD155 S SAT2DAY=0156 S PRSD=$S(WK=1:7,1:14)157 S SAT2DAY=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)158 I SAT2DAY>0 S SAT2DAY=$P($G(^PRST(457.1,SAT2DAY,0)),U,5)="Y"159 Q SAT2DAY160 CARRYOVR(PRSIEN,PPI) ; true if hours are coming in from last pp161 N PRIORSAT,SAT2DAY162 S SAT2DAY=0163 S PRIORSAT=$P($G(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0)),U,2)164 I PRIORSAT>0 S SAT2DAY=$P($G(^PRST(457.1,PRIORSAT,0)),U,5)="Y"165 Q SAT2DAY166 THREE12(WK,PRSIEN,PPI) ;167 N PRSD,TOURDTY,COUNT,ST,EN168 S COUNT=0169 S ST=$S(WK=1:1,1:8),EN=$S(WK=1:7,1:14)170 F PRSD=ST:1:EN D171 . S TOURDTY=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)172 . I $P($G(^PRST(457.1,TOURDTY,0)),U,6)=12 S COUNT=COUNT+1173 I COUNT'=3 Q 1174 N HRS175 D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)176 Q:(HRS($S(WK=1:"W1",1:"W2"))'=36) 1177 Q 0178 HRSMATCH(PPI,DFN) ; Return true if hourly employee tour hrs '= 8B normal hrs179 N MATCH,HRS,NH,ENT,ENTPTR180 I $G(PPI)'>0!($G(DFN)'>0) Q 1181 S MATCH=1182 S NH=-1183 S ENTPTR=$P($G(^PRST(458,PPI,"E",DFN,0)),U,5)184 I ENTPTR'="" D185 . S ENT=$P($G(^PRST(457.5,ENTPTR,1)),U)186 . S NH=$E($G(^PRST(458,PPI,"E",DFN,5)),26,27)187 . Q:NH="00"188 . I +NH'>0 S NH=$P($G(^PRSPC(DFN,0)),U,50)189 I $G(ENT)="" D ^PRSAENT190 I $G(ENT)'="",$E(ENT)'="D",($E(ENT,1,2)'="0D"),$G(NH)'=112 D191 . D TOURHRS^PRSARC07(.HRS,PPI,DFN)192 . I ($G(HRS("W1"))+$G(HRS("W2")))'=+$G(NH) S MATCH=0193 Q MATCH194 105 ; 195 106 ERR ; Set Error 196 107 S ECNT=ECNT+1,ER(ECNT)=TT_$P($T(ERTX+ERR),";;",2)_"^"_$P(X2,"^",K) Q 197 ERR3640 ; Set NAWS (36/40) Errors and errors not related to a single segment198 S ECNT=ECNT+1,ER(ECNT)=$P($T(ERTX+ERR),";;",2) Q199 108 ERTX ;; 200 109 1 ;;No Tour Entered^ … … 202 111 3 ;; not Requested 203 112 4 ;; Requested but not Approved 204 5 ;; Posted outside of Tour Hours or within Recess Hours205 6 ;; Posted within Tour Hours or outside of Recess Hours113 5 ;; Posted outside of Tour Hours 114 6 ;; Posted within Tour Hours 206 115 7 ;; Posted exceeds Requested Hours 207 116 8 ;; Requested but pending Supervisor Approval … … 213 122 14 ;; The minimum charge for Military Leave is one hour 214 123 15 ;; was encapsulated by non-pay 215 16 ;;36/40 AWS tours require216 17 ;; -no 2 day tours on Sat217 18 ;; -no prior pp carryover218 19 ;; -3 12 hr tours/wk 1219 20 ;; -3 12 hr tours/wk 2220 21 ;;Normal/Tour hrs unequal -
FOIAVistA/tag/r/PAID-PRS/PRSAUDP.m
r628 r636 1 PRSAUDP ; WOIFO/DWA - Display Employee Pay Period Audit Data ;12/3/07 2 ;;4.0;PAID;**116**;Sep 21, 1995;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRSAUDP ; HISC/JLS-Display Employee Pay Period Audit Data ;5/13/94 09:43 2 ;;4.0;PAID;;Sep 21, 1995 4 3 ;called by PRSADP2 5 4 D RET Q:QT 6 5 S STATYPE=$P(^DD(458.1101,4,0),"^",3) 7 S PG=PG+1,X=$G(^PRSPC(DFN,0)) W @IOF,!,?3,$P(X,U,1) S X=$P(X,U,9) 8 I '$G(PRSTLV)!($G(PRSTLV)=1) W ?68,"XXX-XX-",$E(X,6,9) 9 I $G(PRSTLV)=2!($G(PRSTLV)=3) W ?68,$E(X),"XX-XX-",$E(X,6,9) 10 I $G(PRSTLV)=7 W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) 11 W !,?26,"Corrected T&A History",!! 6 S PG=PG+1,X=$G(^PRSPC(DFN,0)) W @IOF,!,?3,$P(X,U,1) S X=$P(X,U,9) W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9),!,?26,"Corrected T&A History",!! 12 7 AUN S AUN=0 F S AUN=$O(^PRST(458,PPI,"E",DFN,"X",AUN)) Q:AUN=""!(QT=1) D B 13 8 W @IOF -
FOIAVistA/tag/r/PAID-PRS/PRSDSERV.m
r628 r636 1 PRSDSERV ;WOIFO/MGD,PLT - PAID DOWNLOAD MESSAGE SERVER ;12/3/07 2 ;;4.0;PAID;**6,78,82,116**;Sep 21, 1995;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 1 PRSDSERV ;HISC/MGD-PAID DOWNLOAD MESSAGE SERVER ;09/13/2003 2 ;;4.0;PAID;**6,78,82**;Sep 21, 1995 4 3 D NOW^%DTC S TIME=% S XMPOS=1 D REC^XMS3 G:XMER'=0 EXIT 5 S LPE=$E(XMRG,1,7) I LPE'?1"**"2N1"PDH",LPE'="****PDH" GEXIT4 G:$E(XMRG,1,7)'="****PDH" EXIT 6 5 ; EMPCNT = # emp in this mail message 7 6 ; SEQNUM = Mail message sequence number if more than one message … … 12 11 I $D(^PRSD(450.12,"B",XMZ)) G EXIT 13 12 S MTYPE=$S(TYPE="I":"Initial",TYPE="E":"Edit & Update",TYPE="P":"Payrun",TYPE="T":"Transfer",1:"") 14 ; Set Lines Per Employee (LPE) for the correct interface15 S LPE=$E(LPE,3,4),LPE=$S(LPE?2N:+LPE,TYPE="I":20,(TYPE="E")!(TYPE="T"):15,TYPE="P":9,1:0)16 13 D REC^XMS3 G:XMER'=0 EXIT S STA=$E(XMRG,1,3) I STA'?3N G EXIT 17 14 I TYPE="D" D ^PRSDDL G EXIT ; Process Separation download … … 26 23 S $P(^PRSD(450.12,+Y,0),U,3)="R",$P(^PRSD(450.12,+Y,0),U,4)=TIME 27 24 S ^PRSD(450.12,"C",TYPE_"-"_DATE_"-"_STA_"-"_SEQNUM,+Y)="" 28 SETPRS ;start employee record 25 ; Set Lines Per Employee (LPE) for the correct interface 26 SETPRS S LPE=$S(TYPE="I":20,(TYPE="E")!(TYPE="T"):15,TYPE="P":9,1:0) 29 27 S XMPOS=2 F A=1:1:EMPCNT D SSNLOOP Q:SSN=999999999 30 28 I $D(^XTMP("PRS","MNR",TYPE,DATE,STA,SEQNUM)) K ^XTMP("PRS","MNR",TYPE,DATE,STA,SEQNUM) Q … … 70 68 Q 71 69 ; Piece together the routine name and call the routine 72 PROC S TMPIEN="" F S TMPIEN=$O(^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN)) Q:TMPIEN="" S RCD=^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN),RTNNUM=$P(TMPIEN,"-",3) S:$L(RTNNUM)=1 RTNNUM=0_RTNNUM S RTN="^PRSD"_RTYPE_RTNNUM D :$T(@RTN)]""@RTN70 PROC S TMPIEN="" F S TMPIEN=$O(^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN)) Q:TMPIEN="" S RCD=^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN),RTNNUM=$P(TMPIEN,"-",3) S:$L(RTNNUM)=1 RTNNUM=0_RTNNUM S RTN="^PRSD"_RTYPE_RTNNUM D @RTN 73 71 Q 74 72 PROC2 I TYPE="P",PP'="" D ^PRSDCOMP ;Compute calculated fields -
FOIAVistA/tag/r/PAID-PRS/PRSPUT3.m
r628 r636 1 PRSPUT3 ;WOIFO/MGD,JAH - PART TIME PHYSICIAN UTILITIES #1 ;0 3/23/072 ;;4.0;PAID;**93 ,112**;Sep 21, 1995;Build 541 PRSPUT3 ;WOIFO/MGD,JAH - PART TIME PHYSICIAN UTILITIES #1 ;06/15/05 2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ; … … 268 268 S TCH1=$E(T,1,1) 269 269 D E2^PRS8VW 270 S CHKLN=$P($T(@(TCH1)+0^PRS8VW 2),";;",2)270 S CHKLN=$P($T(@(TCH1)+0^PRS8VW1),";;",2) 271 271 F I=1:1:$L(CHKLN,"^") D Q:FOUND 272 272 . S CHUNK=$P(CHKLN,U,I)
Note:
See TracChangeset
for help on using the changeset viewer.
