Writing contents of an array to a file in free form

[Ju5]

I'm trying to merge several lines in one file so that it prints out as one record in another file. Something seems to be making my code go into infinite loops though as it is taking my program almost 300 seconds to run and that only because I ended the job manually.

The program is supposed to combine all the lines for a single order and write or update the combined lines as one record in another file. Below are the details

Input file - OrdIns
A R OrdInst
*
A S4SORD 10
A S4SLIN 2
A S4DATA 40
A K S4SORD
A K S4SLIN
The records would look like
Order12345 1 instruction1
Order12345 2 instruction2
Order12345 3 instruction3

Output/Update file - StorIns
A R PSHPINS
A ORD# 10
A INST1 40
A INST2 40
A INST3 40
A INST4 40
A INST5 40
The contents should look like:
Order12345 instruction1 instruction2 instruction3

Below is the program I;ve come up with:
FBBOSINS4 IF E K DISK
FBSHIPINS UF A E K DISK
*
D DS
D INST1 11 50
D INST2 51 90
D INST3 91 130
D INST4 131 170
D INST5 171 210
D txtFields 11 210 DIM(5)
*
D tmpOrd S 10A
D recstat S 1A
D indx S 1s 0

/FREE
Read OrdIns;
tmpOrd = S4SORD;

Dow not %eof(OrdIns);
Clear txtFields;

Chain(E) S4SORD StorIns;
If %found(StorIns);
recstat = 'U';
Clear txtFields;
Else;
recstat = 'A';
Endif;

Dow S4SORD = tmpOrd;
indx = %DEC(S4SLIN:1:0);
txtFields(indx) = S4DATA;
Reade tmpOrd OrdIns;
Enddo;

If recstat = 'A';
write PSHPINS;
endif;

If recstat = 'U';
update PSHPINS;
endif;

tmpOrd = S4SORD;
Enddo;

*inlr = *on;
/END-FREE

Any advice would be greatly appreciated.

 

[Mercury2]

Look how it is easy using the RPG cycle.

      H DFTACTGRP(*NO)
     H OPTION(*SRCSTMT: *NODEBUGIO: *NOSHOWCPY)

     FBBOSINS4  IP   E           K DISK
     FBSHIPINS  UF A E           K DISK

     D txtFields       S                   Like(INST1) DIM(5)
      *
     D recstat         S              1A
     D indx            S              1s 0

     IOrdInst       01
     I                                          S4SORD        L1

     C                   If        *InL1 = *On
     C                   Clear                   txtfields
     C                   Endif

     C                   Eval      indx = %DEC(S4SLIN:1:0)
     C                   Eval      txtFields(indx) = S4DATA

     CL1                 Exsr      OutRtn

     C     OutRtn        Begsr

     C     S4SORD        Chain(e)  StorIns

     C                   Eval      INST1 = txtFields(1)
     C                   Eval      INST2 = txtFields(2)
     C                   Eval      INST3 = txtFields(3)
     C                   Eval      INST4 = txtFields(4)
     C                   Eval      INST5 = txtFields(5)

     C                   If        %Found(StorIns)
     C                   Update    PSHPINS
     C                   Else
     C                   Eval      Ord# = S4SORD
     C                   Write     PSHPINS
     C                   Endif

     C                   Endsr

Philippe

 

[Ju5]

Hi Mercury,


Thanks for replying. The 5 lines are a maximum. It is possible that the order has less lines than 5 so I can't hard code. I was hoping on shortening the code hence the loop.

 

[Ju5]

Found the problem. I forgot to check for EOF in

Dow S4SORD = tmpOrd;
indx = %DEC(S4SLIN:1:0);
txtFields(indx) = S4DATA;
Reade tmpOrd OrdIns;
Enddo;

Changed the code to:
BEGSR CombineInst;
Inst = *blanks;
Chain(E) tmpOrd BBOSINS5;
dow not %eof(BBOSINS5);
If S5_S4SORD = S4SORD;
tmpInst = %Trim(Inst) + S5_S4DATA;
Inst = tmpInst;
endif;
Reade tmpOrd BBOSINS5;
enddo;
ENDSR;

The program works fine now