| 1 | PRSPSAP2 ;WOIFO/JAH - Supervisor Approve-update pt phys timecard ;7/26/05
|
|---|
| 2 | ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | TRANSACT ; TRANSfer ACTions to the database
|
|---|
| 6 | ; loop thru temp and update the time card and the ESR day stats
|
|---|
| 7 | N ACT,PRSIEN,PPI,PRSD
|
|---|
| 8 | S PRSIEN=""
|
|---|
| 9 | F S PRSIEN=$O(^TMP($J,"PRSPSAP",PRSIEN)) Q:PRSIEN'>0 D
|
|---|
| 10 | . S PPI=0
|
|---|
| 11 | . F S PPI=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI)) Q:PPI'>0 D
|
|---|
| 12 | .. S PRSD=0
|
|---|
| 13 | .. F S PRSD=$O(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD)) Q:PRSD'>0 D
|
|---|
| 14 | ... S ACT=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,1))
|
|---|
| 15 | ...; Ignore ESR days that the superV skipped or bypassed.
|
|---|
| 16 | ... Q:(ACT="")!(ACT="B")
|
|---|
| 17 | ...;
|
|---|
| 18 | ...; set ESR day status to resubmit and add remarks
|
|---|
| 19 | ... I ACT="R" D
|
|---|
| 20 | .... S REM=$G(^TMP($J,"PRSPSAP",PRSIEN,PPI,PRSD,2))
|
|---|
| 21 | .... D UPESR(PRSIEN,PPI,PRSD,ACT,REM)
|
|---|
| 22 | ... E D
|
|---|
| 23 | ....; try to update the timecard and the ESR
|
|---|
| 24 | .... N CAN S (CAN("CB"),CAN("AE"))=0
|
|---|
| 25 | .... D UPTCARD(.CAN,PRSIEN,PPI,PRSD)
|
|---|
| 26 | .... I CAN("AE") D UPESR(PRSIEN,PPI,PRSD,ACT,"")
|
|---|
| 27 | .... I CAN("CB") D PTP^PRSASR1(PRSIEN,PPI)
|
|---|
| 28 | Q
|
|---|
| 29 | UPESR(PRSIEN,PPI,PRSD,ACT,REM) ; update ESR with either Resubmit OR Approve
|
|---|
| 30 | N PRSFDA,IENS
|
|---|
| 31 | ;
|
|---|
| 32 | ; update ESR status and display any filing errors
|
|---|
| 33 | ;
|
|---|
| 34 | S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|---|
| 35 | S PRSFDA(458.02,IENS,146)=$S(ACT="A":"APPROVED",1:"RESUBMIT")
|
|---|
| 36 | I $G(REM)'="" S PRSFDA(458.02,IENS,148)=REM
|
|---|
| 37 | D FILE^DIE("E","PRSFDA")
|
|---|
| 38 | D MSG^DIALOG()
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | UPTCARD(CAN,PRSIEN,PPI,PRSD) ; UPDATE A TIME CARD
|
|---|
| 42 | ; WITH ESR LEAVE EXCEPTIONS AND HOLIDAY X
|
|---|
| 43 | ; Return CAN by reference.
|
|---|
| 44 | ; CAN("AE") "CAN APPROVE ESR" is set to true if the ESR can be
|
|---|
| 45 | ; approved. i.e. timecard status is T-timekeep or there's
|
|---|
| 46 | ; no affect on the timecard
|
|---|
| 47 | ; CAN("CB") "CAN CALL BANK" is set to true when a call should be
|
|---|
| 48 | ; made to the hours bank API (PTP^PRSASR1).
|
|---|
| 49 | ; Calling routines must consider the order in which
|
|---|
| 50 | ; to APPROVE ESR and CALL HOURS BANK since the API
|
|---|
| 51 | ; PTP^PRSASR, will only count hrs with an approved status.
|
|---|
| 52 | ;
|
|---|
| 53 | ;458.02 (DAY MULTIPLE)
|
|---|
| 54 | ; FIELD: 10 TOUR LAST POSTED BY^P200
|
|---|
| 55 | ; identifies last person to post a tour for employee
|
|---|
| 56 | ; 101 POSTING STATUS^S^T:TIMEKEEPER POSTED;
|
|---|
| 57 | ; P:PAYROLL REVIEWED;X:TRANSMITTED;
|
|---|
| 58 | ; 102 TIMEKEEPER POSTING^P200'^VA(200,
|
|---|
| 59 | ; 103 TK DATE/TIME ENTERED^DATE
|
|---|
| 60 | ; 104 POSTING TYPE^S^1:WORKED ENTIRE TOUR;
|
|---|
| 61 | ; 2:ABSENT ENTIRE TOUR;3:IRREGULAR TOUR;
|
|---|
| 62 | N TCN,ESRN,POST,PSTDT,POSTER,PTYPE
|
|---|
| 63 | N TCSTAT,DYSTAT,DUMB,POSTYPE,TOD,EARY,ERRORS
|
|---|
| 64 | S (CAN("CB"),CAN("AE"))=0
|
|---|
| 65 | ;get the raw posting from the ESR
|
|---|
| 66 | S ESRN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
|
|---|
| 67 | ; day signed on ESR with no work OR get the work segments
|
|---|
| 68 | I $P(ESRN,U)'="" S ESRN=$$GETAPTM(ESRN)
|
|---|
| 69 | ;get the timecard node
|
|---|
| 70 | S TCN=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2))
|
|---|
| 71 | S POST=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10))
|
|---|
| 72 | S PSTDT=$P(POST,U)
|
|---|
| 73 | S DYSTAT=$P(POST,U,2)
|
|---|
| 74 | S POSTER=$P(POST,U,3)
|
|---|
| 75 | S POSTYPE=$P(POST,U,4)
|
|---|
| 76 | ; if the timecard is still with timekeep it can be updated.
|
|---|
| 77 | S TCSTAT=$$TCSTAT(PPI,PRSIEN)
|
|---|
| 78 | I TCSTAT="T" D
|
|---|
| 79 | . S CAN("AE")=1,CAN("CB")=0
|
|---|
| 80 | . D EDTCARD(PPI,PRSIEN,PRSD,ESRN)
|
|---|
| 81 | E D
|
|---|
| 82 | . ;if timecard is in a payroll or transmit we can check
|
|---|
| 83 | . ; for any affect to TimeCard from the ESR. If none
|
|---|
| 84 | .; we can update the ESR to approved and we should make a
|
|---|
| 85 | .; a call to the hours bank after ESR is set to apporved
|
|---|
| 86 | .; the hours bank and quit
|
|---|
| 87 | .; otherwise we have to either return timecard or do corrcted timecard
|
|---|
| 88 | .;
|
|---|
| 89 | .; If timecard has no postings and ESR has no exceptions
|
|---|
| 90 | .; the ESR can be approved since no change to timecard is necessary
|
|---|
| 91 | . I ESRN=""&(TCN="") S (CAN("AE"),CAN("CB"))=1 Q
|
|---|
| 92 | .;
|
|---|
| 93 | .; if ESR matches Timecard, update ESR no Timecard update necessary
|
|---|
| 94 | . D CMPESRTC^PRSPSAP3(.ERRORS,.EARY,"","",PPI,PRSIEN,PRSD)
|
|---|
| 95 | . I ERRORS=0 S (CAN("AE"),CAN("CB"))=1 Q
|
|---|
| 96 | . I "^P^X^"["^"_TCSTAT_"^" S (CAN("AE"),CAN("CB"))=0 D Q
|
|---|
| 97 | .. D CANTPOST^PRSPSAP3(.EARY,TCSTAT,PPI,PRSIEN,PRSD,ESRN)
|
|---|
| 98 | .. S DUMB=$$ASK^PRSLIB00(1)
|
|---|
| 99 | Q
|
|---|
| 100 | EDTCARD(PPI,PRSIEN,PRSD,ESRN) ; edit the timecard
|
|---|
| 101 | ;
|
|---|
| 102 | N EDTSTR,CLEAR,POSTTIME,PRSFDA,IENS
|
|---|
| 103 | ;
|
|---|
| 104 | ; if there's no work, no leave or only RG then ptp gets credit for
|
|---|
| 105 | ; entire day, otherwise we have some exceptions. If the physician
|
|---|
| 106 | ; used leave the entire day then don't post meal and set ptype=2
|
|---|
| 107 | ;
|
|---|
| 108 | S CLEAR=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PRSD,5)
|
|---|
| 109 | S PTYPE=$S($P(ESRN,U)="":1,1:3)
|
|---|
| 110 | I PTYPE=3 D
|
|---|
| 111 | . I $$ABSENT(ESRN,PPI,PRSIEN,PRSD) S PTYPE=2
|
|---|
| 112 | . S TCN=$$ESR2TC(ESRN,PTYPE)
|
|---|
| 113 | .; update the timecard with a global set
|
|---|
| 114 | . S ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,2)=TCN
|
|---|
| 115 | ;
|
|---|
| 116 | ; update timecard status
|
|---|
| 117 | N %,X,%I,%H D NOW^%DTC S POSTTIME=%
|
|---|
| 118 | ;
|
|---|
| 119 | ; update timecard status and display any filing errors
|
|---|
| 120 | ;
|
|---|
| 121 | S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|---|
| 122 | S PRSFDA(458.02,IENS,101)="T"
|
|---|
| 123 | S PRSFDA(458.02,IENS,102)=DUZ
|
|---|
| 124 | S PRSFDA(458.02,IENS,103)=POSTTIME
|
|---|
| 125 | S PRSFDA(458.02,IENS,104)=PTYPE
|
|---|
| 126 | D FILE^DIE("","PRSFDA")
|
|---|
| 127 | D MSG^DIALOG()
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | ESR2TC(ESRN,PT) ;CONVERT ESR DATA TO TIMECARD FORMAT
|
|---|
| 131 | ;
|
|---|
| 132 | N ESR2TC,TCS,I,TSEG,ST,EN,TT,RE,ML,TCN
|
|---|
| 133 | ;
|
|---|
| 134 | S TCN=""
|
|---|
| 135 | F I=1:5:31 D
|
|---|
| 136 | . S TSEG=$P(ESRN,U,I,I+4)
|
|---|
| 137 | . S ST=$P(TSEG,U)
|
|---|
| 138 | . Q:ST=""
|
|---|
| 139 | . S EN=$P(TSEG,U,2)
|
|---|
| 140 | . S TT=$P(TSEG,U,3)
|
|---|
| 141 | . S RE=$P(TSEG,U,4)
|
|---|
| 142 | . S ML=$P(TSEG,U,5)
|
|---|
| 143 | .; if meal posted remove it from leave end time
|
|---|
| 144 | . I (PT=3)&(ML>0) S EN=$$ENDML(EN,ML)
|
|---|
| 145 | . S:$G(TCN)'="" TCN=TCN_"^"
|
|---|
| 146 | . S TCS=ST_U_EN_U_TT_U_RE
|
|---|
| 147 | . S TCN=TCN_TCS
|
|---|
| 148 | ; REMOVE A TRAILING UPARROW GENERATED BY NULL REMARKS CODE
|
|---|
| 149 | I $E(TCN,$L(TCN))=U S TCN=$E(TCN,1,$L(TCN)-1)
|
|---|
| 150 | Q TCN
|
|---|
| 151 | ;
|
|---|
| 152 | ;
|
|---|
| 153 | ABSENT(ESRN,PPI,PRSIEN,PRSD) ;return true if the ESR posting matches all
|
|---|
| 154 | ; the tour start and stop times and uses only one type of leave and
|
|---|
| 155 | ; the meal matches the tours meal.
|
|---|
| 156 | ; i.e. ESR posting equivalent to absent entire tour question.
|
|---|
| 157 | ;
|
|---|
| 158 | N TR1,TR2,TR1ML,TR2ML,TRMEAL,LASTTT,MULTITT,NODE0,RETURN,TCT
|
|---|
| 159 | N TCS,I,TSEG,ST,EN,TT,ML,TCTOUR,ESRTOUR
|
|---|
| 160 | ;
|
|---|
| 161 | S (ESRTOUR,LASTTT)="",(MULTITT,ML,RETURN)=0
|
|---|
| 162 | F I=1:5:31 D
|
|---|
| 163 | . S TSEG=$P(ESRN,U,I,I+4)
|
|---|
| 164 | . S ST=$P(TSEG,U)
|
|---|
| 165 | . Q:ST=""
|
|---|
| 166 | . S EN=$P(TSEG,U,2)
|
|---|
| 167 | . S TT=$P(TSEG,U,3)
|
|---|
| 168 | . I LASTTT="" D
|
|---|
| 169 | .. S LASTTT=TT
|
|---|
| 170 | . E D
|
|---|
| 171 | .. I LASTTT'=TT S MULTITT=1
|
|---|
| 172 | . S ML=ML+$P(TSEG,U,5)
|
|---|
| 173 | . S:$G(ESRTOUR)'="" ESRTOUR=ESRTOUR_"^"
|
|---|
| 174 | . S TCS=ST_U_EN
|
|---|
| 175 | . S ESRTOUR=ESRTOUR_TCS
|
|---|
| 176 | ; REMOVE A TRAILING UPARROW GENERATED BY NULL REMARKS CODE
|
|---|
| 177 | I $E(ESRTOUR,$L(ESRTOUR))=U S ESRTOUR=$E(ESRTOUR,1,$L(ESRTOUR)-1)
|
|---|
| 178 | ;
|
|---|
| 179 | ;
|
|---|
| 180 | S TCT=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
|
|---|
| 181 | S NODE0=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
|
|---|
| 182 | S (TR1ML,TR2ML)=0
|
|---|
| 183 | S TR1=$P(NODE0,U,2) I TR1>0 S TR1ML=$P($G(^PRST(457.1,TR1,0)),U,3)
|
|---|
| 184 | S TR2=$P(NODE0,U,15) I TR2>0 S TR2ML=$P($G(^PRST(457.1,TR2,0)),U,3)
|
|---|
| 185 | S TRMEAL=TR1ML+TR2ML
|
|---|
| 186 | S TCTOUR=""
|
|---|
| 187 | F I=1:3:31 D
|
|---|
| 188 | . S TSEG=$P(TCT,U,I,I+4)
|
|---|
| 189 | . S ST=$P(TSEG,U)
|
|---|
| 190 | . Q:ST=""
|
|---|
| 191 | . S EN=$P(TSEG,U,2)
|
|---|
| 192 | . S:$G(TCTOUR)'="" TCTOUR=TCTOUR_"^"
|
|---|
| 193 | . S TCS=ST_U_EN
|
|---|
| 194 | . S TCTOUR=TCTOUR_TCS
|
|---|
| 195 | I (TCTOUR=ESRTOUR)&('MULTITT)&(TRMEAL=ML) S RETURN=1
|
|---|
| 196 | Q RETURN
|
|---|
| 197 | ;
|
|---|
| 198 | ENDML(END,MEAL) ;GET AN END TIME AND DEDUCT THE MEAL FROM IT
|
|---|
| 199 | ;
|
|---|
| 200 | N X
|
|---|
| 201 | ; quit if we aint gots a good enought end time.
|
|---|
| 202 | Q:($G(END)'?2N.P.2N.A)&(END'="MID")&(END'="NOON") $G(END)
|
|---|
| 203 | S END=$$TWENTY4^PRSPESR2(END)
|
|---|
| 204 | S END=$E(END,1,2)_":"_$E(END,3,4)
|
|---|
| 205 | S END=$$MEALCUT(END,MEAL)
|
|---|
| 206 | ; Convert back to form stored in 458 start stop times
|
|---|
| 207 | S X=END D ^PRSATIM S END=X
|
|---|
| 208 | Q END
|
|---|
| 209 | ;
|
|---|
| 210 | MEALCUT(HHMM,MEAL) ;Subtract meal time from the end time
|
|---|
| 211 | ; (subtract a 15 minute increment from length of time
|
|---|
| 212 | ; in hh:mm format, i.e. hh:mm - mm
|
|---|
| 213 | ;
|
|---|
| 214 | N X,Y,DECR,OBJ,I,HH,MM
|
|---|
| 215 | S MM=$P(HHMM,":",2) ; get minutes
|
|---|
| 216 | ; quit minutes or meal not quarter hours
|
|---|
| 217 | Q:(MM#15'=0&(+MM)!((MEAL#15)'=0&(+MEAL))) HHMM
|
|---|
| 218 | ; get hours
|
|---|
| 219 | S HH=$P(HHMM,":")
|
|---|
| 220 | ;
|
|---|
| 221 | ; convert segment minutes and meal to a digit.
|
|---|
| 222 | ;
|
|---|
| 223 | S X=MM D MEALIN^PRSPESR2 S OBJ=X
|
|---|
| 224 | S X=$G(MEAL) D MEALIN^PRSPESR2 S DECR=X
|
|---|
| 225 | I OBJ=0 S OBJ=4
|
|---|
| 226 | F I=1:1:DECR D
|
|---|
| 227 | . I OBJ=4 D
|
|---|
| 228 | .. I +HH=0 D
|
|---|
| 229 | ... S HH=23
|
|---|
| 230 | .. E D
|
|---|
| 231 | ... S HH="0"_(+HH-1) S HH=$E(HH,$L(HH)-1,$L(HH))
|
|---|
| 232 | . S OBJ=$S(OBJ=4:3,OBJ=3:2,OBJ=2:1,OBJ=1:4)
|
|---|
| 233 | S MM=$S(OBJ=1:15,OBJ=2:30,OBJ=3:45,1:"00")
|
|---|
| 234 | ;
|
|---|
| 235 | Q HH_MM
|
|---|
| 236 | ;
|
|---|
| 237 | TCSTAT(PPI,PRSIEN) ; get timecard status
|
|---|
| 238 | Q:(PPI'>0)!(PRSIEN'>0) 0
|
|---|
| 239 | Q $P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
|
|---|
| 240 | ;
|
|---|
| 241 | GETAPTM(WORK) ; return the work node with only the time that should
|
|---|
| 242 | ; be posted to a PTP's timecard
|
|---|
| 243 | ; INPUT: WORK : ESR work node
|
|---|
| 244 | ; RETURN ESRN : ESR node with only time applicable to PTP's
|
|---|
| 245 | ;
|
|---|
| 246 | N I,TSEG
|
|---|
| 247 | S TCN=""
|
|---|
| 248 | F I=1:5:31 D
|
|---|
| 249 | . S TSEG=$P(WORK,U,I,I+4)
|
|---|
| 250 | . S TT=$P(TSEG,U,3)
|
|---|
| 251 | . Q:TSEG="^^^^"!("^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^TR^TV^"'[(U_TT_U))
|
|---|
| 252 | . S TCN=TCN_TSEG_"^"
|
|---|
| 253 | Q TCN
|
|---|
| 254 | ;
|
|---|
| 255 | ;
|
|---|
