1.11M Members

problem in looping

 
0
 

Hi,

I need some help how to loop in ms cobol 2.20,inorder i can input 5 times.

after displaying the customer name and address.i am going now to input the itm-no.

but i find difficulties on it.

here is the scenario.
If i will input the itmno if it is exist it will display the item description and price,then i will input the qty order.and it will display the total amount.after
that it will go to the second row then input another item no and it will display again
the descrcription and etc until it will reached to 5 rows.
can you help me please how to this.

Thank you in advance.I appreciate more help.

ITEM NO        ITEM DESCRIPTION       UNIT OF MEASURE   QTY-ORDR    PRICE      AMOUNT
00001          bag                    pcs               2           100        200
00002          knife                  pcs               2           100        200
00003          speaker                pcs               2           100        200
00004          towel                  pcs               2           100        200
00005          headset                pcs               2           100        200

here is my code

IDENTIFICATION DIVISION.
       PROGRAM-ID. SOENTRY.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SYSTEM-FILE
              ASSIGN TO DISK
              ORGANIZATION IS INDEXED
              ACCESS MODE IS RANDOM
              RECORD KEY IS SYS-FY.
           SELECT CUSTOMER-FILE
              ASSIGN TO DISK
              ORGANIZATION IS INDEXED
              ACCESS MODE IS RANDOM
              RECORD KEY IS CUSNO.  
           SELECT ITEM-FILE
              ASSIGN TO DISK
              ORGANIZATION IS INDEXED
              ACCESS MODE IS RANDOM
              RECORD KEY IS ITMNO.  
           SELECT SO-FILE
              ASSIGN TO DISK
              ORGANIZATION IS INDEXED
              ACCESS MODE IS RANDOM
              RECORD KEY IS SONO.			
           SELECT SOD-FILE.
              ASSIGN TO DISK
              ORGANIZATION IS INDEXED
              ACCESS MODE IS RANDOM
              RECORD KEY IS SODKEY.
       DATA DIVISION.
       FILE SECTION.
       FD  SYSTEM-FILE LABEL RECORD IS STANDARD
           VALUE OF FILE-ID IS "SYSTEM.DAT".
       01  SYSTEM-RECORD.
           03  SYS-FY           PIC 9(4).
           03  SYS-CONAME       PIC X(50).
           03  SYS-COADDR       PIC X(50).
           03  SYS-USER         PIC 9(10).
           03  SYS-PWORD        PIC 9(10).
           03  SYS-LASTCUSNO    PIC 9(5).
           03  SYS-LASTITMNO    PIC 9(5).
           03  SYS-LASTSONO     PIC 9(7).
           03  SYS-LASTSINO     PIC 9(7).
           03  SYS-LASTORNO     PIC 9(7).
           03  SYS-RECSTAT      PIC A.
       FD  CUSTOMER-FILE LABEL RECORD IS STANDARD
           VALUE OF FILE-ID IS "CUSTOMER.DAT".
       01  CUSTOMER-RECORD.
           03  CUSNO            PIC 9(5).
           03  CUSNAME          PIC X(40).
           03  CUSADDR          PIC X(40).
           03  CUSCONTACTPERSON PIC X(40).
           03  CUSCONTACTNO     PIC 9(18).
           03  CUSCREDITLIMIT   PIC 9(7)V99.
           03  CUSBALANCE       PIC S9(7)V99.
           03  CUSLASTSONO      PIC 9(7).
           03  CUSLASTSINO      PIC 9(7).
           03  CUSLASTORNO      PIC 9(7).
           03  CUSRECSTAT       PIC A.   
       FD  ITEM-FILE LABEL RECORD IS STANDARD
           VALUE OF FILE-ID IS "ITEM.DAT".
       01  ITEM-RECORD.
           03 ITMNO                   PIC 9(5).
           03 ITMDESC                 PIC X(40).
           03 ITMUM                   PIC X(3).
           03 ITMPRICE                PIC S9(6)V99.
           03 ITMQTYONHAND            PIC 9(4).
           03 ITMQTYONORDER           PIC 9(4).
           03 ITMLASTONO              PIC 9(7).
           03 ITMLASTSINO             PIC 9(7).
           03 ITMRECSTAT              PIC X.
       FD  SO-FILE LABEL RECORD IS STANDARD
           VALUE OF FILE-ID IS "SO.DAT".
       01  SO-RECORD.
           03  SONO             PIC 9(7).
           03  SODATE           PIC 9(8).
           03  SOCUSNO          PIC 9(5).
           03  SOPAYMODE        PIC XX.
           03  SOTOTAL          PIC 9(7)V99.
           03  SOPREPBY         PIC X(30).
           03  SOAPPRBY         PIC X(30).
           03  SORECSTAT        PIC X.
       FD  SOD-FILE LABEL RECORD IS STANDARD
           VALUE OF FILE-ID IS "SOD.DAT".
       01  SOD-RECORD.
           03  SODKEY.
               05  SODSONO      PIC 9(7).
               05  SODITMNO     PIC 9(5).
           03  SODQTYORD        PIC 9(4).
           03  SODQTYINV        PIC 9(4).
           03  SODUPRICE        PIC 9(6)V99.
           03  SODAMOUNT        PIC 9(6)V99.
           03  SODRECSTAT       PIC X.
       WORKING-STORAGE SECTION.
       01  ESC-CODE        PIC 99 VALUE 0.
           88  ESC-KEY     VALUE 1.
           88  F2          VALUE 3.
           88  F10         VALUE 11.
       01  ERRMSG       PIC X(75) VALUE SPACES.
       01  ERR          PIC 9 VALUE 0.  
       01  TEMP-VAR.
           03 VAR-ITMNO                   PIC 9(5) OCCURS 5 TIMES.
           03 VAR-ITMDESC                 PIC X(40) OCCURS 5 TIMES.
           03 VAR-ITMUM                   PIC X(3) OCCURS 5 TIMES.
           03 VAR-ITMPRICE                PIC S9(6)V99 OCCURS 5 TIMES.
           03 VAR-ITMQTYONHAND            PIC 9(4) OCCURS 5 TIMES.
           03 VAR-ITMQTYONORDER           PIC 9(4) OCCURS 5 TIMES.
		   03 I                           PIC 9.
		   
       SCREEN SECTION.
       01  HEADER.
           03  BLANK SCREEN BACKGROUND-COLOR 0.
       01  ENTRY-FORM.
           03  LINE 1 COLUMN 31 PIC X(50) 
               FROM SYS-CONAME HIGHLIGHT.
           03  LINE 3 COLUMN 55 "SO NO  :".
           03  LINE 3 COLUMN 65 PIC 9(7) FROM SONO.
		   03  LINE 4 COLUMN 55 "SO DATE:".
           03  LINE 4 COLUMN 65 PIC 9(7) USING SODATE.
           03  LINE 4 COLUMN 5 "CUSTOMER NUMBER:".
           03  LINE 4 COLUMN 25 PIC 9(5) USING CUSNO.
           03  LINE 6 COLUMN 5 "NAME           :".
           03  LINE 6 COLUMN 25 PIC X(40)
               FROM CUSNAME BACKGROUND-COLOR 0.
           03  LINE 7 COLUMN 5 "ADDRESS        :".
           03  LINE 7 COLUMN 25 PIC X(40)
               FROM CUSADDR BACKGROUND-COLOR 0.			   
       01 ITEM-HEADER.			   
           03  LINE 9 COLUMN 5 "ITEM NO" BACKGROUND-COLOR 9.
		   03  LINE 9 COLUMN 13 "     " BACKGROUND-COLOR 9.
           03  LINE 9 COLUMN 18 "     DESCRPTION   " BACKGROUND-COLOR 9.
		   03  LINE 9 COLUMN 35 "          " BACKGROUND-COLOR 9.
		   03  LINE 9 COLUMN 46 "UOM" BACKGROUND-COLOR 9.
		   03  LINE 9 COLUMN 50 "QTY" BACKGROUND-COLOR 9.
           03  LINE 9 COLUMN 54 "UNIT PRICE" BACKGROUND-COLOR 9.
		   03  LINE 9 COLUMN 66 "AMOUNT" BACKGROUND-COLOR 9.
       01  ITMNO-FORM.
      		   03  LINE 10 COLUMN 5 PIC 9(5) USING ITMNO.
      		   03  LINE 10 COLUMN 14 PIC X(40) FROM ITMDESC.
      		   03  LINE 10 COLUMN 46 PIC X(3) FROM ITMUM.
      		   03  LINE 10 COLUMN 54 PIC ZZZ,ZZ9.99 FROM ITMPRICE.
       01  FUNCTION-KEYS.
           03  LINE 24 COLUMN 5 "Esc" HIGHLIGHT.
           03  "=Exit  ".
           03  "F2" HIGHLIGHT.
           03  "=Save  ".
           03  "F10" HIGHLIGHT.
           03  "=Cancel".
       01  ERROR-MESSAGE.
           03  LINE 25 COLUMN 5 PIC X(70) FROM ERRMSG HIGHLIGHT.
       01  CLEAR-SCREEN.
           03  BLANK SCREEN BACKGROUND-COLOR 0.
       PROCEDURE DIVISION.
       MAIN.
           OPEN I-O SYSTEM-FILE CUSTOMER-FILE ITEM-FILE SO-FILE SOD-FILE.
           MOVE 2012 TO SYS-FY.
		   MOVE 10 TO LIN.
           READ SYSTEM-FILE INVALID KEY MOVE 1 TO ERR.
           IF ERR = 1
               DISPLAY "SYSTEM RECORD NOT FOUND."
           ELSE
               PERFORM INITIALIZE-ITEMREC
               DISPLAY HEADER
               PERFORM ENTRY1 UNTIL ESC-KEY
               DISPLAY CLEAR-SCREEN.
           CLOSE SYSTEM-FILE CUSTOMER-FILE ITEM-FILE SO-FILE SOD-FILE.
           STOP RUN.
       ENTRY1.
           COMPUTE SONO = SYS-LASTSONO + 1.
           DISPLAY ENTRY-FORM ITEM-HEADER FUNCTION-KEYS ERROR-MESSAGE.
		   
           MOVE ZEROES TO ERR.
           ACCEPT ENTRY-FORM.
		   READ CUSTOMER-FILE INVALID KEY MOVE 1 TO ERR.
		   MOVE SPACES TO ERRMSG.
		   IF ERR = 1 
		        MOVE "CUSTOMER NO. NOT FOUND." TO ERRMSG
                PERFORM CLEAN
        		GO ENTRY1
		   ELSE
              DISPLAY ENTRY-FORM ITEM-HEADER
              PERFORM ITM-INPUT.			  
          
            
		   
        				
		   
           ACCEPT ESC-CODE FROM ESCAPE KEY.
           IF F2 PERFORM SAVE-ENTRIES
           ELSE IF F10 PERFORM CANCEL-ENTRIES.
       SAVE-ENTRIES.
           IF ITMDESC = SPACES
               MOVE "ITEM DESCRIPTION IS REQUIRED." TO ERRMSG
           ELSE IF ITMUM = SPACES 
               MOVE "ITEM UNIT OF MEASURE IS REQUIRED." TO ERRMSG
           ELSE IF ITMPRICE = ZEROES
               MOVE "ITEM PRICE IS REQUIRED." TO ERRMSG
		   ELSE IF ITMQTYONHAND = ZEROES	 
                MOVE "ITEM QTY ON HAND IS REQUIRED." TO ERRMSG	
           				
           ELSE
               WRITE ITEM-RECORD
               MOVE ITMNO TO SYS-LASTITMNO
               REWRITE SYSTEM-RECORD
               MOVE "ENTRIES RECORDED." TO ERRMSG
               PERFORM INITIALIZE-ITEMREC.
       CANCEL-ENTRIES.
           MOVE "ENTRIES CANCELLED" TO ERRMSG.
           PERFORM INITIALIZE-ITEMREC.
       INITIALIZE-ITEMREC.
           MOVE SPACES TO ITEM-RECORD.
		   MOVE ZEROES TO CUSNO SONO SODATE ITMNO.
           MOVE ZEROES TO ITMPRICE ITMQTYONHAND ITMQTYONORDER.
           MOVE ZEROES TO ITMLASTONO ITMLASTSINO.
           MOVE "A" TO ITMRECSTAT.
       CLEAN.
	       MOVE SPACES TO CUSNAME.
		   MOVE SPACES TO CUSADDR.
		   
       ITM-INPUT.
	       ACCEPT ITMNO-FORM.
		   READ ITEM-FILE INVALID KEY MOVE 1 TO ERR.
		   MOVE SPACES TO ERRMSG.
		   IF ERR = 1 
		        MOVE "ITMNO NO. NOT FOUND." TO ERRMSG
        		GO ITM-INPUT
	       ELSE
		   DISPLAY ITMNO-FORM.
 
0
 

Gah! I haven't had to look at Cobol code for 25+ years! In fact, I last worked with Dec's Dibol after that! I guess there are still Cobol programmers out there... So, what was the question again? :-)

Anyway, what I think you are asking is how you can limit input of bad item numbers (ITMNO) to 5 in a row, correct?

 
0
 

Gah! I haven't had to look at Cobol code for 25+ years! In fact, I last worked with Dec's Dibol after that! I guess there are still Cobol programmers out there... So, what was the question again? :-)

Anyway, what I think you are asking is how you can limit input of bad item numbers (ITMNO) to 5 in a row, correct?

hi,

yes i want to input 5 itmno and display the item description.after pressing the enter key it will display the item description.

like this

ITNMO     ITMDESCRIPTION       UNITOFMEASR.   QTYORDER     ITMPRICE      AMOUNT
0001
after pressing enter key

 ITNMO     ITMDESCRIPTION       UNITOFMEASR.   QTYORDER     ITMPRICE      AMOUNT
 0001      computer mouse       pcs                         300

after inputing qtyorder it will aslo display the amount
 ITNMO     ITMDESCRIPTION       UNITOFMEASR.   QTYORDER     ITMPRICE      AMOUNT
 0001      computer mouse       pcs            2             300          600

and the it will move to the second row.

 ITNMO     ITMDESCRIPTION       UNITOFMEASR.   QTYORDER     ITMPRICE      AMOUNT
 0001      computer mouse       pcs            2             300          600
 0002

 and etc..until it reach 5 records.

Thank you in advance.

You
This article has been dead for over six months: Start a new discussion instead
Post:
Start New Discussion
Tags Related to this Article