PRSPSRC ;WOIFO/MGD - PTP SELECT RECONCILIATION CHOICE ;04/22/05
;;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
;
MAIN(PRSIEN,MIEN) ; Main Driver
; PRSIEN optional parameter-employee file 450 ien
; MIEN optional parameter-ien of memo that needs ptps reconcile choice
;
Q:'DUZ
I $G(PRSIEN)'>0 D
. S SSN=$P($G(^VA(200,DUZ,1)),"^",9)
. I SSN'="" S PRSIEN=$O(^PRSPC("SSN",SSN,0))
Q:$G(PRSIEN)'>0
;
;if MIEN passed make sure it qualifies
I $G(MIEN)>0,'$D(^PRST(458.7,"AST",PRSIEN,3,MIEN)) D Q
. W @IOF
. W !!,"Memorandum status is not Reconciliation Started."
;if MIEN not passed then Find memos that qualify for reconcile
K ^TMP($J,"PRSPRM")
I $G(MIEN)'>0 D
. D MEM^PRSPRM
E D
. D MEMDAT^PRSPRM(MIEN,.STATUS,.STDAT,.ENDAT,.TDAT)
I $G(MIEN)'>0 D KILL^PRSPRM1 Q
;
S DATA2=$G(^PRST(458.7,MIEN,2))
I +DATA2 D D KILL^PRSPRM1 Q
. W !!,"You have already selected the following reconciliation option:"
. W !!,"Reconciliation Option: ",$$EXTERNAL^DILFD(458.7,17,"",+DATA2)
. W !,"Reconciliation Comments: ",$P(DATA2,U,2)
; Display employee and memorandum information
D DISPLAY^PRSPRM
I $D(DIRUT) D KILL^PRSPRM1 Q
; Verify that all daily ESR are completed
S QUIT=0
D ESRCHK^PRSPRM
I QUIT D KILL^PRSPRM1 Q
; Display Summary information
D SUM^PRSPBRP
; Display Reconciliation Choices
D ROPT^PRSPBRP
; Prompt PTP for Reconciliation Choice
D PTPRC
I RO="^" D KILL^PRSPRM1 Q
S PTPRC=$P(MEM(RO),U,2)
; Prompt for PTP Reconciliation Comments
D PTPRCOM
I X="^" D KILL^PRSPRM1 Q
D SAVE
D KILL^PRSPRM1
Q
;
;
PTPRC ; PTP Reconciliation Choice
S END="",END=$O(MEM(END),-1) ; Find range on options
; Prompt for Reconciliation Choice
RO W !!,"Enter Reconciliation Choice: "
R RO:DTIME
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 Choice: "_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
;
S DIR(0)="FO^1:240^^",DIR("A")="PTP's Reconciliation Comments"
D ^DIR
I X="^" Q
S PTPRCOM=X
S TEXT="Reconciliation Comments: "_$E(PTPRCOM,1,48)
S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
S TEXT="",TEXT=$E(PTPRCOM,49,128),INDEX=INDEX+1
I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
S TEXT="",TEXT=$E(PTPRCOM,129,208),INDEX=INDEX+1
I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
S TEXT="",TEXT=$E(PTPRCOM,209,240),INDEX=INDEX+1
I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
S TEXT="",INDEX=INDEX+1
D A1^PRSPUT1 ; Blank Line
Q
;
SAVE ; Save PTP info into #458.7
;
N ESOK,HOL
K PRSFDA,IEN4587
D ^PRSAES
I 'ESOK D Q
. W !!,"Your Reconciliation Choice was not saved."
I ESOK D
. S IEN4587=MIEN_","
. S PRSFDA(458.7,IEN4587,17)=PTPRC
. S PRSFDA(458.7,IEN4587,18)=PTPRCOM
. D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
;
K DATA,DATA2,DIR,DIRUT,END,ENDAT,INDEX,MEM,PTPRC,PTPRCE,PTPRCOM,QUIT
K RO,SSN,STATUS,STDAT,TDAT,TEXT,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPSRC 3441 printed Apr 09, 2024@21:29:42 Page 2
PRSPSRC ;WOIFO/MGD - PTP SELECT RECONCILIATION CHOICE ;04/22/05
+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 ;
MAIN(PRSIEN,MIEN) ; Main Driver
+1 ; PRSIEN optional parameter-employee file 450 ien
+2 ; MIEN optional parameter-ien of memo that needs ptps reconcile choice
+3 ;
+4 if 'DUZ
QUIT
+5 IF $GET(PRSIEN)'>0
Begin DoDot:1
+6 SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
+7 IF SSN'=""
SET PRSIEN=$ORDER(^PRSPC("SSN",SSN,0))
End DoDot:1
+8 if $GET(PRSIEN)'>0
QUIT
+9 ;
+10 ;if MIEN passed make sure it qualifies
+11 IF $GET(MIEN)>0
IF '$DATA(^PRST(458.7,"AST",PRSIEN,3,MIEN))
Begin DoDot:1
+12 WRITE @IOF
+13 WRITE !!,"Memorandum status is not Reconciliation Started."
End DoDot:1
QUIT
+14 ;if MIEN not passed then Find memos that qualify for reconcile
+15 KILL ^TMP($JOB,"PRSPRM")
+16 IF $GET(MIEN)'>0
Begin DoDot:1
+17 DO MEM^PRSPRM
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 DO MEMDAT^PRSPRM(MIEN,.STATUS,.STDAT,.ENDAT,.TDAT)
End DoDot:1
+20 IF $GET(MIEN)'>0
DO KILL^PRSPRM1
QUIT
+21 ;
+22 SET DATA2=$GET(^PRST(458.7,MIEN,2))
+23 IF +DATA2
Begin DoDot:1
+24 WRITE !!,"You have already selected the following reconciliation option:"
+25 WRITE !!,"Reconciliation Option: ",$$EXTERNAL^DILFD(458.7,17,"",+DATA2)
+26 WRITE !,"Reconciliation Comments: ",$PIECE(DATA2,U,2)
End DoDot:1
DO KILL^PRSPRM1
QUIT
+27 ; Display employee and memorandum information
+28 DO DISPLAY^PRSPRM
+29 IF $DATA(DIRUT)
DO KILL^PRSPRM1
QUIT
+30 ; Verify that all daily ESR are completed
+31 SET QUIT=0
+32 DO ESRCHK^PRSPRM
+33 IF QUIT
DO KILL^PRSPRM1
QUIT
+34 ; Display Summary information
+35 DO SUM^PRSPBRP
+36 ; Display Reconciliation Choices
+37 DO ROPT^PRSPBRP
+38 ; Prompt PTP for Reconciliation Choice
+39 DO PTPRC
+40 IF RO="^"
DO KILL^PRSPRM1
QUIT
+41 SET PTPRC=$PIECE(MEM(RO),U,2)
+42 ; Prompt for PTP Reconciliation Comments
+43 DO PTPRCOM
+44 IF X="^"
DO KILL^PRSPRM1
QUIT
+45 DO SAVE
+46 DO KILL^PRSPRM1
+47 QUIT
+48 ;
+49 ;
PTPRC ; PTP Reconciliation Choice
+1 ; Find range on options
SET END=""
SET END=$ORDER(MEM(END),-1)
+2 ; Prompt for Reconciliation Choice
RO WRITE !!,"Enter Reconciliation Choice: "
+1 READ RO:DTIME
+2 IF RO=""
SET RO="^"
+3 if RO="^"
QUIT
+4 IF '$DATA(MEM(RO))
Begin DoDot:1
+5 IF END>1
Begin DoDot:2
+6 WRITE !!,"Enter a number between 1 and ",END," or ^ to exit"
End DoDot:2
+7 IF END'>1
Begin DoDot:2
+8 WRITE !!,"Enter 1 or ^ to exit"
End DoDot:2
End DoDot:1
GOTO RO
+9 SET PTPRCE=$PIECE(MEM(RO),U,1)
SET PTPRC=$PIECE(MEM(RO),U,2)
+10 WRITE " "_PTPRCE
+11 SET TEXT="Enter Reconciliation Choice: "_RO
+12 SET INDEX=INDEX+1
+13 SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
SET TEXT=""
+14 SET INDEX=INDEX+1
+15 ; Blank Line
DO A1^PRSPUT1
+16 QUIT
+17 ;
PTPRCOM ; Prompt for PTP's Reconciliation Comments if paper form was used
+1 ;
+2 SET DIR(0)="FO^1:240^^"
SET DIR("A")="PTP's Reconciliation Comments"
+3 DO ^DIR
+4 IF X="^"
QUIT
+5 SET PTPRCOM=X
+6 SET TEXT="Reconciliation Comments: "_$EXTRACT(PTPRCOM,1,48)
+7 SET INDEX=INDEX+1
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+8 SET TEXT=""
SET TEXT=$EXTRACT(PTPRCOM,49,128)
SET INDEX=INDEX+1
+9 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+10 SET TEXT=""
SET TEXT=$EXTRACT(PTPRCOM,129,208)
SET INDEX=INDEX+1
+11 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+12 SET TEXT=""
SET TEXT=$EXTRACT(PTPRCOM,209,240)
SET INDEX=INDEX+1
+13 IF TEXT'=""
SET ^TMP($JOB,"PRSPRM",INDEX)=TEXT
+14 SET TEXT=""
SET INDEX=INDEX+1
+15 ; Blank Line
DO A1^PRSPUT1
+16 QUIT
+17 ;
SAVE ; Save PTP info into #458.7
+1 ;
+2 NEW ESOK,HOL
+3 KILL PRSFDA,IEN4587
+4 DO ^PRSAES
+5 IF 'ESOK
Begin DoDot:1
+6 WRITE !!,"Your Reconciliation Choice was not saved."
End DoDot:1
QUIT
+7 IF ESOK
Begin DoDot:1
+8 SET IEN4587=MIEN_","
+9 SET PRSFDA(458.7,IEN4587,17)=PTPRC
+10 SET PRSFDA(458.7,IEN4587,18)=PTPRCOM
+11 DO UPDATE^DIE("","PRSFDA","IEN4587")
DO MSG^DIALOG()
End DoDot:1
+12 ;
+13 KILL DATA,DATA2,DIR,DIRUT,END,ENDAT,INDEX,MEM,PTPRC,PTPRCE,PTPRCOM,QUIT
+14 KILL RO,SSN,STATUS,STDAT,TDAT,TEXT,X
+15 QUIT
