Software and Services for Financial Aid
WolffPack differences report |
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
|
*S*************************************************************************
*S***
*S*** WolffPack
*S***
*S*** Subprogram: WFFE325N
*S*** System : FINANCIER
*S*** Title : 2024-25 Federal Load CPS update program
*S*** Function : This subprogram loads data from
*S*** the ADD file into the WF-CPS-2425 file.
*S***
*S*** Copyright 1995 - 2024 WolffPack, Inc. All rights reserved.
*S***
*S*************************************************************************
*S**DEFINE DATA
*S** GLOBAL USING WWGDA
*S** PARAMETER USING WWPDA
*S** PARAMETER USING WFADDDSD
*S***
*S** LOCAL USING WFCPS25D /* Passed to object subprogram
*S** LOCAL USING WFCPS25R /* Passed to object subprogram
*S** LOCAL USING WWAOBJ /* Passed to object subprograms
*S***
*S** LOCAL USING WF25FEDL /* Sequential LDA
*S***
*S** LOCAL
*S** 01 #CNVT-NEG(L)
*S** 01 #CNVT-BYTE(A1)
*S** 01 #SAVE-BYTE(A1)
*S** 01 #15-BYTE-FIELD(A15)
*S** 01 #6-BYTE-FIELD(A6)
*S**END-DEFINE
*S***
*S***
*S*** Populate WW-GDA from WW-PDA
*S** MOVE BY POSITION WW-PDA TO WW-GDA
*S***
*S***
*S**PROG.
*S** REPEAT
*S** PERFORM LOAD-CPS
*S** ESCAPE BOTTOM(PROG.)
*S** END-REPEAT
*S***
*S** MOVE BY POSITION WW-GDA TO WW-PDA
*S***
*S***
*S*************************************************************************
*S**DEFINE SUBROUTINE LOAD-CPS
*S*************************************************************************
*S** /*
*S** /* Load LDA from ADD record
*S** MOVE BY NAME WFADDDSD TO WF25FEDL
*S** /* dh wp25
*S*** write 'WFFE325N:' /
*S*** write 'Label-end:' WF25FEDL.WF-FE-FTI-LABEL-END ':' /
*S*** write 'fisap-L:' WF25FEDL.WF-FE-FISAP-TOT-INC ':' /
*S**
*S** /*
*S** /* Get CPS data record
*S** ASSIGN WWAOBJ.#FUNCTION = 'GET'
*S** ASSIGN WFCPS25D.WW-STUDENT-ID = ##STUDENT-ID
*S** ASSIGN WFCPS25D.WF-FAO = ##FAO-ID
*S** PERFORM CALL-OBJECT-CPS
*S** IF WWAOBJ.#EXISTS
*S** ASSIGN WWAOBJ.#FUNCTION = 'UPDATE'
*S** ELSE
*S** ASSIGN WWAOBJ.#FUNCTION = 'STORE'
*S** END-IF
*S** /*
*S** /* Load data to CPS file
*S** MOVE WF25FEDL.WF-FE-TRANS-UUID TO WFCPS25D.WF-CP-TRANS-UUID
*S** MOVE WF25FEDL.WF-FE-C-TRANS-NO TO WFCPS25D.WF-CP-C-TRANS-NO
*S** MOVE WFADDDSD.WF-AD-COLLEGE TO WFCPS25D.WF-CP-COLLEGE
*S** /*
*S** MOVE WF25FEDL.WF-FE-C-VER TO WFCPS25D.WF-CP-A-VER
*S** /*
*S** MOVE WF25FEDL.WF-FE-C-DEP-MODEL TO WFCPS25D.WF-CP-A-DEP-MODEL
*S** /*
*S*** wp25
*S*** DECIDE FOR FIRST CONDITION
*S*** WHEN WF25FEDL.WF-FE-C-AUTO-ZERO = 'Y'
*S*** MOVE 'Z' TO WFCPS25D.WF-CP-A-SANAL
*S*** WFCPS25D.WF-CP-A-PANAL
*S*** WHEN WF25FEDL.WF-FE-C-FC1-FRMULA = '1' OR = '2' OR = '3'
*S*** MOVE 'R' TO WFCPS25D.WF-CP-A-SANAL
*S*** WFCPS25D.WF-CP-A-PANAL
*S*** WHEN WF25FEDL.WF-FE-C-FC1-FRMULA = '4' OR = '5' OR = '6'
*S*** MOVE 'S' TO WFCPS25D.WF-CP-A-SANAL
*S*** WFCPS25D.WF-CP-A-PANAL
*S*** WHEN NONE
*S*** RESET WFCPS25D.WF-CP-A-SANAL WFCPS25D.WF-CP-A-PANAL
*S*** END-DECIDE
*S** /*
*S** /* Numeric fields
*S** RESET WFCPS25D.WF-CP-A-SC WFCPS25D.WF-CP-A-SCI WFCPS25D.WF-CP-A-SCA
*S** WFCPS25D.WF-CP-A-PC WFCPS25D.WF-CP-A-PCI WFCPS25D.WF-CP-A-PCA
*S** /*
*S*** wp25
*S** /*
*S** /* SC
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-S-FC1-CI,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-S-FC1-CI FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-S-FC1-CI TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-SCI = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-SCI = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SCI BY -1
*S** END-IF
*S** END-IF
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-S-FC1-CI,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-S-FC1-CI FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-S-FC1-CA TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-SCA = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-SCA = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SCA BY -1
*S** END-IF
*S** END-IF
*S** IF (WFCPS25D.WF-CP-A-SCI +
*S** WFCPS25D.WF-CP-A-SCA) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-SC = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-SC =
*S** (WFCPS25D.WF-CP-A-SCI + WFCPS25D.WF-CP-A-SCA)
*S** END-IF
*S** /*
*S** /* PC
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-P1-FC1-CONT,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-P1-FC1-CONT FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-P1-FC1-CONT TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-PC = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-PC = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-PC BY -1
*S** END-IF
*S** END-IF
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-P1-FC1-CA,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-P1-FC1-CA FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-P1-FC1-CA TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-PCA = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-PCA = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-PCA BY -1
*S** END-IF
*S** END-IF
*S** ASSIGN WFCPS25D.WF-CP-A-PCI =
*S** WFCPS25D.WF-CP-A-PC - WFCPS25D.WF-CP-A-PCA
*S*** SIC and SCA no longer delivered
*S*** DECIDE ON FIRST VALUE OF WF25FEDL.WF-FE-C-DEP-MODEL
*S*** VALUE 'D'
*S*** IF WF25FEDL.WF-FE-C-FC1-SIC = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-SCI = VAL(WF25FEDL.WF-FE-C-FC1-SIC)
*S*** ELSE
*S*** MOVE SUBSTRING(WF25FEDL.WF-FE-C-FC1-SIC,7,1) TO #CNVT-BYTE
*S*** PERFORM CONVERT-SIGNS #CNVT-BYTE #CNVT-NEG
*S*** MOVE #CNVT-BYTE TO SUBSTRING(WF25FEDL.WF-FE-C-FC1-SIC,7,1)
*S*** IF WF25FEDL.WF-FE-C-FC1-SIC = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-SCI = VAL(WF25FEDL.WF-FE-C-FC1-SIC)
*S*** IF #CNVT-NEG
*S*** MULTIPLY WFCPS25D.WF-CP-A-SCI BY -1
*S*** END-IF
*S*** END-IF
*S*** END-IF
*S*** IF WF25FEDL.WF-FE-C-FC1-SCA = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-SCA = VAL(WF25FEDL.WF-FE-C-FC1-SCA)
*S*** ELSE
*S*** MOVE SUBSTRING(WF25FEDL.WF-FE-C-FC1-SCA,7,1) TO #CNVT-BYTE
*S*** PERFORM CONVERT-SIGNS #CNVT-BYTE #CNVT-NEG
*S*** MOVE #CNVT-BYTE TO SUBSTRING(WF25FEDL.WF-FE-C-FC1-SCA,7,1)
*S*** IF WF25FEDL.WF-FE-C-FC1-SCA = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-SCA = VAL(WF25FEDL.WF-FE-C-FC1-SCA)
*S*** IF #CNVT-NEG
*S*** MULTIPLY WFCPS25D.WF-CP-A-SCA BY -1
*S*** END-IF
*S*** END-IF
*S*** END-IF
*S*** IF (WFCPS25D.WF-CP-A-SCI + WFCPS25D.WF-CP-A-SCA) > 9999999
*S*** COMPUTE WFCPS25D.WF-CP-A-SC = 9999999
*S*** ELSE
*S*** COMPUTE WFCPS25D.WF-CP-A-SC = WFCPS25D.WF-CP-A-SCI +
*S*** WFCPS25D.WF-CP-A-SCA
*S*** END-IF
*S*** IF WF25FEDL.WF-FE-C-FC1-PC = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-PC = VAL(WF25FEDL.WF-FE-C-FC1-PC)
*S*** END-IF
*S*** IF WF25FEDL.WF-FE-C-FC1-PCA = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-PCA = VAL(WF25FEDL.WF-FE-C-FC1-PCA)
*S*** ELSE
*S*** MOVE SUBSTRING(WF25FEDL.WF-FE-C-FC1-PCA,7,1) TO #CNVT-BYTE
*S*** PERFORM CONVERT-SIGNS #CNVT-BYTE #CNVT-NEG
*S*** MOVE #CNVT-BYTE TO SUBSTRING(WF25FEDL.WF-FE-C-FC1-PCA,7,1)
*S*** IF WF25FEDL.WF-FE-C-FC1-PCA = MASK(9999999)
*S*** ASSIGN WFCPS25D.WF-CP-A-PCA = VAL(WF25FEDL.WF-FE-C-FC1-PCA)
*S*** IF #CNVT-NEG
*S*** MULTIPLY WFCPS25D.WF-CP-A-PCA BY -1
*S*** END-IF
*S*** END-IF
*S*** END-IF
*S*** ASSIGN WFCPS25D.WF-CP-A-PCI = WFCPS25D.WF-CP-A-PC -
*S*** WFCPS25D.WF-CP-A-PCA
*S*** /*
*S*** VALUE 'I'
*S*** RESET WFCPS25D.WF-CP-A-PANAL
*S*** IF WFCPS25D.WF-CP-A-FC1 NE 99999
*S*** ASSIGN WFCPS25D.WF-CP-A-SC = WFCPS25D.WF-CP-A-FC1
*S*** END-IF
*S*** NONE
*S*** RESET WFCPS25D.WF-CP-A-SANAL WFCPS25D.WF-CP-A-PANAL
*S*** END-DECIDE
*S** /*
*S** RESET WFCPS25D.WF-CP-A-FISAP
*S** RESET #CNVT-NEG
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-FISAP-TOT-INC,1,1) TO #CNVT-BYTE
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-FISAP-TOT-INC FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-FISAP-TOT-INC TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** ASSIGN WFCPS25D.WF-CP-A-FISAP = VAL(#15-BYTE-FIELD)
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-FISAP BY -1
*S** END-IF
*S** END-IF
*S** /*
*S** /*
*S** RESET WFCPS25D.WF-CP-A-SAI
*S** RESET #CNVT-NEG
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-C-SAI,1,1) TO #CNVT-BYTE
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-C-SAI FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-C-SAI TO #6-BYTE-FIELD
*S** EXAMINE #6-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #6-BYTE-FIELD = MASK(999999)
*S** ASSIGN WFCPS25D.WF-CP-A-SAI = VAL(#6-BYTE-FIELD)
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SAI BY -1
*S** END-IF
*S** END-IF
*S** /*
*S** /*
*S** RESET WFCPS25D.WF-CP-A-SAI-PROV
*S** RESET #CNVT-NEG
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-C-SAI-PROV,1,1) TO #CNVT-BYTE
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-C-SAI-PROV FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-C-SAI-PROV TO #6-BYTE-FIELD
*S** EXAMINE #6-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #6-BYTE-FIELD = MASK(999999)
*S** ASSIGN WFCPS25D.WF-CP-A-SAI-PROV = VAL(#6-BYTE-FIELD)
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SAI-PROV BY -1
*S** END-IF
*S** END-IF
*S** /*
*S** PERFORM CALL-OBJECT-CPS
*S**END-SUBROUTINE /* LOAD-CPS
*S***
*S*************************************************************************
*S**DEFINE SUBROUTINE CALL-OBJECT-CPS
*S*************************************************************************
*S** /*
*S** /* Call the WF-CPS-xxyy object subprogram
*S** CALLNAT 'WFCPS25O' WW-GDA
*S** WFCPS25D
*S** WFCPS25D-ID
*S** WFCPS25R
*S** WWAOBJ
*S**END-SUBROUTINE /* CALL-OBJECT-CPS
*S**END
*E
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
|
*S*************************************************************************
*S***
*S*** WolffPack
*S***
*S*** Subprogram: WFFE325N
*S*** System : FINANCIER
*S*** Title : 2024-25 Federal Load CPS update program
*S*** Function : This subprogram loads data from
*S*** the ADD file into the WF-CPS-2425 file.
*S***
*S*** Copyright 1995 - 2024 WolffPack, Inc. All rights reserved.
*S***
*S*************************************************************************
*S**DEFINE DATA
*S** GLOBAL USING WWGDA
*S** PARAMETER USING WWPDA
*S** PARAMETER USING WFADDDSD
*S***
*S** LOCAL USING WFCPS25D /* Passed to object subprogram
*S** LOCAL USING WFCPS25R /* Passed to object subprogram
*S** LOCAL USING WWAOBJ /* Passed to object subprograms
*S***
*S** LOCAL USING WF25FEDL /* Sequential LDA
*S***
*S** LOCAL
*S** 01 #CNVT-NEG(L)
*S** 01 #CNVT-BYTE(A1)
*S** 01 #SAVE-BYTE(A1)
*S** 01 #15-BYTE-FIELD(A15)
*S** 01 #6-BYTE-FIELD(A6)
*S**END-DEFINE
*S***
*S***
*S*** Populate WW-GDA from WW-PDA
*S** MOVE BY POSITION WW-PDA TO WW-GDA
*S***
*S***
*S**PROG.
*S** REPEAT
*S** PERFORM LOAD-CPS
*S** ESCAPE BOTTOM(PROG.)
*S** END-REPEAT
*S***
*S** MOVE BY POSITION WW-GDA TO WW-PDA
*S***
*S***
*S*************************************************************************
*S**DEFINE SUBROUTINE LOAD-CPS
*S*************************************************************************
*S** /*
*S** /* Load LDA from ADD record
*S** MOVE BY NAME WFADDDSD TO WF25FEDL
*S** /*
*S** /* Get CPS data record
*S** ASSIGN WWAOBJ.#FUNCTION = 'GET'
*S** ASSIGN WFCPS25D.WW-STUDENT-ID = ##STUDENT-ID
*S** ASSIGN WFCPS25D.WF-FAO = ##FAO-ID
*S** PERFORM CALL-OBJECT-CPS
*S** IF WWAOBJ.#EXISTS
*S** ASSIGN WWAOBJ.#FUNCTION = 'UPDATE'
*S** ELSE
*S** ASSIGN WWAOBJ.#FUNCTION = 'STORE'
*S** END-IF
*S** /*
*S** /* Load data to CPS file
*S** MOVE WF25FEDL.WF-FE-TRANS-UUID TO WFCPS25D.WF-CP-TRANS-UUID
*S** MOVE WF25FEDL.WF-FE-C-TRANS-NO TO WFCPS25D.WF-CP-C-TRANS-NO
*S** MOVE WFADDDSD.WF-AD-COLLEGE TO WFCPS25D.WF-CP-COLLEGE
*S** /*
*S** MOVE WF25FEDL.WF-FE-C-VER TO WFCPS25D.WF-CP-A-VER
*S** /*
*S** MOVE WF25FEDL.WF-FE-C-DEP-MODEL TO WFCPS25D.WF-CP-A-DEP-MODEL
*S** /*
*S** /* Numeric fields
*S** RESET WFCPS25D.WF-CP-A-SC WFCPS25D.WF-CP-A-SCI WFCPS25D.WF-CP-A-SCA
*S** WFCPS25D.WF-CP-A-PC WFCPS25D.WF-CP-A-PCI WFCPS25D.WF-CP-A-PCA
*S** /*
*S** /* SC
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-S-FC1-CI,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-S-FC1-CI FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-S-FC1-CI TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-SCI = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-SCI = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SCI BY -1
*S** END-IF
*S** END-IF
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-S-FC1-CI,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-S-FC1-CI FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-S-FC1-CA TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-SCA = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-SCA = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SCA BY -1
*S** END-IF
*S** END-IF
*S** IF (WFCPS25D.WF-CP-A-SCI +
*S** WFCPS25D.WF-CP-A-SCA) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-SC = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-SC =
*S** (WFCPS25D.WF-CP-A-SCI + WFCPS25D.WF-CP-A-SCA)
*S** END-IF
*S** /*
*S** /* PC
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-P1-FC1-CONT,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-P1-FC1-CONT FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-P1-FC1-CONT TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-PC = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-PC = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-PC BY -1
*S** END-IF
*S** END-IF
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-P1-FC1-CA,1,1) TO #CNVT-BYTE
*S** RESET #CNVT-NEG
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-P1-FC1-CA FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-P1-FC1-CA TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** IF VAL(#15-BYTE-FIELD) > 9999999
*S** ASSIGN WFCPS25D.WF-CP-A-PCA = 9999999
*S** ELSE
*S** ASSIGN WFCPS25D.WF-CP-A-PCA = VAL(#15-BYTE-FIELD)
*S** END-IF
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-PCA BY -1
*S** END-IF
*S** END-IF
*S** ASSIGN WFCPS25D.WF-CP-A-PCI =
*S** WFCPS25D.WF-CP-A-PC - WFCPS25D.WF-CP-A-PCA
*S** /*
*S** RESET WFCPS25D.WF-CP-A-FISAP
*S** RESET #CNVT-NEG
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-FISAP-TOT-INC,1,1) TO #CNVT-BYTE
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-FISAP-TOT-INC FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-FISAP-TOT-INC TO #15-BYTE-FIELD
*S** EXAMINE #15-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #15-BYTE-FIELD = MASK(999999999999999)
*S** ASSIGN WFCPS25D.WF-CP-A-FISAP = VAL(#15-BYTE-FIELD)
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-FISAP BY -1
*S** END-IF
*S** END-IF
*S** /*
*S** /*
*S** RESET WFCPS25D.WF-CP-A-SAI
*S** RESET #CNVT-NEG
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-C-SAI,1,1) TO #CNVT-BYTE
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-C-SAI FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-C-SAI TO #6-BYTE-FIELD
*S** EXAMINE #6-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #6-BYTE-FIELD = MASK(999999)
*S** ASSIGN WFCPS25D.WF-CP-A-SAI = VAL(#6-BYTE-FIELD)
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SAI BY -1
*S** END-IF
*S** END-IF
*S** /*
*S** /*
*S** RESET WFCPS25D.WF-CP-A-SAI-PROV
*S** RESET #CNVT-NEG
*S** MOVE SUBSTRING(WF25FEDL.WF-FE-C-SAI-PROV,1,1) TO #CNVT-BYTE
*S** IF #CNVT-BYTE = '-'
*S** ASSIGN #CNVT-NEG = TRUE
*S** EXAMINE WF25FEDL.WF-FE-C-SAI-PROV FOR '-' DELETE
*S** END-IF
*S** MOVE RIGHT JUSTIFIED WF25FEDL.WF-FE-C-SAI-PROV TO #6-BYTE-FIELD
*S** EXAMINE #6-BYTE-FIELD FOR ' ' REPLACE WITH '0'
*S** IF #6-BYTE-FIELD = MASK(999999)
*S** ASSIGN WFCPS25D.WF-CP-A-SAI-PROV = VAL(#6-BYTE-FIELD)
*S** IF #CNVT-NEG
*S** MULTIPLY WFCPS25D.WF-CP-A-SAI-PROV BY -1
*S** END-IF
*S** END-IF
*S** /*
*S** PERFORM CALL-OBJECT-CPS
*S**END-SUBROUTINE /* LOAD-CPS
*S***
*S*************************************************************************
*S**DEFINE SUBROUTINE CALL-OBJECT-CPS
*S*************************************************************************
*S** /*
*S** /* Call the WF-CPS-xxyy object subprogram
*S** CALLNAT 'WFCPS25O' WW-GDA
*S** WFCPS25D
*S** WFCPS25D-ID
*S** WFCPS25R
*S** WWAOBJ
*S**END-SUBROUTINE /* CALL-OBJECT-CPS
*S**END
*E
|