PRSPSAP3 ;WOIFO/JAH - Supervisor Approve-update pt phys timecard ;01/05/05
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
MARK(ACT,PRSIEN,PPI) ; mark supervisors action on temp global
; ESR STATUS
; when updating a single record we overwrite. When updating
; multiple records we will only update ones with no status.
N ITEM,OLDACT,REM,OLDREM
S ITEM=$P($G(ACT),U,2)
S ACT=$P($G(ACT),U)
I ITEM>0 D
. S PRSD=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,"B",ITEM))
. S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1)=ACT
.; add remarks to the resubmit action, otherwise remove old remarks
. I ACT="R" D
.. S OLDREM=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2))
.. S REM=$$GETREM(OLDREM)
.. I REM'="^" S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2)=$G(REM)
. E D
.. K ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2)
E D
. I ACT="R" S REM=$$GETREM()
. S PRSD=0
. F S PRSD=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD)) Q:PRSD'>0 D
.. S OLDACT=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1))
.. I OLDACT="" D
... S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1)=ACT
... I $G(ACT)="R" S ^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2)=$G(REM)
Q
GETREM(SNIDE) ; return supervisor remark for a resubmit request
; WE CAN'T EDIT THE FIELD DIRECTLY BECAUSE THIS IS A TRANSACTION
; AND NOTHING IS COMMITED TO THE DB UNTIL THEY SIGN
N DIR,DIRUT,REM,DTOUT,DUOUT,X,Y
S REM=""
S DIR(0)="458.02,148^O"
I $G(SNIDE)'="" S DIR("B")=SNIDE
S DIR("A")="Enter Remarks"
D ^DIR
S REM=$G(Y)
I $D(DTOUT)!$D(DUOUT) S REM="^"
Q REM
;
CANTPOST(ER,TCS,PPI,PRSIEN,PRSD,ESRN) ; GIVE SUPERVISOR CAN'T POST INFORMATION
;
N I,LNCNT
D HDR(PRSIEN,PPI,PRSD)
W !!,"Time Discrepancies must be resolved. Timecard Status: "
W $S(TCS="P":"RELEASED TO PAYROLL",1:"TRANSMITTED TO AUSTIN")
W !,"Payroll must "
W $S(TCS="P":"return ",1:"initiate corrected ")
W "timecard or physician must resubmit ESR."
;
W !!!,$$ASK^PRSLIB00(1)
D HDR(PRSIEN,PPI,PRSD)
;
;
W !!,?15,"TIME DISCREPANCIES BETWEEN TIMECARD AND ESR"
;W !,?15,"-------------------------------------------"
W !,?6,"Error",?21,"Type of Time",?39,"Timecard Hrs",?57,"ESR Hrs"
W !,?2,"--------------------------------------------------------------"
S I=0 F S I=$O(ER(I)) Q:I'>0 D
. W !,?2,$P(ER(I),U,2),?26,$P(ER(I),U),?44,$P(ER(I),U,3),?60,$P(ER(I),U,4)
;
W !!,?32,"ESR POSTING"
;W !,?32,"-----------"
N ESR,DAYLNS,DTE,PDT,DAY
S PDT=$G(^PRST(458,PPI,2))
S DTE=$P(PDT,U,PRSD)
D GETESR^PRSPSAP1(.ESR,PPI,PRSIEN,PRSD)
D COLHDRS^PRSPSAP1
W ! F I=1:1:(IOM-1) W "-"
W ! D DAY^PRSPSAPU(.DAYLNS,PRSD_"^"_DTE,.ESR,PRSIEN,PPI)
W !!,?30,"TIMECARD POSTING"
;W !,?30,"----------------"
W !,?7,"Date",?21,"Scheduled Tour",?46,"Tour Exceptions"
W !,?2,"------------------------------------------------------------"
N DFN S DAY=PRSD,DFN=PRSIEN D F0^PRSADP1
W !
Q
;
HDR(PRSIEN,PPI,PRSD) ;
W @IOF,!!,"ESR approval REJECTED for "
W $P($G(^PRSPC(PRSIEN,0)),"^")," on day ",PRSD," in PP "
W $P($G(^PRST(458,PPI,0)),U),"."
Q
;
;===================================================================
;
CMPESRTC(ERCNT,ERMSG,ESRN,TCN,PPI,PRSIEN,PRSD) ;compare the ESR to the timecard
;
; OUTPUT VARIABLE
;
; ERMSG: Array of mismatches in a 4 piece ^ message format
; type of time ^ message ^ timecard total ^ ESR total
;
; LOCAL VARS
; TT : Type of time code from type of time file (2 exceptions for
; WP on timecard with remark 3, awol is "WPAWOL" OR
; remarks 4, on suspension is "WPSUSP")
; ERFND : flag that some mismatch was found
; ESRT
; TCT : total time
;
N TT,ERFND,ESRT,TCT,PRSTA
;
S (ERFND,ERMSG,ERCNT)=0
I ($G(PPI)'>0)!($G(PRSIEN)'>0)!($G(PRSD)'>0) D Q
. S ERMSG=U_"FATAL ERROR: Missing internal lookup parameters."_U_U
I $G(ESRN)="" S ESRN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
I $G(TCN)="" S TCN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
D ESRTCAR(.PRSTA,ESRN,TCN,PPI,PRSIEN,PRSD)
;
;
; Check for any leave posting mismatch (IGNORE WPAWOL, WPSUSP, RG)
S TT=""
F S TT=$O(PRSTA(TT)) Q:TT="" D
. Q:"^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
. S TCT=+$P(PRSTA(TT),U),ESRT=+$P(PRSTA(TT),U,2)
. I TCT'=ESRT D
.. S ERCNT=ERCNT+1
.. S ERMSG(ERCNT)=TT_U_"LEAVE mismatch"_U_TCT_U_ESRT,ERFND=1
;
; Check for problems with NON PAY. If non pay is on the timecard
; then only NO WORK is accepatable on the ESR.
;
I $P($G(PRSTA("NP")),U)>0 D
. S TT=""
. F S TT=$O(PRSTA(TT)) Q:TT=""!(ERFND) D
.. S ESRT=+$P(PRSTA(TT),U,2)
.. I +ESRT>0 D
... S ERCNT=ERCNT+1
... S ERMSG(ERCNT)=TT_U_"NON PAY mismatch"_U_U_ESRT
Q
;
;===================================================================
;
ESRTCAR(PRSTA,ESRN,TCN,PPI,PRSIEN,PRSD) ;
; return an array subscripted by types of time (TT) for each TT
; found in either the ESR or timecard. Piece 1 of each TT subscript
; represents the timcard and piece 2 represents the ESR.
; Both pieces contain the total hours in decimal format of that TT.
;
;
; loop through the timecard and the ESR totaling the various types of
; time for each. Exceptions are as follows:
; 1. when timecard has WP with remarks AWOL or On Suspension then
; don't add to WP total, since this can never be recorded on
; the ESR, instead store on special node ("WPAWOL") or ("WPSUSP")
;
; INPUT VARIABLES
;
; ESRN : electronic subsidiary record posting node
; TCN : timecard posting node
; PPI, PRSIEN, PRSD : package standard
;
;
;LOCAL variables
; TCPT : timecard posting type (worked or absent all day or except)
; TOD : Tour of duty pointer
; PRSML : Length of meal in minutes
; PRSTA : Time Array subscripted by type of time code (piece one is
; the timecard total time and piece 2 is esr total time
; MTT : Type of time associated with the meal
; ZNODE : zero node from timecard for tour pointers and lengths
;
;
N TCPT,TOD,PRSML,ZNODE,T1LEN,T2LEN,NETRG,TCEXAMT
N TSEG,TT,BEG,END,MEAL,HRS,SEGHRS,TRC
K PRSTA
;
S ZNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
;
; get tour length in case we need to determine amount of time
; for the tour when we don't have exceptions on the timecard or
; we need the implied RG
;
S T1LEN=$P(ZNODE,U,8)
S T2LEN=$P(ZNODE,U,14)
;
;
;ESR
;
;
F I=1:5:31 D
. S TSEG=$P(ESRN,U,I,I+4)
. S TT=$P(TSEG,U,3)
.;
.;this line may need to be removed since we are simply looking
.; at all types of time at this stage (also would make this call
.; more useful as an API to get all types of time)
.;
. Q:"^RG^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
. S HRS=$P($G(PRSTA(TT)),U,2)
. S BEG=$P(TSEG,U)
. S END=$P(TSEG,U,2)
. S MEAL=$P(TSEG,U,5)
. S SEGHRS=$$AMT^PRSPSAPU(BEG,END,MEAL)
. S $P(PRSTA(TT),U,2)=SEGHRS+HRS
;
; if timecard isn't posted there's no point in going on
Q:(+$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,2)'>0)
;
;Timecard with exceptions (no full day work or leave)
;
S TCPT=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,4)
I '((TCPT=1)!(TCPT=2)) D
. F I=1:4:24 D
.. S TSEG=$P(TCN,U,I,I+3)
.. S TT=$P(TSEG,U,3)
.. S TRC=$P(TSEG,U,4)
..; check for awol and store separate from other WP
.. I TT="WP" S TT=$S(TRC=3:"WPAWOL",TRC=4:"WPSUSP",1:TT)
.. Q:"^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
.. S HRS=$P($G(PRSTA(TT)),U)
.. S BEG=$P(TSEG,U)
.. S END=$P(TSEG,U,2)
.. S SEGHRS=$$AMT^PRSPSAPU(BEG,END,0)
.. S $P(PRSTA(TT),U)=SEGHRS+HRS
E D
.;
.; if timecard is posted w/exception or work for the full day
.; then use the tour 1 and 2 lengths to record hours
.;
. I TCPT=2 D
..; full day exception posted: get type of time and remarks
.. S TT="" F I=1:4:24 Q:TT'="" S TT=$P(TCN,U,I+2),TRC=$P(TCN,U,I+3)
.. I TT="WP" S TT=$S(TRC=3:"WPAWOL",TRC=4:"WPSUSP",1:TT)
. ;
. ; full day work
. I TCPT=1 S TT="RG"
.;
. S $P(PRSTA(TT),U)=T1LEN+T2LEN
;
; RG should not be coded on the PTP's timecard but we will tabulate
; the implied RG by reducing the tour length by any exceptions totals
;
I $P($G(PRSTA("RG")),U)="" D
. S NETRG=T1LEN+T2LEN
. S TT=""
. F S TT=$O(PRSTA(TT)) Q:TT="" D
..; only times that reduce RG are included
..; (WP, WPAWOL, WPSUSP & NP) reduce RG
.. Q:"^HX^AL^AA^DL^ML^RL^SL^CB^AD^TR^TV^"[(U_TT_U)
.. Q:TT="RG"
.. S TCEXAMT=$P(PRSTA(TT),U)
.. S NETRG=NETRG-TCEXAMT
. S $P(PRSTA("RG"),U)=NETRG
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPSAP3 8631 printed Dec 13, 2024@02:28:15 Page 2
PRSPSAP3 ;WOIFO/JAH - Supervisor Approve-update pt phys timecard ;01/05/05
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
MARK(ACT,PRSIEN,PPI) ; mark supervisors action on temp global
+1 ; ESR STATUS
+2 ; when updating a single record we overwrite. When updating
+3 ; multiple records we will only update ones with no status.
+4 NEW ITEM,OLDACT,REM,OLDREM
+5 SET ITEM=$PIECE($GET(ACT),U,2)
+6 SET ACT=$PIECE($GET(ACT),U)
+7 IF ITEM>0
Begin DoDot:1
+8 SET PRSD=$GET(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,"B",ITEM))
+9 SET ^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,1)=ACT
+10 ; add remarks to the resubmit action, otherwise remove old remarks
+11 IF ACT="R"
Begin DoDot:2
+12 SET OLDREM=$GET(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,2))
+13 SET REM=$$GETREM(OLDREM)
+14 IF REM'="^"
SET ^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,2)=$GET(REM)
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 KILL ^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,2)
End DoDot:2
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 IF ACT="R"
SET REM=$$GETREM()
+19 SET PRSD=0
+20 FOR
SET PRSD=$ORDER(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD))
if PRSD'>0
QUIT
Begin DoDot:2
+21 SET OLDACT=$GET(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,1))
+22 IF OLDACT=""
Begin DoDot:3
+23 SET ^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,1)=ACT
+24 IF $GET(ACT)="R"
SET ^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD,2)=$GET(REM)
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
GETREM(SNIDE) ; return supervisor remark for a resubmit request
+1 ; WE CAN'T EDIT THE FIELD DIRECTLY BECAUSE THIS IS A TRANSACTION
+2 ; AND NOTHING IS COMMITED TO THE DB UNTIL THEY SIGN
+3 NEW DIR,DIRUT,REM,DTOUT,DUOUT,X,Y
+4 SET REM=""
+5 SET DIR(0)="458.02,148^O"
+6 IF $GET(SNIDE)'=""
SET DIR("B")=SNIDE
+7 SET DIR("A")="Enter Remarks"
+8 DO ^DIR
+9 SET REM=$GET(Y)
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
SET REM="^"
+11 QUIT REM
+12 ;
CANTPOST(ER,TCS,PPI,PRSIEN,PRSD,ESRN) ; GIVE SUPERVISOR CAN'T POST INFORMATION
+1 ;
+2 NEW I,LNCNT
+3 DO HDR(PRSIEN,PPI,PRSD)
+4 WRITE !!,"Time Discrepancies must be resolved. Timecard Status: "
+5 WRITE $SELECT(TCS="P":"RELEASED TO PAYROLL",1:"TRANSMITTED TO AUSTIN")
+6 WRITE !,"Payroll must "
+7 WRITE $SELECT(TCS="P":"return ",1:"initiate corrected ")
+8 WRITE "timecard or physician must resubmit ESR."
+9 ;
+10 WRITE !!!,$$ASK^PRSLIB00(1)
+11 DO HDR(PRSIEN,PPI,PRSD)
+12 ;
+13 ;
+14 WRITE !!,?15,"TIME DISCREPANCIES BETWEEN TIMECARD AND ESR"
+15 ;W !,?15,"-------------------------------------------"
+16 WRITE !,?6,"Error",?21,"Type of Time",?39,"Timecard Hrs",?57,"ESR Hrs"
+17 WRITE !,?2,"--------------------------------------------------------------"
+18 SET I=0
FOR
SET I=$ORDER(ER(I))
if I'>0
QUIT
Begin DoDot:1
+19 WRITE !,?2,$PIECE(ER(I),U,2),?26,$PIECE(ER(I),U),?44,$PIECE(ER(I),U,3),?60,$PIECE(ER(I),U,4)
End DoDot:1
+20 ;
+21 WRITE !!,?32,"ESR POSTING"
+22 ;W !,?32,"-----------"
+23 NEW ESR,DAYLNS,DTE,PDT,DAY
+24 SET PDT=$GET(^PRST(458,PPI,2))
+25 SET DTE=$PIECE(PDT,U,PRSD)
+26 DO GETESR^PRSPSAP1(.ESR,PPI,PRSIEN,PRSD)
+27 DO COLHDRS^PRSPSAP1
+28 WRITE !
FOR I=1:1:(IOM-1)
WRITE "-"
+29 WRITE !
DO DAY^PRSPSAPU(.DAYLNS,PRSD_"^"_DTE,.ESR,PRSIEN,PPI)
+30 WRITE !!,?30,"TIMECARD POSTING"
+31 ;W !,?30,"----------------"
+32 WRITE !,?7,"Date",?21,"Scheduled Tour",?46,"Tour Exceptions"
+33 WRITE !,?2,"------------------------------------------------------------"
+34 NEW DFN
SET DAY=PRSD
SET DFN=PRSIEN
DO F0^PRSADP1
+35 WRITE !
+36 QUIT
+37 ;
HDR(PRSIEN,PPI,PRSD) ;
+1 WRITE @IOF,!!,"ESR approval REJECTED for "
+2 WRITE $PIECE($GET(^PRSPC(PRSIEN,0)),"^")," on day ",PRSD," in PP "
+3 WRITE $PIECE($GET(^PRST(458,PPI,0)),U),"."
+4 QUIT
+5 ;
+6 ;===================================================================
+7 ;
CMPESRTC(ERCNT,ERMSG,ESRN,TCN,PPI,PRSIEN,PRSD) ;compare the ESR to the timecard
+1 ;
+2 ; OUTPUT VARIABLE
+3 ;
+4 ; ERMSG: Array of mismatches in a 4 piece ^ message format
+5 ; type of time ^ message ^ timecard total ^ ESR total
+6 ;
+7 ; LOCAL VARS
+8 ; TT : Type of time code from type of time file (2 exceptions for
+9 ; WP on timecard with remark 3, awol is "WPAWOL" OR
+10 ; remarks 4, on suspension is "WPSUSP")
+11 ; ERFND : flag that some mismatch was found
+12 ; ESRT
+13 ; TCT : total time
+14 ;
+15 NEW TT,ERFND,ESRT,TCT,PRSTA
+16 ;
+17 SET (ERFND,ERMSG,ERCNT)=0
+18 IF ($GET(PPI)'>0)!($GET(PRSIEN)'>0)!($GET(PRSD)'>0)
Begin DoDot:1
+19 SET ERMSG=U_"FATAL ERROR: Missing internal lookup parameters."_U_U
End DoDot:1
QUIT
+20 IF $GET(ESRN)=""
SET ESRN=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
+21 IF $GET(TCN)=""
SET TCN=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
+22 DO ESRTCAR(.PRSTA,ESRN,TCN,PPI,PRSIEN,PRSD)
+23 ;
+24 ;
+25 ; Check for any leave posting mismatch (IGNORE WPAWOL, WPSUSP, RG)
+26 SET TT=""
+27 FOR
SET TT=$ORDER(PRSTA(TT))
if TT=""
QUIT
Begin DoDot:1
+28 if "^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
QUIT
+29 SET TCT=+$PIECE(PRSTA(TT),U)
SET ESRT=+$PIECE(PRSTA(TT),U,2)
+30 IF TCT'=ESRT
Begin DoDot:2
+31 SET ERCNT=ERCNT+1
+32 SET ERMSG(ERCNT)=TT_U_"LEAVE mismatch"_U_TCT_U_ESRT
SET ERFND=1
End DoDot:2
End DoDot:1
+33 ;
+34 ; Check for problems with NON PAY. If non pay is on the timecard
+35 ; then only NO WORK is accepatable on the ESR.
+36 ;
+37 IF $PIECE($GET(PRSTA("NP")),U)>0
Begin DoDot:1
+38 SET TT=""
+39 FOR
SET TT=$ORDER(PRSTA(TT))
if TT=""!(ERFND)
QUIT
Begin DoDot:2
+40 SET ESRT=+$PIECE(PRSTA(TT),U,2)
+41 IF +ESRT>0
Begin DoDot:3
+42 SET ERCNT=ERCNT+1
+43 SET ERMSG(ERCNT)=TT_U_"NON PAY mismatch"_U_U_ESRT
End DoDot:3
End DoDot:2
End DoDot:1
+44 QUIT
+45 ;
+46 ;===================================================================
+47 ;
ESRTCAR(PRSTA,ESRN,TCN,PPI,PRSIEN,PRSD) ;
+1 ; return an array subscripted by types of time (TT) for each TT
+2 ; found in either the ESR or timecard. Piece 1 of each TT subscript
+3 ; represents the timcard and piece 2 represents the ESR.
+4 ; Both pieces contain the total hours in decimal format of that TT.
+5 ;
+6 ;
+7 ; loop through the timecard and the ESR totaling the various types of
+8 ; time for each. Exceptions are as follows:
+9 ; 1. when timecard has WP with remarks AWOL or On Suspension then
+10 ; don't add to WP total, since this can never be recorded on
+11 ; the ESR, instead store on special node ("WPAWOL") or ("WPSUSP")
+12 ;
+13 ; INPUT VARIABLES
+14 ;
+15 ; ESRN : electronic subsidiary record posting node
+16 ; TCN : timecard posting node
+17 ; PPI, PRSIEN, PRSD : package standard
+18 ;
+19 ;
+20 ;LOCAL variables
+21 ; TCPT : timecard posting type (worked or absent all day or except)
+22 ; TOD : Tour of duty pointer
+23 ; PRSML : Length of meal in minutes
+24 ; PRSTA : Time Array subscripted by type of time code (piece one is
+25 ; the timecard total time and piece 2 is esr total time
+26 ; MTT : Type of time associated with the meal
+27 ; ZNODE : zero node from timecard for tour pointers and lengths
+28 ;
+29 ;
+30 NEW TCPT,TOD,PRSML,ZNODE,T1LEN,T2LEN,NETRG,TCEXAMT
+31 NEW TSEG,TT,BEG,END,MEAL,HRS,SEGHRS,TRC
+32 KILL PRSTA
+33 ;
+34 SET ZNODE=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
+35 ;
+36 ; get tour length in case we need to determine amount of time
+37 ; for the tour when we don't have exceptions on the timecard or
+38 ; we need the implied RG
+39 ;
+40 SET T1LEN=$PIECE(ZNODE,U,8)
+41 SET T2LEN=$PIECE(ZNODE,U,14)
+42 ;
+43 ;
+44 ;ESR
+45 ;
+46 ;
+47 FOR I=1:5:31
Begin DoDot:1
+48 SET TSEG=$PIECE(ESRN,U,I,I+4)
+49 SET TT=$PIECE(TSEG,U,3)
+50 ;
+51 ;this line may need to be removed since we are simply looking
+52 ; at all types of time at this stage (also would make this call
+53 ; more useful as an API to get all types of time)
+54 ;
+55 if "^RG^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
QUIT
+56 SET HRS=$PIECE($GET(PRSTA(TT)),U,2)
+57 SET BEG=$PIECE(TSEG,U)
+58 SET END=$PIECE(TSEG,U,2)
+59 SET MEAL=$PIECE(TSEG,U,5)
+60 SET SEGHRS=$$AMT^PRSPSAPU(BEG,END,MEAL)
+61 SET $PIECE(PRSTA(TT),U,2)=SEGHRS+HRS
End DoDot:1
+62 ;
+63 ; if timecard isn't posted there's no point in going on
+64 if (+$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,2)'>0)
QUIT
+65 ;
+66 ;Timecard with exceptions (no full day work or leave)
+67 ;
+68 SET TCPT=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,4)
+69 IF '((TCPT=1)!(TCPT=2))
Begin DoDot:1
+70 FOR I=1:4:24
Begin DoDot:2
+71 SET TSEG=$PIECE(TCN,U,I,I+3)
+72 SET TT=$PIECE(TSEG,U,3)
+73 SET TRC=$PIECE(TSEG,U,4)
+74 ; check for awol and store separate from other WP
+75 IF TT="WP"
SET TT=$SELECT(TRC=3:"WPAWOL",TRC=4:"WPSUSP",1:TT)
+76 if "^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U)
QUIT
+77 SET HRS=$PIECE($GET(PRSTA(TT)),U)
+78 SET BEG=$PIECE(TSEG,U)
+79 SET END=$PIECE(TSEG,U,2)
+80 SET SEGHRS=$$AMT^PRSPSAPU(BEG,END,0)
+81 SET $PIECE(PRSTA(TT),U)=SEGHRS+HRS
End DoDot:2
End DoDot:1
+82 IF '$TEST
Begin DoDot:1
+83 ;
+84 ; if timecard is posted w/exception or work for the full day
+85 ; then use the tour 1 and 2 lengths to record hours
+86 ;
+87 IF TCPT=2
Begin DoDot:2
+88 ; full day exception posted: get type of time and remarks
+89 SET TT=""
FOR I=1:4:24
if TT'=""
QUIT
SET TT=$PIECE(TCN,U,I+2)
SET TRC=$PIECE(TCN,U,I+3)
+90 IF TT="WP"
SET TT=$SELECT(TRC=3:"WPAWOL",TRC=4:"WPSUSP",1:TT)
End DoDot:2
+91 ;
+92 ; full day work
+93 IF TCPT=1
SET TT="RG"
+94 ;
+95 SET $PIECE(PRSTA(TT),U)=T1LEN+T2LEN
End DoDot:1
+96 ;
+97 ; RG should not be coded on the PTP's timecard but we will tabulate
+98 ; the implied RG by reducing the tour length by any exceptions totals
+99 ;
+100 IF $PIECE($GET(PRSTA("RG")),U)=""
Begin DoDot:1
+101 SET NETRG=T1LEN+T2LEN
+102 SET TT=""
+103 FOR
SET TT=$ORDER(PRSTA(TT))
if TT=""
QUIT
Begin DoDot:2
+104 ; only times that reduce RG are included
+105 ; (WP, WPAWOL, WPSUSP & NP) reduce RG
+106 if "^HX^AL^AA^DL^ML^RL^SL^CB^AD^TR^TV^"[(U_TT_U)
QUIT
+107 if TT="RG"
QUIT
+108 SET TCEXAMT=$PIECE(PRSTA(TT),U)
+109 SET NETRG=NETRG-TCEXAMT
End DoDot:2
+110 SET $PIECE(PRSTA("RG"),U)=NETRG
End DoDot:1
+111 ;
+112 QUIT
