PRSPSAPU ;WOIFO/JAH - PT Physician, supervisor approval utils ;01/22/05
;;4.0;PAID;**93,125**;Sep 21, 1995;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
ONEPTP(TLE) ; get one or all ptp's from a TLE
; if the selection hasn't a memo or hasn't an ESR to be approved
; then inform and re-ask
;
; return PRSIEN for successful PTP selection
; return 0 for all PTP's in T&L
; return -1 for abort/timeout
;
N ALL,PTP,OUT
S (PTP,ALL,OUT)=0
F D Q:(OUT!(PTP>0)!(ALL))
. S PTP=$$ALL1PTP(TLE)
. I PTP=0 S ALL=1 Q ; all ptp's were selected
. I PTP<0 S OUT=1 Q ; user uparrow or timeout
. I PTP>0,'$D(^PRST(458.7,"B",PTP)) W !!,"There are no Service Level Memoranda on file for ",$P(^PRSPC(PTP,0),U) S PTP=0
. I PTP>0,'$D(^PRST(458,"ASA",PTP)) W !!,"There are no daily ESR's pending approval for ",$P(^PRSPC(PTP,0),U) S PTP=0
I ALL S PTP=0
I OUT S PTP=-1
Q PTP
;
ALL1PTP(TLE) ; ask for one part time physician from a TLE or ALL
I TLE'?1A.E,TLE'>0 Q PRSIEN
N DIC,PRSIEN,D,Y,DUOUT,DTOUT
S PRSIEN=""
S DIC("A")="Select an EMPLOYEE or press RETURN for ALL: "
S DIC(0)="AEQM"
S DIC="^PRSPC("
S DIC("S")="I $P(^(0),""^"",8)=TLE"
; start look up with ATL xref
S D="ATL"_TLE
W !
D IX^DIC
;
; user hit return for all (return 0)
I Y=-1,'($D(DUOUT)!$D(DTOUT)) D
. S PRSIEN=0
E D
. S PRSIEN=+Y
Q PRSIEN
;
UPESRST(PPI,PRSIEN,PRSD) ;update ESR DAILY STATUS
N DIE,DR,DA
S DA(2)=$G(PPI),DA(1)=$G(PRSIEN),DA=$G(PRSD)
S DR="146///SIGNED;149///MANUAL POST"
S DIE="^PRST(458,"_DA(2)_",""E"","_DA(1)_",""D"","
D ^DIE
Q
ESRDTS(ESRDTS,PRSIEN,PPI) ; Return signed dates from PTP's ESR
; return array ESRDTS subscripted sequentially from 1
; ESRDTS(1) = Tue 2-NOV-04
; ESRDTS(2) = Fri 5-NOV-04
N PRSD,ITEMS,PRSDTS
S PRSDTS=$G(^PRST(458,PPI,2))
S (PRSD,ITEMS)=0
F S PRSD=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD)) Q:PRSD'>0 D
. S ITEMS=ITEMS+1
. S ESRDTS(ITEMS)=PRSD_U_$P(PRSDTS,U,PRSD)
Q
DISPLAY(PRSIEN,PPI,CNT) ;display PPI signed esr days for super review/action
; RETURN array CNT
; CNT = count of days
; CNT(1)= days w/status from supervisor during this option
; PGLNS = lines on current page
; DYLNS = lines in a day
;
N I,PRSD,ESRDTS,ESEG,ESR,PGLNS,DAYLNS,OUT
D HDRESR^PRSPSAP1(PRSIEN,PPI,.PGLNS)
;
D ESRDTS^PRSPSAPU(.ESRDTS,PRSIEN,PPI)
S (PRSD,CNT,CNT(1),OUT)=0
F S PRSD=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD)) Q:PRSD'>0!(OUT) D
. I $Y>(IOSL-6) S OUT=$$ASK^PRSLIB00() D HDRESR^PRSPSAP1(PRSIEN,PPI,.PGLNS)
. Q:OUT
. D GETESR^PRSPSAP1(.ESR,PPI,PRSIEN,PRSD)
. S CNT=CNT+1
. W !,CNT
. D DAY(.DAYLNS,ESRDTS(CNT),.ESR,PRSIEN,PPI)
. S PGLNS=PGLNS+DAYLNS
Q
;
DAY(LN,EXTDAY,ESR,PRSIEN,PPI) ; write a day, return # of lines.
N STE,ESEG,REMARKS,START,STOP,MEAL,HOURS,STATUSI,LCNT
S LN=0
S HOURS=""
W ?3,$P(EXTDAY,U,2)
W ?17,ESR("TODEXT")
; if tour is too wide for column move down a line
I $L(ESR("TODEXT"))>16 W ! S LN=LN+1
;
F ESEG=1:5:31 Q:($P(ESR("WORK"),U,ESEG)="") D
. I ESEG>1 W !
.; start
. S START=$P(ESR("WORK"),U,ESEG)
. S STOP=$P(ESR("WORK"),U,ESEG+1)
. S MEAL=$P(ESR("WORK"),U,ESEG+4)
. W ?33,START
. I START'["No work:" D
.. W "-"
.. S HOURS=$$ELAPSE^PRSPESR2(MEAL,START,STOP)
.; stop
. W STOP
.; type of time
. W ?49,$$TTE($P(ESR("WORK"),U,ESEG+2))
.; remarks - use 458.02 to convert to external
. S REMARKS=$P(ESR("WORK"),U,ESEG+3)
. I REMARKS>0 D
.. S LN=LN+1
.. W !,?34,"Remarks: ",$$EXTERNAL^DILFD(458.02,44,"",REMARKS)
.; hours and meal
. W ?61,HOURS,?68,MEAL
; display PTP remarks (if any)
I ESR("RMK")]"" D
. W !,?2,"Physician Remarks: "
. D WRAP(.LCNT,ESR("RMK"),21,66)
. S LN=LN+LCNT
S STATUSI=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,+EXTDAY,1))
W ?72,$$STATUSE(STATUSI)
Q
GETDAY(ESRDY,ESRDTS,ESR,CNT,PRSIEN,PPI) ; RETURN write a day IN ESRDY ARRAY
N BLANKS,LN,ESEG,START
S LN=1
S BLANKS=" "
S ESRDY(LN)=" "_$P(ESRDTS(CNT),U,2)
S ESRDY(LN)=$E(ESRDY(LN)_BLANKS,1,18)_ESR("TODEXT")
; if tour is too wide for the column move down a line for the work
I $L(ESR("TODEXT"))>16 S LN=LN+1,ESRDY(LN)=""
;
F ESEG=1:5:31 Q:($P(ESR("WORK"),U,ESEG)="") D
. I ESEG>1 W !
.; start
. S START=$P(ESR("WORK"),U,ESEG)
. S ESRDY(LN)=$E(ESRDY(LN)_BLANKS,1,35)_START
. I START'["No work-signed by" S ESRDY(LN)=ESRDY(LN)_"-"
.; stop
. S ESRDY(LN)=ESRDY(LN)_$P(ESR("WORK"),U,ESEG+1)
.; type of time
. S ESRDY(LN)=$E(ESRDY(LN)_BLANKS,1,51)_$$TTE($P(ESR("WORK"),U,ESEG+2))
.; remarks
. S ESRDY(LN)=$E(ESRDY(LN)_BLANKS,1,54)_$P(ESR("WORK"),U,ESEG+3)
.; meal
. S ESRDY(LN)=$E(ESRDY(LN)_BLANKS,1,68)_$P(ESR("WORK"),U,ESEG+4)
. S ST=$$STATUSE($G(^TMP($J,"PRSPSAP",PRSIEN,PPI,+ESRDTS(CNT),1)))
. S ESRDY(LN)=$E(ESRDY(LN),1,71)_ST
. S LN=LN+1,ESRDY(LN)=""
Q
;
TTE(CODE) ; return external type of time
N K
Q:$G(CODE)="" CODE
S K=$O(^PRST(457.3,"B",CODE,0))
Q $P($G(^PRST(457.3,+K,0)),"^",2)
;
STATUSE(ST) ; return external form of supervisor action status
S ST=$G(ST)
Q $S(ST="B":"Bypass",ST="R":"Resubmit",ST="A":"Approved",1:"")
;
CLRTCDY(PPI,PRSIEN,PRSD,EST) ;function true (1) for success otherwise 0
; clear a timecard day (2,3,10 nodes) if status is (T) timekeeper
; clear work, posting status and remove approved status from ESR day.
; INPUT: PPI,PRSIEN,PRSD: package standard
; EST : optional, valid ESR DAILY STATUS internal value
;
Q:($G(PPI)'>0)!($G(PRSIEN)'>0)!($G(PRSD)'>0) 0
Q:'$D(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)) 0
N TCSTAT
S TCSTAT=$$TCSTAT^PRSPSAP2(PPI,PRSIEN)
Q:$G(TCSTAT)'="T" 0
;
; kill the timecard work nodes
K ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2),^(3),^(10)
;
; ONLY if a valid ESR daily status is passed then set it
N VALID
D CHK^DIE(458.02,146,"",$G(EST),.VALID)
Q:VALID["^" 1
;
N IENS,PRSFDA
S IENS=PRSD_","_PRSIEN_","_PPI_","
S PRSFDA(458.02,IENS,146)=EST
D FILE^DIE("","PRSFDA")
D MSG^DIALOG()
Q 1
;
WRAP(LNS,STR,TAB,WID) ; format a long message string to break lines at words
; TAB is left margin
; WID is right margin
; return LNS number of lines it took to write
N WORD,I,WC,COLW,W1,W2
S WC=0,WORD=""
S COLW=WID-TAB+1
W ?$G(TAB)
S LNS=1
F I=1:1:$L(STR," ") D
. S WORD=$P(STR," ",I)
. Q:WORD=""
.; break words longer than the width of the column
. F Q:($L(WORD)<(COLW+1)) D
.. S W1=$E(WORD,1,COLW-1)_"-"
.. S W2=$E(WORD,COLW,$L(WORD))
.. S WORD=W1 D WW
.. S WORD=W2
. D WW
Q
WW ; Write Word
I ($X+$L(WORD))>WID D
. I WC>0 W !,?$G(TAB) S LNS=LNS+1,WC=0
W WORD," " S WC=WC+1
Q
;
;
;===============================================================
;
AMT(START,STOP,MEAL) ; return decimal hours between times
; times are in PAID timecard work node format. (e.g. 04:30P )
N AMT,X
S AMT=$$ELAPSE^PRSPESR2(MEAL,START,STOP)
S X=$P(AMT,":",2) S X=$S(X=30:5,X=15:25,X=45:75,1:0)
S AMT=+$P(AMT,":",1)_"."_X
Q AMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPSAPU 7132 printed Apr 09, 2024@21:30:05 Page 2
PRSPSAPU ;WOIFO/JAH - PT Physician, supervisor approval utils ;01/22/05
+1 ;;4.0;PAID;**93,125**;Sep 21, 1995;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
ONEPTP(TLE) ; get one or all ptp's from a TLE
+1 ; if the selection hasn't a memo or hasn't an ESR to be approved
+2 ; then inform and re-ask
+3 ;
+4 ; return PRSIEN for successful PTP selection
+5 ; return 0 for all PTP's in T&L
+6 ; return -1 for abort/timeout
+7 ;
+8 NEW ALL,PTP,OUT
+9 SET (PTP,ALL,OUT)=0
+10 FOR
Begin DoDot:1
+11 SET PTP=$$ALL1PTP(TLE)
+12 ; all ptp's were selected
IF PTP=0
SET ALL=1
QUIT
+13 ; user uparrow or timeout
IF PTP<0
SET OUT=1
QUIT
+14 IF PTP>0
IF '$DATA(^PRST(458.7,"B",PTP))
WRITE !!,"There are no Service Level Memoranda on file for ",$PIECE(^PRSPC(PTP,0),U)
SET PTP=0
+15 IF PTP>0
IF '$DATA(^PRST(458,"ASA",PTP))
WRITE !!,"There are no daily ESR's pending approval for ",$PIECE(^PRSPC(PTP,0),U)
SET PTP=0
End DoDot:1
if (OUT!(PTP>0)!(ALL))
QUIT
+16 IF ALL
SET PTP=0
+17 IF OUT
SET PTP=-1
+18 QUIT PTP
+19 ;
ALL1PTP(TLE) ; ask for one part time physician from a TLE or ALL
+1 IF TLE'?1A.E
IF TLE'>0
QUIT PRSIEN
+2 NEW DIC,PRSIEN,D,Y,DUOUT,DTOUT
+3 SET PRSIEN=""
+4 SET DIC("A")="Select an EMPLOYEE or press RETURN for ALL: "
+5 SET DIC(0)="AEQM"
+6 SET DIC="^PRSPC("
+7 SET DIC("S")="I $P(^(0),""^"",8)=TLE"
+8 ; start look up with ATL xref
+9 SET D="ATL"_TLE
+10 WRITE !
+11 DO IX^DIC
+12 ;
+13 ; user hit return for all (return 0)
+14 IF Y=-1
IF '($DATA(DUOUT)!$DATA(DTOUT))
Begin DoDot:1
+15 SET PRSIEN=0
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET PRSIEN=+Y
End DoDot:1
+18 QUIT PRSIEN
+19 ;
UPESRST(PPI,PRSIEN,PRSD) ;update ESR DAILY STATUS
+1 NEW DIE,DR,DA
+2 SET DA(2)=$GET(PPI)
SET DA(1)=$GET(PRSIEN)
SET DA=$GET(PRSD)
+3 SET DR="146///SIGNED;149///MANUAL POST"
+4 SET DIE="^PRST(458,"_DA(2)_",""E"","_DA(1)_",""D"","
+5 DO ^DIE
+6 QUIT
ESRDTS(ESRDTS,PRSIEN,PPI) ; Return signed dates from PTP's ESR
+1 ; return array ESRDTS subscripted sequentially from 1
+2 ; ESRDTS(1) = Tue 2-NOV-04
+3 ; ESRDTS(2) = Fri 5-NOV-04
+4 NEW PRSD,ITEMS,PRSDTS
+5 SET PRSDTS=$GET(^PRST(458,PPI,2))
+6 SET (PRSD,ITEMS)=0
+7 FOR
SET PRSD=$ORDER(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD))
if PRSD'>0
QUIT
Begin DoDot:1
+8 SET ITEMS=ITEMS+1
+9 SET ESRDTS(ITEMS)=PRSD_U_$PIECE(PRSDTS,U,PRSD)
End DoDot:1
+10 QUIT
DISPLAY(PRSIEN,PPI,CNT) ;display PPI signed esr days for super review/action
+1 ; RETURN array CNT
+2 ; CNT = count of days
+3 ; CNT(1)= days w/status from supervisor during this option
+4 ; PGLNS = lines on current page
+5 ; DYLNS = lines in a day
+6 ;
+7 NEW I,PRSD,ESRDTS,ESEG,ESR,PGLNS,DAYLNS,OUT
+8 DO HDRESR^PRSPSAP1(PRSIEN,PPI,.PGLNS)
+9 ;
+10 DO ESRDTS^PRSPSAPU(.ESRDTS,PRSIEN,PPI)
+11 SET (PRSD,CNT,CNT(1),OUT)=0
+12 FOR
SET PRSD=$ORDER(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,PRSD))
if PRSD'>0!(OUT)
QUIT
Begin DoDot:1
+13 IF $Y>(IOSL-6)
SET OUT=$$ASK^PRSLIB00()
DO HDRESR^PRSPSAP1(PRSIEN,PPI,.PGLNS)
+14 if OUT
QUIT
+15 DO GETESR^PRSPSAP1(.ESR,PPI,PRSIEN,PRSD)
+16 SET CNT=CNT+1
+17 WRITE !,CNT
+18 DO DAY(.DAYLNS,ESRDTS(CNT),.ESR,PRSIEN,PPI)
+19 SET PGLNS=PGLNS+DAYLNS
End DoDot:1
+20 QUIT
+21 ;
DAY(LN,EXTDAY,ESR,PRSIEN,PPI) ; write a day, return # of lines.
+1 NEW STE,ESEG,REMARKS,START,STOP,MEAL,HOURS,STATUSI,LCNT
+2 SET LN=0
+3 SET HOURS=""
+4 WRITE ?3,$PIECE(EXTDAY,U,2)
+5 WRITE ?17,ESR("TODEXT")
+6 ; if tour is too wide for column move down a line
+7 IF $LENGTH(ESR("TODEXT"))>16
WRITE !
SET LN=LN+1
+8 ;
+9 FOR ESEG=1:5:31
if ($PIECE(ESR("WORK"),U,ESEG)="")
QUIT
Begin DoDot:1
+10 IF ESEG>1
WRITE !
+11 ; start
+12 SET START=$PIECE(ESR("WORK"),U,ESEG)
+13 SET STOP=$PIECE(ESR("WORK"),U,ESEG+1)
+14 SET MEAL=$PIECE(ESR("WORK"),U,ESEG+4)
+15 WRITE ?33,START
+16 IF START'["No work:"
Begin DoDot:2
+17 WRITE "-"
+18 SET HOURS=$$ELAPSE^PRSPESR2(MEAL,START,STOP)
End DoDot:2
+19 ; stop
+20 WRITE STOP
+21 ; type of time
+22 WRITE ?49,$$TTE($PIECE(ESR("WORK"),U,ESEG+2))
+23 ; remarks - use 458.02 to convert to external
+24 SET REMARKS=$PIECE(ESR("WORK"),U,ESEG+3)
+25 IF REMARKS>0
Begin DoDot:2
+26 SET LN=LN+1
+27 WRITE !,?34,"Remarks: ",$$EXTERNAL^DILFD(458.02,44,"",REMARKS)
End DoDot:2
+28 ; hours and meal
+29 WRITE ?61,HOURS,?68,MEAL
End DoDot:1
+30 ; display PTP remarks (if any)
+31 IF ESR("RMK")]""
Begin DoDot:1
+32 WRITE !,?2,"Physician Remarks: "
+33 DO WRAP(.LCNT,ESR("RMK"),21,66)
+34 SET LN=LN+LCNT
End DoDot:1
+35 SET STATUSI=$GET(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,+EXTDAY,1))
+36 WRITE ?72,$$STATUSE(STATUSI)
+37 QUIT
GETDAY(ESRDY,ESRDTS,ESR,CNT,PRSIEN,PPI) ; RETURN write a day IN ESRDY ARRAY
+1 NEW BLANKS,LN,ESEG,START
+2 SET LN=1
+3 SET BLANKS=" "
+4 SET ESRDY(LN)=" "_$PIECE(ESRDTS(CNT),U,2)
+5 SET ESRDY(LN)=$EXTRACT(ESRDY(LN)_BLANKS,1,18)_ESR("TODEXT")
+6 ; if tour is too wide for the column move down a line for the work
+7 IF $LENGTH(ESR("TODEXT"))>16
SET LN=LN+1
SET ESRDY(LN)=""
+8 ;
+9 FOR ESEG=1:5:31
if ($PIECE(ESR("WORK"),U,ESEG)="")
QUIT
Begin DoDot:1
+10 IF ESEG>1
WRITE !
+11 ; start
+12 SET START=$PIECE(ESR("WORK"),U,ESEG)
+13 SET ESRDY(LN)=$EXTRACT(ESRDY(LN)_BLANKS,1,35)_START
+14 IF START'["No work-signed by"
SET ESRDY(LN)=ESRDY(LN)_"-"
+15 ; stop
+16 SET ESRDY(LN)=ESRDY(LN)_$PIECE(ESR("WORK"),U,ESEG+1)
+17 ; type of time
+18 SET ESRDY(LN)=$EXTRACT(ESRDY(LN)_BLANKS,1,51)_$$TTE($PIECE(ESR("WORK"),U,ESEG+2))
+19 ; remarks
+20 SET ESRDY(LN)=$EXTRACT(ESRDY(LN)_BLANKS,1,54)_$PIECE(ESR("WORK"),U,ESEG+3)
+21 ; meal
+22 SET ESRDY(LN)=$EXTRACT(ESRDY(LN)_BLANKS,1,68)_$PIECE(ESR("WORK"),U,ESEG+4)
+23 SET ST=$$STATUSE($GET(^TMP($JOB,"PRSPSAP",PRSIEN,PPI,+ESRDTS(CNT),1)))
+24 SET ESRDY(LN)=$EXTRACT(ESRDY(LN),1,71)_ST
+25 SET LN=LN+1
SET ESRDY(LN)=""
End DoDot:1
+26 QUIT
+27 ;
TTE(CODE) ; return external type of time
+1 NEW K
+2 if $GET(CODE)=""
QUIT CODE
+3 SET K=$ORDER(^PRST(457.3,"B",CODE,0))
+4 QUIT $PIECE($GET(^PRST(457.3,+K,0)),"^",2)
+5 ;
STATUSE(ST) ; return external form of supervisor action status
+1 SET ST=$GET(ST)
+2 QUIT $SELECT(ST="B":"Bypass",ST="R":"Resubmit",ST="A":"Approved",1:"")
+3 ;
CLRTCDY(PPI,PRSIEN,PRSD,EST) ;function true (1) for success otherwise 0
+1 ; clear a timecard day (2,3,10 nodes) if status is (T) timekeeper
+2 ; clear work, posting status and remove approved status from ESR day.
+3 ; INPUT: PPI,PRSIEN,PRSD: package standard
+4 ; EST : optional, valid ESR DAILY STATUS internal value
+5 ;
+6 if ($GET(PPI)'>0)!($GET(PRSIEN)'>0)!($GET(PRSD)'>0)
QUIT 0
+7 if '$DATA(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
QUIT 0
+8 NEW TCSTAT
+9 SET TCSTAT=$$TCSTAT^PRSPSAP2(PPI,PRSIEN)
+10 if $GET(TCSTAT)'="T"
QUIT 0
+11 ;
+12 ; kill the timecard work nodes
+13 KILL ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2),^(3),^(10)
+14 ;
+15 ; ONLY if a valid ESR daily status is passed then set it
+16 NEW VALID
+17 DO CHK^DIE(458.02,146,"",$GET(EST),.VALID)
+18 if VALID["^"
QUIT 1
+19 ;
+20 NEW IENS,PRSFDA
+21 SET IENS=PRSD_","_PRSIEN_","_PPI_","
+22 SET PRSFDA(458.02,IENS,146)=EST
+23 DO FILE^DIE("","PRSFDA")
+24 DO MSG^DIALOG()
+25 QUIT 1
+26 ;
WRAP(LNS,STR,TAB,WID) ; format a long message string to break lines at words
+1 ; TAB is left margin
+2 ; WID is right margin
+3 ; return LNS number of lines it took to write
+4 NEW WORD,I,WC,COLW,W1,W2
+5 SET WC=0
SET WORD=""
+6 SET COLW=WID-TAB+1
+7 WRITE ?$GET(TAB)
+8 SET LNS=1
+9 FOR I=1:1:$LENGTH(STR," ")
Begin DoDot:1
+10 SET WORD=$PIECE(STR," ",I)
+11 if WORD=""
QUIT
+12 ; break words longer than the width of the column
+13 FOR
if ($LENGTH(WORD)<(COLW+1))
QUIT
Begin DoDot:2
+14 SET W1=$EXTRACT(WORD,1,COLW-1)_"-"
+15 SET W2=$EXTRACT(WORD,COLW,$LENGTH(WORD))
+16 SET WORD=W1
DO WW
+17 SET WORD=W2
End DoDot:2
+18 DO WW
End DoDot:1
+19 QUIT
WW ; Write Word
+1 IF ($X+$LENGTH(WORD))>WID
Begin DoDot:1
+2 IF WC>0
WRITE !,?$GET(TAB)
SET LNS=LNS+1
SET WC=0
End DoDot:1
+3 WRITE WORD," "
SET WC=WC+1
+4 QUIT
+5 ;
+6 ;
+7 ;===============================================================
+8 ;
AMT(START,STOP,MEAL) ; return decimal hours between times
+1 ; times are in PAID timecard work node format. (e.g. 04:30P )
+2 NEW AMT,X
+3 SET AMT=$$ELAPSE^PRSPESR2(MEAL,START,STOP)
+4 SET X=$PIECE(AMT,":",2)
SET X=$SELECT(X=30:5,X=15:25,X=45:75,1:0)
+5 SET AMT=+$PIECE(AMT,":",1)_"."_X
+6 QUIT AMT
