PRSPUE ;HISC/MGD - UNLOCK PRIOR PP ESR ;07/21/05
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
;====================================================================
SUP ; Supervisor Entry
S PRSTLV=3
T0 D TOP ; print header
D ^PRSAUTL G:TLI<1 EX
N DATEX,PRSIEN
T1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
S DIC("S")="I $P(^(0),""^"",8)=TLE" S D="ATL"_TLE W ! D IX^DIC
S (DFN,PRSIEN)=+Y K DIC G:DFN<1 EX
S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
G:Y<1 EX
S (DATEX,D1)=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
G EX:PPI<1
S PPE=$P($G(^PRST(458,PPI,0)),U,1)
W @IOF
D DIS^PRSPDESR
I 'QT D PROMPT
;
G T1 ;ask for employee again
Q
;
TOP W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
W !?32,"UNLOCK DAILY ESR"
Q
;
DIS ; Display Memorandum
;
D DIS^PRSPDESR
Q
;
PROMPT ;
; Determine current status of ESR
;
K IENS,PRSFDA
N IENS,PRSFDA,STATUS,REMARK
S Y=DATEX
S PRSD=$P($G(^PRST(458,"AD",Y)),U,2)
D DD^%DT
S DATEX=Y
S STATUS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),U,1)
I STATUS<4 D Q
. W !!,"The date must be SIGNED, APPROVED or a DAY OFF to be eligible for unlocking."
;
S DIR(0)="YAO"
S DIR("A")="Confirm Unlock of "_DATEX_" (Y/N): "
W !!
D ^DIR K DIR
Q:'Y
;
S REMARK=$$GETREM^PRSPSAP3()
Q:REMARK="^"
S IENS=PRSD_","_PRSIEN_","_PPI_","
S PRSFDA(458.02,IENS,148)=$G(REMARK) ; remarks
S PRSFDA(458.02,IENS,146)=3 ; RESUBMIT
S PRSFDA(458.02,IENS,147)="@" ; Delete PT PHYSICIAN DATE/TIME STAMP
D UPDATE^DIE("","PRSFDA","IENS"),MSG^DIALOG()
; if timecard has timekeeper status then clean out TC post otherwise
; reapproval may require payroll to return the timecard or do
; a corrected timecard first.
N RETURN S RETURN=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PRSD,)
;
;
W @IOF
D DIS^PRSPDESR
Q
;
EX ; Clean up variables
K D,D1,DASH,DATA0,DATA5,DATA6,DATA7,PRSD,DAY1,DFN,HRS,MT,PDT,PG,POP
K PPE,PPI,PRSALST,PRSAPGM,PRSTLV,PTPRMKS,QUIT,QT,RC,RCEX,SCRTTL
K SEG,SSN,START,STAT,STATEX,STOP,T1,T1EX,TLE,TLI,TLSCREEN,TOT,TOTEX
K X,Y,%DT,%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPUE 2186 printed Nov 22, 2024@17:38:22 Page 2
PRSPUE ;HISC/MGD - UNLOCK PRIOR PP ESR ;07/21/05
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;====================================================================
SUP ; Supervisor Entry
+1 SET PRSTLV=3
T0 ; print header
DO TOP
+1 DO ^PRSAUTL
if TLI<1
GOTO EX
+2 NEW DATEX,PRSIEN
T1 KILL DIC
SET DIC("A")="Select EMPLOYEE: "
SET DIC(0)="AEQM"
SET DIC="^PRSPC("
+1 SET DIC("S")="I $P(^(0),""^"",8)=TLE"
SET D="ATL"_TLE
WRITE !
DO IX^DIC
+2 SET (DFN,PRSIEN)=+Y
KILL DIC
if DFN<1
GOTO EX
+3 SET %DT="AEPX"
SET %DT("A")="Posting Date: "
SET %DT(0)=-DT
WRITE !
DO ^%DT
+4 if Y<1
GOTO EX
+5 SET (DATEX,D1)=Y
SET Y=$GET(^PRST(458,"AD",D1))
SET PPI=$PIECE(Y,"^",1)
+6 if PPI<1
GOTO EX
+7 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U,1)
+8 WRITE @IOF
+9 DO DIS^PRSPDESR
+10 IF 'QT
DO PROMPT
+11 ;
+12 ;ask for employee again
GOTO T1
+13 QUIT
+14 ;
TOP if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM"
+1 WRITE !?32,"UNLOCK DAILY ESR"
+2 QUIT
+3 ;
DIS ; Display Memorandum
+1 ;
+2 DO DIS^PRSPDESR
+3 QUIT
+4 ;
PROMPT ;
+1 ; Determine current status of ESR
+2 ;
+3 KILL IENS,PRSFDA
+4 NEW IENS,PRSFDA,STATUS,REMARK
+5 SET Y=DATEX
+6 SET PRSD=$PIECE($GET(^PRST(458,"AD",Y)),U,2)
+7 DO DD^%DT
+8 SET DATEX=Y
+9 SET STATUS=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),U,1)
+10 IF STATUS<4
Begin DoDot:1
+11 WRITE !!,"The date must be SIGNED, APPROVED or a DAY OFF to be eligible for unlocking."
End DoDot:1
QUIT
+12 ;
+13 SET DIR(0)="YAO"
+14 SET DIR("A")="Confirm Unlock of "_DATEX_" (Y/N): "
+15 WRITE !!
+16 DO ^DIR
KILL DIR
+17 if 'Y
QUIT
+18 ;
+19 SET REMARK=$$GETREM^PRSPSAP3()
+20 if REMARK="^"
QUIT
+21 SET IENS=PRSD_","_PRSIEN_","_PPI_","
+22 ; remarks
SET PRSFDA(458.02,IENS,148)=$GET(REMARK)
+23 ; RESUBMIT
SET PRSFDA(458.02,IENS,146)=3
+24 ; Delete PT PHYSICIAN DATE/TIME STAMP
SET PRSFDA(458.02,IENS,147)="@"
+25 DO UPDATE^DIE("","PRSFDA","IENS")
DO MSG^DIALOG()
+26 ; if timecard has timekeeper status then clean out TC post otherwise
+27 ; reapproval may require payroll to return the timecard or do
+28 ; a corrected timecard first.
+29 NEW RETURN
SET RETURN=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PRSD,)
+30 ;
+31 ;
+32 WRITE @IOF
+33 DO DIS^PRSPDESR
+34 QUIT
+35 ;
EX ; Clean up variables
+1 KILL D,D1,DASH,DATA0,DATA5,DATA6,DATA7,PRSD,DAY1,DFN,HRS,MT,PDT,PG,POP
+2 KILL PPE,PPI,PRSALST,PRSAPGM,PRSTLV,PTPRMKS,QUIT,QT,RC,RCEX,SCRTTL
+3 KILL SEG,SSN,START,STAT,STATEX,STOP,T1,T1EX,TLE,TLI,TLSCREEN,TOT,TOTEX
+4 KILL X,Y,%DT,%ZIS
+5 QUIT
