PRSATPTW ;WASHFO/JAH - Telework Posting;4/13/2012
;;4.0;PAID;**132**;Sep 21, 1995;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
;
TELEWORK(PPI,PRSIEN,PRSD,STAT,POSTTYPE,TC) ; telework posting driver
;
;INPUT:
; PPI-pay period being edited (either correctd timecard or regular posting)
; PRSIEN: employe 450 ien
; PRSD: day number 1-14 being posted
; STAT: timecard status (timekeeper, payroll, transmitted)
; POSTTYPE: 1:Worked Entire Tour 2:Absent Entire Tour 3:Irregular Tour
;
; get telework indicator and check tour for scheduled telework
;
N TWE,MAXTW,SCHED,MED,ADNOC,SCHHRS
S TWE=$$TWE^PRSATE0(PRSIEN,PPI,PRSD)
I POSTTYPE=2 D CLEANTW(PPI,PRSIEN,PRSD) Q
;
; for corrected timecards check if telework eligible during that
; pay period otherwise use current telework indicator and
; quit if no trackable telework indicator
;
Q:($P(TWE,U,4)'="Y")
;
; Get day's scheduled telework?
;
S SCH=$P(TWE,U,5)
;
; Daily employees either telework or they don't so
; we're all done with them after this block
;
N ACTUALTW
I $G(TC)=2!($G(TC)=3) D Q
. S ACTUALTW=$$TWDAY(SCH)
. Q:ACTUALTW<0
. D STORETW(PPI,PRSIEN,PRSD,ACTUALTW)
;
; for hourly employees get max allowable tw hrs based on timecard posting
;
S MAXTW=$$MAXTW(PPI,PRSIEN,PRSD,SCH,POSTTYPE)
I MAXTW="0^0^0" D CLEANTW(PPI,PRSIEN,PRSD) Q
;
;get any telework already posted
; piece 2 SCHEDULED
; 3 MEDICAL
; 4 AD HOC SITU
;
S OLDTWHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,8)),U,2,4)
;
; Prompt for the actual telework hours:
; "REGULAR SCHEDULED","MEDICAL SCHEDULED","AD HOC"
;
D ASKTWHRS(.ACTUALTW,MAXTW,OLDTWHRS,SCH)
;
;store the telework hours posted in the timecard
;
D STORETW(PPI,PRSIEN,PRSD,ACTUALTW)
;
Q
;
MAXTW(PPI,PRSIEN,PRSD,SCH,POSTTYPE) ;
; Extrinsic function to return maximum allowable
; telework for medical, ad hoc, reg. sched.
; RETURN:
; piece 1: maximum regular scheduled
; piece 2: maximum Medical scheduled
; piece 3: maximum AD HOC
;
;
;get tour length, length of exceptions to compute max telewk allowed
;
; Field Node;piece Definition
; TOUR LENGTH 0;8 length of tour
; POSTING TYPE (104) 10;4 1:Worked tour 2:Absent tour 3:Irregular tour
; POSTING STATUS (101) 10;1 T:Timekeeper post P:Payroll rev X:Xmitted
;
N TOT,TOD,MT,MAXTW,TCN,TSET,TT,TRC,TOURLEN,TOUR2LEN,BEG,END
N SEGHRS
;
S MAXTW="0^0^0"
S TOURLEN=+$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,8)
S TOUR2LEN=+$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,14)
;
;initialize telework to the tour length
;
S $P(MAXTW,U,$S(SCH="REG":1,SCH="MED":2,1:3))=TOURLEN
I TOUR2LEN>0 S $P(MAXTW,U,3)=+$P(MAXTW,U,3)+TOUR2LEN
;
; only worked tour, no exceptions, so MAXTW is tour length
;
Q:POSTTYPE=1 MAXTW
;
; else we need to count up exceptions. OT and CT can only be ad hoc.
;
N ADHOC,SUBTOT,TSEG
S TCN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
S ADHOC="^CT^OT^RG^"
;
; for following non work types of time in exceptions, subtract from total available TW
; ^AA^AD^AL^CB^CP^CU^DL^HX^ML^NL^NP^RL^RS^SL^TR^TV^UN^"
;
N I F I=1:4:24 D
. S TSEG=$P(TCN,U,I,I+3)
. S TT=$P(TSEG,U,3)
. Q:TT=""!("^ON^SB^HW^"[(U_TT_U))
. S TRC=$P(TSEG,U,4)
. S BEG=$P(TSEG,U)
. S END=$P(TSEG,U,2)
. S SEGHRS=$$AMT^PRSPSAPU(BEG,END,0)
. I ADHOC[(U_TT_U) D
.. S $P(MAXTW,U,3)=$P(MAXTW,U,3)+SEGHRS
. E D
.. S SUBTOT=$P(MAXTW,U,$S(SCH="REG":1,SCH="MED":2,1:3))
.. S $P(MAXTW,U,$S(SCH="REG":1,SCH="MED":2,1:3))=SUBTOT-SEGHRS
;
Q MAXTW
;
ASKTWHRS(ACTUALTW,MAXTW,OLDTWHRS,SCH) ;
;INPUT:
;
;RETURN:
; ACTUALTW = 3 piece string ^ delimiter TW SCH hrs^TW Med Hrs^TW Adhoc
;
S ACTUALTW="0^0^0"
N ADHOCTYP,THISMTW,THISACT,TWTYPEI
F TWTYPEI=1:1:3 D
. S THISMTW=$P(MAXTW,U,TWTYPEI)
. Q:THISMTW'>0
. S THISACT=$$GETTWHRS(THISMTW,TWTYPEI,OLDTWHRS,SCH)
. I THISACT<0 D Q
.. S THISACT=+$P($G(OLDTWHRS),U,TWTYPEI)
.. S $P(ACTUALTW,U,TWTYPEI)=THISACT
.; for ad hoc-ask if it is ad hod regular or ad hoc medical
. I TWTYPEI=3&(THISACT>0) D
.. S ADHOCTYP=$$GETTYPE()
.. Q:"AM"'[ADHOCTYP
..; might be adding adhoc medical to scheduled medical
.. S $P(ACTUALTW,U,$S(ADHOCTYP="M":2,1:3))=$P(ACTUALTW,U,$S(ADHOCTYP="M":2,1:3))+THISACT
. E D
.. S $P(ACTUALTW,U,TWTYPEI)=THISACT
Q
;
GETTWHRS(MAX,TT,OLDTWHRS,SCH) ;
;
N X,Y,DIR,TWTYPE,THISOLDTW
S TWTYPE=$S(TT=1:"Regular Scheduled",TT=2:"Medical Scheduled",1:"Ad Hoc")
S DIR("A")="Enter Any "_TWTYPE_" Telework Hours"
S DIR(0)="N^0"_":"_MAX_":"_2_U_"K:(X#.25) X"
S DIR("?")="Telework hours must be less than or equal to the amount of work posted."
S DIR("?",1)="Enter telework hours less than or equal to "_MAX_" in quarter hours."
S DIR("??")="PRSA ENTER TW^"
S THISOLDTW=+$P(OLDTWHRS,U,TT)
I THISOLDTW>0 D
. I THISOLDTW'>MAX D
.. S DIR("B")=$S(TT<3:MAX,1:THISOLDTW)
. E D
..; thisoldtw > max
.. S DIR("B")=+MAX
E D
. S DIR("B")=$S(TT<3:+MAX,1:0)
;
; special case for Ad hoc telework stored as medical
I ($G(DIR("B"))'>0)&(TT=3)&(SCH'="MED")&(SCH'="REG") D
. S DIR("B")=+$P(OLDTWHRS,U,2)
;
D ^DIR
I $D(DIRUT) Q -1
Q Y
;
;
GETTYPE() ;
; Prompt for type of additional telework
N X,Y,DIR
S DIR("A")="Type of Telework? "
S DIR(0)="SAB^A:Ad Hoc;M:Medical"
S DIR("B")="A"
D ^DIR
I $D(DIRUT) Q -1
Q Y
;
TWDAY(SCH) ;
; input: SCH - is the daily employee scheduled for Medical or regular
; output: ACTUALTW- return piece positional telework type--
; piece 1 = 1 if medical telework
; '' 2 = 1 if regular scheduled
; '' 3 = 1 if ad hoc situational
;
; Prompt daily tour employees
N X,Y,DIR,ACTUALTW,TWLENGTH,TYPE
S ACTUALTW="0^0^0"
S TYPE=$S(SCH="MED":"Medical",SCH="REG":"Regular",1:"Ad Hoc")
;
I SCH="MED"!(SCH="REG") D
. S DIR("A")="Did Employee Perform "_TYPE_" Telework"
E D
. S DIR("A")="Did Employee Perform Telework"
;
S DIR(0)="Y"
S DIR("B")=$S(SCH'="":"Y",1:"N")
D ^DIR
S TWLENGTH=+Y
Q:$D(DIRUT) -1
Q:TWLENGTH'=1 ACTUALTW
;
I TYPE="Ad Hoc" D Q ACTUALTW
. S ADHOCTYP=$$GETTYPE()
. I "AM"'[ADHOCTYP Q
. S $P(ACTUALTW,U,$S(ADHOCTYP="M":2,1:3))=TWLENGTH
S $P(ACTUALTW,U,$S(SCH="MED":2,SCH="REG":1,1:3))=TWLENGTH
Q ACTUALTW
;
CLEANTW(PPI,PRSIEN,PRSD) ; remove any telework hours, leave any scheduled tw.
N IENS,FDA
S IENS=PRSD_","_PRSIEN_","_PPI_","
S FDA(458.02,IENS,71)="@"
S FDA(458.02,IENS,72)="@"
S FDA(458.02,IENS,73)="@"
D UPDATE^DIE("","FDA","IENS"),MSG^DIALOG()
Q
STORETW(PPI,PRSIEN,PRSD,ACTUALTW) ;
; store telework in node 8 of the "D" (daily) subnode.
;
;S $P(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,8),U,2,4)=ACTUALTW
N IENS,FDA
S IENS=PRSD_","_PRSIEN_","_PPI_","
S FDA(458.02,IENS,71)=+$P(ACTUALTW,U)
S FDA(458.02,IENS,72)=+$P(ACTUALTW,U,2)
S FDA(458.02,IENS,73)=+$P(ACTUALTW,U,3)
D UPDATE^DIE("","FDA","IENS"),MSG^DIALOG()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATPTW 7159 printed Apr 09, 2024@21:30:58 Page 2
PRSATPTW ;WASHFO/JAH - Telework Posting;4/13/2012
+1 ;;4.0;PAID;**132**;Sep 21, 1995;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
+5 ;
TELEWORK(PPI,PRSIEN,PRSD,STAT,POSTTYPE,TC) ; telework posting driver
+1 ;
+2 ;INPUT:
+3 ; PPI-pay period being edited (either correctd timecard or regular posting)
+4 ; PRSIEN: employe 450 ien
+5 ; PRSD: day number 1-14 being posted
+6 ; STAT: timecard status (timekeeper, payroll, transmitted)
+7 ; POSTTYPE: 1:Worked Entire Tour 2:Absent Entire Tour 3:Irregular Tour
+8 ;
+9 ; get telework indicator and check tour for scheduled telework
+10 ;
+11 NEW TWE,MAXTW,SCHED,MED,ADNOC,SCHHRS
+12 SET TWE=$$TWE^PRSATE0(PRSIEN,PPI,PRSD)
+13 IF POSTTYPE=2
DO CLEANTW(PPI,PRSIEN,PRSD)
QUIT
+14 ;
+15 ; for corrected timecards check if telework eligible during that
+16 ; pay period otherwise use current telework indicator and
+17 ; quit if no trackable telework indicator
+18 ;
+19 if ($PIECE(TWE,U,4)'="Y")
QUIT
+20 ;
+21 ; Get day's scheduled telework?
+22 ;
+23 SET SCH=$PIECE(TWE,U,5)
+24 ;
+25 ; Daily employees either telework or they don't so
+26 ; we're all done with them after this block
+27 ;
+28 NEW ACTUALTW
+29 IF $GET(TC)=2!($GET(TC)=3)
Begin DoDot:1
+30 SET ACTUALTW=$$TWDAY(SCH)
+31 if ACTUALTW<0
QUIT
+32 DO STORETW(PPI,PRSIEN,PRSD,ACTUALTW)
End DoDot:1
QUIT
+33 ;
+34 ; for hourly employees get max allowable tw hrs based on timecard posting
+35 ;
+36 SET MAXTW=$$MAXTW(PPI,PRSIEN,PRSD,SCH,POSTTYPE)
+37 IF MAXTW="0^0^0"
DO CLEANTW(PPI,PRSIEN,PRSD)
QUIT
+38 ;
+39 ;get any telework already posted
+40 ; piece 2 SCHEDULED
+41 ; 3 MEDICAL
+42 ; 4 AD HOC SITU
+43 ;
+44 SET OLDTWHRS=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,8)),U,2,4)
+45 ;
+46 ; Prompt for the actual telework hours:
+47 ; "REGULAR SCHEDULED","MEDICAL SCHEDULED","AD HOC"
+48 ;
+49 DO ASKTWHRS(.ACTUALTW,MAXTW,OLDTWHRS,SCH)
+50 ;
+51 ;store the telework hours posted in the timecard
+52 ;
+53 DO STORETW(PPI,PRSIEN,PRSD,ACTUALTW)
+54 ;
+55 QUIT
+56 ;
MAXTW(PPI,PRSIEN,PRSD,SCH,POSTTYPE) ;
+1 ; Extrinsic function to return maximum allowable
+2 ; telework for medical, ad hoc, reg. sched.
+3 ; RETURN:
+4 ; piece 1: maximum regular scheduled
+5 ; piece 2: maximum Medical scheduled
+6 ; piece 3: maximum AD HOC
+7 ;
+8 ;
+9 ;get tour length, length of exceptions to compute max telewk allowed
+10 ;
+11 ; Field Node;piece Definition
+12 ; TOUR LENGTH 0;8 length of tour
+13 ; POSTING TYPE (104) 10;4 1:Worked tour 2:Absent tour 3:Irregular tour
+14 ; POSTING STATUS (101) 10;1 T:Timekeeper post P:Payroll rev X:Xmitted
+15 ;
+16 NEW TOT,TOD,MT,MAXTW,TCN,TSET,TT,TRC,TOURLEN,TOUR2LEN,BEG,END
+17 NEW SEGHRS
+18 ;
+19 SET MAXTW="0^0^0"
+20 SET TOURLEN=+$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,8)
+21 SET TOUR2LEN=+$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,14)
+22 ;
+23 ;initialize telework to the tour length
+24 ;
+25 SET $PIECE(MAXTW,U,$SELECT(SCH="REG":1,SCH="MED":2,1:3))=TOURLEN
+26 IF TOUR2LEN>0
SET $PIECE(MAXTW,U,3)=+$PIECE(MAXTW,U,3)+TOUR2LEN
+27 ;
+28 ; only worked tour, no exceptions, so MAXTW is tour length
+29 ;
+30 if POSTTYPE=1
QUIT MAXTW
+31 ;
+32 ; else we need to count up exceptions. OT and CT can only be ad hoc.
+33 ;
+34 NEW ADHOC,SUBTOT,TSEG
+35 SET TCN=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
+36 SET ADHOC="^CT^OT^RG^"
+37 ;
+38 ; for following non work types of time in exceptions, subtract from total available TW
+39 ; ^AA^AD^AL^CB^CP^CU^DL^HX^ML^NL^NP^RL^RS^SL^TR^TV^UN^"
+40 ;
+41 NEW I
FOR I=1:4:24
Begin DoDot:1
+42 SET TSEG=$PIECE(TCN,U,I,I+3)
+43 SET TT=$PIECE(TSEG,U,3)
+44 if TT=""!("^ON^SB^HW^"[(U_TT_U))
QUIT
+45 SET TRC=$PIECE(TSEG,U,4)
+46 SET BEG=$PIECE(TSEG,U)
+47 SET END=$PIECE(TSEG,U,2)
+48 SET SEGHRS=$$AMT^PRSPSAPU(BEG,END,0)
+49 IF ADHOC[(U_TT_U)
Begin DoDot:2
+50 SET $PIECE(MAXTW,U,3)=$PIECE(MAXTW,U,3)+SEGHRS
End DoDot:2
+51 IF '$TEST
Begin DoDot:2
+52 SET SUBTOT=$PIECE(MAXTW,U,$SELECT(SCH="REG":1,SCH="MED":2,1:3))
+53 SET $PIECE(MAXTW,U,$SELECT(SCH="REG":1,SCH="MED":2,1:3))=SUBTOT-SEGHRS
End DoDot:2
End DoDot:1
+54 ;
+55 QUIT MAXTW
+56 ;
ASKTWHRS(ACTUALTW,MAXTW,OLDTWHRS,SCH) ;
+1 ;INPUT:
+2 ;
+3 ;RETURN:
+4 ; ACTUALTW = 3 piece string ^ delimiter TW SCH hrs^TW Med Hrs^TW Adhoc
+5 ;
+6 SET ACTUALTW="0^0^0"
+7 NEW ADHOCTYP,THISMTW,THISACT,TWTYPEI
+8 FOR TWTYPEI=1:1:3
Begin DoDot:1
+9 SET THISMTW=$PIECE(MAXTW,U,TWTYPEI)
+10 if THISMTW'>0
QUIT
+11 SET THISACT=$$GETTWHRS(THISMTW,TWTYPEI,OLDTWHRS,SCH)
+12 IF THISACT<0
Begin DoDot:2
+13 SET THISACT=+$PIECE($GET(OLDTWHRS),U,TWTYPEI)
+14 SET $PIECE(ACTUALTW,U,TWTYPEI)=THISACT
End DoDot:2
QUIT
+15 ; for ad hoc-ask if it is ad hod regular or ad hoc medical
+16 IF TWTYPEI=3&(THISACT>0)
Begin DoDot:2
+17 SET ADHOCTYP=$$GETTYPE()
+18 if "AM"'[ADHOCTYP
QUIT
+19 ; might be adding adhoc medical to scheduled medical
+20 SET $PIECE(ACTUALTW,U,$SELECT(ADHOCTYP="M":2,1:3))=$PIECE(ACTUALTW,U,$SELECT(ADHOCTYP="M":2,1:3))+THISACT
End DoDot:2
+21 IF '$TEST
Begin DoDot:2
+22 SET $PIECE(ACTUALTW,U,TWTYPEI)=THISACT
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
GETTWHRS(MAX,TT,OLDTWHRS,SCH) ;
+1 ;
+2 NEW X,Y,DIR,TWTYPE,THISOLDTW
+3 SET TWTYPE=$SELECT(TT=1:"Regular Scheduled",TT=2:"Medical Scheduled",1:"Ad Hoc")
+4 SET DIR("A")="Enter Any "_TWTYPE_" Telework Hours"
+5 SET DIR(0)="N^0"_":"_MAX_":"_2_U_"K:(X#.25) X"
+6 SET DIR("?")="Telework hours must be less than or equal to the amount of work posted."
+7 SET DIR("?",1)="Enter telework hours less than or equal to "_MAX_" in quarter hours."
+8 SET DIR("??")="PRSA ENTER TW^"
+9 SET THISOLDTW=+$PIECE(OLDTWHRS,U,TT)
+10 IF THISOLDTW>0
Begin DoDot:1
+11 IF THISOLDTW'>MAX
Begin DoDot:2
+12 SET DIR("B")=$SELECT(TT<3:MAX,1:THISOLDTW)
End DoDot:2
+13 IF '$TEST
Begin DoDot:2
+14 ; thisoldtw > max
+15 SET DIR("B")=+MAX
End DoDot:2
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET DIR("B")=$SELECT(TT<3:+MAX,1:0)
End DoDot:1
+18 ;
+19 ; special case for Ad hoc telework stored as medical
+20 IF ($GET(DIR("B"))'>0)&(TT=3)&(SCH'="MED")&(SCH'="REG")
Begin DoDot:1
+21 SET DIR("B")=+$PIECE(OLDTWHRS,U,2)
End DoDot:1
+22 ;
+23 DO ^DIR
+24 IF $DATA(DIRUT)
QUIT -1
+25 QUIT Y
+26 ;
+27 ;
GETTYPE() ;
+1 ; Prompt for type of additional telework
+2 NEW X,Y,DIR
+3 SET DIR("A")="Type of Telework? "
+4 SET DIR(0)="SAB^A:Ad Hoc;M:Medical"
+5 SET DIR("B")="A"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT -1
+8 QUIT Y
+9 ;
TWDAY(SCH) ;
+1 ; input: SCH - is the daily employee scheduled for Medical or regular
+2 ; output: ACTUALTW- return piece positional telework type--
+3 ; piece 1 = 1 if medical telework
+4 ; '' 2 = 1 if regular scheduled
+5 ; '' 3 = 1 if ad hoc situational
+6 ;
+7 ; Prompt daily tour employees
+8 NEW X,Y,DIR,ACTUALTW,TWLENGTH,TYPE
+9 SET ACTUALTW="0^0^0"
+10 SET TYPE=$SELECT(SCH="MED":"Medical",SCH="REG":"Regular",1:"Ad Hoc")
+11 ;
+12 IF SCH="MED"!(SCH="REG")
Begin DoDot:1
+13 SET DIR("A")="Did Employee Perform "_TYPE_" Telework"
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 SET DIR("A")="Did Employee Perform Telework"
End DoDot:1
+16 ;
+17 SET DIR(0)="Y"
+18 SET DIR("B")=$SELECT(SCH'="":"Y",1:"N")
+19 DO ^DIR
+20 SET TWLENGTH=+Y
+21 if $DATA(DIRUT)
QUIT -1
+22 if TWLENGTH'=1
QUIT ACTUALTW
+23 ;
+24 IF TYPE="Ad Hoc"
Begin DoDot:1
+25 SET ADHOCTYP=$$GETTYPE()
+26 IF "AM"'[ADHOCTYP
QUIT
+27 SET $PIECE(ACTUALTW,U,$SELECT(ADHOCTYP="M":2,1:3))=TWLENGTH
End DoDot:1
QUIT ACTUALTW
+28 SET $PIECE(ACTUALTW,U,$SELECT(SCH="MED":2,SCH="REG":1,1:3))=TWLENGTH
+29 QUIT ACTUALTW
+30 ;
CLEANTW(PPI,PRSIEN,PRSD) ; remove any telework hours, leave any scheduled tw.
+1 NEW IENS,FDA
+2 SET IENS=PRSD_","_PRSIEN_","_PPI_","
+3 SET FDA(458.02,IENS,71)="@"
+4 SET FDA(458.02,IENS,72)="@"
+5 SET FDA(458.02,IENS,73)="@"
+6 DO UPDATE^DIE("","FDA","IENS")
DO MSG^DIALOG()
+7 QUIT
STORETW(PPI,PRSIEN,PRSD,ACTUALTW) ;
+1 ; store telework in node 8 of the "D" (daily) subnode.
+2 ;
+3 ;S $P(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,8),U,2,4)=ACTUALTW
+4 NEW IENS,FDA
+5 SET IENS=PRSD_","_PRSIEN_","_PPI_","
+6 SET FDA(458.02,IENS,71)=+$PIECE(ACTUALTW,U)
+7 SET FDA(458.02,IENS,72)=+$PIECE(ACTUALTW,U,2)
+8 SET FDA(458.02,IENS,73)=+$PIECE(ACTUALTW,U,3)
+9 DO UPDATE^DIE("","FDA","IENS")
DO MSG^DIALOG()
+10 QUIT
