000100 IDENTIFICATION DIVISION. 
000200 PROGRAM-ID.    PO260 IS INITIAL. 
000300 AUTHOR.        BOB. 
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION. 
           COPY "EXCEL.CS".
000600 SOURCE-COMPUTER. PC.
000700 OBJECT-COMPUTER. PC.
000800*REMARKS. 
000900****************************************************************** 
001000*                                                                *
090408* PO260 - Generate Purchase Orders from Sales Orders   V4.4      *
090408* CALLED FROM 6-6-9  ORIGINALLY FOR SUNBELT SALES                *
120508* UPD KWS V4.4.1 - IF BY-WHSE, ONLY RESET GEN-CD IF LINE GENRATED*
011109* UPD KWS V4.4.A- REUSE MILLTEST-SHIP-CD FOR POTYPE-CD (SUNBELTS)*
011109* MOD KWS V4.4.1- SUNBELTS - SET NEW POHD-POTYPE-CD              *
011209* MOD KWS V4.4.1- SUNBELTS - SET DROPSHIP-CD TO YES              *
012709* MOD KWS V4.4.2- SUNBELTS - FIX DROP-SHIP & PO DATES            *
021209* FIX KWS V4.4.2- IF INVALID ITEM, MOVE ZERO TO COST AND WEIGHT  *
022209* FIX KWS V4.4.2- SUNBELTS - DROPSHIP NOT FOR CONSIGNMENT PO     *
052909* FIX KWS V4.4.3- SUNBELTS - 2-1-1, ONLY GENERATE FOR WHSE=01    *
053009* FIX KWS V4.4.3- WOULD ONLY GENERATE FOR FIRST ORDER IN FILE    *
060509* FIX KWS V4.4.3- IN OPEN ORDERS ONLY GEN IF RELEASED AND INVOICD*
061109* MOD KWS V4.4.4- SUNBELTS-MOVE ORDH-SHIP-INST TO POHD-SHIP-INST *
082709* MOD KWS V4.5  - SUNBELTS-IF FROM ORDER ENTRY, USED ORDH-SHIPADR*
102709* FIX KWS V4.5  - SUNBELTS- IF CONSIGNMENT PO, DON'T UPD ONORD   *
001400******************************************************************
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001800     COPY "POHDF.SL". 
001900     COPY "POLNF.SL". 
083096     COPY "PTLNF.SL". 
001800     COPY "ORDHF.SL". 
001900     COPY "ORDLF.SL". 
001800     COPY "EXCNF.SL". 
001800     COPY "ITEMF.SL". 
001800     COPY "CLASF.SL". 
001900     COPY "VENDF.SL". 
082396*    COPY "TAGKF.SL". 
000400     SELECT TAGMF                ASSIGN TO TAGMF-FULLPATH
000600                                 ORGANIZATION IS INDEXED
000700                                 ACCESS MODE IS DYNAMIC
000800                                 RECORD KEY IS TAGMF-KEY
000800                                 FILE STATUS IS TAGMF-STATUS 
                                       LOCK MODE IS AUTOMATIC.

002900     COPY "CNTLF.SL". 
003000     COPY "USERF.SL". 
           COPY "STEST.SL".
003100
003200 DATA DIVISION. 
       BASED-STORAGE SECTION.
           COPY "STEST.BS".
003300 FILE SECTION.
004200     COPY "POHDF.FD". 
004300     COPY "POLNF.FD". 
083096     COPY "PTLNF.FD".
004200     COPY "ORDHF.FD". 
004300     COPY "ORDLF.FD". 
004200     COPY "EXCNF.FD". 
004200     COPY "ITEMF.FD". 
004200     COPY "CLASF.FD". 
004300     COPY "VENDF.FD". 
004400     COPY "CNTLF.FD". 
004500     COPY "USERF.FD". 
004300     COPY "TAGMF.FD". 
000280  01  TAGMF-REC.
082396      03 TAGMF-KEY.
002900         05 TAG-VENDOR     PIC X(8).
               05 TAG-WHSE-NO    PIC X(04).
               05 TAG-DROPSHIP   PIC 9(6).
082396         05 TAG-ITEM-NO    PIC X(12).
               05 TAG-SEQ-NO     PIC 9(6).
082396      03 TAGMF-DATA1.
               05 TAG-SO-NO      PIC 9(6).
               05 TAG-SO-LINE    PIC 9(6).
               05 TAG-PRICE      PIC S9(7)V9(3).
               05 TAG-CUST-NO    PIC X(08).
               05 TAG-QTY        PIC S9(7)V9(5).

           COPY "STEST.FD".
004700 WORKING-STORAGE SECTION. 
CVT    01  PROG-NAME    PIC X(6) VALUE    "PO260".
004800
021192 01  VEND-TABLE.
021192     05 VEND-PO   PIC X(8) OCCURS 8 TIMES.
021192 01  PO-GEN-TABLE.
021192     05 PO-TO-GEN PIC 9(6) OCCURS 8 TIMES.
021192 01  WS-CURRENT-VENDOR   PIC X(8) VALUE SPACES.
062497 01  TEMP-ITEM-NO.
           05 TEMP-FIRST-TWO   PIC XX.
           05 TEMP-LAST-TEN    PIC X(10).
021192 01  WS-I PIC 999        VALUE 1.
021192 01  FOUND-VENDOR-FLAG   PIC X VALUE "N".
021192     88  FOUND-VENDOR    VALUE "Y".
004900 01  PO-BATCH-FLAG    PIC X  VALUE "N". 
005000     88  PO-BATCH     VALUE "Y".
005100* 01  POHDF-NAME          PIC X(5) VALUE "POHDF".
005200* 01  POLNF-NAME          PIC X(5) VALUE "POLNF".
083096* 01  PTLNF-NAME          PIC X(5) VALUE "PTLNF".
005500 01  POHDF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 
005600 01  POLNF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 
083096 01  PTLNF-STATUS        PIC XX.
005500 01  ORDHF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 
005600 01  ORDLF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 
005500 01  EXCNF-STATUS        PIC XX.
005500 01  ITEMF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 
005500 01  CLASF-STATUS        PIC XX.
005600 01  VENDF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 
005600 01  TAGMF-STATUS        PIC XX.
           COPY "FSTATUS88.DTA". 

006200 01  CNTLF-STATUS        PIC XX.
006300 01  USERF-STATUS        PIC XX.
006400 01  INDEX-OCCURS        PIC 9(1).
006500 01  INDEX-PERFORM       PIC 9(1) VALUE 1.
006700 01  LOW-KEY             PIC X(6) VALUE LOW-VALUES. 
006800 01  HIGH-KEY            PIC X(6) VALUE HIGH-VALUES.
006900
007000 01  FIRST-FLAG          PIC X. 
007100     88  FIRST-TIME      VALUE "Y". 
007200     88  NOT-FIRST       VALUE "N". 
007300 01  INPUT-SPECS-1. 
007400     05  FILLER      PIC X(14)  VALUE "1363O01011IE  ". 
007500 77  INVIS-OPTION    PIC X(1) VALUE "X".
008300
008400     COPY "CONSTANT.DTA". 
020996     COPY "TAG.DTA".
008500     COPY "SCREEN.DTA". 
008600     COPY "STATUS.DTA". 
008700     COPY "ERROR.DTA".
008800     COPY "ERRORP.DTA". 
008900     COPY "DATE.DTA". 
020792     COPY "CENTER.DTA". 
           COPY "MSGBOX.DTA".
012400
012800 01  DATE-SPEC      PIC X(14) VALUE "1158D06060E   ". 
021500 01  SYS-DATE               PIC 9(6). 

026000 01  TERMS-DESC.
026100     05  T-PCT       PIC Z9.999.
026200     05  T-DAY1      PIC /ZZ9B.
026300     05  T-TYPE      PIC X(11).
021292 01  WS-TEST-NAME PIC X(8) VALUE SPACES.
021292 01  WS-TEST-ADDR PIC X(8) VALUE "SAME    ".
026400 01  DAY-TYPE.
026500     05  FILLER  PIC X(4)  VALUE "Net".
026600     05  T-DAY2  PIC ZZ9.
026700 01  MONTH-TYPE.
026800     05  FILLER  PIC X(8)  VALUE "EOM Net".
026900     05  T-DAY3  PIC ZZ9.

       01  WS-VARIABLES.
           05  ORDER-DETAIL-CNT   PIC 9(6) VALUE ZERO.
           05  PO-CNT             PIC 9(6) VALUE ZERO.
           05  PO-DETAIL-CNT      PIC 9(6) VALUE ZERO.
           05  PREV-VENDOR        PIC X(08) VALUE LOW-VALUES.
           05  PREV-WHSE-NO       PIC X(04) VALUE LOW-VALUES.
           05  PREV-DROPSHIP      PIC 9(06) VALUE ZEROES.
           05  PREV-ITEM-NO       PIC X(12) VALUE LOW-VALUES.
           05  LAST-POLN-SEQ-NO   PIC 9(6)  VALUE ZERO.
091608     05  HOLD-SEQ-NO        PIC 9(6)  VALUE ZERO.
091608     05  WS-WHSE-NO         PIC X(4)  VALUE SPACES.
120508 01  LINES-GENERATED-CD     PIC 9     VALUE 2.
120508     88 LINES-GENERATED               VALUE 1.
120508     88 NO-LINES-GENERATED            VALUE 2.
021600 01  ORDER-NUMBER           PIC 9(6) VALUE 0. 
021292 77  EXT-AMT          PIC S9(7)V9(6) COMP-3.
021292 77  EXT-QTY          PIC S9(8)V9(5) COMP-3.
021292 01  SHIP-ADDRESS-FLAG       PIC X VALUE "C".
021292     88  USE-OUR-ADDRESS     VALUE "O".
021292     88  USE-CUST-SHIP-ADDR  VALUE "C". 

082396 01  ASK-HELP.
082396     05 FILLER PIC X(40) VALUE
082396     " For this generation, do you want to com".
082396     05 FILLER PIC X(40) VALUE
082396     "bine all detail lines per vendor into   ".
082396     05 FILLER PIC X(40) VALUE
082396     " one purchase order.                   $".

082396     05 FILLER PIC X(40) VALUE
082396     " If you want like Item numbers added tog".
082396     05 FILLER PIC X(40) VALUE
082396     "ether and shown just once on the PO     ".
082396     05 FILLER PIC X(40) VALUE
082396     " select YES for this question.         $".

082396     05 FILLER PIC X(40) VALUE
082396     " Pick where the orders are located that ".
082396     05 FILLER PIC X(40) VALUE
082396     "you wish to generate PO's for.          ".
082396     05 FILLER PIC X(40) VALUE
082396     "                                       $".

082396     05 FILLER PIC X(40) VALUE
082396     " If you select [All Orders] the system w".
082396     05 FILLER PIC X(40) VALUE
082396     "ill generate PO's for the detail lines  ".
082396     05 FILLER PIC X(40) VALUE
082396     " all orders that have detail lines marke".
082396     05 FILLER PIC X(40) VALUE
082396     "d YES and that the Header PO Generated  ".
082396     05 FILLER PIC X(40) VALUE
082396     " code set to NO.  Otherwise, the system ".
082396     05 FILLER PIC X(40) VALUE
082396     "will prompt you to enter each Order.   $".

       01  ORDER-FILE-OPTS.
           05  FILLER       PIC X(22)  VALUE "Current Orders (2.1.1)".
           05  FILLER       PIC X(22)  VALUE "Open Orders (2.2.4)   ".

       01  WHICH-ORDERS-OPTS.
           05  FILLER       PIC X(20)  VALUE "All Orders       ".
           05  FILLER       PIC X(20)  VALUE "Selective Orders ".
           05  WHICH-ORDERS-WHSE PIC X(20) VALUE "All Order for a Whse".

      ******************************************************************
       01  SPECS-1.
      ******************************************************************
091091     05  FILLER      PIC X(14)  VALUE "1150D06060E   ".           

       01  SPECS-1-REDEF REDEFINES SPECS-1.
022895     05  SPEC-1      OCCURS 1 TIMES.
               10  ROW         PIC 99.
               10  COL         PIC 99.
               10  TYP         PIC X.
               10  FLEN        PIC 99.
               10  SLEN        PIC 99.
               10  OPTION      PIC 9.
               10  ATTR1       PIC XX.
               10  ATTR2       PIC XX.
       01  HELP-1              PIC X(03)  VALUE "  $".


      ******************************************************************
       01  ASK-SPECS.
      ******************************************************************
091091     05  FILLER      PIC X(14)  VALUE "0447O02031    ".           
091091     05  FILLER      PIC X(14)  VALUE "0547O02032    ".           
091091     05  FILLER      PIC X(14)  VALUE "0628O02221    ".           
091091     05  FILLER      PIC X(14)  VALUE "0730O03202    ".           

       01  ASK-SPECS-REDEF REDEFINES ASK-SPECS.
022895     05  ASK-SPEC    OCCURS 4 TIMES.
               10  ROW         PIC 99.
               10  COL         PIC 99.
               10  TYP         PIC X.
               10  FLEN        PIC 99.
               10  SLEN        PIC 99.
               10  OPTION      PIC 9.
               10  ATTR1       PIC XX.
               10  ATTR2       PIC XX.
           
082396 01  WS-CONSOL-FLAG            PIC 9 VALUE 1.
           88 CONSOLIDATE-ORDERS-YES       VALUE 1.
           88 CONSOLIDATE-ORDERS-NO        VALUE 2.

       01  WS-COMBINE-DETAIL-FLAG    PIC 9 VALUE 2.
           88 COMBINE-DETAIL-YES           VALUE 1.
           88 COMBINE-DETAIL-NO            VALUE 2.

082396 01  WS-WHICH-ORDER-FILES-FLAG PIC 9 VALUE 1.
           88 PROCESS-CURRENT-ORDERS       VALUE 1.
           88 PROCESS-OPEN-ORDERS          VALUE 2.

082396 01  WS-WHICH-ORDERS-FLAG      PIC 9 VALUE 1.
           88 PROCESS-ALL-ORDERS           VALUE 1.
           88 PROCESS-SELECTIVE            VALUE 2.
           88 PROCESS-SPECIFIC-WHSE        VALUE 3.

       01  WS-DETAIL-WRITTEN-CD      PIC 9 VALUE 2.
           88 DETAIL-WRITTEN-YES           VALUE 1.

       01  RESULTS-MSG.
           05  RESULTS-ORDER-CNT PIC Z,ZZ9 VALUE ZERO.
           05  FILLER           PIC X(31)  VALUE
               " Order Detail Lines Processed ".
           05  FILLER           PIC X(01)  VALUE X"0A".

           05  RESULTS-PO-CNT   PIC Z,ZZ9 VALUE ZERO.
           05  FILLER           PIC X(31)  VALUE
               " PO's Created ".
           05  FILLER           PIC X(01)  VALUE X"0A".

           05  RESULTS-PO-DETAIL-CNT PIC Z,ZZ9 VALUE ZERO.
           05  FILLER           PIC X(31)  VALUE
               " PO Detail Lines Created ".
           05  FILLER           PIC X(01)  VALUE X"0A".

           05  FILLER           PIC X(06)  VALUE " PO # ".
           05  FROM-PO-NO       PIC ZZZZZ9 VALUE ZERO.
           05  FILLER           PIC X(06)  VALUE " Thru ".
           05  TO-PO-NO         PIC ZZZZZ9 VALUE ZERO.
           05  FILLER           PIC X(01)  VALUE X"0A".

090396 01  WS-GROSS-AMT         PIC S9(7)V99  COMP-3  VALUE 0.

021700 01  SPC-ITEM-NO.
081092     05 SPECIAL-ITEM            PIC X(08).
021800     88  SPC-ITEM     VALUES   "C       ", "c       ",
021900                               "F       ", "f       ",
022000                               "S       ", "s       ",
022100                               "T       ", "t       ".
021192     88  THIS-ITEM-IS-COMMENT VALUES   "C       ",
021192                                       "c       ".
081092     05 FILLER                  PIC X(04).

052697 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
090408     88 SUNBELTS            VALUES 00010, 00011.

CLNUP1 77  ORDHF--NAME PIC X(15) VALUE "ORDERH.FIL" .
CLNUP1 77  ORDHF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  TEMP-SUB-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  ORDLF--NAME PIC X(15) VALUE "ORDERL.FIL" .
CLNUP1 77  ORDLF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  CNTLF--NAME PIC X(15) VALUE "CONTROL.FIL" .
CLNUP1 77  CNTLF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  EXCNF--NAME PIC X(15) VALUE "CONTROL2.FIL" .
CLNUP1 77  EXCNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  USERF--NAME PIC X(15) VALUE "USER.FIL" .
CLNUP1 77  USERF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  ITEMF--NAME PIC X(15) VALUE "ITEM.FIL" .
CLNUP1 77  ITEMF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  VENDF--NAME PIC X(15) VALUE "VENDOR.FIL" .
CLNUP1 77  VENDF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  CLASF--NAME PIC X(15) VALUE "CLASS.FIL" .
CLNUP1 77  CLASF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  POHDF--NAME PIC X(15) VALUE "POHDR.FIL" .
CLNUP1 77  POHDF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  POLNF--NAME PIC X(15) VALUE "POLINE.FIL" .
CLNUP1 77  POLNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  PTLNF--NAME PIC X(15) VALUE "POHSTLIN.FIL" .
CLNUP1 77  PTLNF-FULLPATH PIC X(35) VALUE SPACES .

CLNUP1 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
CLNUP1 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
CLNUP1 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.

091109 01  PASS-ORDHF-KEY                       GLOBAL EXTERNAL.
091108     05 PASS-ORDER-NO              PIC 9(6).
091108     05 PASS-SUB-ORDER-NO          PIC 9(6).

CLNUP1 01  IO-WAIT-CD  PIC X VALUE "1"                                  
CLNUP1     88 IO-WAIT-ON VALUE IS "1".
CLNUP1     88 IO-WAIT-OFF VALUE IS "0".
           COPY "STEST.DTA".


       SCREEN SECTION.
CLNUP1     COPY "CONSTANT.SCR".
CLNUP1     COPY "SCRNINIT.SCR".
CLNUP1     COPY "ERRORFIL.SCR".
CLNUP1                         
       01 SCR-PO260-cbl-298-20 VALUE IS "Generating PO(s) for Order " 
            CONTROL DSPL--CONTROL LINE 6 COLUMN 5.
       01 SCR-PO260-cbl-397-23 VALUE IS "NOT FOUND " CONTROL 
            DSPL--CONTROL LINE 1 COLUMN 1.
       01 SCR-PO260-cbl-397-37 PIC IS X(12) FROM POLNF-KEY CONTROL 
            DSPL--CONTROL LINE 1 COLUMN 11.
       01 SCR-PO260-cbl-566-24 VALUE IS "HISTORY DUPLICATE RECORD" 
            CONTROL DSPL--CONTROL LINE 6 COLUMN 25.
       01 SCR-PO260-cbl-569-20 VALUE IS "P/O #" CONTROL DSPL--CONTROL 
            LINE 11 COLUMN 10.
       01 SCR-PO260-cbl-571-16 PIC IS X(30) FROM POHD-CO-NAME CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 33.
       01 SCR-PO260-cbl-572-16 PIC IS X(30) FROM POHD-CO-ADDR1 CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 33.
       01 SCR-PO260-cbl-573-16 PIC IS X(30) FROM POHD-CO-ADDR2 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 33.
       01 SCR-PO260-cbl-574-16 PIC IS X(18) FROM POHD-CO-CITY CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 33.
       01 SCR-PO260-cbl-575-16 PIC IS X(2) FROM POHD-CO-STATE CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 53.
       01 SCR-PO260-cbl-576-16 PIC IS X(10) FROM POHD-CO-ZIP CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 56.
       01 SCR-PO260-cbl-585-20 VALUE IS "Generating PO(s) for Order " 
            CONTROL DSPL--CONTROL LINE 6 COLUMN 5.
       01 SCR-PO260-cbl-591-20 
            VALUE IS "Consolidate Sales Orders on PO's"
            CONTROL DSPL--CONTROL LINE 4 COLUMN 10.
       01 SCR-ASK-COMBINE-DETAIL 
            VALUE IS "Combine Detail Lines            "
            CONTROL DSPL--CONTROL LINE 5 COLUMN 10.
       01 SCR-ASK-ORDER-FILES VALUE IS "Process Orders in "
            CONTROL DSPL--CONTROL LINE 6 COLUMN 10.
       01 SCR-ASK-ALL-ORDERS VALUE IS "Process  "
            CONTROL DSPL--CONTROL LINE 7 COLUMN 10.

       01 SCR-ASK-ORDER-MSG VALUE IS "Order # to Process  "
            CONTROL DSPL--CONTROL LINE 11 COLUMN 30.

       01 SCR-ASK-WHSE-MSG VALUE IS "Whse # to Process  "
            CONTROL DSPL--CONTROL LINE 11 COLUMN 32.

       01 SCR-ORDER-NOT-FOUND-MSG VALUE IS "This Order was not found "
            CONTROL DSPL--CONTROL LINE 21 COLUMN 1.

       01 SCR-ALREADY-GENERATED-MSG VALUE IS
            "This Order has already been Generated "
            CONTROL DSPL--CONTROL LINE 21 COLUMN 1.

091108 01 SCR-NOT-RELEASED-MSG VALUE IS
            "This Order is not RELEASED! "
            CONTROL DSPL--CONTROL LINE 21 COLUMN 1.

022200
022300 PROCEDURE DIVISION.
022400 DECLARATIVES.
023400     COPY "ORDLF.DS". 
023600     COPY "ORDHF.DS". 
023400     COPY "EXCNF.DS". 
023400     COPY "ITEMF.DS". 
023400     COPY "CLASF.DS". 
023600     COPY "VENDF.DS". 
023600     COPY "TAGMF.DS". 
023400     COPY "POLNF.DS". 
083096     COPY "PTLNF.DS". 
023600     COPY "POHDF.DS". 
023800     COPY "CNTLF.DS". 
023900     COPY "USERF.DS". 
024000     GO TO STATUS-EXIT. 
024100
024200     COPY "ERRORFIL.SR".
024300
024400 STATUS-EXIT. EXIT. 
024500
024600 END DECLARATIVES.
024700
024800 MAIN-PROG SECTION. 
024900 OPEN-FILES.
           PERFORM USERF-FILL-FULLPATH.
025000     PERFORM PGM-INIT.
052808     IF USER-SN =  00010 OR 00011
052697        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
052697     IF WS-CUSTOMIZED-FLAG > ZERO
052697        MOVE "PO260M" TO PROG-NAME.

           IF NOT MULTI-WHSE
              MOVE SPACES TO WHICH-ORDERS-WHSE.

025100     PERFORM  OPEN-POLNF.
025200     PERFORM  OPEN-POHDF.
025200     PERFORM  OPEN-VENDF.
025200     PERFORM  OPEN-ITEMF.
025200     PERFORM  OPEN-CLASF.

025400 BEGIN-REPORT.
           MOVE "Purchase Order Generation" TO PGM-NAME.
026100     PERFORM SCREEN-INIT.

082396     PERFORM ASK-QUESTIONS.
082396     IF FLAG = 4
082396        GO TO END-REPORT.
           IF PROCESS-SPECIFIC-WHSE
052909        IF SUNBELTS AND LAST-OPTION = 020101
052909           MOVE "0001" TO WS-WHSE-NO
052909        ELSE
                 PERFORM ASK-WHSE-NO.
           PERFORM PROCESS-ORDERS THRU PROCESS-ORDERS-EXIT.

           PERFORM SHOW-RECAP.

026900 END-REPORT.
027200     PERFORM CLOSE-FILES.
027300
027400 EXIT-RUN.
027500     COPY "FINISH.SR".
027600
027700     COPY "CONTROL.SR". 
027800     COPY "DATECVT.SR". 
027900     COPY "DATECHK.SR". 
071789     COPY "CLRUSERF.SR".
020792     COPY "CENTER.SR".
028000     COPY "MSGBOX.SR".
090396
028100 SUBROUTINE SECTION.
028200 PGM-INIT.
028300     PERFORM CONTROL-INIT.
020996     MOVE TERM-ID TO TAG-NO, SORT-NO.
058000     OPEN INPUT EXCNF.
058100     READ EXCNF.
           CLOSE CNTLF.
           OPEN I-O CNTLF.
029400
PROFIT     COPY "SCRNINIT.SR".
029900
082800 INIT-POLN.
020492     MOVE SPACES TO POLNF-REC.
082900     MOVE SPACES TO POLN-ITEM-NO.
092708     MOVE SPACES TO POLN-WHSE-NO.
083000     MOVE 0 TO POLN-ORDER-QTY, POLN-REC-QTY, POLN-INV-QTY,
083100       POLN-PREVRECD-QTY, POLN-PREVCOST-QTY, POLN-EXT-AMT.
083000     MOVE 1 TO POLN-CONV-FACTOR, POLN-ITEM-CONV-FACTOR,
021492       POLN-ITEM-CONV-CD.
020492     MOVE 2 TO POLN-OVRD1-CD, POLN-OVRD2-CD, POLN-REC-CD,
                     POLN-INV-CD, POLN-DROPSHIP-CD.
011209***     IF CONSIGNMENT-INV-PO
011209****        MOVE 1 TO POLN-DROPSHIP-CD
011209***     ELSE
011209***         MOVE 2 TO POLN-DROPSHIP-CD.

           MOVE 0 TO POLN-DELIV-DATE, POLN-GLACCT.
021292     MOVE TODAYS-DATE TO POLN-DELIV-DATE.
021492     MOVE 0 TO POLN-ITEM-PRICE, POLN-ITEM-COST, POLN-ITEM-WEIGHT.
021492     MOVE 0 TO POLN-DATE-GOODS-RECD, POLN-SALES-ORDER-NO.
090708     MOVE ZERO TO POLN-PARENT-SEQ-NO.
090708     MOVE ZERO   TO POLN-ADDED-COST.
083200
021292 GET-CUST-SHIP-ADDR.
012709     MOVE TAG-SO-NO      TO ORDH-ORDER-NO.
012709     MOVE ZERO           TO ORDH-SUB-ORDER-NO.
012709     PERFORM READ-ORDHF.
021292     MOVE ORDH-SHIP-NAME TO WS-TEST-NAME.
021292     IF ORDH-SHIP-NAME NOT = WS-TEST-ADDR
021292         MOVE ORDH-SHIP-NAME TO POHD-CO-NAME
021292         MOVE ORDH-SHIP-ADDR1 TO POHD-CO-ADDR1
021292         MOVE ORDH-SHIP-ADDR2 TO POHD-CO-ADDR2
021292         MOVE ORDH-SHIP-CITY TO POHD-CO-CITY
021292         MOVE ORDH-SHIP-STATE TO POHD-CO-STATE
021292         MOVE ORDH-SHIP-ZIP TO POHD-CO-ZIP
021292     ELSE
021292         MOVE ORDH-CUST-NAME TO POHD-CO-NAME
021292         MOVE ORDH-CUST-ADDR1 TO POHD-CO-ADDR1
021292         MOVE ORDH-CUST-ADDR2 TO POHD-CO-ADDR2
021292         MOVE ORDH-CUST-CITY TO POHD-CO-CITY
021292         MOVE ORDH-CUST-STATE TO POHD-CO-STATE
021292         MOVE ORDH-CUST-ZIP TO POHD-CO-ZIP.
021292
082890 GET-OUR-CO-NAME.
057100     MOVE CNTL-CONAME TO SOURCE-FIELD.
057200     MOVE 40 TO SOURCE-LEN.
057300     PERFORM LEFT-JUST-FIELD.
057400     MOVE DEST-FIELD TO POHD-CO-NAME.
057500     MOVE CNTL-ADDR1 TO POHD-CO-ADDR1.
057600     MOVE CNTL-ADDR2 TO POHD-CO-ADDR2.
057700     MOVE CNTL-CITY TO POHD-CO-CITY.
057800     MOVE CNTL-STATE TO POHD-CO-STATE.
057900     MOVE CNTL-ZIP TO POHD-CO-ZIP.


021292
       ASK-ORDER-NO.
           MOVE 6  TO FLEN OF SPEC-1(1), SLEN OF SPEC-1(1).
           DISPLAY SCR-ASK-ORDER-MSG.
062497     MOVE "1000000010" TO FKEYS.
           IF LAST-OPTION = 20101 OR LAST-OPTION = 020404
              MOVE PASS-ORDER-NO TO ORDH-ORDER-NO
              MOVE 1 TO FLAG
           ELSE
062497        MOVE 0 TO FLAG.
062497     CALL "SCRN01" USING FLAG, FKEYS, SPECS-1, HELP-1,
062497          ORDH-ORDER-NO.
           
       ASK-WHSE-NO.
           MOVE 4  TO FLEN OF SPEC-1(1), SLEN OF SPEC-1(1).
           DISPLAY SCR-ASK-WHSE-MSG.
062497     MOVE "1000000010" TO FKEYS.
062497     MOVE 0 TO FLAG.
062497     CALL "SCRN01" USING FLAG, FKEYS, SPECS-1, HELP-1,
062497          WS-WHSE-NO.
           
       BREAK-CHECK.
           
           IF PREV-VENDOR NOT = TAG-VENDOR
              PERFORM VENDOR-BREAK.

           IF PREV-WHSE-NO NOT = TAG-WHSE-NO
                 PERFORM WHSE-BREAK.

           IF PREV-DROPSHIP NOT = TAG-DROPSHIP
                 PERFORM DROPSHIP-BREAK.

           IF PREV-ITEM-NO NOT = TAG-ITEM-NO
                 PERFORM ITEM-BREAK.

       VENDOR-BREAK.
           IF PREV-VENDOR = LOW-VALUES 
              MOVE TAG-VENDOR   TO PREV-VENDOR
              MOVE TAG-WHSE-NO  TO PREV-WHSE-NO
              MOVE TAG-DROPSHIP TO PREV-DROPSHIP
              MOVE TAG-ITEM-NO  TO PREV-ITEM-NO
           ELSE
              PERFORM ITEM-BREAK
              IF DETAIL-WRITTEN-YES
                 ADD 1 TO PO-CNT
                 PERFORM REWRITE-POHDF.
           MOVE TAG-VENDOR      TO PREV-VENDOR.
           PERFORM INIT-POHD THRU INIT-POHD-EXIT.
    
       WHSE-BREAK.
           IF PREV-WHSE-NO = LOW-VALUES
              MOVE TAG-WHSE-NO  TO PREV-WHSE-NO
           ELSE
              PERFORM VENDOR-BREAK              
              MOVE TAG-WHSE-NO  TO PREV-WHSE-NO
              MOVE TAG-DROPSHIP TO PREV-DROPSHIP
              MOVE TAG-ITEM-NO  TO PREV-ITEM-NO.

       DROPSHIP-BREAK.
           IF PREV-DROPSHIP = LOW-VALUES
              MOVE TAG-DROPSHIP TO PREV-DROPSHIP
           ELSE
              PERFORM VENDOR-BREAK
              MOVE TAG-WHSE-NO  TO PREV-WHSE-NO
              MOVE TAG-DROPSHIP TO PREV-DROPSHIP
              MOVE TAG-ITEM-NO  TO PREV-ITEM-NO.

       ITEM-BREAK.
           IF PREV-ITEM-NO = LOW-VALUES
              MOVE TAG-ITEM-NO  TO PREV-ITEM-NO
           ELSE
              PERFORM WRITE-POLNF
              PERFORM COPY-ATTACHMENT-LINES THRU
                      COPY-ATTACHMENT-LINES-EXIT
              MOVE TAG-ITEM-NO TO PREV-ITEM-NO
              PERFORM INIT-POLN.

           
025600 SHOW-RECAP.
      *     IF COMBINE-DETAIL-NO AND CONSOLIDATE-ORDERS-NO
      *        IF PROCESS-ALL-ORDERS 
      *           SUBTRACT 1 FROM PO-CNT
      *           SUBTRACT 1 FROM PO-DETAIL-CNT.
           MOVE POHD-PO-NO TO TO-PO-NO.
           MOVE ORDER-DETAIL-CNT  TO RESULTS-ORDER-CNT.
           MOVE PO-CNT            TO RESULTS-PO-CNT.
           MOVE PO-DETAIL-CNT     TO RESULTS-PO-DETAIL-CNT. 
           MOVE POW-DMICONINFORMATION TO WS-MSG-BOX-STYLE.
           ADD  POW-DMOK              TO WS-MSG-BOX-STYLE.
           MOVE "Profits Message"     to WS-MSG-BOX-TITLE.
           MOVE RESULTS-MSG           TO WS-MSG-BOX-TEXT.
           PERFORM CALL-MSG-BOX.

021292 CALC-EXT-AMT.
           IF POLN-ITEM-CONV-FACTOR = 1
071400          COMPUTE POLN-ITEM-PRICE ROUNDED, EXT-AMT ROUNDED =
                  POLN-ITEM-COST * POLN-CONV-FACTOR
           ELSE
           IF POLN-ITEM-CONV-CD = 1
              COMPUTE POLN-ITEM-PRICE ROUNDED, EXT-AMT ROUNDED =
                      POLN-ITEM-COST * POLN-CONV-FACTOR
                         * POLN-ITEM-CONV-FACTOR
           ELSE
              COMPUTE POLN-ITEM-PRICE ROUNDED, EXT-AMT ROUNDED =
                      POLN-ITEM-COST * POLN-CONV-FACTOR
                         / POLN-ITEM-CONV-FACTOR ON SIZE ERROR 
                       MOVE ZERO TO POLN-ITEM-PRICE EXT-AMT END-COMPUTE.
021792     COMPUTE POLN-EXT-AMT ROUNDED =
021792         POLN-ORDER-QTY * POLN-ITEM-COST.
021292

030000 SUBROUTINE-EXIT. EXIT. 

082396 ASK-QUESTIONS SECTION.
082396 ASK-QUES.
           IF LAST-OPTION = 020101 OR LAST-OPTION = 020204
              MOVE 2 TO OPTION OF ASK-SPEC(1)
              MOVE 2 TO OPTION OF ASK-SPEC(2)
              MOVE 2 TO OPTION OF ASK-SPEC(4)
              IF LAST-OPTION = 020204
                 MOVE 2 TO OPTION OF ASK-SPEC(3)
                 GO TO ASK-QUES-DONE
              ELSE
                 MOVE 1 TO OPTION OF ASK-SPEC(3)
                 GO TO ASK-QUES-DONE.

           MOVE ZERO TO PASS-ORDER-NO, PASS-SUB-ORDER-NO.
030200     DISPLAY SCR-PO260-cbl-591-20  .
030200     DISPLAY SCR-ASK-COMBINE-DETAIL.
030200     DISPLAY SCR-ASK-ORDER-FILES.
030200     DISPLAY SCR-ASK-ALL-ORDERS.

030600     MOVE 0 TO FLAG.
082696     MOVE "1001000000" TO FKEYS.
030800     CALL "SCRN04" USING FLAG,  FKEYS, ASK-SPECS, ASK-HELP,
030900          YES-NO, YES-NO, ORDER-FILE-OPTS, WHICH-ORDERS-OPTS.
           IF FLAG NOT = ZERO
              GO TO ASK-QUES-DONE.

091108 ASK-QUES-DONE.
031000     MOVE OPTION OF ASK-SPEC(1) TO WS-CONSOL-FLAG.
031000     MOVE OPTION OF ASK-SPEC(2) TO WS-COMBINE-DETAIL-FLAG.
031000     MOVE OPTION OF ASK-SPEC(3) TO WS-WHICH-ORDER-FILES-FLAG.
031000     MOVE OPTION OF ASK-SPEC(4) TO WS-WHICH-ORDERS-FLAG.
052909     IF SUNBELTS
052909        IF LAST-OPTION = 020101
052909           SET PROCESS-SPECIFIC-WHSE TO TRUE.
082396 ASK-QUES-EXIT. EXIT.

       PROCESS-ORDERS SECTION.
       PROCESS-ORDERS-BEGIN.
           IF PROCESS-CURRENT-ORDERS
              MOVE "ORDERL.FIL"   TO ORDLF--NAME
              MOVE "ORDERH.FIL"   TO ORDHF--NAME
              PERFORM ORDLF-FILL-FULLPATH
              PERFORM ORDHF-FILL-FULLPATH
           ELSE
              MOVE "OPENLINE.FIL" TO ORDLF--NAME
              MOVE "OPENHDR.FIL"  TO ORDHF--NAME
              PERFORM ORDLF-FILL-FULLPATH
              PERFORM ORDHF-FILL-FULLPATH.
           PERFORM OPEN-ORDLF.
           PERFORM OPEN-ORDHF.
           PERFORM OPEN-TAGMF.

           IF PROCESS-SELECTIVE
053009        OR (PROCESS-SPECIFIC-WHSE AND LAST-OPTION NOT = 060609)
              NEXT SENTENCE
           ELSE
              MOVE ZERO     TO ORDH-ORDER-NO
              MOVE ZERO     TO ORDH-SUB-ORDER-NO
              PERFORM START-ORDHF
              IF C-AT-END OF ORDHF-STATUS
                 GO TO PROCESS-ORDERS-DONE
              ELSE
                 PERFORM READ-ORDHF-NEXT.
           MOVE ZERO TO ORDER-DETAIL-CNT, PO-DETAIL-CNT, PO-CNT.
      
       PROCESS-ORDERS-LOOP.
053009*    IF PROCESS-SELECTIVE 
053009     IF PROCESS-SELECTIVE OR 
053009        (PROCESS-SPECIFIC-WHSE AND LAST-OPTION NOT = 060609)
              PERFORM ASK-ORDER-NO
              DISPLAY SCR-CLEAR-21
              IF FLAG = 9
                 MOVE AT-END TO ORDHF-STATUS
              ELSE
                 MOVE ZERO  TO ORDH-SUB-ORDER-NO
                 PERFORM READ-ORDHF
                 IF C-NOT-FOUND OF ORDHF-STATUS
                    DISPLAY SCR-ORDER-NOT-FOUND-MSG
                    GO TO PROCESS-ORDERS-LOOP
                 ELSE
                 IF PO-GENERATED
                    DISPLAY SCR-ALREADY-GENERATED-MSG
                    GO TO PROCESS-ORDERS-LOOP
                 ELSE
                 IF SUNBELTS
                    IF PROCESS-OPEN-ORDERS
                       IF NOT RELEASED-ORDER 
                          DISPLAY SCR-NOT-RELEASED-MSG
                          GO TO PROCESS-ORDERS-LOOP.
            
           IF C-AT-END OF ORDHF-STATUS 
              GO TO PROCESS-ORDERS-DONE.

060509*-- ONLY GENERATE IF ORDER IS RELEASED AND INVOICE PRINTED --*
060509     IF PROCESS-OPEN-ORDERS
060509        IF NOT INVOICE-PRINTED-YES OR NOT RELEASED-ORDER
060509           GO TO PROCESS-ORDERS-READ-NEXT.
  
      *-- HEADER MARKED AS ALREADY PROCESSED --*
           IF PO-GENERATED
              GO TO PROCESS-ORDERS-READ-NEXT.

120508     SET NO-LINES-GENERATED TO TRUE.
           PERFORM PROCESS-ORDER-DETAIL THRU PROCESS-ORDER-DETAIL-EXIT.

      *-- If not consolidating many orders onto one PO, create PO's after each Order --*
           IF CONSOLIDATE-ORDERS-NO
              PERFORM CREATE-PURCH-ORDERS THRU CREATE-PURCH-ORDERS-EXIT.

120508     IF PROCESS-SPECIFIC-WHSE
120508        IF LINES-GENERATED
120508           MOVE 1 TO ORDH-PO-GENERATED-CD
120508        ELSE
120508           NEXT SENTENCE
120508     ELSE
              MOVE 1 TO ORDH-PO-GENERATED-CD.
           PERFORM REWRITE-ORDHF.

       PROCESS-ORDERS-READ-NEXT.           
           IF PROCESS-ALL-ORDERS OR PROCESS-SPECIFIC-WHSE
              PERFORM READ-ORDHF-NEXT.
           IF LAST-OPTION = 020101 OR 020204
              GO TO PROCESS-ORDERS-DONE.
           GO TO PROCESS-ORDERS-LOOP.

       PROCESS-ORDERS-DONE.
           IF CONSOLIDATE-ORDERS-YES
              PERFORM CREATE-PURCH-ORDERS THRU CREATE-PURCH-ORDERS-EXIT.
           CLOSE ORDLF, ORDHF.

       PROCESS-ORDERS-EXIT. EXIT.

       PROCESS-ORDER-DETAIL SECTION.
       PROCESS-ORDER-DETAIL-BEGIN.
           MOVE ORDH-ORDER-NO       TO ORDL-ORDER-NO.
           MOVE ORDH-SUB-ORDER-NO   TO ORDL-SUB-ORDER-NO.
           MOVE ZERO                TO ORDL-SEQ-NO.
           PERFORM START-ORDLF.
           IF C-AT-END OF ORDLF-STATUS
                GO TO PROCESS-ORDER-DETAIL-DONE.
           PERFORM READ-ORDLF-NEXT.

       PROCESS-ORDER-DETAIL-LOOP.
           IF C-AT-END OF ORDLF-STATUS 
              GO TO PROCESS-ORDER-DETAIL-DONE.

      *-- DETAIL LINE SET TO NOT GENERATE PO DETAIL --*
           IF NOT GENERATE-PO-YES
              GO TO PROCESS-ORDER-DETAIL-READ-NEXT.

           MOVE ORDL-ITEM-NO       TO SPC-ITEM-NO.
           IF SPC-ITEM
              GO TO PROCESS-ORDER-DETAIL-READ-NEXT.

           IF PROCESS-SPECIFIC-WHSE
              IF ORDL-WHSE-NO NOT = WS-WHSE-NO
                 GO TO PROCESS-ORDER-DETAIL-READ-NEXT.

120508     SET LINES-GENERATED TO TRUE.

           ADD 1 TO ORDER-DETAIL-CNT.
           MOVE ORDL-VENDOR        TO TAG-VENDOR.
           MOVE ORDL-ITEM-NO       TO TAG-ITEM-NO.
           MOVE ORDL-WHSE-NO       TO TAG-WHSE-NO.
**           MOVE ORDL-DROPSHIP-CD   TO TAG-DROPSHIP.
           IF ORDL-DROPSHIP-CD = 1
              MOVE ORDL-ORDER-NO   TO TAG-DROPSHIP
           ELSE
              MOVE ZERO            TO TAG-DROPSHIP.
           MOVE ORDL-ORDER-NO      TO TAG-SO-NO.
           MOVE ORDL-SEQ-NO        TO TAG-SO-LINE.
           MOVE ORDL-ITEM-COST     TO TAG-PRICE.
           MOVE ORDH-CUST-NO       TO TAG-CUST-NO.
060509     IF LAST-OPTION = 060609 AND PROCESS-OPEN-ORDERS AND
060509        WS-WHSE-NO = "0002"
060509        MOVE ORDL-SHIP-QTY   TO TAG-QTY
060509     ELSE
              MOVE ORDL-ORDER-QTY  TO TAG-QTY.
           MOVE ZERO               TO TAG-SEQ-NO.
           PERFORM WRITE-TAGMF.
052909     MOVE 2 TO ORDL-GENERATE-PO-CD.
052909     PERFORM REWRITE-ORDLF.


       PROCESS-ORDER-DETAIL-READ-NEXT.
           PERFORM READ-ORDLF-NEXT.
           GO TO PROCESS-ORDER-DETAIL-LOOP.

       PROCESS-ORDER-DETAIL-DONE.

       PROCESS-ORDER-DETAIL-EXIT. EXIT.

       CREATE-PURCH-ORDERS SECTION.
       CREATE-PURCH-ORDERS-BEGIN.
021209     PERFORM INIT-POLN.
           MOVE SPACES TO TAG-VENDOR, TAG-ITEM-NO, TAG-WHSE-NO.
           MOVE ZERO   TO TAG-DROPSHIP, TAG-SEQ-NO.
           PERFORM START-TAGMF.
           IF C-AT-END OF TAGMF-STATUS
              GO TO CREATE-PURCH-ORDERS-DONE.
           PERFORM READ-TAGMF-NEXT.
           MOVE LOW-VALUES TO PREV-VENDOR.
           MOVE LOW-VALUES TO PREV-WHSE-NO.
           MOVE ZEROES     TO PREV-DROPSHIP.
           MOVE LOW-VALUES TO PREV-ITEM-NO.
           MOVE ZERO       TO LAST-POLN-SEQ-NO.

       CREATE-PURCH-ORDERS-LOOP.
           IF C-AT-END OF TAGMF-STATUS
              GO TO CREATE-PURCH-ORDERS-DONE.
           PERFORM BREAK-CHECK.           
           MOVE TAG-SO-NO     TO ORDL-ORDER-NO.
           MOVE ZERO          TO ORDL-SUB-ORDER-NO.
           MOVE TAG-SO-LINE   TO ORDL-SEQ-NO.
           PERFORM READ-ORDLF.

           MOVE TAG-ITEM-NO      TO ITEM-NUMBER.
           MOVE TAG-WHSE-NO      TO ITEM-WHSE-NO.
           PERFORM READ-ITEMF.

           MOVE ITEM-CLASS       TO CLAS-NUMBER
           PERFORM READ-CLASF.
           IF VEND-EXP-ACCT NOT = ZERO
              MOVE VEND-EXP-ACCT TO POLN-GLACCT
           ELSE
              MOVE CLAS-EXP-ACCT    TO POLN-GLACCT.

           MOVE POHD-PO-NO       TO POLN-PO-NO.
           MOVE TAG-ITEM-NO      TO POLN-ITEM-NO.
           MOVE TAG-WHSE-NO      TO POLN-WHSE-NO. 
           MOVE 0                TO POLN-DATE-GOODS-RECD.
           IF COMBINE-DETAIL-NO
120508*       MOVE ORDL-ORDER-NO TO POLN-SALES-ORDER-NO
120508*       MOVE ORDH-CUST-NO  TO POLN-CUST-NO
120508        MOVE TAG-SO-NO     TO POLN-SALES-ORDER-NO
120508        MOVE TAG-CUST-NO   TO POLN-CUST-NO
           ELSE
              MOVE ZERO          TO POLN-SALES-ORDER-NO
              MOVE SPACES        TO POLN-CUST-NO.

      *     MOVE ITEM-VITEM-NO    TO POLN-VITEM-NO.
           IF ITEM-VENDOR3 = TAG-VENDOR
               MOVE ITEM-VITEM-NO3 TO POLN-VITEM-NO
           ELSE IF ITEM-VENDOR2 = TAG-VENDOR
               MOVE ITEM-VITEM-NO2 TO POLN-VITEM-NO
           ELSE
               MOVE ITEM-VITEM-NO TO POLN-VITEM-NO.

           MOVE ITEM-PO-UOM      TO POLN-ITEM-UOM.
021292     MOVE ITEM-CONV-CD TO POLN-ITEM-CONV-CD.
021292     MOVE ITEM-CONV-FACTOR TO POLN-ITEM-CONV-FACTOR.
           MOVE ORDL-ITEM-WEIGHT TO POLN-ITEM-WEIGHT.
021992     MOVE ORDL-DROPSHIP-CD TO POLN-DROPSHIP-CD.

022209*--- remove below, no controlled by flag in the pohd file ---*
012109*     IF SUNBELTS
012109*        IF TAG-WHSE-NO = "0002" OR "0003" OR "0004"
012109*           MOVE 1 TO POLN-DROPSHIP-CD.
           MOVE ORDL-ITEM-BIN    TO POLN-ITEM-BIN.
           MOVE ORDL-ITEM-DESC   TO POLN-ITEM-DESC.
           MOVE ITEM-LAST-COST   TO POLN-ITEM-COST.
           MOVE ITEM-LAST-COST   TO POLN-ITEM-PRICE.
060509*    ADD  ORDL-ORDER-QTY   TO POLN-ORDER-QTY.
060509*    IF ORDL-ORDER-QTY > ZERO
060509*       IF ORDL-DROPSHIP-CD = 2
060509*          ADD ORDL-ORDER-QTY TO ITEM-ONORD
060509     ADD  TAG-QTY   TO POLN-ORDER-QTY.
060509     IF TAG-QTY > ZERO
060509        IF ORDL-DROPSHIP-CD = 2
102709           IF NOT CONSIGNMENT-INV-PO OF POHDF-REC
060509              ADD TAG-QTY TO ITEM-ONORD
                    PERFORM REWRITE-ITEMF.

           IF COMBINE-DETAIL-NO
              MOVE SPACES TO PREV-ITEM-NO.

       CREATE-PURCH-ORDERS-READ-NEXT.
           PERFORM READ-TAGMF-NEXT.
           GO TO CREATE-PURCH-ORDERS-LOOP.

       CREATE-PURCH-ORDERS-DONE.
           MOVE HIGH-VALUES TO TAG-ITEM-NO.
           PERFORM BREAK-CHECK.
           IF DETAIL-WRITTEN-YES
              ADD 1 TO PO-CNT
              PERFORM REWRITE-POHDF.

      *-- Clears the TAG file and reopens it for use when NOT consolidating Orders --*
           CLOSE TAGMF.
           OPEN  OUTPUT TAGMF.
           CLOSE TAGMF
           OPEN  I-O    TAGMF.

       CREATE-PURCH-ORDERS-EXIT.

091608 COPY-ATTACHMENT-LINES SECTION.
091608 COPY-ATTACHMENTS-BEGIN.
            MOVE ORDL-SEQ-NO TO HOLD-SEQ-NO.
            IF COMBINE-DETAIL-YES
               GO TO COPY-ATTACHMENT-LINES-EXIT.
            PERFORM READ-ORDLF-NEXT.

       COPY-ATTACHMENTS-LOOP.
            IF ORDLF-STATUS = AT-END
               GO TO COPY-ATTACHMENT-LINES-EXIT.
            IF ORDL-PARENT-SEQ-NO NOT = HOLD-SEQ-NO
               GO TO COPY-ATTACHMENT-LINES-EXIT.
            PERFORM INIT-POLN.
            MOVE POHD-PO-NO   TO POLN-PO-NO.
            MOVE HOLD-SEQ-NO  TO POLN-PARENT-SEQ-NO
            MOVE ORDL-ITEM-NO TO POLN-ITEM-NO.
            MOVE ORDL-ITEM-DESC TO POLN-ITEM-DESC.
            PERFORM WRITE-POLNF.
            PERFORM READ-ORDLF-NEXT.
            GO TO COPY-ATTACHMENTS-LOOP.
091608 COPY-ATTACHMENT-LINES-EXIT. EXIT.  
045500
011109 CREATE-COMMENT-LINE SECTION.
011109 CREATE-COMMENT-BEGIN.
011109    IF STANDARD-PO
011109       GO TO CREATE-COMMENT-LINE-EXIT.

011109    PERFORM INIT-POLN.
011109    MOVE POHD-PO-NO TO POLN-PO-NO
011109    MOVE 000001  TO POLN-SEQ-NO
011109    MOVE "C"     TO POLN-ITEM-NO

011109    IF STOCK-REQUISITION-PO
011109       MOVE "  *Stock Requisition PO*" TO POLN-ITEM-DESC
011109    ELSE
011109       MOVE "  *Consignment Invoice PO*" TO POLN-ITEM-DESC.
011109    PERFORM WRITE-POLNF-COMMENT.
011109 CREATE-COMMENT-LINE-EXIT. EXIT.

044200 ORDER-ASSIGN SECTION.
044300 ORDER-ASSIGN-START.
045100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF
           END-READ END-PERFORM.
045200 ORDER-ASSIGN-AGAIN.
045300     MOVE CNTL-NEXT-PO TO POHD-PO-NO.
045400     ADD 1 TO CNTL-NEXT-PO.
062497 ORDER-ASSIGN-RETRY.
045500     PERFORM WRITE-POHDF.
045600     IF POHDF-STATUS = DUPLICATE-RECORD
045700           GO TO ORDER-ASSIGN-AGAIN.
045800     REWRITE CNTLF-REC.
045100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF NO LOCK
           END-READ END-PERFORM.
046100 ORDER-ASSIGN-DONE.
046300     PERFORM READ-POHDF.
           IF FROM-PO-NO = ZERO
              MOVE POHD-PO-NO TO FROM-PO-NO.
011109     PERFORM CREATE-COMMENT-LINE THRU CREATE-COMMENT-LINE-EXIT.      
046500 ORDER-ASSIGN-EXIT. EXIT.


       INIT-POHD SECTION.
       IPS.
021492     MOVE TAG-VENDOR TO VEND-NUMBER.
           PERFORM READ-VENDF.
           IF VENDF-STATUS = NOT-FOUND
               GO TO INIT-POHD-EXIT.

079100     MOVE VEND-NAME TO POHD-VEND-NAME.
079200     MOVE VEND-ADDR1 TO POHD-VEND-ADDR1.
079300     MOVE VEND-ADDR2 TO POHD-VEND-ADDR2.
079400     MOVE VEND-CITY TO POHD-VEND-CITY.
079500     MOVE VEND-STATE TO POHD-VEND-STATE.
079600     MOVE VEND-ZIP TO POHD-VEND-ZIP.
079700     MOVE VEND-CONTACT TO POHD-VEND-CONTACT.
021192     IF VEND-BUYER-CD < 1 OR VEND-BUYER-CD > 9
021192       OR VEND-BUYER-CD NOT NUMERIC
021192         MOVE 1 TO VEND-BUYER-CD.
079800     MOVE EXCN-BUYER(VEND-BUYER-CD) TO POHD-BUYER.
079900     MOVE SPACES TO TERMS-DESC.
080000     MOVE VEND-DISC-DAYS TO POHD-DISC-DAYS, T-DAY1.
080100     MOVE VEND-DISC-PCT TO POHD-DISC-PCT, T-PCT.
080200     MOVE VEND-DUE-CD TO POHD-DUE-CD.
080300     MOVE VEND-DISC-CD TO POHD-DISC-CD.
080400     MOVE VEND-DUE-DAYS TO POHD-DUE-DAYS.
080500     IF VEND-DISC-CD = 1
080600         MOVE VEND-DUE-DAYS TO T-DAY2
080700         MOVE DAY-TYPE TO T-TYPE
080800     ELSE MOVE VEND-DUE-DAYS TO T-DAY3
080900         MOVE MONTH-TYPE TO T-TYPE.
081000     IF VEND-DISC-DAYS = 0 AND VEND-DISC-PCT = 0
081100         MOVE SPACES TO TERMS-DESC
081200         IF VEND-DUE-DAYS NOT = 0
081300             IF VEND-DISC-CD = 1
081400                 MOVE DAY-TYPE TO TERMS-DESC
081500             ELSE MOVE MONTH-TYPE TO TERMS-DESC.
081600     MOVE TERMS-DESC TO POHD-TERMS-DESC.
081700     MOVE VEND-BO-CD TO POHD-BO-CD.
081800     IF VEND-FOB-CD = 1
081900         MOVE "Origin" TO POHD-FOB-PT
082000     ELSE MOVE "Destination" TO POHD-FOB-PT.
091796     MOVE EXCN-SHIP(VEND-SHIP-CD) TO POHD-SHIP-INST.
061109     IF SUNBELTS
061109        IF CONSOLIDATE-ORDERS-NO
061109           MOVE ORDH-SHIP-INST TO POHD-SHIP-INST.
082200     MOVE SPACES TO POHD-REQ-NO, POHD-INV-NO, POHD-INV-DESC.
082300     MOVE 0 TO POHD-GROSS-AMT, POHD-INV-AMT, POHD-INV-DATE,
082400       POHD-DUE-DATE, POHD-CHK-NO.
082500     MOVE 1 TO POHD-STATUS-CD, POHD-HALT-CD, POHD-TYPE-CD.
082600     MOVE 2 TO POHD-PRINT-CD, POHD-OPEN-CD.
082796     MOVE 2 TO POHD-SJ-POST.

           MOVE TAG-VENDOR    TO POHD-VEND-NO.
           MOVE spaces        TO POHD-REQ-NO.
012709*    MOVE ORDH-ORD-DATE TO POHD-PO-DATE.
102709*    MOVE ORDH-ORD-DATE TO POHD-DELIV-DATE.
102709*    MOVE ORDH-ORD-DATE TO DATE-IN
102709     ACCEPT DATE-ACCP FROM DATE.
102709     MOVE A-YEAR     TO I-YEAR.
102709     MOVE A-MONTH    TO I-MONTH.
102709     MOVE A-DAY      TO I-DAY.
102709     MOVE DATE-IN    TO POHD-PO-DATE, POHD-DELIV-DATE.
060604     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT
060604     COMPUTE POHD-DATE-REV = 999999 - JULIAN-DAYS.
011109*    MOVE 2    TO POHD-MILLTEST-SHIP-CD, POHD-MILLTEST-INV-CD.
011109     MOVE 2    TO                        POHD-MILLTEST-INV-CD.
011109     IF NOT SUNBELTS
011109        MOVE 2 TO POHD-POTYPE-CD
011109     ELSE
011109     IF TAG-WHSE-NO = "0002" OR "0003" OR "0004"
011109        MOVE 3  TO POHD-POTYPE-CD
011109     ELSE
011109        MOVE 2  TO POHD-POTYPE-CD.

           IF TAG-DROPSHIP = ZERO
              MOVE "O"   TO SHIP-ADDRESS-FLAG
           ELSE 
              MOVE "C"   TO SHIP-ADDRESS-FLAG.
082709     IF SUNBELTS AND LAST-OPTION = 020101 OR 020204
082709        PERFORM GET-CUST-SHIP-ADDR
082709     ELSE
021292     IF USE-CUST-SHIP-ADDR
021292         PERFORM GET-CUST-SHIP-ADDR
021292     ELSE
020792         PERFORM GET-OUR-CO-NAME.
           PERFORM ORDER-ASSIGN THRU ORDER-ASSIGN-EXIT.
           MOVE 2 TO WS-DETAIL-WRITTEN-CD.
           MOVE ZERO TO WS-GROSS-AMT.


       INIT-POHD-EXIT. EXIT.
082700
058100 IN-OUT SECTION.
058200 OPEN-POHDF.
058300     OPEN I-O    POHDF. 
058400 OPEN-POLNF.
058500     OPEN I-O    POLNF. 
058200 OPEN-ORDHF.
082796     OPEN I-O    ORDHF. 
058400 OPEN-ORDLF.
058500     OPEN I-O    ORDLF. 
058400 OPEN-VENDF.
058500     OPEN INPUT  VENDF. 
058400 OPEN-TAGMF.
           OPEN OUTPUT TAGMF.
082396     CLOSE TAGMF.
           OPEN I-O TAGMF.
058400 OPEN-ITEMF.
058500     OPEN I-O    ITEMF. 
058400 OPEN-CLASF.
058500     OPEN INPUT  CLASF. 
058600
091400 START-ORDHF.
091600     START ORDHF KEY NOT < ORDHF-KEY
091700         INVALID KEY MOVE AT-END TO ORDHF-STATUS.
082396 START-TAGMF.
082396     START TAGMF KEY NOT < TAGMF-KEY
082396         INVALID KEY MOVE AT-END TO TAGMF-STATUS.
059300 START-POLNF. 
082396     START POLNF KEY NOT < POLNF-KEY
059500         INVALID KEY MOVE AT-END TO POLNF-STATUS. 
059300 START-ORDLF. 
082396     START ORDLF KEY NOT < ORDLF-KEY
059500         INVALID KEY MOVE AT-END TO ORDLF-STATUS. 

083096 READ-POLNF. 
060000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      POLNF-STATUS OR IO-WAIT-OFF 
           READ POLNF INVALID KEY
060100         MOVE NOT-FOUND TO POLNF-STATUS
           END-READ END-PERFORM.
059900 READ-POLNF-NEXT. 
060000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      POLNF-STATUS OR IO-WAIT-OFF 
           READ POLNF NEXT
060100         AT END MOVE AT-END TO POLNF-STATUS
           END-READ END-PERFORM.
060200     IF NOT C-AT-END OF POLNF-STATUS 
060300         IF POLN-PO-NO NOT = POHD-PO-NO 
060400             MOVE AT-END TO POLNF-STATUS. 
060500 READ-POHDF.
060600     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      POHDF-STATUS OR IO-WAIT-OFF 
           READ POHDF INVALID KEY 
060700         MOVE SPACES TO POHDF-REC
           END-READ END-PERFORM.
060500 READ-ORDHF.
060600     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ORDHF-STATUS OR IO-WAIT-OFF 
           READ ORDHF INVALID KEY 
060700         MOVE SPACES TO ORDHF-REC
091396         MOVE NOT-FOUND TO ORDHF-STATUS
           END-READ END-PERFORM.

059900 READ-ORDHF-NEXT. 
060000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ORDHF-STATUS OR IO-WAIT-OFF 
           READ ORDHF NEXT
060100         AT END MOVE AT-END TO ORDHF-STATUS
           END-READ END-PERFORM.

083096 READ-ORDLF. 
060000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ORDLF-STATUS OR IO-WAIT-OFF 
           READ ORDLF INVALID KEY
060100         MOVE NOT-FOUND TO ORDLF-STATUS
           END-READ END-PERFORM.
059900 READ-ORDLF-NEXT. 
060000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ORDLF-STATUS OR IO-WAIT-OFF 
           READ ORDLF NEXT
060100         AT END MOVE AT-END TO ORDLF-STATUS
           END-READ END-PERFORM.
060200     IF NOT C-AT-END OF ORDLF-STATUS 
060300         IF ORDL-ORDER-NO NOT = ORDH-ORDER-NO 
060400             MOVE AT-END TO ORDLF-STATUS. 

060500 READ-VENDF.
060600     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      VENDF-STATUS OR IO-WAIT-OFF 
           READ VENDF INVALID KEY 
               MOVE NOT-FOUND TO VENDF-STATUS
060700         MOVE SPACES TO VENDF-REC
           END-READ END-PERFORM.
082396 READ-TAGMF-NEXT. 
082396     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      TAGMF-STATUS OR IO-WAIT-OFF 
           READ TAGMF NEXT
082396         AT END MOVE AT-END TO TAGMF-STATUS
           END-READ END-PERFORM.
060500 READ-ITEMF.
060600     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ITEMF-STATUS OR IO-WAIT-OFF 
           READ ITEMF INVALID KEY 
               MOVE NOT-FOUND TO ITEMF-STATUS
060700         MOVE SPACES TO ITEMF-REC
021209         MOVE ZERO   TO ITEM-LAST-COST, ITEM-WEIGHT 
           END-READ END-PERFORM.
060500 READ-CLASF.
060600     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CLASF-STATUS OR IO-WAIT-OFF 
           READ CLASF INVALID KEY 
               MOVE NOT-FOUND TO CLASF-STATUS
060700         MOVE SPACES TO CLASF-REC
021192         MOVE 0 TO CLAS-EXP-ACCT
           END-READ END-PERFORM.
082796 REWRITE-ORDHF. 
021192     REWRITE ORDHF-REC
                 INVALID KEY MOVE ORDHF-STATUS TO ORDHF-STATUS. 
052909 REWRITE-ORDLF. 
052909     REWRITE ORDLF-REC
                 INVALID KEY MOVE ORDLF-STATUS TO ORDLF-STATUS. 
021492 REWRITE-ITEMF. 
021492     REWRITE ITEMF-REC
                 INVALID KEY MOVE ITEMF-STATUS TO ITEMF-STATUS. 
060800 WRITE-POHDF. 
060900     WRITE POHDF-REC 
                 INVALID KEY MOVE POHDF-STATUS TO POHDF-STATUS.
        
060800 WRITE-POLNF. 
           PERFORM CALC-EXT-AMT.
062597     ADD POLN-EXT-AMT      TO WS-GROSS-AMT.
           MOVE WS-GROSS-AMT     TO POHD-GROSS-AMT.
           COMPUTE POLN-SEQ-NO = LAST-POLN-SEQ-NO + 1280.
           IF POLN-PARENT-SEQ-NO = ZERO
              MOVE POLN-SEQ-NO   TO POLN-PARENT-SEQ-NO.
           MOVE POLN-SEQ-NO TO LAST-POLN-SEQ-NO.
060900     WRITE POLNF-REC
               INVALID KEY MOVE DUPLICATE-RECORD TO POLNF-STATUS
082396         GO TO WRITE-POLNF.
091608     IF POLN-SEQ-NO = POLN-PARENT-SEQ-NO
              ADD 1 TO PO-DETAIL-CNT.
           MOVE 1 TO WS-DETAIL-WRITTEN-CD.

011609 WRITE-POLNF-COMMENT. 
011609     WRITE POLNF-REC
011609         INVALID KEY MOVE DUPLICATE-RECORD TO POLNF-STATUS
011609                     PERFORM REWRITE-POLNF.

082396 REWRITE-POLNF. 
082396     REWRITE POLNF-REC
               INVALID KEY MOVE POLNF-STATUS TO POLNF-STATUS.
082396 REWRITE-POHDF. 
060900     REWRITE POHDF-REC
082396       INVALID KEY MOVE POHDF-STATUS TO POHDF-STATUS.
       MOVE 2 TO WS-DETAIL-WRITTEN-CD.

044500 WRITE-TAGMF. 
           ADD 1 TO TAG-SEQ-NO.
044600     WRITE TAGMF-REC
121896       INVALID KEY MOVE TAGMF-STATUS TO TAGMF-STATUS.
           IF C-DUP-RECORD OF TAGMF-STATUS
              GO TO WRITE-TAGMF.


061000 CLOSE-FILES. 
061100     CLOSE POHDF. 
061200     CLOSE POLNF. 
061200     CLOSE VENDF. 
061200     CLOSE ITEMF. 
061200     CLOSE CLASF. 
061400 IN-OUT-EXIT. EXIT. 
       FILENAMES SECTION.
       FILL-PATHS.
            MOVE SPACES TO TEMP-SUB-DIR.
            STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
            PERFORM CNTLF-FILL-FULLPATH.
            PERFORM EXCNF-FILL-FULLPATH.
            PERFORM ITEMF-FILL-FULLPATH.
            PERFORM VENDF-FILL-FULLPATH.
            PERFORM CLASF-FILL-FULLPATH.
            PERFORM POHDF-FILL-FULLPATH.
            PERFORM POLNF-FILL-FULLPATH.
       ORDHF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ORDHF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORDHF--NAME 
            DELIMITED BY SPACES INTO ORDHF-FULLPATH.
       ORDLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ORDLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORDLF--NAME 
            DELIMITED BY SPACES INTO ORDLF-FULLPATH.
       CNTLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CNTLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
            DELIMITED BY SPACES INTO CNTLF-FULLPATH.
       EXCNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO EXCNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EXCNF--NAME 
            DELIMITED BY SPACES INTO EXCNF-FULLPATH.
       USERF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO USERF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
            INTO USERF-FULLPATH.
       ITEMF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ITEMF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ITEMF--NAME 
            DELIMITED BY SPACES INTO ITEMF-FULLPATH.
       VENDF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO VENDF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" VENDF--NAME 
            DELIMITED BY SPACES INTO VENDF-FULLPATH.
       CLASF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CLASF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CLASF--NAME 
            DELIMITED BY SPACES INTO CLASF-FULLPATH.
       POHDF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO POHDF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" POHDF--NAME 
            DELIMITED BY SPACES INTO POHDF-FULLPATH.
       POLNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO POLNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" POLNF--NAME 
            DELIMITED BY SPACES INTO POLNF-FULLPATH.

       CHAINCALLS SECTION.
       CHN--PARM-BLOCK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
            .

       CHN--PARM-BLK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.

       SCRN-TEST SECTION.
            COPY "STEST.SR".
