256 lines
8.4 KiB
Mathematica
256 lines
8.4 KiB
Mathematica
PRSPSAP2 ;WOIFO/JAH - Supervisor Approve-update pt phys timecard ;7/26/05
|
|
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
|
Q
|
|
TRANSACT ; TRANSfer ACTions to the database
|
|
; loop thru temp and update the time card and the ESR day stats
|
|
N ACT,PRSIEN,PPI,PRSD
|
|
S PRSIEN=""
|
|
F S PRSIEN=$O(^TMP($J,"PRSPSAP",PRSIEN)) Q:PRSIEN'>0 D
|
|
. S PPI=0
|
|
. F S PPI=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI)) Q:PPI'>0 D
|
|
.. S PRSD=0
|
|
.. F S PRSD=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD)) Q:PRSD'>0 D
|
|
... S ACT=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1))
|
|
...; Ignore ESR days that the superV skipped or bypassed.
|
|
... Q:(ACT="")!(ACT="B")
|
|
...;
|
|
...; set ESR day status to resubmit and add remarks
|
|
... I ACT="R" D
|
|
.... S REM=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2))
|
|
.... D UPESR(PRSIEN,PPI,PRSD,ACT,REM)
|
|
... E D
|
|
....; try to update the timecard and the ESR
|
|
.... N CAN S (CAN("CB"),CAN("AE"))=0
|
|
.... D UPTCARD(.CAN,PRSIEN,PPI,PRSD)
|
|
.... I CAN("AE") D UPESR(PRSIEN,PPI,PRSD,ACT,"")
|
|
.... I CAN("CB") D PTP^PRSASR1(PRSIEN,PPI)
|
|
Q
|
|
UPESR(PRSIEN,PPI,PRSD,ACT,REM) ; update ESR with either Resubmit OR Approve
|
|
N PRSFDA,IENS
|
|
;
|
|
; update ESR status and display any filing errors
|
|
;
|
|
S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|
S PRSFDA(458.02,IENS,146)=$S(ACT="A":"APPROVED",1:"RESUBMIT")
|
|
I $G(REM)'="" S PRSFDA(458.02,IENS,148)=REM
|
|
D FILE^DIE("E","PRSFDA")
|
|
D MSG^DIALOG()
|
|
Q
|
|
;
|
|
UPTCARD(CAN,PRSIEN,PPI,PRSD) ; UPDATE A TIME CARD
|
|
; WITH ESR LEAVE EXCEPTIONS AND HOLIDAY X
|
|
; Return CAN by reference.
|
|
; CAN("AE") "CAN APPROVE ESR" is set to true if the ESR can be
|
|
; approved. i.e. timecard status is T-timekeep or there's
|
|
; no affect on the timecard
|
|
; CAN("CB") "CAN CALL BANK" is set to true when a call should be
|
|
; made to the hours bank API (PTP^PRSASR1).
|
|
; Calling routines must consider the order in which
|
|
; to APPROVE ESR and CALL HOURS BANK since the API
|
|
; PTP^PRSASR, will only count hrs with an approved status.
|
|
;
|
|
;458.02 (DAY MULTIPLE)
|
|
; FIELD: 10 TOUR LAST POSTED BY^P200
|
|
; identifies last person to post a tour for employee
|
|
; 101 POSTING STATUS^S^T:TIMEKEEPER POSTED;
|
|
; P:PAYROLL REVIEWED;X:TRANSMITTED;
|
|
; 102 TIMEKEEPER POSTING^P200'^VA(200,
|
|
; 103 TK DATE/TIME ENTERED^DATE
|
|
; 104 POSTING TYPE^S^1:WORKED ENTIRE TOUR;
|
|
; 2:ABSENT ENTIRE TOUR;3:IRREGULAR TOUR;
|
|
N TCN,ESRN,POST,PSTDT,POSTER,PTYPE
|
|
N TCSTAT,DYSTAT,DUMB,POSTYPE,TOD,EARY,ERRORS
|
|
S (CAN("CB"),CAN("AE"))=0
|
|
;get the raw posting from the ESR
|
|
S ESRN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
|
|
; day signed on ESR with no work OR get the work segments
|
|
I $P(ESRN,U)'="" S ESRN=$$GETAPTM(ESRN)
|
|
;get the timecard node
|
|
S TCN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
|
|
S POST=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10))
|
|
S PSTDT=$P(POST,U)
|
|
S DYSTAT=$P(POST,U,2)
|
|
S POSTER=$P(POST,U,3)
|
|
S POSTYPE=$P(POST,U,4)
|
|
; if the timecard is still with timekeep it can be updated.
|
|
S TCSTAT=$$TCSTAT(PPI,PRSIEN)
|
|
I TCSTAT="T" D
|
|
. S CAN("AE")=1,CAN("CB")=0
|
|
. D EDTCARD(PPI,PRSIEN,PRSD,ESRN)
|
|
E D
|
|
. ;if timecard is in a payroll or transmit we can check
|
|
. ; for any affect to TimeCard from the ESR. If none
|
|
.; we can update the ESR to approved and we should make a
|
|
.; a call to the hours bank after ESR is set to apporved
|
|
.; the hours bank and quit
|
|
.; otherwise we have to either return timecard or do corrcted timecard
|
|
.;
|
|
.; If timecard has no postings and ESR has no exceptions
|
|
.; the ESR can be approved since no change to timecard is necessary
|
|
. I ESRN=""&(TCN="") S (CAN("AE"),CAN("CB"))=1 Q
|
|
.;
|
|
.; if ESR matches Timecard, update ESR no Timecard update necessary
|
|
. D CMPESRTC^PRSPSAP3(.ERRORS,.EARY,"","",PPI,PRSIEN,PRSD)
|
|
. I ERRORS=0 S (CAN("AE"),CAN("CB"))=1 Q
|
|
. I "^P^X^"["^"_TCSTAT_"^" S (CAN("AE"),CAN("CB"))=0 D Q
|
|
.. D CANTPOST^PRSPSAP3(.EARY,TCSTAT,PPI,PRSIEN,PRSD,ESRN)
|
|
.. S DUMB=$$ASK^PRSLIB00(1)
|
|
Q
|
|
EDTCARD(PPI,PRSIEN,PRSD,ESRN) ; edit the timecard
|
|
;
|
|
N EDTSTR,CLEAR,POSTTIME,PRSFDA,IENS
|
|
;
|
|
; if there's no work, no leave or only RG then ptp gets credit for
|
|
; entire day, otherwise we have some exceptions. If the physician
|
|
; used leave the entire day then don't post meal and set ptype=2
|
|
;
|
|
S CLEAR=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PRSD,5)
|
|
S PTYPE=$S($P(ESRN,U)="":1,1:3)
|
|
I PTYPE=3 D
|
|
. I $$ABSENT(ESRN,PPI,PRSIEN,PRSD) S PTYPE=2
|
|
. S TCN=$$ESR2TC(ESRN,PTYPE)
|
|
.; update the timecard with a global set
|
|
. S ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2)=TCN
|
|
;
|
|
; update timecard status
|
|
N %,X,%I,%H D NOW^%DTC S POSTTIME=%
|
|
;
|
|
; update timecard status and display any filing errors
|
|
;
|
|
S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|
S PRSFDA(458.02,IENS,101)="T"
|
|
S PRSFDA(458.02,IENS,102)=DUZ
|
|
S PRSFDA(458.02,IENS,103)=POSTTIME
|
|
S PRSFDA(458.02,IENS,104)=PTYPE
|
|
D FILE^DIE("","PRSFDA")
|
|
D MSG^DIALOG()
|
|
Q
|
|
;
|
|
ESR2TC(ESRN,PT) ;CONVERT ESR DATA TO TIMECARD FORMAT
|
|
;
|
|
N ESR2TC,TCS,I,TSEG,ST,EN,TT,RE,ML,TCN
|
|
;
|
|
S TCN=""
|
|
F I=1:5:31 D
|
|
. S TSEG=$P(ESRN,U,I,I+4)
|
|
. S ST=$P(TSEG,U)
|
|
. Q:ST=""
|
|
. S EN=$P(TSEG,U,2)
|
|
. S TT=$P(TSEG,U,3)
|
|
. S RE=$P(TSEG,U,4)
|
|
. S ML=$P(TSEG,U,5)
|
|
.; if meal posted remove it from leave end time
|
|
. I (PT=3)&(ML>0) S EN=$$ENDML(EN,ML)
|
|
. S:$G(TCN)'="" TCN=TCN_"^"
|
|
. S TCS=ST_U_EN_U_TT_U_RE
|
|
. S TCN=TCN_TCS
|
|
; REMOVE A TRAILING UPARROW GENERATED BY NULL REMARKS CODE
|
|
I $E(TCN,$L(TCN))=U S TCN=$E(TCN,1,$L(TCN)-1)
|
|
Q TCN
|
|
;
|
|
;
|
|
ABSENT(ESRN,PPI,PRSIEN,PRSD) ;return true if the ESR posting matches all
|
|
; the tour start and stop times and uses only one type of leave and
|
|
; the meal matches the tours meal.
|
|
; i.e. ESR posting equivalent to absent entire tour question.
|
|
;
|
|
N TR1,TR2,TR1ML,TR2ML,TRMEAL,LASTTT,MULTITT,NODE0,RETURN,TCT
|
|
N TCS,I,TSEG,ST,EN,TT,ML,TCTOUR,ESRTOUR
|
|
;
|
|
S (ESRTOUR,LASTTT)="",(MULTITT,ML,RETURN)=0
|
|
F I=1:5:31 D
|
|
. S TSEG=$P(ESRN,U,I,I+4)
|
|
. S ST=$P(TSEG,U)
|
|
. Q:ST=""
|
|
. S EN=$P(TSEG,U,2)
|
|
. S TT=$P(TSEG,U,3)
|
|
. I LASTTT="" D
|
|
.. S LASTTT=TT
|
|
. E D
|
|
.. I LASTTT'=TT S MULTITT=1
|
|
. S ML=ML+$P(TSEG,U,5)
|
|
. S:$G(ESRTOUR)'="" ESRTOUR=ESRTOUR_"^"
|
|
. S TCS=ST_U_EN
|
|
. S ESRTOUR=ESRTOUR_TCS
|
|
; REMOVE A TRAILING UPARROW GENERATED BY NULL REMARKS CODE
|
|
I $E(ESRTOUR,$L(ESRTOUR))=U S ESRTOUR=$E(ESRTOUR,1,$L(ESRTOUR)-1)
|
|
;
|
|
;
|
|
S TCT=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
|
|
S NODE0=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
|
|
S (TR1ML,TR2ML)=0
|
|
S TR1=$P(NODE0,U,2) I TR1>0 S TR1ML=$P($G(^PRST(457.1,TR1,0)),U,3)
|
|
S TR2=$P(NODE0,U,15) I TR2>0 S TR2ML=$P($G(^PRST(457.1,TR2,0)),U,3)
|
|
S TRMEAL=TR1ML+TR2ML
|
|
S TCTOUR=""
|
|
F I=1:3:31 D
|
|
. S TSEG=$P(TCT,U,I,I+4)
|
|
. S ST=$P(TSEG,U)
|
|
. Q:ST=""
|
|
. S EN=$P(TSEG,U,2)
|
|
. S:$G(TCTOUR)'="" TCTOUR=TCTOUR_"^"
|
|
. S TCS=ST_U_EN
|
|
. S TCTOUR=TCTOUR_TCS
|
|
I (TCTOUR=ESRTOUR)&('MULTITT)&(TRMEAL=ML) S RETURN=1
|
|
Q RETURN
|
|
;
|
|
ENDML(END,MEAL) ;GET AN END TIME AND DEDUCT THE MEAL FROM IT
|
|
;
|
|
N X
|
|
; quit if we aint gots a good enought end time.
|
|
Q:($G(END)'?2N.P.2N.A)&(END'="MID")&(END'="NOON") $G(END)
|
|
S END=$$TWENTY4^PRSPESR2(END)
|
|
S END=$E(END,1,2)_":"_$E(END,3,4)
|
|
S END=$$MEALCUT(END,MEAL)
|
|
; Convert back to form stored in 458 start stop times
|
|
S X=END D ^PRSATIM S END=X
|
|
Q END
|
|
;
|
|
MEALCUT(HHMM,MEAL) ;Subtract meal time from the end time
|
|
; (subtract a 15 minute increment from length of time
|
|
; in hh:mm format, i.e. hh:mm - mm
|
|
;
|
|
N X,Y,DECR,OBJ,I,HH,MM
|
|
S MM=$P(HHMM,":",2) ; get minutes
|
|
; quit minutes or meal not quarter hours
|
|
Q:(MM#15'=0&(+MM)!((MEAL#15)'=0&(+MEAL))) HHMM
|
|
; get hours
|
|
S HH=$P(HHMM,":")
|
|
;
|
|
; convert segment minutes and meal to a digit.
|
|
;
|
|
S X=MM D MEALIN^PRSPESR2 S OBJ=X
|
|
S X=$G(MEAL) D MEALIN^PRSPESR2 S DECR=X
|
|
I OBJ=0 S OBJ=4
|
|
F I=1:1:DECR D
|
|
. I OBJ=4 D
|
|
.. I +HH=0 D
|
|
... S HH=23
|
|
.. E D
|
|
... S HH="0"_(+HH-1) S HH=$E(HH,$L(HH)-1,$L(HH))
|
|
. S OBJ=$S(OBJ=4:3,OBJ=3:2,OBJ=2:1,OBJ=1:4)
|
|
S MM=$S(OBJ=1:15,OBJ=2:30,OBJ=3:45,1:"00")
|
|
;
|
|
Q HH_MM
|
|
;
|
|
TCSTAT(PPI,PRSIEN) ; get timecard status
|
|
Q:(PPI'>0)!(PRSIEN'>0) 0
|
|
Q $P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
|
|
;
|
|
GETAPTM(WORK) ; return the work node with only the time that should
|
|
; be posted to a PTP's timecard
|
|
; INPUT: WORK : ESR work node
|
|
; RETURN ESRN : ESR node with only time applicable to PTP's
|
|
;
|
|
N I,TSEG
|
|
S TCN=""
|
|
F I=1:5:31 D
|
|
. S TSEG=$P(WORK,U,I,I+4)
|
|
. S TT=$P(TSEG,U,3)
|
|
. Q:TSEG="^^^^"!("^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U))
|
|
. S TCN=TCN_TSEG_"^"
|
|
Q TCN
|
|
;
|
|
;
|