Routine: PRSPSAPU

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.

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

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)

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

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)

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)=""

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

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

 ;===============================================================

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  Feb 18, 2025@23:54:48                                                                                                                                                                                                    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

PRSPSAPU.m