source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPRM1.m@ 823

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

initial load of WorldVistAEHR

File size: 7.4 KB
RevLine 
[613]1PRSPRM1 ;WOIFO/MGD - PTP RECONCILE MEMORANDUM - 1 ;01/29/07
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 ;
10PTPCHK ; Check for Reconciliation info entered by PTP on electronic form
11 ;
12 S DATA2=$G(^PRST(458.7,MIEN,2))
13 S PTPRC=$P(DATA2,U,1),PTPRCOM=$P(DATA2,U,2)
14 I PTPRC="" S PTPRCE="" Q
15 S PTPRCE=$$RCE(PTPRC)
16 S END="",END=$O(MEM(END),-1) ; Find range on options
17 F I=1:1:END D Q:ACTRC=PTPRC
18 . S ACTRC=$P($G(MEM(I)),U,2) ; Numerical choice entered by PTP
19 S TEXT=""
20 D A1^PRSPUT1
21 S TEXT="PTP's Reconciliation Choice: "_I_" "_PTPRCE
22 D A1^PRSPUT1
23 ; Set this into ^TMP for long messages
24 S TEXT="PTP's Reconciliation Comments: "_$E(PTPRCOM,1,48)
25 S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
26 W !,TEXT
27 S TEXT=$E(PTPRCOM,49,128),INDEX=INDEX+1
28 I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
29 S TEXT=$E(PTPRCOM,129,208),INDEX=INDEX+1
30 I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
31 S TEXT=$E(PTPRCOM,209,240),INDEX=INDEX+1
32 I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
33 S TEXT=""
34 D A1^PRSPUT1 ; Blank Line
35 Q
36 ;
37HRRC ; HR Reconciliation Choice
38 S END="",END=$O(MEM(END),-1) ; Find range on options
39 ; Prompt for Reconciliation Option
40RO W !!,"Enter Reconciliation Option: "
41 R RO:DTIME
42 S RO=$$UPPER^PRSRUTL(RO)
43 I RO="" S RO="^"
44 Q:RO="^"
45 I '$D(MEM(RO)) D G RO
46 . I END>1 D
47 . . W !!,"Enter a number between 1 and ",END," or ^ to exit"
48 . I END'>1 D
49 . . W !!,"Enter 1 or ^ to exit"
50 S PTPRCE=$P(MEM(RO),U,1),PTPRC=$P(MEM(RO),U,2)
51 W " "_PTPRCE
52 S TEXT="Enter Reconciliation Option: "_RO
53 S INDEX=INDEX+1
54 S ^TMP($J,"PRSPRM",INDEX)=TEXT,TEXT=""
55 S INDEX=INDEX+1
56 D A1^PRSPUT1 ; Blank Line
57 Q
58 ;
59PTPRCOM ; Prompt for PTP's Reconciliation Comments if paper form was used
60 ;
61 Q:PTPRCOM'=""&(PTPRC) ; PTP didn't enter any reconciliation comments
62 W !
63 S DIR(0)="FO^1:240^^",DIR("A")="PTP's Reconciliation Comments"
64 D ^DIR K DIR
65 I PTPRCOM="",(X'=""&(X'="^")) D
66 . S PTPHRCOM="PTP/hr: "_X
67 . S TEXT="Reconciliation Comments: "_$E(PTPHRCOM,1,48)
68 . S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
69 . S TEXT="",TEXT=$E(PTPHRCOM,49,128),INDEX=INDEX+1
70 . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
71 . S TEXT="",TEXT=$E(PTPHRCOM,129,208),INDEX=INDEX+1
72 . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
73 . S TEXT="",TEXT=$E(PTPHRCOM,209,240),INDEX=INDEX+1
74 . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
75 . S TEXT="",INDEX=INDEX+1
76 . D A1^PRSPUT1 ; Blank Line
77 Q
78 ;
79TRNS ; Transfer hours to current memorandum
80 ;
81 Q:PTPRC'=2&(PTPRC'=4)
82 Q:'NMIEN
83 ;
84 D MEM^PRSPUT1(PRSIEN,NMIEN)
85 D A1^PRSPUT1 ; Blank Line
86 ;
87 ; Transfer Prompt
88 S TPROMPT="Transfer "_$S(OTHRS>0:"+",1:"")_OTHRS_" hours: "
89 S DIR(0)="Y"
90 S DIR("A")=TPROMPT
91 D ^DIR K DIR
92 I X="^" D Q
93 . S QUIT=1
94 . W !!,"Memorandum will have to be reconciled at a future date."
95 S TEXT=TPROMPT_" "_X
96 S INDEX=INDEX+1
97 S ^TMP($J,"PRSPRM",INDEX)=TEXT
98 S INDEX=INDEX+1,TEXT=""
99 D A1^PRSPUT1 ; Blank Line
100 ;
101CAL ; Calculate results after transfer
102 S DATA=$G(^PRST(458.7,NMIEN,0))
103 S AHRS=$P(DATA,U,4) ; AGREED HOURS
104 S THRSWK=$P(DATA,U,10) ; TOTAL HOURS WORKED
105 S NPAYHRS=$P(DATA,U,12) ; NONPAY HOURS
106 S WPAYHRS=$P(DATA,U,13) ; WITHOUT PAY HOURS
107 S POMC=$P(DATA,U,14) ; PERCENTAGE OF MEMORANDUM COMPLETED
108 S POHC=$P(DATA,U,15) ; PERCENTAGE OF HOURS COMPLETED
109 S AHTCM=$P(DATA,U,16) ; AVERAGE HOURS TO COMPLETE MEMORANDUM
110 S POT=$P(DATA,U,17) ; % OFF TARGET
111 ;
112 S AAHRS=AHRS-NPAYHRS-WPAYHRS ; AGREED HOURS adjusted for NP and WP
113 S I=$P($$MEMCPP^PRSPUT3(NMIEN),U,2) ; Determine # PP already worked
114 S PPREM=26-I ; Pay Periods REMaining
115 S NTHRSWK=THRSWK+OTHRS ; New Total Hours Worked
116 S NPOHC=$FN(THRSWK/AAHRS,"",2) ; New % Of Hours Completed
117 S NAHTCM=(AAHRS-THRSWK)/PPREM ; Average Hours/PP To Complete Memorandum
118 S NAHTCM=$FN(NAHTCM,"",2)
119 I I>0 D
120 . S NPOT=(AHRS/26*I)-NPAYHRS-WPAYHRS
121 . S NPOT=THRSWK-NPOT/NPOT,NPOT=NPOT*100,NPOT=$FN(NPOT,"",2)
122 I I=0 S NPOT=0
123 ;
124 ; Display updated Memorandum info
125 D MEM^PRSPUT1(PRSIEN,NMIEN,,,OTHRS)
126 Q
127 ;
128HRCOM ; Prompt for HR's final reconciliation comments
129 W !
130 S DIR(0)="FO^1:240^^",DIR("A")="Enter Final Reconciliation Comments"
131 D ^DIR K DIR
132 S HRCOM=X
133 I HRCOM'=""&(HRCOM'="^") D
134 . S TEXT="Enter Final Reconciliation Comments: "_$E(HRCOM,1,44)
135 . S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
136 . S TEXT="",TEXT=$E(HRCOM,44,123),INDEX=INDEX+1
137 . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
138 . S TEXT="",TEXT=$E(HRCOM,124,203),INDEX=INDEX+1
139 . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
140 . S TEXT="",TEXT=$E(HRCOM,204,240),INDEX=INDEX+1
141 . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
142 S TEXT="",INDEX=INDEX+1
143 D A1^PRSPUT1 ; Blank Line
144 Q
145 ;
146PRT ; Print form for Chief of Staff approval
147 ;
148 S DIR(0)="Y"
149 S DIR("A")="Print reconciliation for Chief of Staff approval "
150 D ^DIR K DIR
151 I X="^" S QUIT=1 Q
152 Q:X="N"!(X="n") ; Quit on 2nd pass
153 S INDX="",INDX=$O(^TMP($J,"PRSPRM",INDX),-1),INDX=INDX+1
154 S ^TMP($J,"PRSPRM",INDX)="",INDX=INDX+1 ; Blank Line
155 S $P(DASH,"_",34)="_"
156 S TEXT="Chief of Staff signature "_DASH_" Date "
157 S DASH="",$P(DASH,"_",14)="_",TEXT=TEXT_DASH
158 S ^TMP($J,"PRSPRM",INDX)=TEXT
159 ;
160 W !
161 K IOP,%ZIS
162 S %ZIS("A")="Select Device: ",%ZIS="MQ"
163 D ^%ZIS
164 I POP D Q
165 . S QUIT=1
166 . K %ZIS,IOP
167 I $D(IO("Q")) D Q
168 . S ZTDESC="PRS PTP COMPLETE RECONCILE"
169 . S ZTRTN="PRINT^PRSPRM1"
170 . S ZTSAVE("^TMP($J,""PRSPRM"",")=""
171 . D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
172 . K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
173 . D HOME^%ZIS
174 U IO
175 D PRINT^PRSPRM1,^%ZISC
176 K %ZIS,IOP
177 Q
178 ;
179ESIG ; Prompt for Electronic Signature and store fields in #458.7
180 ;
181 N ESOK
182 D ^PRSAES
183 Q:'ESOK
184 ; Set fields when transferring + or - balance
185 I PTPRC=2!(PTPRC=4) D
186 . S IEN4587=NMIEN_","
187 . S PRSFDA(458.7,IEN4587,8)=OTHRS ; CARRYOVER HOURS
188 . S PRSFDA(458.7,IEN4587,14)=+NPOHC ; % OF HOURS COMPLETED
189 . S PRSFDA(458.7,IEN4587,15)=+NAHTCM ; AVE HRS/PP TO COMPLETE MEM
190 . S PRSFDA(458.7,IEN4587,16)=+NPOT ; % OFF TARGET
191 . D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
192 ; Update the status of the old memorandum
193 S IEN4587=MIEN_","
194 I PTPRCOM=""&($G(PTPHRCOM)'="") D ; PTP Reconciliation Comm from paper
195 . S PRSFDA(458.7,IEN4587,18)=PTPHRCOM
196 S PRSFDA(458.7,IEN4587,19)=DUZ ; RECONCILED BY
197 D NOW^%DTC
198 S PRSFDA(458.7,IEN4587,20)=% ; DATE/TIME RECONCILED
199 S PRSFDA(458.7,IEN4587,21)=HRCOM ; HR RECONCILIATION COMMENTS
200 S PRSFDA(458.7,IEN4587,5)=4 ; STATUS = RECONCILED
201 D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
202 Q
203 ;
204PRINT ; Print the paper version of the Reconciliation form
205 ;
206 S INDEX=""
207 F S INDEX=$O(^TMP($J,"PRSPRM",INDEX)) Q:'INDEX D
208 . S TEXT=^TMP($J,"PRSPRM",INDEX)
209 . W !,TEXT
210 Q
211 ;
212RCE(PTPRC) ;
213 I PTPRC=1 S PTPRCE="No reconciliation needed"
214 I PTPRC=2 S PTPRCE="Transfer negative balance"
215 I PTPRC=3 S PTPRCE="Pay VA for negative balance"
216 I PTPRC=4 S PTPRCE="Transfer positive balance"
217 I PTPRC=5 S PTPRCE="Pay Phy for positive balance"
218 Q PTPRCE
219 ;
220KILL ; Clean up variables
221 ;
222 K ACTRC,AHRCOM,AHRS,AAHRS,AHTCM,AMT,ARRAY,ASK,ASK2,D1,DASH
223 K DATA,DATA0,DATA2,DATA4,DATA5,DAY,DIR,DIRUT,END,ENDDAT,ENDSTA
224 K ESRSTAT,HRCOM,I,IEN4587,INDEX,INDX,MEM,MIEN,NAHTCM,NMIEN,NPAYHRS
225 K NPHRS,NPOHC,NPOMC,NPOT,NTHRSWK,OLDMIEN,OTHRS,OTP,POP,POHC,POMC
226 K POT,PPE,PPI,PPEX,PPEX1,PPCNT,PPREM,PRPRCE,PRSAPGM,PRSIEN,PRSFDA
227 K PTPHRCOM,PTPRC,PTPRCE,PTPRCOM,QUIT,RATE,RO,SALARY,SCRTTL,SHRCOM
228 K SPAA,START,STATUS,STDAT,SSN,TDAT,TDATE,TEXT,THRSWK
229 K TPROMPT,WPAYHRS,WPHRS,ZTSAVE,X,Y,%
230 K ^TMP($J,"PRSPRM")
231 Q
Note: See TracBrowser for help on using the repository browser.