× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



I am not sure I understand the issue. Does F7 end the loop? When else would you want to end the loop?

A simple line added of :
C   *INKG     DOUEQ*OFF
C   *INKG     OREQ *OFF

would run the loop once. :)

Bill Hopkins wrote:
Hi All,

Can/will someone remind me how to code this to stop the loop on screen
02 or suggest a better way to handle it. I can not remember.......

H        1
ADJ100FM
0002 FWORKSTN CX  F     645            WORKSTN
0003 F                                              KFMTS  ADJ100FM
0004 FADJTYPE IF  F      80L32AI     1 DISK
0005 F*
0006 F*PRT     O   F      80            PRINTER
0007 F*
0008 F*  ADJUSTMENT TYPE FILE UPDATE
0009 F*
0010 E                    SEL        17  1               SELECT RECORD
0011 E                    ATD        17 32               FULL NAME
0012 E                    MSG     1   2 50               MESSAGES
0013 I*
0014 IWORKSTN NS  01   1 C1
0015 I                                        1   10CODE
0016 I                                        2  33 ILOKUP
0017 I                                       34  50 SEL
0018 I                                       51 594 ATD
0019 I                                      596 645 ZMSG
0020 I*
0021 I        NS  02   1 C2
0022 I                                        1   10CODE
0023 I                                        2  33 ATD2
0024 I                                       34  38 CACT
0025 I                                       39  41 DSTR
0026 I                                       42  44 DDPT
0027 I                                       45  49 DACT
0028 I*
0029 I        NS  99
0030 I*
0031 IADJTYPE NS  10
0032 I                                        1  32 ADJTYP
0033 I                                       34  38 CRACCT
0034 I                                       39  41 DBSTOR
0035 I                                       42  44 DBDEPT
0036 I                                       45  49 DBACCT
0037
C********************************************************************
0038 C* HANDLE SCREEN 1 - SCRN01
0039
C********************************************************************
0040 C*
0041 C           *INKG     IFEQ *OFF
0042 C*
0043 C           ILOKUP    IFNE *BLANKS
0044 C                     EXSR POSTO
0045 C                     END
0046 C*
0047 C           *INKA     IFEQ *ON
0048 C                     EXSR ROLLUP
0049 C                     END
0050 C*
0051 C           *INKB     IFEQ *ON
0052 C                     EXSR ROLLDN
0053 C                     END
0054 C*
0055 C                     EXSR SELECT
0056 C*
0057 C                     EXSR LOAD1
0058 C*
0059 C                     Z-ADD1         CODE
0060 C                     EXCPTSCRN01
0061 C*
0062 C                     END
0063 C*
0064 C*
0065
C********************************************************************
0066 C* LOAD SCREEN RECORDS
0067
C********************************************************************
0068 C*
0069 CSR         LOAD1     BEGSR
0070 C*
0071 C                     CLEARSEL
0072 C                     CLEARATD
0073 C                     CLEARZMSG
0074 C                     Z-ADD1         X       20
0075 C*
0076 C                     READ ADJTYPE                  50
0077 C           *IN50     DOWEQ*OFF
0078 C           X         ANDLE17
0079 C*
0080 C                     MOVE *BLANK    SEL,X
0081 C                     MOVELADJTYP    ATD,X
0082 C*
0083 C                     READ ADJTYPE                  50
0084 C                     ADD  1         X
0085 C*
0086 C                     END
0087 C*
0088 C           *IN50     IFEQ *ON
0089 C                     MOVELMSG,1     ZMSG
0090 C                     END
0091 C*
0092 C                     ENDSR
0093 C*
0094 C*
0095
C********************************************************************
0096 C* POSITION TO
0097 C******************************************************************
0098 C*
0099 CSR         POSTO     BEGSR
0100 C*
0101 C           ILOKUP    SETLLADJTYPE
0102 C                     CLEARILOKUP
0103 C*
0104 CSR                   ENDSR
0105 C*
0106
C********************************************************************
0107 C* SELECT RECORD
0108 C******************************************************************
0109 C*
0110 CSR         SELECT    BEGSR
0111 C*
0112 C                     Z-ADD1         Y       20
0113 C*
0114 C           Y         DOWLE17
0115 C           SEL,Y     IFEQ 'X'
0116 C           ATD,Y     CHAINADJTYPE              90
0117 C           *IN90     IFEQ *OFF
0118 C*
0119 C                     EXSR SCRN02
0120 C*
0121 C                     END
0122 C                     END
0123 C                     ADD  1         Y
0124 C                     END
0125 C*
0126 C*
0127 CSR                   ENDSR
0128 C*
0129
C********************************************************************
0130 C* ROLL UP
0131 C******************************************************************
0132 C*
0133 CSR         ROLLUP    BEGSR
0134 C*
0135 C           ATD,1     SETLLADJTYPE                  90
0136 C*
0137 CSR                   ENDSR
0138 C*
0139
C********************************************************************
0140 C* ROLL DOWN
0141 C******************************************************************
0142 C*
0143 CSR         ROLLDN    BEGSR
0144 C*
0145 C           ATD,17    SETLLADJTYPE
0146 C*
0147 CSR                   ENDSR
0148 C*
0149 C*
0150
C********************************************************************
0151 C* HANDLE SCREEN 2 - SCRN02
0152 C******************************************************************
0153 C*
0154 CSR         SCRN02    BEGSR
0155 C*
0156 C                     MOVE *OFF      *INKG
0157 C                     Z-ADD2         CODE
0158 C*
0159 C           *INKG     DOWEQ*OFF
0160 C*
0161 C                     MOVELATD,Y     ATD2
0162 C                     MOVE CRACCT    CACT
0163 C                     MOVE DBSTOR    DSTR
0164 C                     MOVE DBDEPT    DDPT
0165 C                     MOVE DBACCT    DACT
0166 C*
0167 C                     EXCPTSCRN02
0168 C*
0169 C                     END
0170 C*
0171 CSR                   ENDSR
0172 C*
0173 C******************************************************************
0174 C*
0175 OWORKSTN E                SCRN01
0176 O                                   K6 'SCRN01'
0177 O                         SEL       49
0178 O                         ATD      593
0179 O                         ZMSG     643
0180 C*
0181 OWORKSTN E                SCRN02
0182 O                                   K6 'SCRN02'
0183 O                         ATD2      32
0184 O                         CACT      37
0185 O                         DSTR      40
0186 O                         DDPT      43
0187 O                         DACT      48
0188 O                         ZMSG      98
**
--- End of File is reached ---

-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Bill Hopkins
Sent: Wednesday, September 27, 2006 8:24 AM
To: RPG programming on the AS400 / iSeries
Subject: RE: rpt II

Hi Jim,

Any luck on finding the "old s36 file maintenance program generator " ?

Thanks
Bill

-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Jim Horn
Sent: Friday, September 22, 2006 4:31 PM
To: rpg400-l@xxxxxxxxxxxx
Subject: rpt II


Bill

I might be able to find an old s36 file maintenance program generator
that I
wrote long ago.  Not simple but you could pull out the stuff you wanted.

Could scan through multiple "alternative index" files.  Roll through
records
multiple screens per record  - select a record for
inquiry/update/delete.
Lots of hooks to do specialized things.

Jim Horn




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.