source: FOIAVistA/trunk/r/PAID-PRS/PRSXP105.m@ 707

Last change on this file since 707 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1PRSXP105 ;WCIOFO/RRG-CORRECT VCS ALLOTMENT ;11/18/2005
2 ;;4.0;PAID;**105**;Sep 21, 1995
3 ;
4 ;
5 Q
6 ;
7 ;
8READ ; This module will run as a post install for *105
9 ; It will update the read access value and the
10 ; 'Date Last Updated' for 4 fields in #450
11 ;
12 F I=758,759,760,761 S ^DD(450,I,8)="FP",^DD(450,I,"DT")=DT
13 Q
14 ;
15 ;
16 ; The remainder of this program will correct the formatting
17 ; for the following fields:
18 ;
19 ; PAID EMPLOYEE (#450)
20 ; #586.1 - VCS ALLOTMENT AMT
21 ;
22 ; PAID PAYRUN DATA (#459)
23 ; #171 - VCS ALLOTMENT AMT
24 ;
25DEVICE ;Ask device or queue
26 ;
27 ;
28 W ! K IOP,%ZIS
29 S %ZIS("A")="Select Device: ",%ZIS="MQ"
30 D ^%ZIS K %ZIS,IOP
31 Q:POP
32 ;
33 I $D(IO("Q")) D Q
34 . S PRSAPGM="START^PRSXP105",XQY0="CORRECT VCS ALLOTTMENT FIELDS",PRSALST=""
35 . D QUE^PRSAUTL
36 . K PRSAPGM,XQY0,PRSALST,POP
37 ;
38 ;
39START ; Main Driver
40 ;
41 D 450
42 D 459
43 I $D(^TMP($J,"LOCKED","P105")) D WARN
44 Q
45 ;
46450 ; Correct data in the PAID EMPLOYEE (#450) file
47 ;
48 N CNT,DA,DATA,DIE,DR,EMP,LCNT,LINE,LINE2,MESS,MSG,MSG1,LKCNT
49 N NAME,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
50 S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK"
51 K ^TMP($J)
52 S MESS="PAID EMPLOYEE (#450)",MSG1=" beginning at "
53 D TIME
54 D STAUCI
55 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
56 S MESS="Correcting the VCS ALLOTMENT AMT (#586.1) field."
57 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
58 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
59 S ^TMP($J,"P105",LCNT)=LINE2,LCNT=LCNT+1
60 S MESS=" CURRENT CORRECTED"
61 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
62 S MESS="PAID EMPLOYEE (#450) VALUE VALUE"
63 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
64 S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
65 ;
66 ;
67 S (EMP,CNT)=0,LKCNT=1,FILE=450
68 F S EMP=$O(^PRSPC(EMP)) Q:'EMP D
69 . S DATA=$$GET1^DIQ(450,EMP,586.1)
70 . Q:DATA="" ; Quit if they don't have any VCS Allotment
71 . ; Quit if the value has already been formatted by another download
72 . Q:DATA["."
73 . D NAME
74 . L +^PRSPC(EMP):0
75 . I '$T D LOCKED Q
76 . S PVAL=DATA ; Previous value
77 . D DD^PRSDUTIL
78 . S DR="586.1///^S X=DATA",DA=EMP,DIE=450
79 . D ^DIE
80 . L -^PRSPC(EMP)
81 . S CNT=CNT+1
82 . S MESS=NAME,$E(MESS,31,35)=PVAL,$E(MESS,40,46)=DATA
83 . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
84 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
85 S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
86 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
87 S MESS=$S(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
88 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
89 I STATUS="Check" D
90 . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
91 . S ^TMP($J,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
92 . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
93 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
94 S MESS="PAID EMPLOYEE (#450)",MSG1=" ending at "
95 D TIME
96 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
97 S STATUS="OK",MSG=MSG_"450 "_STATUS
98 D XMT
99 Q
100 ;
101 ;
102459 ; Correct data in the PAID PAYRUN DATA (#459) file
103 ;
104 N CNT,DATA,EMP,I,IENS,LCNT,LINE,MESS,MSG
105 N NAME,PPE,PPI,PPIEN,PRSFDA,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
106 S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK",FILE=459
107 K ^TMP($J,"P105")
108 S MESS="PAID PAYRUN DATA (#459)",MSG1=" beginning at "
109 D TIME
110 D STAUCI
111 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
112 S MESS="Correcting the VCS ALLOTMENT AMT (#171) field of the"
113 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
114 S MESS="EMPLOYEE (#459.01) multiple."
115 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
116 S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
117 S PPI="03-10"
118 F S PPIEN="",PPI=$O(^PRST(459,"B",PPI)) Q:'PPI!(PPI>"07-20") D
119 . S PPIEN=$O(^PRST(459,"B",PPI,0)) Q:'PPIEN
120 . S PPE=$P(^PRST(459,PPIEN,0),"^")
121 . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
122 . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
123 . S ^TMP($J,"P105",LCNT)="Pay Period "_PPE,LCNT=LCNT+1
124 . S ^TMP($J,"P105",LCNT)=LINE2,LCNT=LCNT+1
125 . S MESS=" CURRENT CORRECTED"
126 . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
127 . S MESS="PAID PAYRUN DATA (#459) VALUE VALUE"
128 . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
129 . S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
130 . S (CNT,EMP)=0
131 . F S EMP=$O(^PRST(459,PPIEN,"P",EMP)) Q:'EMP D
132 . . S IENS=EMP_","_PPIEN_","
133 . . S DATA=$$GET1^DIQ(459.01,IENS,171)
134 . . Q:DATA="" ; Quit if they don't have any VCS Allotment
135 . . ; Quit if the value has already been formatted by another download
136 . . Q:DATA["."
137 . . D NAME
138 . . L +^PRST(459,PPIEN,"P",EMP):0
139 . . I '$T D LOCKED Q
140 . . S PVAL=DATA
141 . . D DD^PRSDUTIL
142 . . S IENS=EMP_","_PPIEN_",",PRSFDA(459.01,IENS,171)=DATA
143 . . D FILE^DIE("","PRSFDA") ; Correct data
144 . . S CNT=CNT+1
145 . . L -^PRST(459,PPIEN,"P",EMP)
146 . . S $E(NAME,1,$L(TNAME))=TNAME,$E(NAME,31,35)=PVAL,$E(NAME,40,46)=DATA
147 . . S ^TMP($J,"P105",LCNT)=NAME,LCNT=LCNT+1
148 . S MESS=$S(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
149 . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
150 . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
151 . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
152 . I STATUS="Check" D
153 . . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
154 . . S ^TMP($J,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
155 . . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
156 S MESS="PAID PAYRUN DATA (#459)",MSG1=" ending at "
157 D TIME
158 S STATUS="OK",MSG=MSG_"459 "_STATUS
159 D XMT
160 Q
161 ;
162XMT ; Send status via mail message
163 ;
164 I $D(^TMP($J,"P105")) D
165 . N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
166 . S XMDUZ=.5
167 . S XMSUB=MSG
168 . S XMTEXT="^TMP($J,""P105"","
169 . S XMY(DUZ)=""
170 . S XMY("G.PAD@"_^XMB("NETNAME"))=""
171 . D ^XMD
172 ;
173 K ^TMP($J,"P105"),Y,%
174 Q
175 ;
176TIME ; Get current Time
177 ;
178 D NOW^%DTC
179 S Y=%
180 D DD^%DT
181 S TIME=Y
182 S MESS=MESS_" clean up routine"_MSG1_TIME_"."
183 S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
184 Q
185 ;
186 ; Get Station Number
187 ;
188STAUCI S STANUM=$$KSP^XUPARAM("INST")_","
189 S STANUM=$$GET1^DIQ(4,STANUM,99)
190 S MSG=STANUM_" - "
191 ;
192 ; Check for UCI,VOL
193 ;
194 X ^%ZOSF("UCI")
195 S UCIX=$G(Y)
196 I UCIX="" S UCIX="??????"
197 S MSG=MSG_UCIX_" - "
198 Q
199 ;
200NAME ; Format name
201 ;
202 S NAME="",$P(NAME," ",30)=""
203 S TNAME=$$GET1^DIQ(450,EMP,.01)
204 I TNAME="" S TNAME=EMP
205 S $E(NAME,1,$L(TNAME))=TNAME
206 Q
207 ;
208LOCKED ; Message for locked records
209 ;
210 S MESS=NAME_" record was locked in file # "_FILE
211 S ^TMP($J,"LOCKED","P105",LKCNT)=MESS,LKCNT=LKCNT+1
212 S STATUS="Check"
213 Q
214 ;
215WARN ; Warning message if records were locked
216 ;
217 S ^TMP($J,"LOCKED","P105",LKCNT)="",LKCNT=LKCNT+1
218 S ^TMP($J,"LOCKED","P105",LKCNT)="These records were locked.",LKCNT=LKCNT+1
219 S ^TMP($J,"LOCKED","P105",LKCNT)="Contact NVS @ 888-596-4357",LKCNT=LKCNT+1
220 ;
221 I $D(^TMP($J,"LOCKED","P105")) D
222 . N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
223 . S XMDUZ=.5
224 . S XMSUB="Locked records - PRS*4*105"
225 . S XMTEXT="^TMP($J,""LOCKED"",""P105"","
226 . S XMY(DUZ)=""
227 . S XMY("G.PAD@"_^XMB("NETNAME"))=""
228 . D ^XMD
229 ;
230 K ^TMP($J,"LOCKED","P105"),Y,%
231 Q
232 ;
Note: See TracBrowser for help on using the repository browser.