PRSPRM1 ;WOIFO/MGD - PTP RECONCILE MEMORANDUM - 1 ;01/29/07
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; The following routine will allow HR to complete the reconciliation
; process for a memorandum that has expired or been terminated.
;
Q
;
PTPCHK ; Check for Reconciliation info entered by PTP on electronic form
;
S DATA2=$G(^PRST(458.7,MIEN,2))
S PTPRC=$P(DATA2,U,1),PTPRCOM=$P(DATA2,U,2)
I PTPRC="" S PTPRCE="" Q
S PTPRCE=$$RCE(PTPRC)
S END="",END=$O(MEM(END),-1) ; Find range on options
F I=1:1:END D Q:ACTRC=PTPRC
. S ACTRC=$P($G(MEM(I)),U,2) ; Numerical choice entered by PTP
S TEXT=""
D A1^PRSPUT1
S TEXT="PTP's Reconciliation Choice: "_I_" "_PTPRCE
D A1^PRSPUT1
; Set this into ^TMP for long messages
S TEXT="PTP's Reconciliation Comments: "_$E(PTPRCOM,1,48)
S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
W !,TEXT
S TEXT=$E(PTPRCOM,49,128),INDEX=INDEX+1
I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
S TEXT=$E(PTPRCOM,129,208),INDEX=INDEX+1
I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
S TEXT=$E(PTPRCOM,209,240),INDEX=INDEX+1
I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
S TEXT=""
D A1^PRSPUT1 ; Blank Line
Q
;
HRRC ; HR Reconciliation Choice
S END="",END=$O(MEM(END),-1) ; Find range on options
; Prompt for Reconciliation Option
RO W !!,"Enter Reconciliation Option: "
R RO:DTIME
S RO=$$UPPER^PRSRUTL(RO)
I RO="" S RO="^"
Q:RO="^"
I '$D(MEM(RO)) D G RO
. I END>1 D
. . W !!,"Enter a number between 1 and ",END," or ^ to exit"
. I END'>1 D
. . W !!,"Enter 1 or ^ to exit"
S PTPRCE=$P(MEM(RO),U,1),PTPRC=$P(MEM(RO),U,2)
W " "_PTPRCE
S TEXT="Enter Reconciliation Option: "_RO
S INDEX=INDEX+1
S ^TMP($J,"PRSPRM",INDEX)=TEXT,TEXT=""
S INDEX=INDEX+1
D A1^PRSPUT1 ; Blank Line
Q
;
PTPRCOM ; Prompt for PTP's Reconciliation Comments if paper form was used
;
Q:PTPRCOM'=""&(PTPRC) ; PTP didn't enter any reconciliation comments
W !
S DIR(0)="FO^1:240^^",DIR("A")="PTP's Reconciliation Comments"
D ^DIR K DIR
I PTPRCOM="",(X'=""&(X'="^")) D
. S PTPHRCOM="PTP/hr: "_X
. S TEXT="Reconciliation Comments: "_$E(PTPHRCOM,1,48)
. S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",TEXT=$E(PTPHRCOM,49,128),INDEX=INDEX+1
. I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",TEXT=$E(PTPHRCOM,129,208),INDEX=INDEX+1
. I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",TEXT=$E(PTPHRCOM,209,240),INDEX=INDEX+1
. I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",INDEX=INDEX+1
. D A1^PRSPUT1 ; Blank Line
Q
;
TRNS ; Transfer hours to current memorandum
;
Q:PTPRC'=2&(PTPRC'=4)
Q:'NMIEN
;
D MEM^PRSPUT1(PRSIEN,NMIEN)
D A1^PRSPUT1 ; Blank Line
;
; Transfer Prompt
S TPROMPT="Transfer "_$S(OTHRS>0:"+",1:"")_OTHRS_" hours: "
S DIR(0)="Y"
S DIR("A")=TPROMPT
D ^DIR K DIR
I X="^" D Q
. S QUIT=1
. W !!,"Memorandum will have to be reconciled at a future date."
S TEXT=TPROMPT_" "_X
S INDEX=INDEX+1
S ^TMP($J,"PRSPRM",INDEX)=TEXT
S INDEX=INDEX+1,TEXT=""
D A1^PRSPUT1 ; Blank Line
;
CAL ; Calculate results after transfer
S DATA=$G(^PRST(458.7,NMIEN,0))
S AHRS=$P(DATA,U,4) ; AGREED HOURS
S THRSWK=$P(DATA,U,10) ; TOTAL HOURS WORKED
S NPAYHRS=$P(DATA,U,12) ; NONPAY HOURS
S WPAYHRS=$P(DATA,U,13) ; WITHOUT PAY HOURS
S POMC=$P(DATA,U,14) ; PERCENTAGE OF MEMORANDUM COMPLETED
S POHC=$P(DATA,U,15) ; PERCENTAGE OF HOURS COMPLETED
S AHTCM=$P(DATA,U,16) ; AVERAGE HOURS TO COMPLETE MEMORANDUM
S POT=$P(DATA,U,17) ; % OFF TARGET
;
S AAHRS=AHRS-NPAYHRS-WPAYHRS ; AGREED HOURS adjusted for NP and WP
S I=$P($$MEMCPP^PRSPUT3(NMIEN),U,2) ; Determine # PP already worked
S PPREM=26-I ; Pay Periods REMaining
S NTHRSWK=THRSWK+OTHRS ; New Total Hours Worked
S NPOHC=$FN(THRSWK/AAHRS,"",2) ; New % Of Hours Completed
S NAHTCM=(AAHRS-THRSWK)/PPREM ; Average Hours/PP To Complete Memorandum
S NAHTCM=$FN(NAHTCM,"",2)
I I>0 D
. S NPOT=(AHRS/26*I)-NPAYHRS-WPAYHRS
. S NPOT=THRSWK-NPOT/NPOT,NPOT=NPOT*100,NPOT=$FN(NPOT,"",2)
I I=0 S NPOT=0
;
; Display updated Memorandum info
D MEM^PRSPUT1(PRSIEN,NMIEN,,,OTHRS)
Q
;
HRCOM ; Prompt for HR's final reconciliation comments
W !
S DIR(0)="FO^1:240^^",DIR("A")="Enter Final Reconciliation Comments"
D ^DIR K DIR
S HRCOM=X
I HRCOM'=""&(HRCOM'="^") D
. S TEXT="Enter Final Reconciliation Comments: "_$E(HRCOM,1,44)
. S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",TEXT=$E(HRCOM,44,123),INDEX=INDEX+1
. I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",TEXT=$E(HRCOM,124,203),INDEX=INDEX+1
. I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
. S TEXT="",TEXT=$E(HRCOM,204,240),INDEX=INDEX+1
. I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
S TEXT="",INDEX=INDEX+1
D A1^PRSPUT1 ; Blank Line
Q
;
PRT ; Print form for Chief of Staff approval
;
S DIR(0)="Y"
S DIR("A")="Print reconciliation for Chief of Staff approval "
D ^DIR K DIR
I X="^" S QUIT=1 Q
Q:X="N"!(X="n") ; Quit on 2nd pass
S INDX="",INDX=$O(^TMP($J,"PRSPRM",INDX),-1),INDX=INDX+1
S ^TMP($J,"PRSPRM",INDX)="",INDX=INDX+1 ; Blank Line
S $P(DASH,"_",34)="_"
S TEXT="Chief of Staff signature "_DASH_" Date "
S DASH="",$P(DASH,"_",14)="_",TEXT=TEXT_DASH
S ^TMP($J,"PRSPRM",INDX)=TEXT
;
W !
K IOP,%ZIS
S %ZIS("A")="Select Device: ",%ZIS="MQ"
D ^%ZIS
I POP D Q
. S QUIT=1
. K %ZIS,IOP
I $D(IO("Q")) D Q
. S ZTDESC="PRS PTP COMPLETE RECONCILE"
. S ZTRTN="PRINT^PRSPRM1"
. S ZTSAVE("^TMP($J,""PRSPRM"",")=""
. D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
. K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
. D HOME^%ZIS
U IO
D PRINT^PRSPRM1,^%ZISC
K %ZIS,IOP
Q
;
ESIG ; Prompt for Electronic Signature and store fields in #458.7
;
N ESOK
D ^PRSAES
Q:'ESOK
; Set fields when transferring + or - balance
I PTPRC=2!(PTPRC=4) D
. S IEN4587=NMIEN_","
. S PRSFDA(458.7,IEN4587,8)=OTHRS ; CARRYOVER HOURS
. S PRSFDA(458.7,IEN4587,14)=+NPOHC ; % OF HOURS COMPLETED
. S PRSFDA(458.7,IEN4587,15)=+NAHTCM ; AVE HRS/PP TO COMPLETE MEM
. S PRSFDA(458.7,IEN4587,16)=+NPOT ; % OFF TARGET
. D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
; Update the status of the old memorandum
S IEN4587=MIEN_","
I PTPRCOM=""&($G(PTPHRCOM)'="") D ; PTP Reconciliation Comm from paper
. S PRSFDA(458.7,IEN4587,18)=PTPHRCOM
S PRSFDA(458.7,IEN4587,19)=DUZ ; RECONCILED BY
D NOW^%DTC
S PRSFDA(458.7,IEN4587,20)=% ; DATE/TIME RECONCILED
S PRSFDA(458.7,IEN4587,21)=HRCOM ; HR RECONCILIATION COMMENTS
S PRSFDA(458.7,IEN4587,5)=4 ; STATUS = RECONCILED
D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
Q
;
PRINT ; Print the paper version of the Reconciliation form
;
S INDEX=""
F S INDEX=$O(^TMP($J,"PRSPRM",INDEX)) Q:'INDEX D
. S TEXT=^TMP($J,"PRSPRM",INDEX)
. W !,TEXT
Q
;
RCE(PTPRC) ;
I PTPRC=1 S PTPRCE="No reconciliation needed"
I PTPRC=2 S PTPRCE="Transfer negative balance"
I PTPRC=3 S PTPRCE="Pay VA for negative balance"
I PTPRC=4 S PTPRCE="Transfer positive balance"
I PTPRC=5 S PTPRCE="Pay Phy for positive balance"
Q PTPRCE
;
KILL ; Clean up variables
;
K ACTRC,AHRCOM,AHRS,AAHRS,AHTCM,AMT,ARRAY,ASK,ASK2,D1,DASH
K DATA,DATA0,DATA2,DATA4,DATA5,DAY,DIR,DIRUT,END,ENDDAT,ENDSTA
K ESRSTAT,HRCOM,I,IEN4587,INDEX,INDX,MEM,MIEN,NAHTCM,NMIEN,NPAYHRS
K NPHRS,NPOHC,NPOMC,NPOT,NTHRSWK,OLDMIEN,OTHRS,OTP,POP,POHC,POMC
K POT,PPE,PPI,PPEX,PPEX1,PPCNT,PPREM,PRPRCE,PRSAPGM,PRSIEN,PRSFDA
K PTPHRCOM,PTPRC,PTPRCE,PTPRCOM,QUIT,RATE,RO,SALARY,SCRTTL,SHRCOM
K SPAA,START,STATUS,STDAT,SSN,TDAT,TDATE,TEXT,THRSWK
K TPROMPT,WPAYHRS,WPHRS,ZTSAVE,X,Y,%
K ^TMP($J,"PRSPRM")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPRM1 7795 printed Oct 16, 2024@18:28:56 Page 2
PRSPRM1 ;WOIFO/MGD - PTP RECONCILE MEMORANDUM - 1 ;01/29/07
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; The following routine will allow HR to complete the reconciliation
+5 ; process for a memorandum that has expired or been terminated.
+6 ;
+7 QUIT
+8 ;
PTPCHK ; Check for Reconciliation info entered by PTP on electronic form
+1 ;
+2 SET DATA2=$GET(^PRST(458.7,MIEN,2))
+3 SET PTPRC=$PIECE(DATA2,U,1)
SET PTPRCOM=$PIECE(DATA2,U,2)
+4 IF PTPRC=""
SET PTPRCE=""
QUIT
+5 SET PTPRCE=$$RCE(PTPRC)
+6 ; Find range on options
SET END=""
SET END=$ORDER(MEM(END),-1)
+7 FOR I=1:1:END
Begin DoDot:1
+8 ; Numerical choice entered by PTP
SET ACTRC=$PIECE($GET(MEM(I)),U,2)
End DoDot:1
if ACTRC=PTPRC
QUIT
+9 SET TEXT=""
+10 DO A1^PRSPUT1
+11 SET TEXT="PTP's Reconciliation Choice: "_I_" "_PTPRCE
+12 DO A1^PRSPUT1
+13 ; Set this into ^TMP for long messages
+14 SET TEXT="PTP's Reconciliation Comments: "_$EXTRACT(PTPRCOM,1,48)
+15 SET INDEX=INDEX+1
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+16 WRITE !,TEXT
+17 SET TEXT=$EXTRACT(PTPRCOM,49,128)
SET INDEX=INDEX+1
+18 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
WRITE !,TEXT
+19 SET TEXT=$EXTRACT(PTPRCOM,129,208)
SET INDEX=INDEX+1
+20 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
WRITE !,TEXT
+21 SET TEXT=$EXTRACT(PTPRCOM,209,240)
SET INDEX=INDEX+1
+22 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
WRITE !,TEXT
+23 SET TEXT=""
+24 ; Blank Line
DO A1^PRSPUT1
+25 QUIT
+26 ;
HRRC ; HR Reconciliation Choice
+1 ; Find range on options
SET END=""
SET END=$ORDER(MEM(END),-1)
+2 ; Prompt for Reconciliation Option
RO WRITE !!,"Enter Reconciliation Option: "
+1 READ RO:DTIME
+2 SET RO=$$UPPER^PRSRUTL(RO)
+3 IF RO=""
SET RO="^"
+4 if RO="^"
QUIT
+5 IF '$DATA(MEM(RO))
Begin DoDot:1
+6 IF END>1
Begin DoDot:2
+7 WRITE !!,"Enter a number between 1 and ",END," or ^ to exit"
End DoDot:2
+8 IF END'>1
Begin DoDot:2
+9 WRITE !!,"Enter 1 or ^ to exit"
End DoDot:2
End DoDot:1
GOTO RO
+10 SET PTPRCE=$PIECE(MEM(RO),U,1)
SET PTPRC=$PIECE(MEM(RO),U,2)
+11 WRITE " "_PTPRCE
+12 SET TEXT="Enter Reconciliation Option: "_RO
+13 SET INDEX=INDEX+1
+14 SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
SET TEXT=""
+15 SET INDEX=INDEX+1
+16 ; Blank Line
DO A1^PRSPUT1
+17 QUIT
+18 ;
PTPRCOM ; Prompt for PTP's Reconciliation Comments if paper form was used
+1 ;
+2 ; PTP didn't enter any reconciliation comments
if PTPRCOM'=""&(PTPRC)
QUIT
+3 WRITE !
+4 SET DIR(0)="FO^1:240^^"
SET DIR("A")="PTP's Reconciliation Comments"
+5 DO ^DIR
KILL DIR
+6 IF PTPRCOM=""
IF (X'=""&(X'="^"))
Begin DoDot:1
+7 SET PTPHRCOM="PTP/hr: "_X
+8 SET TEXT="Reconciliation Comments: "_$EXTRACT(PTPHRCOM,1,48)
+9 SET INDEX=INDEX+1
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+10 SET TEXT=""
SET TEXT=$EXTRACT(PTPHRCOM,49,128)
SET INDEX=INDEX+1
+11 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+12 SET TEXT=""
SET TEXT=$EXTRACT(PTPHRCOM,129,208)
SET INDEX=INDEX+1
+13 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+14 SET TEXT=""
SET TEXT=$EXTRACT(PTPHRCOM,209,240)
SET INDEX=INDEX+1
+15 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+16 SET TEXT=""
SET INDEX=INDEX+1
+17 ; Blank Line
DO A1^PRSPUT1
End DoDot:1
+18 QUIT
+19 ;
TRNS ; Transfer hours to current memorandum
+1 ;
+2 if PTPRC'=2&(PTPRC'=4)
QUIT
+3 if 'NMIEN
QUIT
+4 ;
+5 DO MEM^PRSPUT1(PRSIEN,NMIEN)
+6 ; Blank Line
DO A1^PRSPUT1
+7 ;
+8 ; Transfer Prompt
+9 SET TPROMPT="Transfer "_$SELECT(OTHRS>0:"+",1:"")_OTHRS_" hours: "
+10 SET DIR(0)="Y"
+11 SET DIR("A")=TPROMPT
+12 DO ^DIR
KILL DIR
+13 IF X="^"
Begin DoDot:1
+14 SET QUIT=1
+15 WRITE !!,"Memorandum will have to be reconciled at a future date."
End DoDot:1
QUIT
+16 SET TEXT=TPROMPT_" "_X
+17 SET INDEX=INDEX+1
+18 SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+19 SET INDEX=INDEX+1
SET TEXT=""
+20 ; Blank Line
DO A1^PRSPUT1
+21 ;
CAL ; Calculate results after transfer
+1 SET DATA=$GET(^PRST(458.7,NMIEN,0))
+2 ; AGREED HOURS
SET AHRS=$PIECE(DATA,U,4)
+3 ; TOTAL HOURS WORKED
SET THRSWK=$PIECE(DATA,U,10)
+4 ; NONPAY HOURS
SET NPAYHRS=$PIECE(DATA,U,12)
+5 ; WITHOUT PAY HOURS
SET WPAYHRS=$PIECE(DATA,U,13)
+6 ; PERCENTAGE OF MEMORANDUM COMPLETED
SET POMC=$PIECE(DATA,U,14)
+7 ; PERCENTAGE OF HOURS COMPLETED
SET POHC=$PIECE(DATA,U,15)
+8 ; AVERAGE HOURS TO COMPLETE MEMORANDUM
SET AHTCM=$PIECE(DATA,U,16)
+9 ; % OFF TARGET
SET POT=$PIECE(DATA,U,17)
+10 ;
+11 ; AGREED HOURS adjusted for NP and WP
SET AAHRS=AHRS-NPAYHRS-WPAYHRS
+12 ; Determine # PP already worked
SET I=$PIECE($$MEMCPP^PRSPUT3(NMIEN),U,2)
+13 ; Pay Periods REMaining
SET PPREM=26-I
+14 ; New Total Hours Worked
SET NTHRSWK=THRSWK+OTHRS
+15 ; New % Of Hours Completed
SET NPOHC=$FNUMBER(THRSWK/AAHRS,"",2)
+16 ; Average Hours/PP To Complete Memorandum
SET NAHTCM=(AAHRS-THRSWK)/PPREM
+17 SET NAHTCM=$FNUMBER(NAHTCM,"",2)
+18 IF I>0
Begin DoDot:1
+19 SET NPOT=(AHRS/26*I)-NPAYHRS-WPAYHRS
+20 SET NPOT=THRSWK-NPOT/NPOT
SET NPOT=NPOT*100
SET NPOT=$FNUMBER(NPOT,"",2)
End DoDot:1
+21 IF I=0
SET NPOT=0
+22 ;
+23 ; Display updated Memorandum info
+24 DO MEM^PRSPUT1(PRSIEN,NMIEN,,,OTHRS)
+25 QUIT
+26 ;
HRCOM ; Prompt for HR's final reconciliation comments
+1 WRITE !
+2 SET DIR(0)="FO^1:240^^"
SET DIR("A")="Enter Final Reconciliation Comments"
+3 DO ^DIR
KILL DIR
+4 SET HRCOM=X
+5 IF HRCOM'=""&(HRCOM'="^")
Begin DoDot:1
+6 SET TEXT="Enter Final Reconciliation Comments: "_$EXTRACT(HRCOM,1,44)
+7 SET INDEX=INDEX+1
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+8 SET TEXT=""
SET TEXT=$EXTRACT(HRCOM,44,123)
SET INDEX=INDEX+1
+9 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+10 SET TEXT=""
SET TEXT=$EXTRACT(HRCOM,124,203)
SET INDEX=INDEX+1
+11 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+12 SET TEXT=""
SET TEXT=$EXTRACT(HRCOM,204,240)
SET INDEX=INDEX+1
+13 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
End DoDot:1
+14 SET TEXT=""
SET INDEX=INDEX+1
+15 ; Blank Line
DO A1^PRSPUT1
+16 QUIT
+17 ;
PRT ; Print form for Chief of Staff approval
+1 ;
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Print reconciliation for Chief of Staff approval "
+4 DO ^DIR
KILL DIR
+5 IF X="^"
SET QUIT=1
QUIT
+6 ; Quit on 2nd pass
if X="N"!(X="n")
QUIT
+7 SET INDX=""
SET INDX=$ORDER(^TMP($JOB,"PRSPRM",INDX),-1)
SET INDX=INDX+1
+8 ; Blank Line
SET ^TMP($JOB,"PRSPRM",INDX)=""
SET INDX=INDX+1
+9 SET $PIECE(DASH,"_",34)="_"
+10 SET TEXT="Chief of Staff signature "_DASH_" Date "
+11 SET DASH=""
SET $PIECE(DASH,"_",14)="_"
SET TEXT=TEXT_DASH
+12 SET ^TMP($JOB,"PRSPRM",INDX)=TEXT
+13 ;
+14 WRITE !
+15 KILL IOP,%ZIS
+16 SET %ZIS("A")="Select Device: "
SET %ZIS="MQ"
+17 DO ^%ZIS
+18 IF POP
Begin DoDot:1
+19 SET QUIT=1
+20 KILL %ZIS,IOP
End DoDot:1
QUIT
+21 IF $DATA(IO("Q"))
Begin DoDot:1
+22 SET ZTDESC="PRS PTP COMPLETE RECONCILE"
+23 SET ZTRTN="PRINT^PRSPRM1"
+24 SET ZTSAVE("^TMP($J,""PRSPRM"",")=""
+25 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Canceled!")
+26 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+27 DO HOME^%ZIS
End DoDot:1
QUIT
+28 USE IO
+29 DO PRINT^PRSPRM1
DO ^%ZISC
+30 KILL %ZIS,IOP
+31 QUIT
+32 ;
ESIG ; Prompt for Electronic Signature and store fields in #458.7
+1 ;
+2 NEW ESOK
+3 DO ^PRSAES
+4 if 'ESOK
QUIT
+5 ; Set fields when transferring + or - balance
+6 IF PTPRC=2!(PTPRC=4)
Begin DoDot:1
+7 SET IEN4587=NMIEN_","
+8 ; CARRYOVER HOURS
SET PRSFDA(458.7,IEN4587,8)=OTHRS
+9 ; % OF HOURS COMPLETED
SET PRSFDA(458.7,IEN4587,14)=+NPOHC
+10 ; AVE HRS/PP TO COMPLETE MEM
SET PRSFDA(458.7,IEN4587,15)=+NAHTCM
+11 ; % OFF TARGET
SET PRSFDA(458.7,IEN4587,16)=+NPOT
+12 DO UPDATE^DIE("","PRSFDA","IEN4587")
DO MSG^DIALOG()
End DoDot:1
+13 ; Update the status of the old memorandum
+14 SET IEN4587=MIEN_","
+15 ; PTP Reconciliation Comm from paper
IF PTPRCOM=""&($GET(PTPHRCOM)'="")
Begin DoDot:1
+16 SET PRSFDA(458.7,IEN4587,18)=PTPHRCOM
End DoDot:1
+17 ; RECONCILED BY
SET PRSFDA(458.7,IEN4587,19)=DUZ
+18 DO NOW^%DTC
+19 ; DATE/TIME RECONCILED
SET PRSFDA(458.7,IEN4587,20)=%
+20 ; HR RECONCILIATION COMMENTS
SET PRSFDA(458.7,IEN4587,21)=HRCOM
+21 ; STATUS = RECONCILED
SET PRSFDA(458.7,IEN4587,5)=4
+22 DO UPDATE^DIE("","PRSFDA","IEN4587")
DO MSG^DIALOG()
+23 QUIT
+24 ;
PRINT ; Print the paper version of the Reconciliation form
+1 ;
+2 SET INDEX=""
+3 FOR
SET INDEX=$ORDER(^TMP($JOB,"PRSPRM",INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+4 SET TEXT=^TMP($JOB,"PRSPRM",INDEX)
+5 WRITE !,TEXT
End DoDot:1
+6 QUIT
+7 ;
RCE(PTPRC) ;
+1 IF PTPRC=1
SET PTPRCE="No reconciliation needed"
+2 IF PTPRC=2
SET PTPRCE="Transfer negative balance"
+3 IF PTPRC=3
SET PTPRCE="Pay VA for negative balance"
+4 IF PTPRC=4
SET PTPRCE="Transfer positive balance"
+5 IF PTPRC=5
SET PTPRCE="Pay Phy for positive balance"
+6 QUIT PTPRCE
+7 ;
KILL ; Clean up variables
+1 ;
+2 KILL ACTRC,AHRCOM,AHRS,AAHRS,AHTCM,AMT,ARRAY,ASK,ASK2,D1,DASH
+3 KILL DATA,DATA0,DATA2,DATA4,DATA5,DAY,DIR,DIRUT,END,ENDDAT,ENDSTA
+4 KILL ESRSTAT,HRCOM,I,IEN4587,INDEX,INDX,MEM,MIEN,NAHTCM,NMIEN,NPAYHRS
+5 KILL NPHRS,NPOHC,NPOMC,NPOT,NTHRSWK,OLDMIEN,OTHRS,OTP,POP,POHC,POMC
+6 KILL POT,PPE,PPI,PPEX,PPEX1,PPCNT,PPREM,PRPRCE,PRSAPGM,PRSIEN,PRSFDA
+7 KILL PTPHRCOM,PTPRC,PTPRCE,PTPRCOM,QUIT,RATE,RO,SALARY,SCRTTL,SHRCOM
+8 KILL SPAA,START,STATUS,STDAT,SSN,TDAT,TDATE,TEXT,THRSWK
+9 KILL TPROMPT,WPAYHRS,WPHRS,ZTSAVE,X,Y,%
+10 KILL ^TMP($JOB,"PRSPRM")
+11 QUIT
