|
midrange.com
Below are the parts of the COBOL to answer your questions. Thanks.
Brad
89 007400 DATA DIVISION.
11/13/86
90 007500 FILE SECTION.
11/13/86
007600
11/13/86
007700* FD Statement for Claim Entry Display File
11/13/86
91 007800 COPY SXXX000F OF QCOPYSRC.
11/13/86
92 +000100 FD DISPLAY-FILE
SXXX000F
93 +000200 LABEL RECORDS ARE OMITTED.
SXXX000F
94 +000300 01 DISPLAY-RECORD.
SXXX000F
95 007900 COPY DDS-ALL-FORMATS OF SWSC212.
04/22/05
96 +000001 05 SWSC212-RECORD PIC X(184).
<-ALL-FMTS
+000002* INPUT FORMAT:FWSC21002 FROM FILE SWSC212
OF LIBRARY GOOD <-ALL-FMTS
+000003* PROMPT SCREEN
<-ALL-FMTS
97 +000004 05 FWSC21002-I REDEFINES SWSC212-RECORD.
<-ALL-FMTS
98 +000005 06 FWSC21002-I-INDIC.
<-ALL-FMTS
99 +000006 07 IN03 PIC 1 INDIC 03.
<-ALL-FMTS
+000007* Exit Screen
<-ALL-FMTS
100 +000008 07 IN24 PIC 1 INDIC 24.
<-ALL-FMTS
+000009* TOTAL ABORT
<-ALL-FMTS
101 +000010 07 IN99 PIC 1 INDIC 99.
<-ALL-FMTS
+000011* help text
<-ALL-FMTS
102 +000012 06 POLICY PIC X(10).
<-ALL-FMTS
+000013* POLICY NUMBER
<-ALL-FMTS
103 +000014 06 CERT PIC X(4).
<-ALL-FMTS
+000015* Certificate
<-ALL-FMTS
104 +000016 06 CLAIM PIC X(8).
<-ALL-FMTS
+000017* CLAIM NO
<-ALL-FMTS
105 +000018 06 CLMNT PIC X(2).
<-ALL-FMTS
+000019* ClMNT NO
<-ALL-FMTS
+000020* OUTPUT FORMAT:FWSC21002 FROM FILE SWSC212
OF LIBRARY GOOD <-ALL-FMTS
+000021* PROMPT SCREEN
<-ALL-FMTS
106 +000022 05 FWSC21002-O REDEFINES SWSC212-RECORD.
<-ALL-FMTS
107 +000023 06 FWSC21002-O-INDIC.
<-ALL-FMTS
108 +000024 07 IN27 PIC 1 INDIC 27.
<-ALL-FMTS
109 +000025 07 IN29 PIC 1 INDIC 29.
<-ALL-FMTS
110 +000026 07 IN89 PIC 1 INDIC 89.
<-ALL-FMTS
111 +000027 07 IN30 PIC 1 INDIC 30.
<-ALL-FMTS
112 +000028 07 IN33 PIC 1 INDIC 33.
<-ALL-FMTS
113 +000029 07 IN35 PIC 1 INDIC 35.
<-ALL-FMTS
114 +000030 07 IN34 PIC 1 INDIC 34.
<-ALL-FMTS
115 +000031 07 IN36 PIC 1 INDIC 36.
<-ALL-FMTS
116 +000032 07 IN43 PIC 1 INDIC 43.
<-ALL-FMTS
117 +000033 07 IN31 PIC 1 INDIC 31.
<-ALL-FMTS
118 +000034 07 IN32 PIC 1 INDIC 32.
<-ALL-FMTS
119 +000035 06 USER PIC X(4).
<-ALL-FMTS
+000036* User ID
<-ALL-FMTS
120 +000037 06 POLICY PIC X(10).
<-ALL-FMTS
+000038* POLICY NUMBER
<-ALL-FMTS
121 +000039 06 CERT PIC X(4).
<-ALL-FMTS
+000040* Certificate
<-ALL-FMTS
122 +000041 06 CLAIM PIC X(8).
<-ALL-FMTS
+000042* CLAIM NO
<-ALL-FMTS
123 +000043 06 CLMNT PIC X(2).
<-ALL-FMTS
+000044* ClMNT NO
<-ALL-FMTS
+000045* INPUT FORMAT:FWSC21003 FROM FILE SWSC212
OF LIBRARY GOOD <-ALL-FMTS
+000046* DETAIL OTHER
<-ALL-FMTS
124 +000047 05 FWSC21003-I REDEFINES SWSC212-RECORD.
<-ALL-FMTS
125 +000048 06 FWSC21003-I-INDIC.
<-ALL-FMTS
126 +000049 07 IN03 PIC 1 INDIC 03.
<-ALL-FMTS
+000050* Exit Screen
<-ALL-FMTS
127 +000051 07 IN24 PIC 1 INDIC 24.
<-ALL-FMTS
+000052* TOTAL ABORT
<-ALL-FMTS
128 +000053 07 IN99 PIC 1 INDIC 99.
<-ALL-FMTS
+000054* help text
<-ALL-FMTS
129 +000055 07 IN38 PIC 1 INDIC 38.
<-ALL-FMTS
130 +000056 06 CHGLSC PIC S9(8).
<-ALL-FMTS
131 +000057 06 CHGEXC PIC S9(8).
<-ALL-FMTS
132 +000058 06 CLMSTS PIC X(1).
<-ALL-FMTS
+000059* CLAIM STATUS
<-ALL-FMTS
+000060* OUTPUT FORMAT:FWSC21003 FROM FILE SWSC212
OF LIBRARY GOOD <-ALL-FMTS
+000061* DETAIL OTHER
<-ALL-FMTS
133 +000062 05 FWSC21003-O REDEFINES SWSC212-RECORD.
<-ALL-FMTS
134 +000063 06 FWSC21003-O-INDIC.
<-ALL-FMTS
135 +000064 07 IN27 PIC 1 INDIC 27.
<-ALL-FMTS
136 +000065 07 IN29 PIC 1 INDIC 29.
<-ALL-FMTS
137 +000066 07 IN53 PIC 1 INDIC 53.
<-ALL-FMTS
138 +000067 07 IN48 PIC 1 INDIC 48.
<-ALL-FMTS
139 +000068 07 IN37 PIC 1 INDIC 37.
<-ALL-FMTS
140 +000069 07 IN46 PIC 1 INDIC 46.
<-ALL-FMTS
141 +000070 07 IN47 PIC 1 INDIC 47.
<-ALL-FMTS
142 +000071 07 IN45 PIC 1 INDIC 45.
<-ALL-FMTS
143 +000072 07 IN52 PIC 1 INDIC 52.
<-ALL-FMTS
144 +000073 06 USER PIC X(4).
<-ALL-FMTS
+000074* User ID
<-ALL-FMTS
145 +000075 06 POLICY PIC X(10).
<-ALL-FMTS
+000076* Policy Number
<-ALL-FMTS
146 +000077 06 CERT PIC X(4).
<-ALL-FMTS
+000078* Certificate
<-ALL-FMTS
147 +000079 06 CLAIM PIC X(8).
<-ALL-FMTS
+000080* CLAIM NO
<-ALL-FMTS
148 +000081 06 CLMNT PIC X(2).
<-ALL-FMTS
+000082* CLAIMANT NO
<-ALL-FMTS
149 +000083 06 INSNAM PIC X(30).
<-ALL-FMTS
+000084* Insured Name
<-ALL-FMTS
150 +000085 06 DEDIND PIC S9(7)V9(2).
<-ALL-FMTS
+000086* IND DEDUCTIBLE
<-ALL-FMTS
151 +000087 06 CLMNAM PIC X(30).
<-ALL-FMTS
+000088* Claimant Name
<-ALL-FMTS
152 +000089 06 DEDAGG PIC S9(7)V9(2).
<-ALL-FMTS
+000090* AGG DEDUCTIBLE
<-ALL-FMTS
153 +000091 06 PDTDLS PIC S9(8)V9(2).
<-ALL-FMTS
154 +000092 06 PDTDEX PIC S9(8)V9(2).
<-ALL-FMTS
155 +000093 06 RESLSO PIC S9(8).
<-ALL-FMTS
+000094* Reserve Los Orig
<-ALL-FMTS
156 +000095 06 RESEXO PIC S9(8).
<-ALL-FMTS
+000096* Reserve EXP Orig
<-ALL-FMTS
157 +000097 06 RESLSC PIC S9(8).
<-ALL-FMTS
+000098* Reserve Los Curr
<-ALL-FMTS
158 +000099 06 RESEXC PIC S9(8).
<-ALL-FMTS
+000100* Reserve EXP Curr
<-ALL-FMTS
159 +000101 06 CHGLSC PIC S9(8).
<-ALL-FMTS
160 +000102 06 CHGEXC PIC S9(8).
<-ALL-FMTS
161 +000103 06 CLMSTS PIC X(1).
<-ALL-FMTS
+000104* CLAIM STATUS
<-ALL-FMTS
008000
11/13/86
008100* FD Statement for Date Control File
11/13/86
162 008200 COPY DXXX000F OF QCOPYSRC
11/13/86
163 008300 REPLACING GENERIC-FILE
11/13/86
164 008400 BY DATE-CONTROL-FILE
11/13/86
165 008500 GENERIC-RECORD
11/13/86
166 008600 BY DATE-CONTROL-RECORD.
11/13/86
167 +000100 FD DATE-CONTROL-FILE
DXXX000F
168 +000200 LABEL RECORDS ARE STANDARD.
DXXX000F
169 +000300 01 DATE-CONTROL-RECORD.
DXXX000F
170 008700 COPY DDS-ALL-FORMATS OF DXXF001.
11/13/86
171 +000001 05 DXXF001-RECORD PIC X(195).
<-ALL-FMTS
+000002* I-O FORMAT:RXXF00101 FROM FILE DXXF001
OF LIBRARY PADTA <-ALL-FMTS
+000003* DATE CONTROL RECORD
<-ALL-FMTS
+000004*THE KEY DEFINITIONS FOR RECORD FORMAT RXXF00101
<-ALL-FMTS
+000005* NUMBER NAME
RETRIEVAL TYPE ALTSEQ <-ALL-FMTS
+000006* 0001 CDKEY1
ASCENDING AN NO <-ALL-FMTS
+000007* 0002 CDKEY2
ASCENDING AN NO <-ALL-FMTS
+000008* 0003 CDKEY3
ASCENDING AN NO <-ALL-FMTS
172 +000009 05 RXXF00101 REDEFINES DXXF001-RECORD.
<-ALL-FMTS
173 +000010 06 CDKEY1 PIC X(10).
<-ALL-FMTS
+000011* DATE CONTROL ID
<-ALL-FMTS
174 +000012 06 CDKEY2 PIC X(10).
<-ALL-FMTS
+000013* DATE CONTROL SEQ
<-ALL-FMTS
175 +000014 06 CDKEY3 PIC X(10).
<-ALL-FMTS
+000015* UNUSED
<-ALL-FMTS
176 +000016 06 EFFDTE PIC S9(8).
<-ALL-FMTS
+000017* EFFECTIVE DATE
<-ALL-FMTS
177 +000018 06 CDDESC PIC X(30).
<-ALL-FMTS
+000019* CODEFILE DESC
<-ALL-FMTS
178 +000020 06 ENDDTE PIC S9(8).
<-ALL-FMTS
+000021* ENDING DATE
<-ALL-FMTS
179 +000022 06 CTLDT1 PIC S9(8)
COMP-3. <-ALL-FMTS
+000023* CONTROL DATE 1
<-ALL-FMTS
180 +000024 06 CTLDT2 PIC S9(8)
COMP-3. <-ALL-FMTS
+000025* CONTROL DATE 2
<-ALL-FMTS
181 +000026 06 CTLDT3 PIC S9(8)
COMP-3. <-ALL-FMTS
+000027* CONTROL DATE 3
<-ALL-FMTS
782 016900 01 TOTAL-EXPENSE PIC S9(8)V99 VALUE 0.
03/21/86
017000
10/02/84
017100
10/30/85
783 017200 01 SWITCH-AREA.
06/15/84
784 017300 03 TRANSACTION-SWITCH PIC 9(2) VALUE ZERO.
10/15/85
017400
07/27/84
785 017500 01 ERROR-SWITCH-AREA.
10/30/85
786 017600 03 ERROR-STATUS PIC 1 VALUE B"0".
10/30/85
787 017700 88 ERROR-FREE VALUE B"0".
10/30/85
788 017800 88 ERRORS-EXIST VALUE B"1".
10/30/85
017900
05/02/84
789 018000 01 INDICATOR-AREA.
05/02/84
790 018100 03 IN03 PIC 1 VALUE B"0".
04/27/05
791 018200 88 END-OF-PROCESS VALUE B"1".
05/02/84
792 018300 03 IN24 PIC 1 VALUE B"0".
05/02/84
793 018400 88 TOTAL-ABORT VALUE B"1".
05/02/84
794 018600 03 IN26 PIC 1 VALUE B"0".
07/24/84
795 018700 88 ADD-MODE VALUE B"1".
07/24/84
796 018800 03 IN27 PIC 1 VALUE B"0".
07/24/84
797 018900 88 CHANGE-MODE VALUE B"1".
07/24/84
798 019000 03 IN28 PIC 1 VALUE B"0".
07/24/84
799 019100 88 DELETE-MODE VALUE B"1".
07/24/84
800 019200 03 IN29 PIC 1 VALUE B"0".
07/24/84
801 019300 88 INQUIRE-MODE VALUE B"1".
07/24/84
802 019500 03 IN30 PIC 1 VALUE B"0".
05/02/84
803 019600 88 POLICY-OMITTED VALUE B"1".
05/02/84
804 019700 03 IN31 PIC 1 VALUE B"0".
05/02/84
805 019800 88 CLAIM-OMITTED VALUE B"1".
05/02/84
806 019900 03 IN32 PIC 1 VALUE B"0".
05/02/84
807 020000 88 CLAIMANT-OMITTED VALUE B"1".
05/02/84
808 020100 03 IN33 PIC 1 VALUE B"0".
05/02/84
809 020200 88 POLICY-CLAIM-NOT-FOUND VALUE B"1".
05/03/84
810 020300 03 IN34 PIC 1 VALUE B"0".
05/02/84
811 020400 88 RECORD-IN-USE VALUE B"1".
05/03/84
812 020500 03 IN35 PIC 1 VALUE B"0".
05/02/84
813 020600 88 CLAIMANT-NOT-FOUND VALUE B"1".
05/02/84
814 020700 03 IN36 PIC 1 VALUE B"0".
05/02/84
815 020800 88 POLICY-CLAIM-MISMATCH VALUE B"1".
05/07/84
816 020900 03 IN37 PIC 1 VALUE B"0".
05/03/84
817 021000 88 NO-CHANGES-MADE VALUE B"1".
05/03/84
818 021100 03 IN38 PIC 1 VALUE B"0".
10/31/85
819 021200 88 NO-FIELD-CHANGED VALUE B"0".
07/30/84
820 021300 88 FIELDS-CHANGED VALUE B"1".
07/30/84
821 021400 03 IN39 PIC 1 VALUE B"0".
10/31/85
822 021500 88 NO-RESLSC-CHANGE VALUE B"0".
07/30/84
823 021600 88 RESLSC-CHANGED VALUE B"1".
07/30/84
824 021700 03 IN40 PIC 1 VALUE B"0".
10/31/85
825 021800 88 NO-RESEXC-CHANGE VALUE B"0".
07/30/84
826 021900 88 RESEXC-CHANGED VALUE B"1".
07/30/84
827 022000 03 IN41 PIC 1 VALUE B"0".
10/31/85
828 022100 88 NO-CLAIMANT-STATUS-CHANGE VALUE B"0".
10/31/85
829 022200 88 CLAIMANT-STATUS-CHANGED VALUE B"1".
10/31/85
830 022300 03 IN42 PIC 1 VALUE B"0".
10/31/85
831 022400 88 OPTIONAL-FIELDS-CHANGED VALUE B"1".
08/02/84
832 022500 03 IN43 PIC 1 VALUE B"0".
08/20/87
833 022600 88 INCIDENT VALUE B"1".
08/20/87
834 022700 03 IN45 PIC 1 VALUE B"0".
10/31/85
835 022800 88 CANNOT-REOPEN VALUE B"1".
10/30/85
836 022900 03 IN46 PIC 1 VALUE B"0".
10/31/85
837 023000 03 IN47 PIC 1 VALUE B"0".
10/31/85
838 023100 88 CHGLSC-NEG-TOO-BIG VALUE B"1".
07/22/87
839 023200 03 IN48 PIC 1 VALUE B"0".
10/31/85
840 023300 88 CHGEXC-NEG-TOO-BIG VALUE B"1".
07/22/87
841 023400 03 IN50 PIC 1 VALUE B"0".
10/31/85
842 023500 03 IN51 PIC 1 VALUE B"0".
11/01/85
843 023600 03 IN52 PIC 1 VALUE B"0".
11/01/85
844 023700 88 CLMSTS-INVALID VALUE B"1".
07/22/87
845 023704 03 IN53 PIC 1 VALUE B"0".
04/28/05
846 023705 88 RESERVES-UNDER-LIMIT VALUE B"0".
04/28/05
847 023706 88 RESERVES-OVER-LIMIT VALUE B"1".
04/28/05
848 023800 03 IN60 PIC 1 VALUE B"0".
10/30/85
849 023900 03 IN81 PIC 1 VALUE B"0".
05/02/84
850 024000 88 MORE-DRAFTS VALUE B"0".
05/02/84
851 024100 88 NO-MORE-DRAFTS VALUE B"1".
05/02/84
852 024200 03 IN82 PIC 1 VALUE B"0".
05/02/84
853 024300 88 DRAFT-NOT-PAID VALUE B"0".
05/02/84
854 024400 88 DRAFT-PAID VALUE B"1".
05/02/84
855 024500 03 IN88 PIC 1 VALUE B"0".
11/06/85
856 024600 03 IN89 PIC 1 VALUE B"0".
11/06/85
857 024700 03 IN90 PIC 1 VALUE B"0".
08/01/84
858 024800 88 FIELD-NOT-USED VALUE B"0".
08/01/84
859 024900 03 IN99 PIC 1 VALUE B"0".
06/19/84
860 025000 88 HELP-OFF VALUE B"0".
07/27/84
861 025100 88 HELP-REQUESTED VALUE B"1".
05/03/84
862 025200 66 IOMODE-INDICATORS RENAMES IN26 OF INDICATOR-AREA
07/24/84
863 025300 THRU IN29 OF INDICATOR-AREA.
07/24/84
864 025400 66 ERROR-INDICATORS RENAMES IN30 OF INDICATOR-AREA
05/02/84
865 025500 THRU IN60 OF INDICATOR-AREA.
10/30/85
1275 069300 PERFORM 200-TOTAL-PAID-TO-DATE THRU 210-EXIT.
10/30/85
069400
07/28/87
1276 069500 MOVE TOTAL-LOSS TO PDTDLS OF FWSC21003-O.
07/28/87
1277 069600 MOVE TOTAL-EXPENSE TO PDTDEX OF FWSC21003-O.
07/28/87
069700
06/14/84
069800
04/26/05
069801 132-READ-OTHER-RESERVES.
04/26/05
1278 069803 PERFORM 300-CHECK-RESERVE-CAP THRU 300-EXIT.
04/26/05
1279 069900 MOVE CORRESPONDING INDICATOR-AREA TO
FWSC21003-O-INDIC. 07/28/87
* ** CORRESPONDING items for
statement 1279:
* ** IN27
* ** IN29
* ** IN37
* ** IN45
* ** IN46
* ** IN47
* ** IN48
* ** IN52
* ** IN53
* ** End of CORRESPONDING items
for statement 1279
1280 069901 DISPLAY "IN53 " IN53 OF INDICATOR-AREA.
04/28/05
1281 070000 WRITE DISPLAY-RECORD FORMAT IS "FWSC21003".
07/28/87
070100
07/28/87
070200 132-REREAD-OTHER-SCREEN.
06/15/84
1282 070300 READ DISPLAY-FILE FORMAT IS "FWSC21003".
07/28/87
1283 070400 MOVE ALL B"0" TO ERROR-INDICATORS.
06/14/84
1284 070500 SET ERROR-FREE TO TRUE.
08/01/84
1285 070600 MOVE CORRESPONDING FWSC21003-I-INDIC TO
INDICATOR-AREA. 07/28/87
* ** CORRESPONDING items for
statement 1285:
* ** IN03
* ** IN24
* ** IN99
* ** IN38
* ** End of CORRESPONDING items
for statement 1285
1286 070700 IF END-OF-PROCESS
11/01/85
1287 070800 GO TO 132-EXIT
11/01/85
070900 ELSE
11/01/85
1288 071000 IF TOTAL-ABORT
11/01/85
1289 071100 GO TO 999-END-OF-JOB.
12/09/85
1290 071200 IF HELP-REQUESTED
06/14/84
1291 071300 CALL "LXXU001" USING CWSC210H01
07/28/87
1292 071400 PERFORM 131-SETUP-OTHER-RESERVES
09/04/84
1293 071500 GO TO 132-READ-OTHER-RESERVES.
09/04/84
071600
07/28/87
071700 132-EXIT.
06/15/84
071800 EXIT.
06/14/84
071900
06/14/84
1294 072000 133-EDIT-OTHER-RESERVES.
06/15/84
1295 072100 MOVE CLMSTS OF FWSC21003-I TO HOLD-CLMSTS.
07/28/87
1296 072200 MOVE CHGLSC OF FWSC21003-I TO HOLD-CHGLSC.
07/28/87
1297 072300 MOVE CHGEXC OF FWSC21003-I TO HOLD-CHGEXC.
07/28/87
072400
07/22/87
1298 072401 IF CHGLSC OF FWSC21003-I > RESCAP
04/27/05
-----Original Message-----
From: cobol400-l-bounces@xxxxxxxxxxxx
[mailto:cobol400-l-bounces@xxxxxxxxxxxx] On Behalf Of
MichaelQuigley@xxxxxxxxxx
Sent: Friday, April 29, 2005 8:17 AM
To: cobol400-l@xxxxxxxxxxxx
Subject: Re: [COBOL400-L] Conditioned Field
OK. a couple more questions:
How have you defined the screen's record in the COBOL program?
o Do you define separate record areas for the input record from the
output record?
o Do you define a separate indicator area (using INDARA in the
or
o Do you simply use the COPY DDS-ALL-FORMATS?
Then how is your write statement coded in the COBOL?
Michael Quigley
AS/400 Programming Coordinator
The Way International
www.TheWay.org
Original message:
------------------------------
Sent: Thursday, April 28, 2005 9:00 PM
To: cobol400-l@xxxxxxxxxxxx
Subject: [COBOL400-L] Conditioned Field
I have a screen with an IO field and another output only field.
If the user types a value over a certain limit into the IO field, I set
an indicator 53 in the COBOL on and move a message to the output only
field saying "over limit".
On my screen I have an error message on the IO field for indicator 53.
What I want to happen is that the error message triggers AND the "over
limit" shows in the output only field.
What actually happens is the error message gets triggered but the output
only field shows a previous value of "under" even though when I display
the value of that field just before the write to the screen the value is
indeed "over limit".
What would be causing this?
Thanks.
Brad
_______________________________________________
This is the COBOL Programming on the iSeries/AS400 (COBOL400-L) mailing
list To post a message email: COBOL400-L@xxxxxxxxxxxx To subscribe,
unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/cobol400-l
or email: COBOL400-L-request@xxxxxxxxxxxx Before posting, please take a
moment to review the archives at http://archive.midrange.com/cobol400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
