| 1 | PRSPUE ;HISC/MGD - UNLOCK PRIOR PP ESR ;07/21/05
|
|---|
| 2 | ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;====================================================================
|
|---|
| 5 | SUP ; Supervisor Entry
|
|---|
| 6 | S PRSTLV=3
|
|---|
| 7 | T0 D TOP ; print header
|
|---|
| 8 | D ^PRSAUTL G:TLI<1 EX
|
|---|
| 9 | N DATEX,PRSIEN
|
|---|
| 10 | T1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
|
|---|
| 11 | S DIC("S")="I $P(^(0),""^"",8)=TLE" S D="ATL"_TLE W ! D IX^DIC
|
|---|
| 12 | S (DFN,PRSIEN)=+Y K DIC G:DFN<1 EX
|
|---|
| 13 | S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
|
|---|
| 14 | G:Y<1 EX
|
|---|
| 15 | S (DATEX,D1)=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
|
|---|
| 16 | G EX:PPI<1
|
|---|
| 17 | S PPE=$P($G(^PRST(458,PPI,0)),U,1)
|
|---|
| 18 | W @IOF
|
|---|
| 19 | D DIS^PRSPDESR
|
|---|
| 20 | I 'QT D PROMPT
|
|---|
| 21 | ;
|
|---|
| 22 | G T1 ;ask for employee again
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | TOP W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
|
|---|
| 26 | W !?32,"UNLOCK DAILY ESR"
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | DIS ; Display Memorandum
|
|---|
| 30 | ;
|
|---|
| 31 | D DIS^PRSPDESR
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | PROMPT ;
|
|---|
| 35 | ; Determine current status of ESR
|
|---|
| 36 | ;
|
|---|
| 37 | K IENS,PRSFDA
|
|---|
| 38 | N IENS,PRSFDA,STATUS,REMARK
|
|---|
| 39 | S Y=DATEX
|
|---|
| 40 | S PRSD=$P($G(^PRST(458,"AD",Y)),U,2)
|
|---|
| 41 | D DD^%DT
|
|---|
| 42 | S DATEX=Y
|
|---|
| 43 | S STATUS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),U,1)
|
|---|
| 44 | I STATUS<4 D Q
|
|---|
| 45 | . W !!,"The date must be SIGNED, APPROVED or a DAY OFF to be eligible for unlocking."
|
|---|
| 46 | ;
|
|---|
| 47 | S DIR(0)="YAO"
|
|---|
| 48 | S DIR("A")="Confirm Unlock of "_DATEX_" (Y/N): "
|
|---|
| 49 | W !!
|
|---|
| 50 | D ^DIR K DIR
|
|---|
| 51 | Q:'Y
|
|---|
| 52 | ;
|
|---|
| 53 | S REMARK=$$GETREM^PRSPSAP3()
|
|---|
| 54 | Q:REMARK="^"
|
|---|
| 55 | S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|---|
| 56 | S PRSFDA(458.02,IENS,148)=$G(REMARK) ; remarks
|
|---|
| 57 | S PRSFDA(458.02,IENS,146)=3 ; RESUBMIT
|
|---|
| 58 | S PRSFDA(458.02,IENS,147)="@" ; Delete PT PHYSICIAN DATE/TIME STAMP
|
|---|
| 59 | D UPDATE^DIE("","PRSFDA","IENS"),MSG^DIALOG()
|
|---|
| 60 | ; if timecard has timekeeper status then clean out TC post otherwise
|
|---|
| 61 | ; reapproval may require payroll to return the timecard or do
|
|---|
| 62 | ; a corrected timecard first.
|
|---|
| 63 | N RETURN S RETURN=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PRSD,)
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
| 66 | W @IOF
|
|---|
| 67 | D DIS^PRSPDESR
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | EX ; Clean up variables
|
|---|
| 71 | K D,D1,DASH,DATA0,DATA5,DATA6,DATA7,PRSD,DAY1,DFN,HRS,MT,PDT,PG,POP
|
|---|
| 72 | K PPE,PPI,PRSALST,PRSAPGM,PRSTLV,PTPRMKS,QUIT,QT,RC,RCEX,SCRTTL
|
|---|
| 73 | K SEG,SSN,START,STAT,STATEX,STOP,T1,T1EX,TLE,TLI,TLSCREEN,TOT,TOTEX
|
|---|
| 74 | K X,Y,%DT,%ZIS
|
|---|
| 75 | Q
|
|---|
