Changeset 636 for FOIAVistA/tag/r/PAID-PRS/PRS8AC.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• PAID-PRS/PRS8AC.m (modified) (8 diffs)

FOIAVistA/tag/r/PAID-PRS/PRS8AC.m

@@ -1 @@
-PRS8AC ;HISC/MRL-DECOMPOSITION, ACTIVITY STRING ;05/18/07
- ;;4.0;PAID;**40,45,54,52,69,75,90,96,112**;Sep 21, 1995;Build 54
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+PRS8AC ;HISC/MRL-DECOMPOSITION, ACTIVITY STRING ;01/22/04
+ ;;4.0;PAID;**40,45,54,52,69,75,90,96**;Sep 21, 1995
  ;
  ;The primary purpose of this routine is to create the activity
@@ -16 +15 @@
  S Q=0
  I DY>0,DY<15 D  G END:Q
- .I DAY(DY,"OFF"),"LSWARUHFGDr"[VAR S Q=1 ;exc invalid day off VAR
+ .I DAY(DY,"OFF"),"LSWARUHFGD"[VAR S Q=1 ;exc invalid day off VAR
  K OC,FLAG
  ;
  S DAYZ=DAY(DY,"W")_$G(DAY(DY,"N")),MTM=0
  S DAYH=$G(DAY(DY,"HOL"))_$G(DAY(DY+1,"HOL")) ;holiday node
- N DAYR
- S DAYR=DAY(DY,"r")_$G(DAY(DY,"rN")) ; Recess
  ;
  ;P 45 FIREFIGHTERS F NODE TO TRACK ADDITIONAL FF HRS
@@ -29 +26 @@
  F T=+V:1:+$P(V,"^",2) D
  .I +VAR,$E(DAYH,T),$E(DAYZ,T)?1A Q  ;no override holiday
- .; Don't override Recess but allow Unscheduled Regular (VAR=4)
- .I +VAR,VAR'=4,$E(DAYR,T)="r" Q  ; don't override Recess
  .I VAR="A"&(JURY=1) S VAR="J"
  .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
  .I "JLSWNnARUXYFGD"[VAR1,T'>96,'$E(DAYZ,T) Q  ;invalid outside tour
- .; Regular employees can't earn ct/use ot during work
- .I +NAWS'=9,"EOPQT4"[VAR1,T'>96,$E(DAYZ,T) Q
- .; 9mo AWS checks
- .I +NAWS=9,"PQT"[VAR1,T'>96,$E(DAYZ,T) Q  ;can't earn ct/use ot during work
- .; Allow CT/OT/UN/ON if posted over Recess otherwise don't allow
- .I +NAWS=9,"4OEC"[VAR1,T'>96,$E(DAYZ,T),$E(DAYR,T)'="r" S $E(DAYR,T)=VAR1 Q
+ .I "EOPQT4"[VAR1,T'>96,$E(DAYZ,T) Q  ;can't earn ct/use ot during work
  .I "OE"[VAR1,"BC"[DAYZ(1),$L(DAYZ(1)) D  ; Change OT or CT to CB/SB OT
  ..S VAR1=$C($A($E(DAYZ,T))+32)
@@ -54 +44 @@
  .I $E(DAYZ,T)=5,"ALSRUFGD"[VAR1 S VAR1=$E(DAYZ,T)
  .I $E(DAYZ,T)="-","BbCctes"[VAR1 Q  ;unavail for oc/sb or sch ot/ct
- .;
- .I VAR'="r" D
- ..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) D
- ...S DAY(DY-1,"N")=$E(DAY(DY-1,"N"),0,T-1)_VAR1_$E(DAY(DY-1,"N"),T+1,999) ;save VAR
- ..; When processing tour time also copy tour into DAYR
- ..I "1235"[VAR1 D
- ...S DAYR=$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) D
- ....S DAY(DY-1,"rN")=$E(DAY(DY-1,"rN"),0,T-1)_VAR1_$E(DAY(DY-1,"rN"),T+1,999)
- .;
- .; The following check will record Recess and will then update VAR1 to 0 which
- .; will result in the normally scheduled tour being marked as being no tour.
- .; This will allow Unscheduled Regular, OT and CT to be posted over the tour.
- .I VAR="r" D
- ..S DAYR=$E(DAYR,0,T-1)_VAR1_$E(DAYR,T+1,999)
- ..S DAYZ=$E(DAYZ,0,T-1)_0_$E(DAYZ,T+1,999) ; Overwrite tour
- ..I $E($G(DAY(DY-1,"rN")),T)'="",VAR1'=$E($G(DAY(DY-1,"rN")),T) D
- ...S DAY(DY-1,"rN")=$E(DAY(DY-1,"rN"),0,T-1)_VAR1_$E(DAY(DY-1,"rN"),T+1,999)
- ...S DAY(DY-1,"N")=$E(DAY(DY-1,"N"),0,T-1)_0_$E(DAY(DY-1,"N"),T+1,999)
- ..S Y=48 D SET ; Count Recess
- .;
+ .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
  .I VAR1="J" S Y=5 D SET ;set authorized absence for jury duty
  .I VAR1="M" S Y=5 D SET ; authorized absence for ML
  .;ot on non-premium T&L
- .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)_"^"))) D
+ .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
  ..Q:$E(DAY(DY,"P"),T)=5&("ALSRUFGD"'[VAR)
  ..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
  ...I "^7^8^9^11^"[("^"_$P(V,"^",4)_"^")&("^S^T^U^V^"'[(U_PMP_U)) S CODE="n" Q
- ...I $P(V,"^",4)=17 S CODE="N" Q  ; Code 17 - OT/CT with premiums 
  ...I VAR1=5 S CODE=VAR Q
  ...S CODE=1
@@ -125 +93 @@
  ..K S,VAR1
  ;
+ ;
  S DAY(DY,"W")=$E(DAYZ,1,96) ;todays activity
  S DAY(DY,"N")=$E(DAYZ,97,999) ;tomorrows activity from today/if any
- S DAY(DY,"r")=$E(DAYR,1,96) ; Today's Recess
- S DAY(DY,"rN")=$E(DAYR,97,999) ; Tomorrow's Recess/if any
  S:$E(DAY(DY,"P"),97,999)'="" DAY(DY,"P1")=$E(DAY(DY,"P"),97,999) ;non-prem ot for next day
  S DAY(DY,"P")=$E(DAY(DY,"P"),1,96) ;non-prem ot for today
- I DAY(DY,"N")?1"0"."0",DAY(DY,"rN")'["r" S DAY(DY,"N")=""
+ I DAY(DY,"N")?1"0"."0" S DAY(DY,"N")=""
  S DAY(DY,"HOL")=$E(DAYH,1,96)
  ;
@@ -167 +134 @@
  .S X=DAY(DY-1,"P1")_$E(DAY(DY,"P"),$L(DAY(DY-1,"P1"))+1,96)
  .S DAY(DY,"P")=X
- I $D(DAY(DY-1,"rN")),$L(DAY(DY-1,"rN")) D
- .S X=DAY(DY-1,"rN")_$E(DAY(DY,"r"),$L(DAY(DY-1,"rN"))+1,96)
- .S DAY(DY,"r")=X
  ;
 END ; --- all done here