SQL Query Returns and Runaway Errors

Hi All,

 

I'm having a bit of trouble with some of my code, and I'm wondering if
someone can give me an idea as to what I'm doing wrong.

 

A little background on the problem - I have an entry screen where the
user can enter data in two fields.  When he or she presses ENTER, the
system will check to ensure all fields are filled out.  If not, it will
issue an error.  Otherwise, it will search a table and return any
records associated with the search to a subfile.

 

I'm having two problems with it:

 

1) The error checking works, but when an error occurs, the program goes
into an endless loop and locks up.  The only way I can stop it is to end
the session or cancel the program.

 

2) My SQL statement is written successfully, but no data is returned.
Again, it appears to go into an endless loop.

 

If anyone has any ideas, I'd really appreciate it.  Thanks, and here's
the code for your review:

 

     FDMDPEGD   CF   E             Workstn

     F                                     Sfile(KDSDTA:Rrn)

     F                                     IndDS(WkStnIndics)

     D WkStnIndics     DS

     D  Exit                   3      3N

     D  Cancel                12     12N

     D  EError                50     50N

     D  SflEnd                40     40N

     D  SflDspCtl             85     85N

     D  SflDsp                95     95N

     D  SflClr                75     75N

     D*

     D LastRRN         S                   LIKE(Rrn)

     D EmptySfl        S               N

     D CurrentYM       S              4    INZ

     D cyy             S              2    INZ

     D cmm             S              2    INZ

     D GetKDL          S            500A   INZ varying

     D apos            C                   ''''

     D GETYM           S              4A   INZ

     D GETRRN          S              3A   INZ

 

     C     *ENTRY        PLIST

     C                   PARM                    PCODE             1

     C*

 

      /free

 

        DoW not Exit;

          If EError = *OFF;

            ExSR FindKDL;

          Endif;

        EndDo;

 

        *InLR = *on;

 

        BegSR *InzSR;

          PLANT = 'Plant-' + PCODE;

          cyy = %subst(%char(%subdt(%date():*Y)):3:2);

          if %len(%trim(%char(%subdt(%date():*M)))) = 1;

            cmm = '0' + %char(%subdt(%date():*M));

          else;

            cmm = %char(%subdt(%date():*M));

          endif;

          CurrentYM = cyy + cmm;

          GETYM = CurrentYM;

          EError = *OFF;

          Write prompt;

          Write FKeys;

          SflDspCtl = *ON;

          Exfmt KDSCTRL;

          Read PROMPT;

        EndSR;

 

 

        BegSR FindKDL;

          If EError = *OFF;

          If GETYM < CurrentYM;

            Message = 'KD Lot Start Date older than current date!';

            Write Msg;

            EError = *ON;

          Endif;

          Endif;

 

          If EError = *OFF;

          If %trim(GETYM) = '' or %trim(GETRRN) = '';

            Message = 'Please enter full KD Lot info (ie: 0506-001)';

            Write Msg;

            EError = *ON;

          Endif;

          Endif;

 

          If EError = *OFF;

          If %Len(%trim(GETYM)) < 4 or %Len(%trim(GETRRN)) < 3;

            Message = 'Please enter a full S/O Number (ie: 003)';

            Write Msg;

            EError = *ON;

          Endif;

          Endif;

 

          If EError = *OFF;

          ExSR SFLClear;

          GetKDL = 'SELECT * FROM DMDPG_PF';

          GetKDL = GetKDL + ' WHERE SKDLYM = ' + apos + GETYM + apos;

          GetKDL = GetKDL + ' AND INT(SKDLRRN) < ' + GETRRN;

          GetKDL = GetKDL + ' AND PLCD =' + apos + pcode + apos;

          GetKDL = GetKDL + ' ORDER BY partno, partcl';

      /end-free

     C/Exec SQL

     C+ PREPARE SQL FROM :GetKDL

     C/End-exec

     C*

     C/Exec SQL

     C+ DECLARE C1 SCROLL CURSOR for SQL

     C/End-exec

     C*

     C/Exec SQL

     C+ Open C1

     C/End-exec

      /free

          rrn = lastrrn;

          DoW sqlcod <> 100;

      /End-free

     C/Exec SQL

     C+ FETCH NEXT FROM C1

     C+ INTO :SUPP, :SUPPLC, :SCSNM, :PARTNO, :PARTCL,

     C+ :ITOTAL, :RQMT, :SKDLYM, :SKDLRRN

     C/END-EXEC

     C*

      /free

            if sqlcod = 0;

              rrn = rrn + 1;

              write KDSDTA;

            Endif;

          EndDo;

 

          If rrn = 0;

            sfldsp = *ON;

          else;

            lastrrn = rrn;

          endif;

 

          If sqlcod = 100;

            SFLEnd = *ON;

          EndIf;

            ExSR PromptSch;

          Endif;

        EndSR;

 

          BegSR PromptSch;

            If NOT EmptySfl;

              SflDspCtl = *ON;

              SflDsp = *ON;

            Else;

              SflDspCtl = *ON;

              SflDsp = *OFF;

              Message = 'No Records Found.';

              Write Msg;

            Endif;

          EndSR;

 

          BegSR SFLClear;

            SflClr = *on;

            SflDsp = *off;

            SflDspCtl = *off;

            Write KDSCTRL;

            rrn = 0;

            lastrrn = 0;

            SflClr = *off;

          EndSR;

      /End-Free

 

-=-=-=-=-=-=-=-=-=-=-=-=-=-

Brian Piotrowski

Specialist - I.T.

Simcoe Parts Service, Inc.

Ph: 705-435-7814 x343

Fx: 705-435-6746

bpiotrowski@xxxxxxxxxxxxxxx

-=-=-=-=-=-=-=-=-=-=-=-=-=-