465 lines
37 KiB
COBOL
465 lines
37 KiB
COBOL
00001 IDENTIFICATION DIVISION. 04/11/13
|
|
00002 PROGRAM-ID. DTSBU599. DTSBU599
|
|
00003 DATE-WRITTEN. 03/14/07. LV001
|
|
00004 DTSBU599
|
|
00005 ******************************************************************DTSBU599
|
|
00006 * CALLING SEQUENCE: THIS PROGRAM IS CALLED TO FORMAT A *DTSBU599
|
|
00007 * BARCODE PRINT LINE *DTSBU599
|
|
00008 * *DTSBU599
|
|
00009 ******************************************************************DTSBU599
|
|
00010 * *DTSBU599
|
|
00011 * !!!!!!!!!!! CAUTION !!!!!! CAUTION!!!! CAUTION !!!! *DTSBU599
|
|
00012 * *DTSBU599
|
|
00013 * PLEASE PAY EXTRA ATTENTION TO THE BARCODE PRINT FORMULATION *DTSBU599
|
|
00014 * *DTSBU599
|
|
00015 * THE BARCODE DATA IS FOMULATED USING CODE128. TWO BARCODE FONTS*DTSBU599
|
|
00016 * ARE USED TO PRINT THE BARCODE LINE. FONT C128CP IS USED TO *DTSBU599
|
|
00017 * PRINT CHARACTERS UP TO ASCII HEX 80,(EXCEPT 3 CHARACTERS DTSBU599
|
|
00018 * RIGHT/LEFT SQUARE BRACKET AND THE CARROT). FONT C128XP.FNT *DTSBU599
|
|
00019 * IS USED TO PRINT ALL REMAINING CHARACTERS INCLUDING THE START *DTSBU599
|
|
00020 * AND STOP CHARACTER. *DTSBU599
|
|
00021 * *DTSBU599
|
|
00022 * THE DATA CONTAINED IN THE BARCODE IS AS FOLLOWS: *DTSBU599
|
|
00023 * 1. EMPLOYER NUMBER - PIC 9(06) DTSBU599
|
|
00024 * DTSBU599
|
|
00025 * DTSBU599
|
|
00026 * DTSBU599
|
|
00027 * DTSBU599
|
|
00028 * *DTSBU599
|
|
00029 * THE BARCODE IS CALCULATED USING CODE128 SUBSETB AND SUBSETC *DTSBU599
|
|
00030 * FORMULA. SUBSETB IS USED ON ANY TYPE OF DATA. SUBSETC IS USED *DTSBU599
|
|
00031 * ON NUMERIC DATA ONLY. THE NUMERIC DATA IS PAIRED TO PRODUCE *DTSBU599
|
|
00032 * A PACKED BARCODE. A SWITCH CHARACTER IS USED TO PRINT A *DTSBU599
|
|
00033 * BARCODE LINE USING SUBSETB AND SUBSETC. THIS PROGRAM USES BOTH*DTSBU599
|
|
00034 * SUBSETS AND SWITCH CHARACTERS. *DTSBU599
|
|
00035 * *DTSBU599
|
|
00036 * FOUR SEPERATE XEROX CMES ARE USED TO PRINT THE BARCODE LINE *DTSBU599
|
|
00037 * DEPENDING UPON WHICH SUBSET AND FONTS ARE CALLED. THE CME *DTSBU599
|
|
00038 * ARE AS FOLLOWS: *DTSBU599
|
|
00039 * *DTSBU599
|
|
00040 * 1. PAYSB1 - PRINT BARCODE LINE USING SUBSETB WITH ALL DATA *DTSBU599
|
|
00041 * CONTAINED IN C128CP FONT. *DTSBU599
|
|
00042 * 2. PAYSB2 - PRINT BARCODE LINE USING SUBSETB WITH CHECK DIGIT*DTSBU599
|
|
00043 * AND DATA CONTAINED IN C128XP.FNT *DTSBU599
|
|
00044 * *DTSBU599
|
|
00045 * 3. PAYSC1 - PRINT BARCODE LINE USING SUBSETC WITH ALL DATA *DTSBU599
|
|
00046 * CONTAINED IN C128CP FONT. *DTSBU599
|
|
00047 * 4. PAYSC2 - PRINT BARCODE LINE USING SUBSETC WITH CHECK DIGIT*DTSBU599
|
|
00048 * AND DATA CONTAINED IN C128XP.FNT *DTSBU599
|
|
00049 * *DTSBU599
|
|
00050 * THIS PROGRAM USES THE SWITCH CHARACTER ANY TIME SUBSETC IS *DTSBU599
|
|
00051 * CALLED BECAUSE OF THE ALPHA NUMERIC DATA IN OUR BARCODE *DTSBU599
|
|
00052 * PRINT STREAM. *DTSBU599
|
|
00053 * *DTSBU599
|
|
00054 * THE CODE VALUE USED TO CALCULATE THE CHECK DIGIT IS STORED IN *DTSBU599
|
|
00055 * 'DOESTAX.DEVL.BARCODE.HEX.VALUE'. *DTSBU599
|
|
00056 * *DTSBU599
|
|
00057 * THE VALUE OF EACH FIELD IN THE BARCODE DATA IS STORED IN DTSBU599
|
|
00058 * 'DOESTAX.DEVL.BARCODE.HEX.CODEV'. *DTSBU599
|
|
00059 * *DTSBU599
|
|
00060 * !!!!!!!!!!! CAUTION !!!!!! CAUTION!!!! CAUTION !!!! *DTSBU599
|
|
00061 * *DTSBU599
|
|
00062 * *DTSBU599
|
|
00063 * 03/14/07 INITIAL DEVELOPMENT. *DTSBU599
|
|
00064 * REFERENCE # SPEC032. CHANGED BY: ZL1 *DTSBU599
|
|
00065 * *DTSBU599
|
|
00066 * *DTSBU599
|
|
00067 * DESCRIPTION: *DTSBU599
|
|
00068 * *DTSBU599
|
|
00069 * THIS MODULE ACCEPTS 40 BYTES OF RAW DATA AND RETURNS *DTSBU599
|
|
00070 * 50 BYTES OF BARCODED DATA *DTSBU599
|
|
00071 * *DTSBU599
|
|
00072 * *DTSBU599
|
|
00073 * PROCESSING: *DTSBU599
|
|
00074 * *DTSBU599
|
|
00075 * DETAIL: *DTSBU599
|
|
00076 * *DTSBU599
|
|
00077 * RECORDS READ: *DTSBU599
|
|
00078 * *DTSBU599
|
|
00079 * *DTSBU599
|
|
00080 * PRINTED OUTPUTS: *DTSBU599
|
|
00081 * *DTSBU599
|
|
00082 * RECORDS WRITTEN: *DTSBU599
|
|
00083 * *DTSBU599
|
|
00084 * MODULES CALLED: *DTSBU599
|
|
00085 * *DTSBU599
|
|
00086 * *DTSBU599
|
|
00087 ******************************************************************DTSBU599
|
|
00088 EJECT DTSBU599
|
|
00089 ******************************************************************DTSBU599
|
|
00090 * DATASET DESCRIPTIONS *DTSBU599
|
|
00091 ******************************************************************DTSBU599
|
|
00092 ENVIRONMENT DIVISION. DTSBU599
|
|
00093 CONFIGURATION SECTION. DTSBU599
|
|
00094 INPUT-OUTPUT SECTION. DTSBU599
|
|
00095 DTSBU599
|
|
00096 FILE-CONTROL. DTSBU599
|
|
00097 DTSBU599
|
|
00098 SELECT BARCODE-PAYORDER-FILE ASSIGN TO BARCDEF1 DTSBU599
|
|
00099 FILE STATUS IS BARCODE-FILE-STATUS. DTSBU599
|
|
00100 DTSBU599
|
|
00101 SELECT BARCODE-CHARCODE-FILE ASSIGN TO BARCDEF2 DTSBU599
|
|
00102 FILE STATUS IS BARCODE-FILE-STATUS. DTSBU599
|
|
00103 DTSBU599
|
|
00104 ******************************************************************DTSBU599
|
|
00105 * FILE DESCRIPTIONS *DTSBU599
|
|
00106 ******************************************************************DTSBU599
|
|
00107 DATA DIVISION. DTSBU599
|
|
00108 FILE SECTION. DTSBU599
|
|
00109 DTSBU599
|
|
00110 FD BARCODE-PAYORDER-FILE DTSBU599
|
|
00111 RECORDING MODE IS F DTSBU599
|
|
00112 RECORD CONTAINS 150 CHARACTERS. DTSBU599
|
|
00113 DTSBU599
|
|
00114 01 BARCODE-PAYORDER-RECORD PIC X(150). DTSBU599
|
|
00115 DTSBU599
|
|
00116 DTSBU599
|
|
00117 FD BARCODE-CHARCODE-FILE DTSBU599
|
|
00118 RECORDING MODE IS F DTSBU599
|
|
00119 RECORD CONTAINS 460 CHARACTERS. DTSBU599
|
|
00120 DTSBU599
|
|
00121 01 BARCODE-VALUES-RECORD PIC X(460). DTSBU599
|
|
00122 DTSBU599
|
|
00123 ******************************************************************DTSBU599
|
|
00124 * WORKING STORAGE SECTION *DTSBU599
|
|
00125 ******************************************************************DTSBU599
|
|
00126 WORKING-STORAGE SECTION. DTSBU599
|
|
001265 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU599 04/11/13'. DTSBU599
|
|
00127 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU599 04/11/13'. DTSBU599
|
|
00128 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU599 03/21/07'. DTSBU599
|
|
00129 DTSBU599
|
|
00130 01 WS-PROGRAM-CONSTANTS. DTSBU599
|
|
00131 05 PRINT-BARSETC-FONT2 PIC 9(1) VALUE ZEROS. DTSBU599
|
|
00132 05 PRINT-BARSETB-FONT2 PIC 9(1) VALUE ZEROS. DTSBU599
|
|
00133 05 CHAR-NOT-CONVERTED PIC 9(1) VALUE ZEROS. DTSBU599
|
|
00134 05 WS-QUOTE PIC X(1) VALUE QUOTE. DTSBU599
|
|
00135 05 BARCODE-SSN-TOTAL PIC 9(9) VALUE ZEROS. DTSBU599
|
|
00136 05 BARCODE-BWE-TOTAL PIC 9(9) VALUE ZEROS. DTSBU599
|
|
00137 05 TOTAL-BARCODE-VALUE PIC 9(9) VALUE ZEROS. DTSBU599
|
|
00138 05 DIVIDE-BARCODE-VALUE PIC 9(6) VALUE ZEROS. DTSBU599
|
|
00139 05 REMAINDER-BARCODE-VALUE PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00140 05 BARSETB-CHAR-FOUND PIC 9(1) VALUE ZEROS. DTSBU599
|
|
00141 05 BARCODE-CHAR-FOUND PIC 9(1) VALUE ZEROS. DTSBU599
|
|
00142 05 BARCODE-CHAR-INDEX PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00143 05 BARCODE-MULTIPLIER PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00144 05 BARCODE-NAME-TOTAL PIC 9(6) VALUE ZEROS. DTSBU599
|
|
00145 05 BARCODE-NAME-VALUE PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00146 05 CHECK-BARCODE-VALUE PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00147 05 BARCODE-SETB-INDEX PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00148 05 BARCODE-SETB-ONDEX PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00149 05 BARCODE-VALUE-INDEX PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00150 05 BARCODE-NAME-INDEX PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00151 05 BARCODE-SETB-VALUE PIC 9(5) VALUE ZEROS. DTSBU599
|
|
00152 05 BARCODE-SSN-INDEX PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00153 05 BARCODE-BWE-INDEX PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00154 05 BARSETC-SSN-INDEX PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00155 05 BARSETC-BWE-INDEX PIC 9(3) VALUE ZEROS. DTSBU599
|
|
00156 DTSBU599
|
|
00157 * THIS FILE CONTAINS ALL VALID CHARACTERS ACCEPTED BY THE BARCODEDTSBU599
|
|
00158 * FONTS ACCORDING TO THEIR ASCII DATA VALUE AND POSITION. DO NOT DTSBU599
|
|
00159 * CHANGE THIS FILE. THIS FILE IS USED TO CALCULATE THE CHARACTERDTSBU599
|
|
00160 * POSITION VALUE IN DETERMINING THE BARCODE CHECK DIGIT. IF THIS DTSBU599
|
|
00161 * FILE IS MODIFIED THE BARCODE SCANNER WILL NOT WORK. THIS FILE DTSBU599
|
|
00162 * CAN ONLY CHANGE IF THE FONTS CHARACTERS ARE BEING REMAPPED TO DTSBU599
|
|
00163 * A NEW ASCII VALUE !!!!!!!!!. DTSBU599
|
|
00164 DTSBU599
|
|
00165 01 WS-BARCODE-HEX-VALUES. DTSBU599
|
|
00166 05 BARCODE-HEX-INPUT-VALUES OCCURS 150 TIMES. DTSBU599
|
|
00167 10 BARCODE-HEX-VALUE PIC X(01). DTSBU599
|
|
00168 DTSBU599
|
|
00169 DTSBU599
|
|
00170 * THIS FILE CONTAINS ALL VALID CHARACTERS ACCEPTED BY THE BARCODEDTSBU599
|
|
00171 * FONTS ACCORDING TO THEIR ASCII DATA VALUE AND POSITION. DO NOT DTSBU599
|
|
00172 * CHANGE THIS FILE. THIS FILE IS USED TO CALCULATE THE CHARACTERDTSBU599
|
|
00173 * ASCII VALUE BASED ON POSITION IN THE DATA STREAM.***** IF THIS DTSBU599
|
|
00174 * FILE IS MODIFIED THE BARCODE SCANNER WILL NOT WORK. THIS FILE DTSBU599
|
|
00175 * CAN ONLY CHANGE IF THE FONTS CHARACTERS ARE BEING REMAPPED TO DTSBU599
|
|
00176 * A NEW ASCII VALUE !!!!!!!!!. DTSBU599
|
|
00177 DTSBU599
|
|
00178 01 WS-BARCODE-CHARCODE-VALUES. DTSBU599
|
|
00179 05 BARCODE-CHARCODE-VALUES OCCURS 115 TIMES. DTSBU599
|
|
00180 10 BARCODE-CHAR-VALUE PIC X(01). DTSBU599
|
|
00181 10 BARCODE-CODE-VALUE PIC X(03). DTSBU599
|
|
00182 DTSBU599
|
|
00183 ******************************************************************DTSBU599
|
|
00184 * PAYODR-BARCODE-LINE IS USED TO CALCULATE THE BARCODE FORMULA FORDTSBU599
|
|
00185 * BOTH TYPE OF CODE128 DATA STREAM. HOWEVER ONLY SUBSETB PRINT DTSBU599
|
|
00186 * STREAM IS PRINTED FROM THIS LINE. DTSBU599
|
|
00187 * DTSBU599
|
|
00188 ******************************************************************DTSBU599
|
|
00189 DTSBU599
|
|
00190 01 WS-BARCODE-IN-DATA. DTSBU599
|
|
00191 05 WS-BARCODE-DATA-IN PIC X(40). DTSBU599
|
|
00192 05 WS-BARCODE-DATA-INX REDEFINES DTSBU599
|
|
00193 WS-BARCODE-DATA-IN. DTSBU599
|
|
00194 10 WS-INPUT-DATA OCCURS 40 TIMES PIC X. DTSBU599
|
|
00195 DTSBU599
|
|
00196 DTSBU599
|
|
00197 01 WS-BARCODE-OUT-DATA. DTSBU599
|
|
00198 05 WS-BARCODE-DATA-OUT PIC X(50). DTSBU599
|
|
00199 05 WS-BARCODE-DATA-OUTX REDEFINES DTSBU599
|
|
00200 WS-BARCODE-DATA-OUT. DTSBU599
|
|
00201 10 WS-OUTPUT-DATA OCCURS 50 TIMES PIC X. DTSBU599
|
|
00202 DTSBU599
|
|
00203 DTSBU599
|
|
00204 01 WS-PROGRAM-VARIABLES. DTSBU599
|
|
00205 05 WS-ABEND-CODE PIC S9(4) COMP. DTSBU599
|
|
00206 DTSBU599
|
|
00207 05 PAYORDER-FILE-STATUS PIC X(2). DTSBU599
|
|
00208 88 PAYORDER-FILE-OK VALUE ZERO. DTSBU599
|
|
00209 DTSBU599
|
|
00210 05 BARCODE-FILE-STATUS PIC X(2). DTSBU599
|
|
00211 88 BARCODE-FILE-OK VALUE ZERO. DTSBU599
|
|
00212 DTSBU599
|
|
00213 ******************************************************************DTSBU599
|
|
00214 * LINKAGE SECTION *DTSBU599
|
|
00215 ******************************************************************DTSBU599
|
|
00216 LINKAGE SECTION. DTSBU599
|
|
00217 01 BARIL599-LINK-AREA. DTSBU599
|
|
00218 ++INCLUDE BARIL599 DTSBU599
|
|
00219 ******************************************************************DTSBU599
|
|
00220 * *DTSBU599
|
|
00221 ******************************************************************DTSBU599
|
|
00222 PROCEDURE DIVISION USING DTSBU599
|
|
00223 BARIL599-LINK-AREA. DTSBU599
|
|
00224 DTSBU599
|
|
00225 PROC0000-MAIN. DTSBU599
|
|
00226 PERFORM INIT0000-INITILIZE THRU INIT0000-EXIT DTSBU599
|
|
00227 DTSBU599
|
|
00228 IF L599-DATA-CONVERTED = 1 DTSBU599
|
|
00229 DISPLAY ' BARCODE DATA PASSED IS NOT VALIED ' DTSBU599
|
|
00230 ELSE DTSBU599
|
|
00231 PERFORM PROC1000-GENERATE-BARCODE THRU PROC1000-EXIT DTSBU599
|
|
00232 PERFORM TERM000-TERMINATE THRU TERM000-EXIT. DTSBU599
|
|
00233 DTSBU599
|
|
00234 PROC0000-EXIT. DTSBU599
|
|
00235 GOBACK. DTSBU599
|
|
00236 DTSBU599
|
|
00237 INIT0000-INITILIZE. DTSBU599
|
|
00238 DTSBU599
|
|
00239 MOVE 0 TO L599-DATA-CONVERTED. DTSBU599
|
|
00240 DTSBU599
|
|
00241 PERFORM SERV1400-OPEN-BARCODE-PAYORDER THRU SERV1400-EXIT. DTSBU599
|
|
00242 DTSBU599
|
|
00243 PERFORM SERV1500-OPEN-BARCODE-CHARCODE THRU SERV1500-EXIT. DTSBU599
|
|
00244 DTSBU599
|
|
00245 IF L599-REC-LENGTH < 5 OR DTSBU599
|
|
00246 L599-REC-LENGTH > 40 DTSBU599
|
|
00247 MOVE 1 TO L599-DATA-CONVERTED DTSBU599
|
|
00248 DISPLAY ' BARCODE DATA LENGTH IS NOT CORRECT'. DTSBU599
|
|
00249 DTSBU599
|
|
00250 IF L599-INPUT-DATA = SPACES DTSBU599
|
|
00251 MOVE 1 TO L599-DATA-CONVERTED DTSBU599
|
|
00252 DISPLAY ' INPUT DATA IS ALL SPACES !!!!!!!!'. DTSBU599
|
|
00253 DTSBU599
|
|
00254 INIT0000-EXIT. DTSBU599
|
|
00255 EXIT. DTSBU599
|
|
00256 DTSBU599
|
|
00257 PROC1000-GENERATE-BARCODE. DTSBU599
|
|
00258 DTSBU599
|
|
00259 MOVE L599-INPUT-DATA TO WS-BARCODE-DATA-IN. DTSBU599
|
|
00260 DTSBU599
|
|
00261 DTSBU599
|
|
00262 ******************************************************************DTSBU599
|
|
00263 * THE BARCODE ROUTINE MUST BE PERFORMED FIRST TO DETERMINE WHICH DTSBU599
|
|
00264 * XEROX CME PRINT LINE TO CALL WHEN PRINTING THE PAY ORDER FORM. DTSBU599
|
|
00265 * THE MODIFY COMMAND, MODIFIES THE XEROX JDE TO INSERT THE PROPER DTSBU599
|
|
00266 * CME COMMAND. DTSBU599
|
|
00267 ******************************************************************DTSBU599
|
|
00268 DTSBU599
|
|
00269 MOVE ZEROS TO PRINT-BARSETB-FONT2 DTSBU599
|
|
00270 PRINT-BARSETC-FONT2 DTSBU599
|
|
00271 CHAR-NOT-CONVERTED DTSBU599
|
|
00272 TOTAL-BARCODE-VALUE DTSBU599
|
|
00273 BARCODE-SSN-TOTAL DTSBU599
|
|
00274 BARCODE-BWE-TOTAL DTSBU599
|
|
00275 BARCODE-NAME-TOTAL DTSBU599
|
|
00276 BARCODE-VALUE-INDEX. DTSBU599
|
|
00277 DTSBU599
|
|
00278 DTSBU599
|
|
00279 PERFORM PROC1600-BARSETB THRU PROC1600-EXIT. DTSBU599
|
|
00280 DTSBU599
|
|
00281 PROC1000-EXIT. DTSBU599
|
|
00282 EXIT. DTSBU599
|
|
00283 DTSBU599
|
|
00284 PROC1600-BARSETB. DTSBU599
|
|
00285 DTSBU599
|
|
00286 ***************************************************************** DTSBU599
|
|
00287 * THIS ROUTINE WILL BE CALLED TO FORMULATE A SUBSETB TYPE BARCODE DTSBU599
|
|
00288 * WHENEVER THE DATA STREAM CONTAINS DATA THAT CANNOT BE USED IN DTSBU599
|
|
00289 * CONJUNCTION WITH SUBSETC. DTSBU599
|
|
00290 ***************************************************************** DTSBU599
|
|
00291 DTSBU599
|
|
00292 MOVE ZEROS TO TOTAL-BARCODE-VALUE DTSBU599
|
|
00293 BARCODE-NAME-TOTAL DTSBU599
|
|
00294 BARCODE-VALUE-INDEX DTSBU599
|
|
00295 PRINT-BARSETB-FONT2 DTSBU599
|
|
00296 BARSETB-CHAR-FOUND. DTSBU599
|
|
00297 DTSBU599
|
|
00298 MOVE SPACES TO WS-BARCODE-OUT-DATA. DTSBU599
|
|
00299 DTSBU599
|
|
00300 ***************************************************************** DTSBU599
|
|
00301 * SET UP SPECIAL CONTROL CHARACTERS FOR PRINTING BARCODE USING DTSBU599
|
|
00302 * SUBSETB DTSBU599
|
|
00303 ***************************************************************** DTSBU599
|
|
00304 DTSBU599
|
|
00305 MOVE 1 TO BARCODE-SETB-ONDEX. DTSBU599
|
|
00306 DTSBU599
|
|
00307 MOVE '*' TO WS-OUTPUT-DATA (BARCODE-SETB-ONDEX) DTSBU599
|
|
00308 DTSBU599
|
|
00309 MOVE 104 TO TOTAL-BARCODE-VALUE. DTSBU599
|
|
00310 DTSBU599
|
|
00311 PERFORM PROC1675-BARSETB-CHARCODE THRU PROC1675-EXIT DTSBU599
|
|
00312 VARYING BARCODE-SETB-INDEX FROM 1 BY 1 UNTIL DTSBU599
|
|
00313 BARCODE-SETB-INDEX GREATER L599-REC-LENGTH. DTSBU599
|
|
00314 DTSBU599
|
|
00315 * DISPLAY 'TOT ' TOTAL-BARCODE-VALUE. DTSBU599
|
|
00316 DTSBU599
|
|
00317 DIVIDE 103 INTO TOTAL-BARCODE-VALUE GIVING DTSBU599
|
|
00318 DIVIDE-BARCODE-VALUE. DTSBU599
|
|
00319 DTSBU599
|
|
00320 * DISPLAY 'DIV ' DIVIDE-BARCODE-VALUE. DTSBU599
|
|
00321 DTSBU599
|
|
00322 COMPUTE REMAINDER-BARCODE-VALUE = DTSBU599
|
|
00323 DIVIDE-BARCODE-VALUE * 103. DTSBU599
|
|
00324 DTSBU599
|
|
00325 * DISPLAY 'REM ' REMAINDER-BARCODE-VALUE. DTSBU599
|
|
00326 DTSBU599
|
|
00327 COMPUTE CHECK-BARCODE-VALUE = DTSBU599
|
|
00328 TOTAL-BARCODE-VALUE - REMAINDER-BARCODE-VALUE. DTSBU599
|
|
00329 DTSBU599
|
|
00330 * DISPLAY 'CHKV ' CHECK-BARCODE-VALUE. DTSBU599
|
|
00331 DTSBU599
|
|
00332 ADD 1 TO BARCODE-SETB-ONDEX. DTSBU599
|
|
00333 DTSBU599
|
|
00334 IF CHECK-BARCODE-VALUE = ZEROS DTSBU599
|
|
00335 MOVE SPACES TO WS-OUTPUT-DATA (BARCODE-SETB-ONDEX) DTSBU599
|
|
00336 ELSE DTSBU599
|
|
00337 MOVE BARCODE-HEX-VALUE(CHECK-BARCODE-VALUE) DTSBU599
|
|
00338 TO WS-OUTPUT-DATA (BARCODE-SETB-ONDEX). DTSBU599
|
|
00339 DTSBU599
|
|
00340 * DISPLAY 'HEXV ' BARCODE-HEX-VALUE(CHECK-BARCODE-VALUE). DTSBU599
|
|
00341 DTSBU599
|
|
00342 * IF CHECK-BARCODE-VALUE = 91 OR 92 OR 93 OR 94 DTSBU599
|
|
00343 * MOVE 'B3' TO L599-FONT-FORMAT-USED DTSBU599
|
|
00344 * ELSE DTSBU599
|
|
00345 IF CHECK-BARCODE-VALUE = 59 OR 61 OR 62 OR > 90 DTSBU599
|
|
00346 MOVE 'B2' TO L599-FONT-FORMAT-USED DTSBU599
|
|
00347 ELSE DTSBU599
|
|
00348 MOVE 'B1' TO L599-FONT-FORMAT-USED. DTSBU599
|
|
00349 DTSBU599
|
|
00350 ADD 1 TO BARCODE-SETB-ONDEX. DTSBU599
|
|
00351 DTSBU599
|
|
00352 MOVE ',' TO WS-OUTPUT-DATA (BARCODE-SETB-ONDEX) DTSBU599
|
|
00353 DTSBU599
|
|
00354 * DISPLAY 'DOUT ' WS-BARCODE-OUT-DATA. DTSBU599
|
|
00355 MOVE WS-BARCODE-OUT-DATA TO L599-BARCODED-DATA. DTSBU599
|
|
00356 DTSBU599
|
|
00357 PROC1600-EXIT. DTSBU599
|
|
00358 EXIT. DTSBU599
|
|
00359 DTSBU599
|
|
00360 PROC1675-BARSETB-CHARCODE. DTSBU599
|
|
00361 DTSBU599
|
|
00362 DTSBU599
|
|
00363 PERFORM PROC1680-BARSETB-CODE-VALUE THRU PROC1680-EXIT DTSBU599
|
|
00364 VARYING BARCODE-CHAR-INDEX FROM 1 BY 1 UNTIL DTSBU599
|
|
00365 BARCODE-CHAR-INDEX GREATER THAN 106. DTSBU599
|
|
00366 DTSBU599
|
|
00367 IF BARSETB-CHAR-FOUND = ZEROS DTSBU599
|
|
00368 DISPLAY '!!!! INVALID CHAR IN BARSETB !!!!' DTSBU599
|
|
00369 DISPLAY 'DATA ' WS-BARCODE-IN-DATA DTSBU599
|
|
00370 PERFORM SERV2100-ABEND-PGM THRU SERV2100-EXIT. DTSBU599
|
|
00371 DTSBU599
|
|
00372 ADD 1 TO BARCODE-SETB-ONDEX. DTSBU599
|
|
00373 DTSBU599
|
|
00374 MOVE WS-INPUT-DATA (BARCODE-SETB-INDEX) TO DTSBU599
|
|
00375 WS-OUTPUT-DATA (BARCODE-SETB-ONDEX). DTSBU599
|
|
00376 DTSBU599
|
|
00377 COMPUTE BARCODE-SETB-VALUE = DTSBU599
|
|
00378 BARCODE-SETB-VALUE * BARCODE-SETB-INDEX. DTSBU599
|
|
00379 DTSBU599
|
|
00380 COMPUTE TOTAL-BARCODE-VALUE = DTSBU599
|
|
00381 TOTAL-BARCODE-VALUE + BARCODE-SETB-VALUE. DTSBU599
|
|
00382 DTSBU599
|
|
00383 PROC1675-EXIT. DTSBU599
|
|
00384 EXIT. DTSBU599
|
|
00385 DTSBU599
|
|
00386 PROC1680-BARSETB-CODE-VALUE. DTSBU599
|
|
00387 DTSBU599
|
|
00388 IF WS-INPUT-DATA (BARCODE-SETB-INDEX) = DTSBU599
|
|
00389 BARCODE-CHAR-VALUE (BARCODE-CHAR-INDEX) DTSBU599
|
|
00390 MOVE BARCODE-CODE-VALUE (BARCODE-CHAR-INDEX) DTSBU599
|
|
00391 TO BARCODE-SETB-VALUE DTSBU599
|
|
00392 MOVE 1 TO BARSETB-CHAR-FOUND DTSBU599
|
|
00393 MOVE 107 TO BARCODE-CHAR-INDEX. DTSBU599
|
|
00394 DTSBU599
|
|
00395 PROC1680-EXIT. DTSBU599
|
|
00396 EXIT. DTSBU599
|
|
00397 DTSBU599
|
|
00398 DTSBU599
|
|
00399 DTSBU599
|
|
00400 SERV1400-OPEN-BARCODE-PAYORDER. DTSBU599
|
|
00401 DTSBU599
|
|
00402 OPEN INPUT BARCODE-PAYORDER-FILE. DTSBU599
|
|
00403 DTSBU599
|
|
00404 IF NOT BARCODE-FILE-OK DTSBU599
|
|
00405 DISPLAY SPACE DTSBU599
|
|
00406 DISPLAY 'BARCDEF1 - BARCODE HEX FILE ERROR' DTSBU599
|
|
00407 DISPLAY 'BARCDEF1 - RETURN OPEN: ' BARCODE-FILE-STATUS DTSBU599
|
|
00408 MOVE 90 TO WS-ABEND-CODE DTSBU599
|
|
00409 CALL 'ILBOABN0' USING WS-ABEND-CODE. DTSBU599
|
|
00410 DTSBU599
|
|
00411 READ BARCODE-PAYORDER-FILE INTO WS-BARCODE-HEX-VALUES. DTSBU599
|
|
00412 DTSBU599
|
|
00413 IF NOT BARCODE-FILE-OK DTSBU599
|
|
00414 DISPLAY SPACE DTSBU599
|
|
00415 DISPLAY 'BARCDEF1 - BARCODE HEX FILE ERROR' DTSBU599
|
|
00416 DISPLAY 'BARCDEF1 - RETURN READ: ' BARCODE-FILE-STATUS DTSBU599
|
|
00417 MOVE 90 TO WS-ABEND-CODE DTSBU599
|
|
00418 CALL 'ILBOABN0' USING WS-ABEND-CODE. DTSBU599
|
|
00419 SERV1400-EXIT. DTSBU599
|
|
00420 EXIT. DTSBU599
|
|
00421 DTSBU599
|
|
00422 SERV1500-OPEN-BARCODE-CHARCODE. DTSBU599
|
|
00423 DTSBU599
|
|
00424 OPEN INPUT BARCODE-CHARCODE-FILE. DTSBU599
|
|
00425 DTSBU599
|
|
00426 IF NOT BARCODE-FILE-OK DTSBU599
|
|
00427 DISPLAY SPACE DTSBU599
|
|
00428 DISPLAY 'BARCDEF2 - BARCODE CHAR FILE ERROR' DTSBU599
|
|
00429 DISPLAY 'BARCDEF2 - RETURN OPEN: ' BARCODE-FILE-STATUS DTSBU599
|
|
00430 MOVE 90 TO WS-ABEND-CODE DTSBU599
|
|
00431 CALL 'ILBOABN0' USING WS-ABEND-CODE. DTSBU599
|
|
00432 DTSBU599
|
|
00433 READ BARCODE-CHARCODE-FILE INTO WS-BARCODE-CHARCODE-VALUES. DTSBU599
|
|
00434 DTSBU599
|
|
00435 IF NOT BARCODE-FILE-OK DTSBU599
|
|
00436 DISPLAY SPACE DTSBU599
|
|
00437 DISPLAY 'BARCDEF2 - BARCODE CHAR FILE ERROR' DTSBU599
|
|
00438 DISPLAY 'BARCDEF2 - RETURN READ: ' BARCODE-FILE-STATUS DTSBU599
|
|
00439 MOVE 90 TO WS-ABEND-CODE DTSBU599
|
|
00440 CALL 'ILBOABN0' USING WS-ABEND-CODE. DTSBU599
|
|
00441 SERV1500-EXIT. DTSBU599
|
|
00442 EXIT. DTSBU599
|
|
00443 DTSBU599
|
|
00444 DTSBU599
|
|
00445 SERV2100-ABEND-PGM. DTSBU599
|
|
00446 DTSBU599
|
|
00447 DISPLAY SPACE. DTSBU599
|
|
00448 DISPLAY 'BARCDE01 - PROGRAM ABENDED INVALID DATA '. DTSBU599
|
|
00449 MOVE 99 TO WS-ABEND-CODE. DTSBU599
|
|
00450 CALL 'ILBOABN0' USING WS-ABEND-CODE. DTSBU599
|
|
00451 DTSBU599
|
|
00452 SERV2100-EXIT. DTSBU599
|
|
00453 EXIT. DTSBU599
|
|
00454 DTSBU599
|
|
00455 TERM000-TERMINATE. DTSBU599
|
|
00456 DTSBU599
|
|
00457 DTSBU599
|
|
00458 CLOSE BARCODE-PAYORDER-FILE. DTSBU599
|
|
00459 CLOSE BARCODE-CHARCODE-FILE. DTSBU599
|
|
00460 DTSBU599
|
|
00461 TERM000-EXIT. DTSBU599
|
|
00462 EXIT. DTSBU599
|
|
00463 DTSBU599
|