source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPSRC.m@ 1501

Last change on this file since 1501 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1PRSPSRC ;WOIFO/MGD - PTP SELECT RECONCILIATION CHOICE ;04/22/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 ; The following routine will allow HR to complete the reconciliation
6 ; process for a memorandum that has expired or been terminated.
7 ;
8 Q
9 ;
10MAIN(PRSIEN,MIEN) ; Main Driver
11 ; PRSIEN optional parameter-employee file 450 ien
12 ; MIEN optional parameter-ien of memo that needs ptps reconcile choice
13 ;
14 Q:'DUZ
15 I $G(PRSIEN)'>0 D
16 . S SSN=$P($G(^VA(200,DUZ,1)),"^",9)
17 . I SSN'="" S PRSIEN=$O(^PRSPC("SSN",SSN,0))
18 Q:$G(PRSIEN)'>0
19 ;
20 ;if MIEN passed make sure it qualifies
21 I $G(MIEN)>0,'$D(^PRST(458.7,"AST",PRSIEN,3,MIEN)) D Q
22 . W @IOF
23 . W !!,"Memorandum status is not Reconciliation Started."
24 ;if MIEN not passed then Find memos that qualify for reconcile
25 K ^TMP($J,"PRSPRM")
26 I $G(MIEN)'>0 D
27 . D MEM^PRSPRM
28 E D
29 . D MEMDAT^PRSPRM(MIEN,.STATUS,.STDAT,.ENDAT,.TDAT)
30 I $G(MIEN)'>0 D KILL^PRSPRM1 Q
31 ;
32 S DATA2=$G(^PRST(458.7,MIEN,2))
33 I +DATA2 D D KILL^PRSPRM1 Q
34 . W !!,"You have already selected the following reconciliation option:"
35 . W !!,"Reconciliation Option: ",$$EXTERNAL^DILFD(458.7,17,"",+DATA2)
36 . W !,"Reconciliation Comments: ",$P(DATA2,U,2)
37 ; Display employee and memorandum information
38 D DISPLAY^PRSPRM
39 I $D(DIRUT) D KILL^PRSPRM1 Q
40 ; Verify that all daily ESR are completed
41 S QUIT=0
42 D ESRCHK^PRSPRM
43 I QUIT D KILL^PRSPRM1 Q
44 ; Display Summary information
45 D SUM^PRSPBRP
46 ; Display Reconciliation Choices
47 D ROPT^PRSPBRP
48 ; Prompt PTP for Reconciliation Choice
49 D PTPRC
50 I RO="^" D KILL^PRSPRM1 Q
51 S PTPRC=$P(MEM(RO),U,2)
52 ; Prompt for PTP Reconciliation Comments
53 D PTPRCOM
54 I X="^" D KILL^PRSPRM1 Q
55 D SAVE
56 D KILL^PRSPRM1
57 Q
58 ;
59 ;
60PTPRC ; PTP Reconciliation Choice
61 S END="",END=$O(MEM(END),-1) ; Find range on options
62 ; Prompt for Reconciliation Choice
63RO W !!,"Enter Reconciliation Choice: "
64 R RO:DTIME
65 I RO="" S RO="^"
66 Q:RO="^"
67 I '$D(MEM(RO)) D G RO
68 . I END>1 D
69 . . W !!,"Enter a number between 1 and ",END," or ^ to exit"
70 . I END'>1 D
71 . . W !!,"Enter 1 or ^ to exit"
72 S PTPRCE=$P(MEM(RO),U,1),PTPRC=$P(MEM(RO),U,2)
73 W " "_PTPRCE
74 S TEXT="Enter Reconciliation Choice: "_RO
75 S INDEX=INDEX+1
76 S ^TMP($J,"PRSPRM",INDEX)=TEXT,TEXT=""
77 S INDEX=INDEX+1
78 D A1^PRSPUT1 ; Blank Line
79 Q
80 ;
81PTPRCOM ; Prompt for PTP's Reconciliation Comments if paper form was used
82 ;
83 S DIR(0)="FO^1:240^^",DIR("A")="PTP's Reconciliation Comments"
84 D ^DIR
85 I X="^" Q
86 S PTPRCOM=X
87 S TEXT="Reconciliation Comments: "_$E(PTPRCOM,1,48)
88 S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
89 S TEXT="",TEXT=$E(PTPRCOM,49,128),INDEX=INDEX+1
90 I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
91 S TEXT="",TEXT=$E(PTPRCOM,129,208),INDEX=INDEX+1
92 I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
93 S TEXT="",TEXT=$E(PTPRCOM,209,240),INDEX=INDEX+1
94 I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
95 S TEXT="",INDEX=INDEX+1
96 D A1^PRSPUT1 ; Blank Line
97 Q
98 ;
99SAVE ; Save PTP info into #458.7
100 ;
101 N ESOK,HOL
102 K PRSFDA,IEN4587
103 D ^PRSAES
104 I 'ESOK D Q
105 . W !!,"Your Reconciliation Choice was not saved."
106 I ESOK D
107 . S IEN4587=MIEN_","
108 . S PRSFDA(458.7,IEN4587,17)=PTPRC
109 . S PRSFDA(458.7,IEN4587,18)=PTPRCOM
110 . D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
111 ;
112 K DATA,DATA2,DIR,DIRUT,END,ENDAT,INDEX,MEM,PTPRC,PTPRCE,PTPRCOM,QUIT
113 K RO,SSN,STATUS,STDAT,TDAT,TEXT,X
114 Q
Note: See TracBrowser for help on using the repository browser.