524 lines
27 KiB
Plaintext
524 lines
27 KiB
Plaintext
F**********************************************************************************************
|
|
F* AUTHOR: Wes Ray
|
|
F*
|
|
F* This program is called by __________ when the user presses F10 to run the report. The input
|
|
F* file BATCH is a physical file in QTEMP that is created/cleared each time __________ is run.
|
|
F* BATCH will contain two kinds of records:
|
|
F*
|
|
F* 'PATTERN_NAME ' 'COL#' 'YARDS'
|
|
F* OR
|
|
F* 'USER_MESSAGE ' '50 character message to be printed at top of report'
|
|
F*
|
|
F* In the interactive program there is a screen that allows the user to enter notes (up 50 char
|
|
F* each) that will appear at the top of the report. Using a special string in the pattern field
|
|
F* allows us to identify that the rest of the record is a user message. This allows the user to
|
|
F* enter as many as they would like. The program first reads though the entire BATCH file and
|
|
F* prints all USER_MESSAGEs to the top of the report, SETLL is called to reposition the file
|
|
F* back to the begining and the file is then processed again for the SKUs entered.
|
|
F*
|
|
F* 12/23/13 - I'm an idiot. All I needed to do to sort by more than one field was overlay a
|
|
F* larger field overtop of the type and color and sort by that. Of course this only
|
|
F* works if the composite key you want to sort by resides in contiguous space.
|
|
F* At any rate, the warp and fill lists on this report are now sorted by type AND
|
|
F* then color which makes them much easier to use when the lists get long.
|
|
F* 01-15-14 nw-01 call program to check delivery & collection (#1299)
|
|
F* 01/21/14 WR-01 Add finish description to SKU detail page. (#1310)
|
|
F**********************************************************************************************
|
|
FQPRINT O F 132 PRINTER OFLIND(*INOF) INFDS(PRTFBK)
|
|
FFILE1 IF E K DISK WR-01
|
|
FFILE2 IF E K DISK WR-01
|
|
FBATCH IF F 65 DISK
|
|
F**********************************************************************************************
|
|
D* Named Constants
|
|
D**********************************************************************************************
|
|
D Title C '**REDACTED**'
|
|
D Title1 C 'Yarn Projection Report'
|
|
D PGM C 'PGM: REDACTED'
|
|
D*linesPerPg C CONST(64)
|
|
D**********************************************************************************************
|
|
D* Variables
|
|
D**********************************************************************************************
|
|
D sysDate S D DATFMT(*USA) INZ(*sys)
|
|
D sysTime S T TIMFMT(*USA) INZ(*sys)
|
|
D yardsInt S 5 0 INZ(0)
|
|
D count S 3 0 INZ(0)
|
|
D linesNeeded S 2 0 INZ(0)
|
|
D goToNewPage S 1 INZ('N')
|
|
D i S 4 0 INZ(1) index for lists
|
|
D j S 3 0 INZ(1) index for fills
|
|
D wrpInLst S 1A INZ('N')
|
|
D fllInLst S LIKE(wrpInLst)
|
|
D grandTotPicks S +2 LIKE(totalPicks)
|
|
D grandTotDays S LIKE(daysToWeave)
|
|
D lastFillPrnt S 6A
|
|
D finishPrint S 27A WR-01
|
|
D delv1 S 3A INZ('8wk') nw-01
|
|
D delv2 S 6A INZ('8-10wk') nw-01
|
|
D delv3 S 7A INZ('10-12wk') nw-01
|
|
D delvPrnt S 7A nw-01
|
|
D**********************************************************************************************
|
|
D projection DS
|
|
D errorMsg 1 14
|
|
D style1 15 18
|
|
D style2 19 23 0
|
|
D patternNum 24 28 0
|
|
D totalPicks 29 38 0
|
|
D piecePicks 39 44 0
|
|
D daysToWeave 45 50 2
|
|
D warpYarn 51 56
|
|
D warpColor 55 76
|
|
D WARP 51 76
|
|
D fillType 77 148
|
|
D fillTypes 6A OVERLAY(fillType) DIM(12)
|
|
D fillColor 149 388
|
|
D fillColors 20A OVERLAY(fillColor) DIM(12)
|
|
D fillNeed 389 448
|
|
D fillNeeded 5 0 OVERLAY(fillNeed) DIM(12)
|
|
D fillOnHnd 449 508
|
|
D fillOnHand 5 0 OVERLAY(fillOnHnd) DIM(12)
|
|
D fillReq 509 568
|
|
D fillReqd 5 0 OVERLAY(fillReq) DIM(12)
|
|
D fillBalan 569 628
|
|
D fillBalanc 5 0 OVERLAY(fillBalan) DIM(12)
|
|
D fillDelCd 629 640
|
|
D fillDelCod 1 OVERLAY(fillDelCd) DIM(12)
|
|
D DERP1 641 644
|
|
D DERP2 646 649
|
|
D warpStyle 641 649
|
|
D**********************************************************************************************
|
|
D delv_coll DS nw-01
|
|
D #8week 1 1 nw-01
|
|
D #8to10 2 2 nw-01
|
|
D #10to12 3 3 nw-01
|
|
D #collection 4 7 nw-01
|
|
D**********************************************************************************************
|
|
D* Printer file information data structure
|
|
D**********************************************************************************************
|
|
D PRTFBK DS
|
|
D CUR_LINE 367 368I 0 * Current line num
|
|
D**********************************************************************************************
|
|
D* Data structure for printing warp information because wrpLstDS(i).wrpTypeDS is a little long
|
|
D* for the O-specs ;)
|
|
D**********************************************************************************************
|
|
D pWARP DS
|
|
D pWrpType 1 9A
|
|
D pWrpCol 10 29A
|
|
D pWrpYds 30 34 0
|
|
D**********************************************************************************************
|
|
D* Data structure for printing fill information because fllLstDS(i).fllTypeDS is a little long
|
|
D* for the O-specs ;)
|
|
D**********************************************************************************************
|
|
D pFILL DS
|
|
D pFllType 1 6A
|
|
D pFllCol 7 26A
|
|
D pFllLbs 27 32 0
|
|
D pllOHnDS 33 37 0
|
|
D pllReqDS 38 42 0
|
|
D pllBalDS 43 47 0
|
|
D**********************************************************************************************
|
|
D* Basically an ILE equivalent to a multiple occurence data structure. This is serves as a list
|
|
D* of unnique warps required by all of the SKUs entered. So, if 7 of the SKUs require A-1600
|
|
D* BLACK warps it will only occur in this list once but with the total yardage of the 7 SKUs
|
|
D*
|
|
D* QUALIFIED is required for data structures with the DIM keyword. QUALIFIED allows you to
|
|
D* access the subfields like this: wrpLstDS(i).wrpTypeDS where i is the "occurence" and the
|
|
D* name after the dot is the sub field you wish to access.
|
|
D**********************************************************************************************
|
|
D wrpLstDS DS DIM(100) QUALIFIED
|
|
D wrpTypeDS 1 9A
|
|
D wrpColDS 10 29A
|
|
D wrpTyClDS 1 29A * Used to sort array
|
|
D wrpYdsDS 30 34 0
|
|
D**********************************************************************************************
|
|
D fllLstDs DS DIM(1200) QUALIFIED
|
|
D fllTypeDS 1 6A
|
|
D fllColDS 7 26A
|
|
D fllTyClDS 1 26A * Used to sort array
|
|
D fllLbsDS 27 32 0
|
|
D fllOHnDS 33 37 0
|
|
D fllReqDS 38 42 0
|
|
D fllBalDS 43 47 0
|
|
D**********************************************************************************************
|
|
D getProjection PR ExtPgm('______')
|
|
D Parm1 LIKE(PATT)
|
|
D Parm2 LIKE(COLO)
|
|
D Parm3 LIKE(YARD)
|
|
D Parm4 LIKE(projection)
|
|
D**********************************************************************************************
|
|
D getDelv_Coll PR ExtPgm('________') nw-01
|
|
D Parm1 LIKE(PATT) nw-01
|
|
D Parm2 LIKE(delv_coll) nw-01
|
|
D**********************************************************************************************
|
|
IBATCH NS
|
|
I 1 15 PATT
|
|
I 16 19 COLO
|
|
I 20 24 YARD
|
|
I 16 65 userMsg
|
|
C**********************************************************************************************
|
|
C* M A I N L I N E P R O C E S S I N G
|
|
C**********************************************************************************************
|
|
/free
|
|
EXCEPT HEADER; //Write report heading
|
|
EXSR writeUsrMsg;
|
|
EXCEPT detailHead; //Write detail column headers
|
|
READ BATCH; //Priming read
|
|
|
|
DOW NOT (%EOF(BATCH));
|
|
IF NOT (PATT = 'USER_MESSAGE ');
|
|
count += 1; //Count number of SKUs processed
|
|
|
|
CALLP getProjection(PATT:COLO:YARD:projection); //Get projection info
|
|
|
|
yardsInt = %DEC(YARD:5:0); //Cast YARDS to an int for formatting on report
|
|
grandTotPicks += totalPicks; //accumulate picks
|
|
grandTotDays += daysToWeave; //accumulate days
|
|
|
|
CALLP getDelv_Coll(PATT:delv_coll); //Get delivery & collection info
|
|
EXSR CHKDELVCOLL;
|
|
|
|
CHAIN PATT PATMAST; //Look up pattern to get finish key WR-01
|
|
IF %FOUND(PATMAST); |
|
|
CHAIN PFNHKY FINISHP; //Look up finish description w/ finish key |
|
|
IF %FOUND(FINISHP); |
|
|
finishPrint = FNHDES; //Print finish description on first page |
|
|
ENDIF; |
|
|
ENDIF; WR-01
|
|
|
|
EXSR CHKOVERFLOW;
|
|
EXCEPT detail; //Write sku detail line
|
|
|
|
EXSR processWarp; //Add this SKUs warp to the warp list
|
|
EXSR processFill; //Add this SKUs fill to the fill list
|
|
|
|
projection = *BLANKS; //Explicitly clear these variables just in case
|
|
delv_coll = *BLANKS;
|
|
finishPrint = *BLANKS;
|
|
ENDIF;
|
|
READ BATCH; //grab next sku from batch input file
|
|
ENDDO;
|
|
|
|
EXCEPT detailFoot; //write sku detail footer. total days to weave etc..
|
|
|
|
EXCEPT NEWPAGE;
|
|
EXCEPT HEADER; //go to new page
|
|
|
|
EXSR writeWarps; //write warp information
|
|
|
|
EXCEPT NEWPAGE;
|
|
EXCEPT HEADER; //go to new page
|
|
|
|
EXSR writeFill; //write fill information
|
|
|
|
//Tidy up any open resources and exit.
|
|
*INLR = *ON;
|
|
RETURN;
|
|
/end-free
|
|
C**********************************************************************************************
|
|
C* E N D M A I N L I N E P R O C E S S I N G
|
|
C**********************************************************************************************
|
|
C* CHKDELVCOLL - Sub-routine to check delivery codes
|
|
C**********************************************************************************************
|
|
C CHKDELVCOLL BEGSR nw-01
|
|
/free
|
|
IF #8week = '*';
|
|
delvPrnt = delv1;
|
|
ENDIF;
|
|
IF #8to10 = '*';
|
|
delvPrnt = delv2;
|
|
ENDIF;
|
|
IF #10to12 = '*';
|
|
delvPrnt = delv3;
|
|
ENDIF;
|
|
/end-free
|
|
C ENDSR nw-01
|
|
C**********************************************************************************************
|
|
C* CHKOVERFLOW - Sub-routine to print report header during page overflow
|
|
C**********************************************************************************************
|
|
C CHKOVERFLOW BEGSR
|
|
/free
|
|
IF *INOF = *ON;
|
|
EXCEPT Header;
|
|
*INOF = *OFF;
|
|
ENDIF;
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* warpInList - Sub-routine that loops throught the wrpLstDS data structure array to see if
|
|
C* the warp from the last processed SKU is already on the list. If it is the
|
|
C* yardage from the the last processed SKU is added to what is already in the list
|
|
C* Otherwise wrpInLst remains 'N' causing addWarp to be executed.
|
|
C**********************************************************************************************
|
|
C warpInList BEGSR
|
|
/free
|
|
i = 1;
|
|
//DSPLY warpStyle;
|
|
DOW NOT (i > 100);
|
|
|
|
IF warpStyle = wrpLstDS(i).wrpTypeDS;
|
|
IF warpColor = wrpLstDS(i).wrpColDS;
|
|
wrpInLst = 'Y'; //Warp already in list
|
|
wrpLstDS(i).wrpYdsDS += %DEC(yard:5:0); //Add current yardage to yards for this warp
|
|
LEAVE; //Exit do-while loop
|
|
ENDIF;
|
|
ENDIF;
|
|
|
|
i += 1;
|
|
ENDDO;
|
|
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* fillInList - Sub-routine that checks for every fill required by the last SKU processed if it
|
|
C* is already in the fllLstDS data structure array. If it is; the lbs required and
|
|
C* lbs needed are added to what is already in the list and the balance is then
|
|
C* recalculated. Otherwise fllInLst remains 'N' causing addFill to be executed.
|
|
C**********************************************************************************************
|
|
C fillInList BEGSR
|
|
/free
|
|
i = 1;
|
|
DOW NOT (i > 1200);
|
|
|
|
IF (fillTypes(j) = fllLstDS(i).fllTypeDS) AND
|
|
NOT (fillTypes(j) = *BLANKS);
|
|
IF fillColors(j) = fllLstDS(i).fllColDS;
|
|
fllInLst = 'Y'; //Fill already in list
|
|
fllLstDS(i).fllLbsDS += fillNeeded(j); //Add current LBS to LBS for this fill
|
|
fllLstDS(i).fllBalDS = fllLstDS(i).fllOHnDS;
|
|
fllLstDS(i).fllBalDS -= fllLstDS(i).fllReqDS;
|
|
fllLstDS(i).fllBalDS -= fllLstDS(i).fllLbsDS;
|
|
LEAVE; //Exit do-while loop
|
|
ENDIF;
|
|
ENDIF;
|
|
|
|
i += 1;
|
|
ENDDO;
|
|
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* addWarp - Sub-routine to add a warp to the wrpLstDS data structure array. This is called if
|
|
C* wrpInLst = 'N' after calling warpInList.
|
|
C**********************************************************************************************
|
|
C addWarp BEGSR
|
|
/free
|
|
i = 1;
|
|
|
|
DOW NOT (i > 100);
|
|
IF wrpLstDS(i).wrpTypeDS = *BLANKS;
|
|
wrpLstDS(i).wrpTypeDS = warpStyle;
|
|
wrpLstDS(i).wrpColDS = warpColor;
|
|
wrpLstDS(i).wrpYdsDS = %DEC(yard:5:0);
|
|
LEAVE;
|
|
ENDIF;
|
|
|
|
i += 1;
|
|
ENDDO;
|
|
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* addFill - Sub-routine to add a fill yarn to the fllLstDS data structure array. This is
|
|
C* called if fllInLst = 'N' after fillInList is called.
|
|
C**********************************************************************************************
|
|
C addFill BEGSR
|
|
/free
|
|
i = 1;
|
|
|
|
DOW NOT (i > 1200);
|
|
IF fllLstDS(i).fllTypeDS = *BLANKS;
|
|
fllLstDS(i).fllTypeDS = fillTypes(j);
|
|
fllLstDS(i).fllColDS = fillColors(j);
|
|
fllLstDS(i).fllLbsDS = fillNeeded(j);
|
|
fllLstDS(i).fllOHnDS = fillOnHand(j);
|
|
fllLstDS(i).fllReqDS = fillReqd(j);
|
|
fllLstDS(i).fllBalDS = fillBalanc(j);
|
|
LEAVE;
|
|
ENDIF;
|
|
|
|
i += 1;
|
|
ENDDO;
|
|
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* processWarp - Sub-routine that calls warpInList and addWarp if needed for each SKU processed
|
|
C**********************************************************************************************
|
|
C processWarp BEGSR
|
|
/free
|
|
wrpInLst = 'N';
|
|
EXSR warpInList;
|
|
IF wrpInLst = 'N';
|
|
EXSR addWarp;
|
|
ENDIF;
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* processFill - Sub-routine that calls fillInList and addFill if needed for each fill yarn
|
|
C* required by the last read SKU.
|
|
C**********************************************************************************************
|
|
C processFill BEGSR
|
|
/free
|
|
j = 1;
|
|
|
|
DOW NOT (j > 12);
|
|
fllInLst = 'N';
|
|
EXSR fillInList;
|
|
IF fllInLst = 'N';
|
|
EXSR addFill;
|
|
ENDIF;
|
|
j += 1;
|
|
ENDDO;
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* writeWarps - Sub-routine that sorts the wrpLstDs data structure array by wrpTypeDS and then
|
|
C* writes the list of required warps to the report.
|
|
C**********************************************************************************************
|
|
C writeWarps BEGSR
|
|
/free
|
|
SORTA %subarr(wrpLstDS(*).wrpTyClDS : 1 : %elem(wrpLstDs)); //Sort array by type then color
|
|
EXCEPT warpDetHed;
|
|
i = 1;
|
|
|
|
DOW NOT (i > 100);
|
|
EXSR CHKOVERFLOW;
|
|
IF NOT (wrpLstDS(i).wrpTypeDS = *BLANKS);
|
|
pWARP = wrpLstDS(i);
|
|
EXCEPT warpDetail;
|
|
ENDIF;
|
|
i += 1;
|
|
ENDDO;
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* writeFill - Sub-routine that sorts the fllLstDS data structure array by fllTypeDS and then
|
|
C* writes the required fill yarn information to the report.
|
|
C**********************************************************************************************
|
|
C writeFill BEGSR
|
|
/free
|
|
SORTA %subarr(fllLstDS(*).fllTyClDS : 1 : %elem(fllLstDs)); //Sort array by type then color
|
|
EXCEPT fillDetHed;
|
|
i = 1;
|
|
|
|
DOW NOT (i > 1200);
|
|
IF *INOF = *ON;
|
|
EXCEPT Header;
|
|
EXCEPT fillDetHed;
|
|
*INOF = *OFF;
|
|
ENDIF;
|
|
IF NOT (fllLstDS(i).fllTypeDS = *BLANKS);
|
|
pFILL = fllLstDS(i);
|
|
|
|
IF (pllBalDS < 0);
|
|
*IN88 = *ON; //*IN88 Conditions a negative balance note on the report
|
|
ENDIF;
|
|
|
|
IF NOT (pFllType = lastFillPrnt);
|
|
EXCEPT BLANK; //Inserts a blank line between different types of fill on the report
|
|
ENDIF;
|
|
|
|
EXCEPT fillDetail;
|
|
lastFillPrnt = pFllType;
|
|
ENDIF;
|
|
i += 1;
|
|
*IN88 = *OFF;
|
|
ENDDO;
|
|
/end-free
|
|
C ENDSR
|
|
C**********************************************************************************************
|
|
C* writeUsrMsg - Sub-Routine that loops through every record in BATCH at the start of the
|
|
C* program. For any record encountered where the pattern name is 'USER_MESSAGE '
|
|
C* the rest of the record is written to the top of the report. These are the
|
|
C* notes the user entered in the interactive program.
|
|
C**********************************************************************************************
|
|
C writeUsrMsg BEGSR
|
|
/free
|
|
READ BATCH;//Priming read
|
|
DOW NOT (%EOF(BATCH));
|
|
IF (PATT = 'USER_MESSAGE ');
|
|
EXSR CHKOVERFLOW;
|
|
EXCEPT usrMSG;
|
|
ENDIF;
|
|
READ BATCH;
|
|
ENDDO;
|
|
SETLL *START BATCH; //Reposition BATCH for SKU processing
|
|
/end-free
|
|
C**********************************************************************************************
|
|
C ENDSR
|
|
OQPRINT E Header 1 2
|
|
O Title 23
|
|
O Title1 51
|
|
O 96 'Page' WR-01
|
|
O PAGE 101 WR-01
|
|
O E Header 2
|
|
O PGM 16
|
|
O sysDate 40
|
|
O sysTime 50
|
|
O E newPage 1
|
|
O 1 ' '
|
|
O E blank 1
|
|
O 1 ' '
|
|
O E usrMSG
|
|
O userMsg 52
|
|
O**********************************************************************************************
|
|
O E detailHead 1 nw-01
|
|
O 54 'Days to' nw-01
|
|
O 65 'Extended' nw-01
|
|
O E detailHead 1 2
|
|
O 8 'Pattern' nw-01
|
|
O 23 'Color' |
|
|
O 30 'Yards' |
|
|
O 44 'Picks' |
|
|
O 53 'Weave' |
|
|
O 65 'Delivery' |
|
|
O 73 'Coll.' nw-01
|
|
O 81 'Finish' WR-01
|
|
O E detail 1
|
|
O PATT 16 nw-01
|
|
O COLO 22 |
|
|
O yardsInt Z 30 |
|
|
O totalPicks O 44 |
|
|
O daysToWeave O 53 |
|
|
O delvPrnt b 64 |
|
|
O #collection 72 nw-01
|
|
O finishPrint 102 WR-01
|
|
O**********************************************************************************************
|
|
O E detailFoot 1 1
|
|
O count z 18
|
|
O 23 'SKUs'
|
|
O E detailFoot 1
|
|
O grandTotPicks O 18
|
|
O 24 'Picks'
|
|
O E detailFoot 1
|
|
O grandTotDays O 18
|
|
O 32 'Days to weave'
|
|
O**********************************************************************************************
|
|
O E warpDetHed 2
|
|
O 19 'Warp Yards Needed'
|
|
O E warpDetHed 2
|
|
O 11 'Type'
|
|
O 18 'Color'
|
|
O E warpDetail 1
|
|
O pWrpType 11
|
|
O pWrpCol 33
|
|
O pWrpYds O 40
|
|
O 46 'Yards'
|
|
O**********************************************************************************************
|
|
O E fillDetHed 2
|
|
O 18 'Fill Information'
|
|
O E fillDetHed 1
|
|
O 6 'Type'
|
|
O 15 'Color'
|
|
O 37 'Needed'
|
|
O 51 'On-Hand'
|
|
O 61 'Required'
|
|
O 71 'Balance'
|
|
O E fillDetail 1
|
|
O pFllType 8
|
|
O pFllCol 30
|
|
O pFllLbs O 37
|
|
O pllOHnDS O 51
|
|
O pllReqDS O 61
|
|
O pllBalDS O 71
|
|
O 88 93 '<== Negative Balance!'
|
|
|