Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSATE6

PRSATE6.m

Go to the documentation of this file. 
  1. PRSATE6 ; WCIOFO/JAH-VALIDATE FIREFIGHTER TOURS OF DUTY (ToD);3/19/99
  1.  ;;4.0;PAID;**45,132**;Sep 21, 1995;Build 13
  1.  Q
  1. FFTOUR(PPI,DFN,WHICHPP,ERROR) ; Validate a Firefighter ToD
  1.  N WK1BTOT,WK2BTOT,BASEMAX,PMP
  1.  ;
  1.  S PMP=$$GETPMP(DFN)
  1.  ;
  1.  ;Define maximum base hrs for 1 week of a firefighter ToD.
  1.  ;
  1.  S BASEMAX=$$GETBSMAX(DFN,PPI,WHICHPP)
  1.  ;
  1.  ; Loop thru week 1,2 & get total base ToD hrs scheduled.
  1.  ;
  1.  D GETTOTS(PPI,DFN,WHICHPP,.WK1BTOT,.WK2BTOT)
  1.  ;
  1.  ; convert minutes to 1/4 hour segments
  1.  ;
  1.  S WK1BTOT=WK1BTOT/15,WK2BTOT=WK2BTOT/15
  1.  ;
  1.  ; Determine any error in ToD
  1.  ;
  1.  D GETERROR(WK1BTOT,WK2BTOT,BASEMAX,PMP,.ERROR)
  1.  ;
  1.  ; display any errors
  1.  ;
  1.  I $$ISERRORS(.ERROR)  D
  1.  . D DISPERR(PPI,DFN,PMP,WHICHPP,.ERROR,BASEMAX)
  1.  Q
  1.  ;=======================
  1.  ;
  1. GETBSMAX(DFN,PPI,WHICHPP) ; GET MAX BASE ToD HRS FOR FIREFIGHTER'S WEEK
  1.  ;INPUT:
  1.  ;  Employee DFN  or internal entry number in file 450 
  1.  ;OUTPUT:
  1.  ;  return total base hrs in .25 hr segments that 
  1.  ;  this fire fighter is allowed in a week of thier ToD.
  1.  ;  If this isn't a firefighter (Premium pay indicator C)
  1.  ;  then return 0
  1.  ;
  1.  S MAX=0
  1.  S TOURTYPE=$$FLEXIND(PPI,DFN,WHICHPP)
  1.  S MAX=$S(TOURTYPE="C":53,1:40)
  1.  Q MAX*4
  1.  ;=======================
  1.  ;
  1. GETPMP(DFN) ; RETURN PREMIUM PAY INDICATOR CODE FROM FILE 450
  1.  ;^DD(450,548,0) = PREMIUM PAY IND^F^^PREMIUM;6
  1.  Q $P($G(^PRSPC(DFN,"PREMIUM")),"^",6)
  1.  ;=======================
  1.  ;
  1. GETTOTS(PPI,DFN,WHICHPP,WK1TOT,WK2TOT) ;
  1.  N TOURDAY,TOUR,SEGMNT,START,STOP,SPECIND
  1.  ;
  1.  S (WK1TOT,WK2TOT)=0
  1.  F TOURDAY=1:1:14  D
  1.  .  S TOUR=$$GETTOUR(PPI,DFN,WHICHPP,TOURDAY)
  1.  .  S MEAL=$$MEALTM(PPI,DFN,TOURDAY,WHICHPP)
  1.  .;
  1.  .;  Read each segment of ToD.
  1.  .;
  1.  .  F SEGMNT=1:3 D  Q:$P(TOUR,"^",SEGMNT)=""
  1.  ..   S (STARTHR,START)=$P(TOUR,"^",SEGMNT)
  1.  ..   S (STOPHR,STOP)=$P(TOUR,"^",SEGMNT+1)
  1.  ..   S SPECIND=$P(TOUR,"^",SEGMNT+2)
  1.  ..;
  1.  ..;  if this is base ToD hours then add the time to the approriate
  1.  ..;  week.
  1.  ..;
  1.  ..   I SPECIND="",$G(START)'="",$G(STOP)'="" D
  1.  ...     D MINUTES(.START,.STOP)
  1.  ...     S (WK1LEN,WK2LEN)=0
  1.  ...;
  1.  ...;    when ToD crosses midnight check if it's Sat. or Sun
  1.  ...;    & adjust the stop time
  1.  ...;
  1.  ...     I STOP<(START+1) D
  1.  ....      I (TOURDAY#7)=0 D
  1.  .....        D SPLIT(STARTHR,STOPHR,.WK1LEN,.WK2LEN)
  1.  .....        I WK1LEN+1>WK2LEN S WK1LEN=WK1LEN-MEAL
  1.  .....        I WK1LEN<WK2LEN S WK2LEN=WK2LEN-MEAL
  1.  .....        D UPTOT(.WK1TOT,.WK2TOT,WK1LEN,WK2LEN)
  1.  ....      E  D
  1.  .....        S STOP=1440+STOP
  1.  .....        S LEN=STOP-START-MEAL
  1.  .....        I TOURDAY<8 D UPTOT(.WK1TOT,.WK2TOT,LEN,0)
  1.  .....        I TOURDAY>7 D UPTOT(.WK1TOT,.WK2TOT,0,LEN)
  1.  ...     E  D
  1.  ....       S LEN=STOP-START-MEAL
  1.  ....       I TOURDAY<8 D UPTOT(.WK1TOT,.WK2TOT,LEN,0)
  1.  ....       I TOURDAY>7 D UPTOT(.WK1TOT,.WK2TOT,0,LEN)
  1.  ;
  1.  Q
  1.  ;=======================
  1.  ;
  1. MEALTM(PPI,DFN,DAY,WHICHPP) ;
  1.  ; RETURN LENGTH OF MEALTIME FOR THIS EMPs ToD ON THIS DAY.
  1.  N TOUR
  1.  S LEN=0
  1.  S TOUR=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0))
  1.  S TOUR=$P(TOUR,"^",2)
  1.  I $P(TOUR,"^",4),(WHICHPP="N") S TOUR=$P(TOUR,"^",4)
  1.  I TOUR S LEN=$P($G(^PRST(457.1,TOUR,0)),"^",3)
  1.  ;
  1.  Q LEN
  1.  ;=======================
  1.  ;
  1. MINUTES(T1,T2) ; CONVERT TIME 1 & TWO TO MINUTES FROM MIDNIGHT
  1.  ; OF THE CURRENT DAY.  IF T2 IS LESS THAN OR EQUAL TO T1 THEN
  1.  ; IT IS ASSUMMED TO BE ON THE NEXT DAY.
  1.  ;
  1.  N X,Y
  1.  ;
  1.  ;call to convert start & stop to minutes from midnight
  1.  ;
  1.  S X=T1_"^"_T2
  1.  D CNV^PRSATIM
  1.  S T1=$P(Y,"^",1),T2=$P(Y,"^",2)
  1.  Q
  1.  ;=======================
  1.  ;
  1. SPLIT(DAY,T1,T2,L1,L2) ; SPLIT two day ToD into 2 segments.
  1.  ;INPUT:
  1.  ;  DAY = day of pay period that the ToD begins.
  1.  ;  T1  = start time of ToD in 08:00A format.
  1.  ;  T2  = stop time of ToD in 11:00P format.
  1.  ;OUTPUT:
  1.  ;  L1 = Length of ToD (minutes) from start time to midnight.
  1.  ;  L2 = Length of ToD (min) from midnight to stop time in next day.
  1.  ;
  1.  N X,Y
  1.  S X=T1_"^"_"MID"
  1.  D CNV^PRSATIM
  1.  S L1=$P(Y,"^",2)-$P(Y,"^",1)
  1.  S X="MID^"_T2
  1.  S L2=$P(Y,"^",2)-$P(Y,"^",1)
  1.  ;
  1.  ; If it's the 2nd Sat of the pay period then move the carry over
  1.  ; to the first week of this pay period.
  1.  ;
  1.  I DAY=14 S TEMP=L2,L2=L1,L1=TEMP
  1.  Q
  1.  ;=======================
  1.  ;
  1. UPTOT(W1T,W2T,W1LN,W2LN) ;
  1.  S W1T=W1T+W1LN
  1.  S W2T=W2T+W2LN
  1.  Q
  1.  ;=======================
  1.  ;
  1. GETERROR(W1TOT,W2TOT,BMAX,PMP,ERROR) ;
  1.  ;
  1.  ;    1. Code C firefighters on compressed ToDs may not have base 
  1.  ;       ToD hours that exceed 53 for either week 1 or 2.
  1.  ;     2. Code C firefighters without compressed ToDs may not have 
  1.  ;        base hours that exceed 40 for either week 1 or 2.
  1.  ;     3. Code C firefighters may not have base ToD hours that 
  1.  ;        exceed 80.
  1.  ;
  1.  I PMP="C" D
  1.  .  I W1TOT>BMAX S ERROR(1)=1
  1.  .  I W2TOT>BMAX S ERROR(2)=1
  1.  .  I (W2TOT+W1TOT)>(80*4) S ERROR(3)=1
  1.  Q
  1.  ;=======================
  1.  ;
  1. ISERRORS(ERROR) ; RETURN TRUE IF THERE ARE ERRORS IN THE ERROR ARRAY
  1.  S (ENUM,IS)=0
  1.  F  S ENUM=$O(ERROR(ENUM)) Q:ENUM=""!IS  I +$G(ERROR(ENUM)) S IS=1
  1.  ;
  1.  Q IS
  1.  ;=======================
  1.  ;
  1. DISPERR(PPI,DFN,PMP,WHICHPP,ERROR,BMAX) ;
  1.  ;
  1.  ; See GETERRORS for error descriptions.
  1.  ;
  1.  N FLX,COUNT,WK
  1.  S FLX=$$FLEXIND(PPI,DFN,WHICHPP)
  1.  S FLX=$S(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None")
  1.  ;
  1.  S WK="",COUNT=0
  1.  I $G(ERROR(1)) S WK="one"
  1.  I $G(ERROR(2)) S WK="two"
  1.  I WK="two",$G(ERROR(1)) S WK="one and two"
  1.  W @IOF,!!!,?5,"There are the following problems with the tour entered:"
  1.  I +$G(ERROR(1))!(+$G(ERROR(2))) D
  1.  . S COUNT=COUNT+1
  1.  . W !!,?7,COUNT,".  Code ",PMP," firefighters with a compressed/flex "
  1.  . W !,?11,"indicator of ",FLX," may not have BASE tour hours that "
  1.  . W !,?11,"exceed ",BMAX/4," for week ",WK,"."
  1.  ;
  1.  I +$G(ERROR(3)) D
  1.  . S COUNT=COUNT+1
  1.  . W !!,?7,COUNT,".  Code ",PMP," firefighters may not have BASE tour "
  1.  . W !,?11,"hours that exceed 80 for the pay period."
  1.  ;
  1.  Q
  1.  ;=======================
  1.  ;
  1. ASKTOFIX() ;RETURN TK RESPONSE--DO YOU WANT TO FIX THE ToD?
  1.  N DIR,DIRUT,Y
  1.  W !!
  1.  S DIR("A",1)="This tour MUST BE CORRECTED or it will be removed."
  1.  S DIR("A")="Correct the tour"
  1.  S DIR(0)="Y"
  1.  S DIR("B")="Y"
  1.  S DIR("?",1)=" You must correct the tour.  Answer Yes to re-edit the tour."
  1.  S DIR("?")=" If you answer No the entire tour will be removed. "
  1.  D ^DIR
  1.  Q Y
  1.  ;=======================
  1.  ;
  1. GETTOUR(PPI,DFN,WHICHPP,PPDAY) ; This function returns the employees ToD
  1.  ; based on the WHICHPP variable.  WHICHPP can be set to N, for next
  1.  ; pay period, or C for current pay period or 'L' for last.  If set 
  1.  ; to 'N'ext, we have to look at the prior scheduled field in the 
  1.  ; current pay period to see if the ToD is changing next pp.
  1.  ;
  1.  N TEMPTOUR,TOURNODE,TOUR
  1.  I PPI'>0!(DFN'>0)!(PPDAY'>0) Q 0
  1.  S TOURNODE=$G(^PRST(458,PPI,"E",DFN,"D",PPDAY,0))
  1.  S TOUR=$P(TOURNODE,U,2)
  1.  S TEMPTOUR=$P(TOURNODE,U,3)
  1.  I WHICHPP="N",+TEMPTOUR D
  1.  .  S TOUR=$P(TOURNODE,"^",4)
  1.  I TOUR'>0 Q 0
  1.  Q $G(^PRST(457.1,TOUR,1))
  1.  ;=======================
  1.  ;
  1. SAVETOUR(PPI,DFN) ;SAVE ToD in ^TMP global
  1.  ;
  1.  S %X="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
  1.  S %Y="^TMP($J,""OLDTOUR""," D %XY^%RCR
  1.  Q
  1.  ;=======================
  1.  ;
  1. RESTORE(PPI,DFN) ;restore a ToD
  1.  ;  use with EXTREME CAUTION. SAVETOUR should be called 1st.
  1.  ; This utility first removes the entire "D" node from the
  1.  ; input employee's pay period record.  It depends on the fact that
  1.  ; a backup of an earlier copy of the "D" node was saved in TMP.
  1.  N %X,%Y
  1.  K ^PRST(458,PPI,"E",DFN,"D")
  1.  S %X="^TMP($J,""OLDTOUR"","
  1.  S %Y="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
  1.  D %XY^%RCR
  1.  Q
  1.  ;=======================
  1.  ;
  1. ASKTEMP() ; ASK USER-TEMP OR PERM ToD CHANGE
  1.  N DIR,DIRUT
  1.  S DIR("A")="Is this tour change Temporary or Permanent? "
  1.  S DIR("B")="P"
  1.  S DIR(0)="SAMO^P:Permanent;T:Temporary"
  1.  S DIR("?")="A Temporary change is for this Pay Period only."
  1.  S DIR("?",1)="A Permanent change is for this and future Pay Periods."
  1.  D ^DIR
  1.  I $D(DIRUT) S Y="^"
  1.  Q Y
  1.  ;=======================
  1.  ;
  1. GETEMP(TLE) ; SELECT EMP FROM THE PASSED T&L UNIT
  1.  N DIC,X,Y,D
  1.  S DIC("A")="Select EMPLOYEE: "
  1.  S DIC("S")="I $P(^(0),""^"",8)=TLE"
  1.  S DIC(0)="AEQM"
  1.  S DIC="^PRSPC("
  1.  S D="ATL"_TLE
  1.  W ! D IX^DIC S DFN=+Y K DIC
  1.  Q DFN
  1.  ;=======================
  1.  ;
  1. FLEXIND(PPI,DFN,WHICHPP) ;
  1.  ;Return emp's flexitime code (compressed, flex or none)
  1.  ; INPUT:
  1.  ;    PPI = pp internal #
  1.  ;    DFN =  emps internal # from 450/458
  1.  ;    WHICHPP = N for next pp otherwise current
  1.  Q $P($G(^PRST(458,PPI,"E",DFN,0)),"^",$S(WHICHPP="N":7,1:6))
  1.  ;=======================
  1.  ;
  1. ASKTLWRK(TLE) ; ASK TIMEKEEP WHICH TLU ToD WILL BE WORKED
  1.  N DIC,X,Y
  1.  S DIC="^PRST(455.5,"
  1.  S DIC(0)="AEQM"
  1.  S DIC("A")="T&L on which Tour will be worked: "
  1.  S DIC("B")=TLE
  1.  W ! D ^DIC
  1.  Q +Y
  1.  ;
  1. ASKTWMF() ;ask telework tour for fixed monday/friday tour
  1.  N DIR,DIRUT,X,Y
  1.  S DIR("A")="Do you wish to schedule any telework tours"
  1.  S DIR(0)="Y",DIR("?")="Answer NO if there is no telework day for the pay period."
  1.  D ^DIR
  1.  QUIT $S(Y=0:"N",Y=1:"Y",1:"^")