|
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 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.
midrange.com
