Some questions about MAP Processing and Data Validation



Support for OS/VS COBOL, VS COBOL II, COBOL for OS/390 & VM and Enterprise COBOL for z/OS

Re: Some questions about MAP Processing and Data Validation

Postby rogerb » Mon Aug 13, 2018 11:09 pm

Yes, that's right Mr. Terry Heinze.
I still have the same problem when I'm using the code tags.
The problem exists if I click on Quick Reply or if I click on POSTREPLY.

Thank you,
Roger
rogerb
 
Posts: 64
Joined: Sat Jul 28, 2018 9:14 pm
Has thanked: 5 times
Been thanked: 0 time

Re: Re: Some questions about MAP Processing and Data Validation

 

Re: Some questions about MAP Processing and Data Validation

Postby Terry Heinze » Tue Aug 14, 2018 12:20 am

Try this:
    Copy (or Cut) some text
    Click Code
    You should see a cursor insertion character between the [ code ] and the [ / code ]
    Paste your copied text there
    Preview
    If okay, click Submit
    Otherwise edit your pasted text and go back to preview

P.S. Make sure you DON'T have Disable BBCode checked.
.... Terry
Terry Heinze
 
Posts: 209
Joined: Wed Dec 04, 2013 11:08 pm
Location: Richfield, MN, USA
Has thanked: 11 times
Been thanked: 11 times

Re: Some questions about MAP Processing and Data Validation

Postby Terry Heinze » Tue Aug 14, 2018 12:23 am

The purpose of this meeting

I followed my own instructions and got this.
.... Terry
Terry Heinze
 
Posts: 209
Joined: Wed Dec 04, 2013 11:08 pm
Location: Richfield, MN, USA
Has thanked: 11 times
Been thanked: 11 times

Re: Some questions about MAP Processing and Data Validation

Postby rogerb » Tue Aug 14, 2018 12:35 am

Thank you very much for your answers
rogerb
 
Posts: 64
Joined: Sat Jul 28, 2018 9:14 pm
Has thanked: 5 times
Been thanked: 0 time

Re: Some questions about MAP Processing and Data Validation

Postby rogerb » Tue Aug 14, 2018 12:39 am

Thank you very much for your answers.
There seems to be a limit for the characters it's possible to insert in the code tags.
When I insert a line it works well, but when I insert the entire program it does not work.

000100 IDENTIFICATION DIVISION.                                         00010001
 


Thank you,
Roger
rogerb
 
Posts: 64
Joined: Sat Jul 28, 2018 9:14 pm
Has thanked: 5 times
Been thanked: 0 time

Re: Some questions about MAP Processing and Data Validation

Postby Terry Heinze » Tue Aug 14, 2018 1:09 am

How many lines long is your program? Are they 80-byte records?
.... Terry
Terry Heinze
 
Posts: 209
Joined: Wed Dec 04, 2013 11:08 pm
Location: Richfield, MN, USA
Has thanked: 11 times
Been thanked: 11 times

Re: Some questions about MAP Processing and Data Validation

Postby rogerb » Tue Aug 14, 2018 7:12 pm

I've counted the lines of the entire program.
It has 433 lines.
I know it's a lot, so I probably make posts with snippets of code.

Thank you.
Roger
rogerb
 
Posts: 64
Joined: Sat Jul 28, 2018 9:14 pm
Has thanked: 5 times
Been thanked: 0 time

Re: Some questions about MAP Processing and Data Validation

Postby prino » Tue Aug 14, 2018 8:18 pm

rogerb wrote:I've counted the lines of the entire program.
It has 433 lines.
I know it's a lot, so I probably make posts with snippets of code.

Just tried, using the Preview button, something a bit on the big side, 968 lines. Absolutely no problem. I would suggest that you make sure you strip trailing blanks!

And just use
[code]...[/code]
and not
[code=mainframe]...[/code]


And just for needless fun:

{$define foreign}
(************** Copyright (C) Robert AH Prins 2018-2018 ****************
*                                                                      *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 3, or (at your option)  *
* any later version.                                                   *
*                                                                      *
* This program is distributed in the hope that it will be useful,      *
* but WITHOUT ANY WARRANTY; without even the implied warranty of       *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        *
* GNU General Public License for more details.                         *
*                                                                      *
* You should have received a copy of the GNU General Public License    *
* along with this program; if not, write to the Free Software          *
* Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110, USA   *
************************************************************************
+------------+---------------------------------------------------------+
| Date       | Major changes                                           |
+------------+---------------------------------------------------------+
|            |                                                         |
+------------+---------------------------------------------------------+
| 2018-MM-DD | - correct for old nationality continueing after border  |
+------------+---------------------------------------------------------+
| 2018-08-07 | - remove non-AVX code                                   |
|            | - replace "rep movsd" by direct buffer manipulation     |
+------------+---------------------------------------------------------+
| 2018-07-09 | - new procedure (self-contained)                        |
+------------+---------------------------------------------------------+
************************************************************************
* FOREIGNERS:                                                          *
*                                                                      *
* This procedure tabulates the longest (KM/#R) series of rides with    *
* "foreigners", i.e. drivers with a nationality that is not the one    *
* of the current country.                                              *
***********************************************************************)
const
  foreign_topl  : string[127]{124} = ' ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'^M^J +
                                     ' ³ Trip ³ Ride ³   #R ³ KM (R+) ³ Nat ³ Countries           ³';
  foreign_sep   : string[063]{061} = ' ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´';
  foreign_skel  : string[063]{061} = ' ³      ³      ³      ³         ³     ³                     ³';

type
  fslot = record                                                 {s  32}
            lptr  : liftptr;                                      {   4}
            _c    : longint;                                      {   4}
            km    : longint;                                      {   4}
            time  : longint;                                      {   4}
            filler: string[15];                                   {  16}
          end;

const
  a_nisc: array [0..1] of char = '*~';

const
  ifslot: fslot = (lptr  : nil;
                   _c    : 0;
                   km    : 0;
                   time  : 0;
                   filler: '');

var mcslot  : fslot;
var mdslot  : fslot;
var mrslot  : fslot;

var ncslot  : fslot;
var ndslot  : fslot;
var nrslot  : fslot;

{$ifdef asm}
(***********************************************************************
* FOREIGN_WRITER:                                                      *
*                                                                      *
* Write out the "foreign"/"native" sequences to a list.                *
***********************************************************************)
procedure foreign_writer(_i: longint; var slot: fslot); assembler; {&uses ebx,esi,edi} {&frame+}
var slift_ptr: liftptr;

var ptrip    : longint;
var pride    : longint;

var _c       : longint;
var km       : longint;

var _n       : longint;
var _nisc    : longint;

asm
  //a-in foreign_writer
  mov     eax, lift_ptr
  mov     slift_ptr, eax

  mov     esi, slot
  mov     ebx, [esi + offset fslot.lptr]

  or      ptrip, -1
  or      pride, -1

  and     _c, 0
  and     km, 0

  and     _n, 0
  and     _nisc, 0

@01:
{ vmovdqu _line,      ymm2 }  db    $c5,$fe,$7f,$15; dd offset _line
{ vmovdqu _line + 32, ymm3 }  db    $c5,$fe,$7f,$1d; dd offset _line + 32

  mov     byte ptr _line, 3

  mov     eax, [ebx + offset lift_list.trip]
  cmp     eax, ptrip
  je      @02

  mov     ptrip, eax

  push    eax
  push    $04
  call    integer_2_line                                    //> int2str.pas

@02:
  mov     byte ptr _line, 10

@03:
  mov     eax, [ebx + offset lift_list.ride]
  cmp     eax, pride
  je      @04

  mov     pride, eax

  push    eax
  push    $04
  call    integer_2_line                                    //> int2str.pas

@04:
  cmp     _i, 2
  jg      @05

  mov     byte ptr _line, 24

  mov     eax, [ebx + offset lift_list.owner]
  push    dword ptr [eax + offset lift_list.dtv.km]
  push    $16
  call    integer_2_line                                    //> int2str.pas

@05:
  mov     byte ptr _line, 61

  mov     eax, [ebx + offset lift_list.s_nat]
  mov     dword ptr _line[35], eax

  mov     eax, [ebx + offset lift_list.s_cnty]
  mov     dword ptr _line[41], eax

  // case _i of
  // 1..2:

  cmp     _i, 2
  ja      @10

  //----------------------------------------------------------------
  // Print the no-match data
  //----------------------------------------------------------------
  mov     edx, offset _line[41]

  inc     _n

  // if (lift_ptr^.split     = '*') or
  //    (lift_ptr^.s_cnty[1] = '*') then

  cmp     byte ptr [ebx + offset lift_list.split], "*"
  je      @07

  cmp     byte ptr [ebx + offset lift_list.s_cnty], "*"
  jne     @09

@06:
  cmp     byte ptr [ebx + offset lift_list.split], "*"
  je      @07

  mov     ebx, [ebx + offset lift_list.lift_nxt]
  jmp     @06

@07:
  mov     eax, [ebx + offset lift_list.s_cnty]
  mov     [edx], eax

  // if lift_ptr^.s_cnty = lift_ptr^.s_nat then

  cmp     eax, [ebx + offset lift_list.s_nat]
  jne     @08

  mov     _nisc, 1

@08:
  add     edx, 4

  mov     ebx, [ebx + offset lift_list.lift_nxt]
  cmp     byte ptr [ebx + offset lift_list.split], "*"
  je      @07

@09:
  mov     ebx, [ebx + offset lift_list.owner]
  mov     ebx, [ebx + offset lift_list.ll_nxt]
  jmp     @19

@10:
  //--------------------------------------------------------------------
  // Print the match data
  //--------------------------------------------------------------------
  // 3..4

  cmp     _i, 4
  ja      @19

  mov     edi, [ebx + offset lift_list.s_nat]

  // repeat

@11:
  // if (lift_ptr^.split      = ' ') and
  //    (lift_ptr^.s_cnty[1] <> '*') then

  cmp     byte ptr [ebx + offset lift_list.split], " "
  jne     @12

  cmp     byte ptr [ebx + offset lift_list.s_cnty], "*"
  je      @12

  // nxt_lift:= lift_ptr^.ll_nxt

  mov     edx, [ebx + offset lift_list.ll_nxt]
  jmp     @14

@12:
  // else
  // if (lift_ptr^.split   = '*') and
  //    (lift_ptr^.cday[3] = 'a') then

  cmp     byte ptr [ebx + offset lift_list.split], "*"
  jne     @13

  cmp     byte ptr [ebx + offset lift_list.cday + 3], "a"
  jne     @13

  // nxt_lift:= lift_ptr^.owner^.ll_nxt

  mov     eax, [ebx + offset lift_list.owner]
  mov     edx, [eax + offset lift_list.ll_nxt]
  jmp     @14

@13:
  // else
  // nxt_lift:= lift_ptr^.lift_nxt

  mov     ebx, [ebx + offset lift_list.lift_nxt]
  jmp     @16

@14:
  // if snat = lift_list.s_cnty then

  cmp     edi, [ebx + offset lift_list.s_cnty]
  jne     @15

  inc     _n

  inc     _c
  mov     eax, [ebx + offset lift_list.dtv.km]
  add     km, eax

@15:
  mov     ebx, edx

@16:
  // until (_n     = slot._c)         or
  //       (snat  <> lift_ptr^.s_nat) or
  //       (ptrip <> lift_ptr^.trip)

  mov     eax, _n
  cmp     eax, [esi + offset fslot._c]
  je      @17

  cmp     edi, [ebx + offset lift_list.s_nat]
  jne     @17

  mov     eax, ptrip
  cmp     eax, [ebx + offset lift_list.trip]
  je      @11

@17:
  // if _c <> slot._c then

  mov     eax, _c
  cmp     eax, [esi + offset fslot._c]
  je      @18

  mov     byte ptr _line, 17

  push    eax
  push    $04
  call    integer_2_line                                    //> int2str.pas

  and     _c, 0

@18:
  mov     byte ptr _line, 24

  push    km
  push    $16
  call    integer_2_line                                    //> int2str.pas

  mov     dword ptr _line[35], edi

  mov     byte ptr _line, 61

  and     km, 0

@19:
  push    _i
  call    new_fast_ptr

  mov     eax, _n
  cmp     eax, [esi + offset fslot._c]
  jne     @01

{ vmovdqu _line,      ymm2 }  db    $c5,$fe,$7f,$15; dd offset _line
{ vmovdqu _line + 32, ymm3 }  db    $c5,$fe,$7f,$1d; dd offset _line + 32

  mov     byte ptr _line, 17

  push    dword ptr [esi + offset fslot._c]
  push    $04
  call    integer_2_line                                    //> int2str.pas

  push    dword ptr [esi + offset fslot.km]
  push    $16
  call    integer_2_line                                    //> int2str.pas

  mov     byte ptr _line, 61

  mov     eax, _nisc
  mov     al, byte ptr a_nisc[eax]
  mov     byte ptr _line[24], al

  push    _i
  call    new_fast_ptr                                      //> fast_all.pas

  mov     eax, slift_ptr
  mov     lift_ptr, eax
  //a-out
end; {foreign_writer}

{$else}

procedure foreign_writer(_i: longint; var slot: fslot);
var slift_ptr: liftptr;
var nxt_lift : liftptr;

var __ok     : boolean;

var ptrip    : longint;
var pride    : longint;

var _c       : longint;
var km       : longint;

var snat     : tycona;
var scnty    : tycona;

var _n       : longint;
var _p       : longint;
var _nisc    : longint;

begin
  slift_ptr:= lift_ptr;
  lift_ptr := slot.lptr;

  ptrip    := -1;
  pride    := -1;

  _c       := 0;
  km       := 0;

  _n       := 0;
  _nisc    := 0;

  repeat
    _line   := foreign_skel;
    _line[0]:= #3;

    if ptrip <> lift_ptr^.trip then
      begin
        ptrip:= lift_ptr^.trip;
        add_integer_2_line4(ptrip);                         //> liftsupp.pas
      end;

    _line[0]:= #10;

    if pride <> lift_ptr^.ride then
      begin
        pride:= lift_ptr^.ride;
        add_integer_2_line4(pride);                         //> liftsupp.pas
      end;

    if _i <= 2 then
      begin
        _line[0]:= #24;
        km_2_line(lift_ptr^.owner^.dtv.km, 5);              //> all_supp.pas
      end;

    _line[0]:= #61;

    move(lift_ptr^.s_nat,  _line[35], sizeof(lift_ptr^.s_nat));
    move(lift_ptr^.s_cnty, _line[41], sizeof(lift_ptr^.s_cnty));

    case _i of
      //----------------------------------------------------------------
      // Print the no-match data
      //----------------------------------------------------------------
      1..2: begin
              inc(_n);

              if (lift_ptr^.split     = '*') or
                 (lift_ptr^.s_cnty[1] = '*') then
                begin
                  while(lift_ptr^.split <> '*') do
                    lift_ptr:= lift_ptr^.lift_nxt;

                  _p:= 41;

                  while(lift_ptr^.split = '*') do
                    begin
                      move(lift_ptr^.s_cnty, _line[_p], sizeof(lift_ptr^.s_cnty));

                      if longint(lift_ptr^.s_cnty) = longint(lift_ptr^.s_nat) then
                        _nisc:= 1;

                      inc(_p, 4);
                      lift_ptr:= lift_ptr^.lift_nxt;
                    end;
                end;

              lift_ptr:= lift_ptr^.owner^.ll_nxt;
            end;

      //----------------------------------------------------------------
      // Print the match data
      //----------------------------------------------------------------
      3..4: begin
              longint(snat):= longint(lift_ptr^.s_nat);

              repeat
                __ok          := true;
                longint(scnty):= longint(lift_ptr^.s_cnty);

                if (lift_ptr^.split      = ' ') and
                   (lift_ptr^.s_cnty[1] <> '*') then
                  nxt_lift:= lift_ptr^.ll_nxt

                else
                if (lift_ptr^.split   = '*') and
                   (lift_ptr^.cday[3] = 'a') then
                  nxt_lift:= lift_ptr^.owner^.ll_nxt

                else
                  begin
                    __ok    := false;
                    nxt_lift:= lift_ptr^.lift_nxt;
                  end;

                if __ok then
                  if longint(snat) = longint(scnty) then
                    begin
                      inc(_n);

                      inc(_c);
                      inc(km, lift_ptr^.dtv.km);
                    end;

                lift_ptr:= nxt_lift;
              until (_n             = slot._c)                  or
                    (longint(snat) <> longint(lift_ptr^.s_nat)) or
                    (ptrip         <> lift_ptr^.trip);

              if _c <> slot._c then
                begin
                  _line[0]:= #17;
                  add_integer_2_line4(_c);                  //> liftsupp.pas
                  _C:= 0;
                end;

              _line[0]:= #24;
              km_2_line(km, 5);                             //> all_supp.pas
              _line[0]:= #61;
              km      := 0;
            end;
    end;

    new_fast_ptr(_i);
  until _n = slot._c;

  _line   := foreign_skel;
  _line[0]:= #17;

  add_integer_2_line4(slot._c);                             //> liftsupp.pas
  km_2_line(slot.km, 5);                                    //> all_supp.pas

  _line[0] := #61;
  _line[24]:= a_nisc[_nisc];

  new_fast_ptr(_i);                                         //> fast_all.pas

  lift_ptr:= slift_ptr;
end; {foreign_writer}
{$endif}

{$ifdef asm}
procedure foreigners; assembler; {&uses ebx,esi,edi} {&frame-}
var nxt_lift: liftptr;

var cnty    : tycona;
var __ok    : boolean;
var __pend  : boolean;

asm
  //a-in foreigners
  db    $c5,$fe,$6f,$05; dd offset ifslot             // vmovdqu ymm0, ifslot
  db    $c5,$fe,$7f,$05; dd offset mcslot             // vmovdqu mcslot, ymm0
  db    $c5,$fe,$7f,$05; dd offset mdslot             // vmovdqu mdslot, ymm0
  db    $c5,$fe,$7f,$05; dd offset mrslot             // vmovdqu mrslot, ymm0
  db    $c5,$fe,$7f,$05; dd offset ncslot             // vmovdqu ncslot, ymm0
  db    $c5,$fe,$7f,$05; dd offset ndslot             // vmovdqu ndslot, ymm0
  db    $c5,$fe,$7f,$05; dd offset nrslot             // vmovdqu nrslot, ymm0

  db    $c5,$fe,$6f,$15; dd offset foreign_skel       // vmovdqu ymm2, foreign_skel
  db    $c5,$fe,$6f,$1d; dd offset foreign_skel + 32  // vmovdqu ymm3, foreign_skel + 32
  db    $c5,$fe,$7f,$15; dd offset _line              // vmovdqu _line,             ymm2
  db    $c5,$fe,$7f,$1d; dd offset _line + 32         // vmovdqu _line + 32,        ymm3

  mov   ebx, lift_top

@01:
  mov   __ok, true

  mov   eax, [ebx + offset lift_list.s_cnty]
  mov   cnty, eax

  // if (lift_ptr^.split      = ' ') and
  //    (lift_ptr^.s_cnty[1] <> '*') then

  cmp   byte ptr [ebx + offset lift_list.split], " "
  jne   @02

  cmp   byte ptr [ebx + offset lift_list.s_cnty], "*"
  je    @02

  // nxt_lift:= lift_ptr^.ll_nxt

  mov   edx, [ebx + offset lift_list.ll_nxt]
  jmp   @04

@02:
  // else
  // if (lift_ptr^.split   = '*') and
  //    (lift_ptr^.cday[3] = 'a') then

  cmp   byte ptr [ebx + offset lift_list.split], "*"
  jne   @03

  cmp   byte ptr [ebx + offset lift_list.cday + 3], "a"
  jne   @03

  // nxt_lift:= lift_ptr^.owner^.ll_nxt

  mov   eax, [ebx + offset lift_list.owner]
  mov   edx, [eax + offset lift_list.ll_nxt]
  jmp   @04

@03:
  // else
  mov   __ok, false

  // nxt_lift:= lift_ptr^.lift_nxt

  mov   edx, [ebx + offset lift_list.lift_nxt]

@04:
  mov   nxt_lift, edx

  cmp   __ok, false
  je    @18

  // if lift_ptr^.s_nat = cnty then

  mov   eax, [ebx + offset lift_list.s_nat]
  cmp   eax, cnty
  jne   @11

  //----------------------------------------------------------
  // Process the finished no-match data
  //----------------------------------------------------------
  mov   esi, offset ncslot

  cmp   dword [esi + offset fslot.km], 0
  jle   @09

  db    $c5,$fe,$6f,$0e  // vmovdqu ymm1, [esi]

  // if (ncslot.km > ndslot.km) or
  //    (ncslot.km = ndslot.km) and
  //    (ncslot._c > ndslot._c) then

  mov   edi, offset ndslot

  mov   eax, [esi + offset fslot.km]
  cmp   eax, [edi + offset fslot.km]
  jg    @05
  jne   @06

  mov   eax, [esi + offset fslot._c]
  cmp   eax, [edi + offset fslot._c]
  jle   @06

@05:
  db    $c5,$fe,$7f,$0f  // vmovdqu [edi], ymm1

  push  1
  push  edi
  call  foreign_writer                                      //> foreign.pas

@06:
  // if (ncslot._c > nrslot._c) or
  //    (ncslot._c = nrslot._c) and
  //    (ncslot.km > nrslot.km) then

  mov   edi, offset nrslot

  mov   eax, [esi + offset fslot._c]
  cmp   eax, [edi + offset fslot._c]
  jg    @07
  jne   @08

  mov   eax, [esi + offset fslot.km]
  cmp   eax, [edi + offset fslot.km]
  jle   @08

@07:
  db    $c5,$fe,$7f,$0f  // vmovdqu [edi], ymm1

  push  2
  push  edi
  call  foreign_writer                                      //> foreign.pas

@08:
  db    $c5,$fe,$7f,$06  // vmovdqu [esi], ymm0

  //----------------------------------------------------------
  // Process matching data
  //----------------------------------------------------------
@09:
  mov   esi, offset mcslot

  cmp   [esi + offset fslot.lptr], 0
  jne   @10

  mov   [esi + offset fslot.lptr], ebx

@10:
  inc   [esi + offset fslot._c]

  mov   eax, [ebx + offset lift_list.owner]
  mov   eax, [eax + offset lift_list.dtv.km]
  add   [esi + offset fslot.km], eax
  jmp   @18

@11:
  //----------------------------------------------------------
  // Process the finished match data
  //----------------------------------------------------------
  mov   esi, offset mcslot

  cmp   dword [esi + offset fslot.km], 0
  jle   @16

  db    $c5,$fe,$6f,$0e  // vmovdqu ymm1, [esi]

  // if (mcslot.km > mdslot.km) or
  //    (mcslot.km = mdslot.km) and
  //    (mcslot._c > mdslot._c) then

  mov   edi, offset mdslot

  mov   eax, [esi + offset fslot.km]
  cmp   eax, [edi + offset fslot.km]
  jg    @12
  jne   @13

  mov   eax, [esi + offset fslot._c]
  cmp   eax, [edi + offset fslot._c]
  jle   @13

@12:
  db    $c5,$fe,$7f,$0f  // vmovdqu [edi], ymm1

  push  3
  push  edi
  call  foreign_writer                                      //> foreign.pas

@13:
  // if (mcslot._c > mrslot._c) or
  //    (mcslot._c = mrslot._c) and
  //    (mcslot.km > mrslot.km) then

  mov   edi, offset mrslot

  mov   eax, [esi + offset fslot._c]
  cmp   eax, [edi + offset fslot._c]
  jg    @14
  jne   @15

  mov   eax, [esi + offset fslot.km]
  cmp   eax, [edi + offset fslot.km]
  jle   @15

@14:
  db    $c5,$fe,$7f,$0f  // vmovdqu [edi], ymm1

  push  4
  push  edi
  call  foreign_writer                                      //> foreign.pas

@15:
  db    $c5,$fe,$7f,$06  // vmovdqu [esi], ymm0

  //----------------------------------------------------------
  // Process non-matching data
  //----------------------------------------------------------
@16:
  mov   esi, offset ncslot

  cmp   [esi + offset fslot.lptr], 0
  jne   @17

  mov   [esi + offset fslot.lptr], ebx

@17:
  inc   [esi + offset fslot._c]

  mov   eax, [ebx + offset lift_list.owner]
  mov   eax, [eax + offset lift_list.dtv.km]
  add   [esi + offset fslot.km], eax

@18:
  mov   ebx, nxt_lift

  test  ebx, ebx
  jnz   @01

  mov   _i, 1

@19:
  push  offset foreign_topl
  call  write_anyline                                       //> hhcommon.pas

  // if odd(_i) then

  test  _i, 1
  je    @20

  mov   eax, textrec(liftout).bufptr
  add   eax, textrec(liftout).bufpos
  mov   byte ptr [eax - (type foreign_topl - 3) - 2 + 92], "L"

@20:
  mov   __pend, true

  mov   ebx, fast_top

@21:
  test  ebx, ebx
  jz    @24

  movzx eax, byte [ebx + offset fast_list.ftype]
  cmp   eax, _i
  jne   @23

  cmp   __pend, true
  jne   @22

  push  offset foreign_sep
  call  write_anyline                                       //> hhcommon.pas

@22:
  lea   eax, [ebx + 4]
  push  eax
  call  write_anyline                                       //> hhcommon.pas

  cmp   byte ptr [ebx + offset fast_list.fline + 24], " "
  setne __pend

@23:
  mov   ebx, [ebx + offset fast_list.fast_nxt]
  jmp   @21

@24:
  push  offset foreign_sep
  call  write_sep_endl                                      //> hhcommon.pas

  inc   _i
  cmp   _i, 4
  jle   @19

@25:
  call  delete_fastlist                                     //> fast_all.pas
  //a-out
end; {foreigners}

{$else}

procedure foreigners;
var nxt_lift: liftptr;

var __ok    : boolean;
var __pend  : boolean;

begin
  mcslot  := ifslot;
  mdslot  := ifslot;
  mrslot  := ifslot;

  ncslot  := ifslot;
  ndslot  := ifslot;
  nrslot  := ifslot;

  lift_ptr:= lift_top;

  repeat
    __ok:= true;

    if (lift_ptr^.split      = ' ') and
       (lift_ptr^.s_cnty[1] <> '*') then
      nxt_lift:= lift_ptr^.ll_nxt

    else
    if (lift_ptr^.split   = '*') and
       (lift_ptr^.cday[3] = 'a') then
      nxt_lift:= lift_ptr^.owner^.ll_nxt

    else
      begin
        __ok    := false;
        nxt_lift:= lift_ptr^.lift_nxt;
      end;

    if __ok then
      begin
        if longint(lift_ptr^.s_nat) = longint(lift_ptr^.s_cnty) then
          begin
            //----------------------------------------------------------
            // Process the finished no-match data
            //----------------------------------------------------------
            if ncslot.km > 0 then
              begin
                if (ncslot.km > ndslot.km) or
                   (ncslot.km = ndslot.km) and
                   (ncslot._c > ndslot._c) then
                  begin
                    ndslot:= ncslot;

                    foreign_writer(1, ndslot);              //> foreign.pas
                  end;

                if (ncslot._c > nrslot._c) or
                   (ncslot._c = nrslot._c) and
                   (ncslot.km > nrslot.km) then
                  begin
                    nrslot:= ncslot;

                    foreign_writer(2, nrslot);              //> foreign.pas
                  end;

                ncslot:= ifslot;
              end;

            //----------------------------------------------------------
            // Process matching data
            //----------------------------------------------------------
            if mcslot.lptr = nil then
              mcslot.lptr:= lift_ptr;

            inc(mcslot._c);
            inc(mcslot.km,   lift_ptr^.owner^.dtv.km);
          end
        else
          begin
            //----------------------------------------------------------
            // Process the finished match data
            //----------------------------------------------------------
            if mcslot.km > 0 then
              begin
                if (mcslot.km > mdslot.km) or
                   (mcslot.km = mdslot.km) and
                   (mcslot._c > mdslot._c) then
                  begin
                    mdslot:= mcslot;

                    foreign_writer(3, mdslot);              //> foreign.pas
                  end;

                if (mcslot._c > mrslot._c) or
                   (mcslot._c = mrslot._c) and
                   (mcslot.km > mrslot.km) then
                  begin
                    mrslot:= mcslot;

                    foreign_writer(4, mrslot);              //> foreign.pas
                  end;

                mcslot:= ifslot;
              end;

            //----------------------------------------------------------
            // Process non-matching data
            //----------------------------------------------------------
            if ncslot.lptr = nil then
              ncslot.lptr:= lift_ptr;

            inc(ncslot._c);
            inc(ncslot.km,   lift_ptr^.owner^.dtv.km);
          end;
      end;

    lift_ptr:= nxt_lift;
  until lift_ptr = nil;

  for _i:= 1 to 4 do
    begin
      _line:= foreign_topl;

      if odd(_i) then
        _line[92]:= 'L';

      write_line;                                           //> hhcommon.pas
      __pend:= true;

      fast_ptr:= fast_top;

      while fast_ptr <> nil do
        begin
          if fast_ptr^.ftype = char(_i) then
            begin
              if __pend then
                write_anyline(foreign_sep);                 //> hhcommon.pas

              write_anyline(fast_ptr^.fline);               //> hhcommon.pas

              __pend:= fast_ptr^.fline[24] <> ' ';
            end;

          fast_ptr:= fast_ptr^.fast_nxt;
        end;

      write_sep_endl(foreign_sep);                          //> hhcommon.pas
    end;

  delete_fastlist;                                          //> fast_all.pas
end; {foreigners}
{$endif}
Robert AH Prins
robert.ah.prins @ the.17+Gb.Google thingy
User avatar
prino
 
Posts: 564
Joined: Wed Mar 11, 2009 12:22 am
Location: Oostende, Belgium
Has thanked: 3 times
Been thanked: 24 times

Re: Some questions about MAP Processing and Data Validation

Postby rogerb » Tue Aug 14, 2018 10:22 pm

Thank you very much for all your answers.
It was really about spaces, I had to remove all the spaces after the last number in the line.
But that wasn't enough, so I removed all the spaces, and when I post I can add the code inside the code tags.
When I press preview, the code shows up.
Now, I would like to return to the beginning.
I opened this new post because of the advice of Mr. Robert Sample about the usual way to process maps.
I've changed my program to follow that advice.
This is the code of my COBOL program now:


000100IDENTIFICATIONDIVISION.00010001
000200PROGRAM-ID.CARPRG.00020099
000300AUTHOR.RMQB.00030002
000400*---------------------------------------------00040002
000500*OBJECTIVE:WRITEANDREAD-SEQUENTIALFILE00050099
000600*CARSINFORMATION00060099
000700*---------------------------------------------00070002
001700DATADIVISION.00170002
003400WORKING-STORAGESECTION.00340002
00341001REGISTO.00341099
00343005DATESOLDPICX(10).00343099
00344005FILLERPICX(01).00344099
00345005CARBRANDPICX(10).00345099
00345105FILLERPICX(01).00345199
00346005CARMODELPICX(10).00346099
00346105FILLERPICX(01).00346199
00347005REGISTRATIONPICX(09).00347099
00347105FILLERPICX(01).00347199
00348005CLIENTNAMEPICX(10).00348099
00349005CONTACTPIC9(09).00349099
00349105FILLERPICX(01).00349199
00349205PRODUCTIONYEARPIC9(04).00349299
00349305FILLERPICX(01).00349399
00349405MILEAGEPIC9(06).00349499
00349505FILLERPICX(01).00349599
00349605CARPRICEPIC9(05).00349699
00349705FILLERPICX(60).00349799
00349805FILLERPICX(60).00349899
00350001FS-CARPICX(02)VALUESPACES.00350099
00360088FS-CAR-OKVALUE'00'.00360099
00370088FS-CAR-EOFVALUE'10'.00370099
00371001CARNOPIC9(09)COMP-5.00371099
00372001RBASTOPPIC9(09)COMP-5.00372099
00373001READ-RECORDPIC9(09)COMP-5.00373099
00374001SEARCH-RECPIC9(09)COMP-5.00374099
00380001WS-MESSAGEPICX(50).00380099
00390001WS-COMMAREAPICX(10)VALUESPACES.00390094
00400001OPTION-IN.00400099
00410005OPTIONPICX(18).00410099
00420001FILEDATA.00420099
00430005DATA-WRITEPICX(18).00430099
00440005DATA-READPICX(18).00440099
00450001WS-ABSTIMEPICS9(15)COMP-3.00450099
00460001WS-DATEPICX(10).00460099
00470001WS-DAYWEEKPICS9(8)USAGEBINARY.00470099
00480001WS-NAMEDAYPICX(09).00480099
00490001RESPONSEPICS9(08)BINARY.00490099
00570001COUNTERS.00570099
00580005READ-COUNTPIC9(2).00580099
00581005CAR-COUNTPIC9(3).00581099
00590001WS-LENPICS9(4)COMP-3.00590099
00590101WS-KEY-LENPICS9(4)COMP.00590199
00591001WS-STD-REC-KEYPIC9(3).00591099
00592001CH1PICX(01)VALUE'S'.00592099
00593001CH2PICX(01)VALUE'S'.00593099
00594001CH3PICX(01)VALUE'S'.00594099
00595001CH4PICX(01)VALUE'S'.00595099
006000COPYCARMAP.00600099
006010*COPYDFHBMSCA.00601099
006100LINKAGESECTION.00610036
00620001DFHCOMMAREAPICX(10).00620036
006300*TRANS(ECAR)MAPSET(CARMAP)GROUP(CARPRG)00630099
006400*MAPFIELDSOPTINFOMSGSALEBRANDMODELPLATECLIENT00640099
006410*CONTINUEDPHONECREAT(CREATIONDATE)MILESPRICE00641099
006500PROCEDUREDIVISION.00650002
006600000-MAIN.00660099
006700*MOVEDFHCOMMAREATOWS-COMMAREA.00670099
006800IFEIBCALEN=0THEN00680099
006810MOVEDFHCOMMAREATOWS-COMMAREA00681099
006900PERFORM010-PREPARE00690099
007000MOVE'FIRST'TOWS-COMMAREA00700099
007010MOVESPACESTOREGISTO00701099
007011INITIALIZERESPONSE00701199
007020INITIALIZEREGISTO00702099
007030INITIALIZECARNO00703099
007100INITIALIZEFS-CARREAD-COUNT00710099
007200INITIALIZEWS-LENWS-STD-REC-KEY00720099
007300MOVE1TOCAR-COUNT00730099
007400MOVE99999999TORESPONSE00740099
007600END-IF.00760099
007700*FILLER/SEPARATOR00770099
007800IFEIBCALEN>0THEN00780099
007900PERFORM010-PREPARE00790099
008000END-IF.00800099
009000PERFORM020-CHOICE.00900099
009200EXECCICS00920099
009300RETURN00930099
009400END-EXEC.00940099
009500GOBACK.00950099
009600010-PREPARE.00960099
009900EXECCICS00990099
010000ASKTIME01000099
010100ABSTIME(WS-ABSTIME)01010099
010200END-EXEC.01020099
010300EXECCICS01030099
010400FORMATTIME01040099
010500ABSTIME(WS-ABSTIME)01050099
010600DDMMYYYY(WS-DATE)01060099
010700DATESEP('/')01070099
010800END-EXEC.01080099
010900EXECCICS01090099
011000FORMATTIME01100099
011100ABSTIME(WS-ABSTIME)01110099
011200DAYOFWEEK(WS-DAYWEEK)01120099
011300END-EXEC.01130099
011400EVALUATEWS-DAYWEEK01140099
011500WHEN001150099
011600MOVE"SUNDAY"TOWS-NAMEDAY01160099
011700WHEN101170099
011800MOVE"MONDAY"TOWS-NAMEDAY01180099
011900WHEN201190099
012000MOVE"TUESDAY"TOWS-NAMEDAY01200099
012100WHEN301210099
012200MOVE"WEDNESDAY"TOWS-NAMEDAY01220099
012300WHEN401230099
012400MOVE"THURSDAY"TOWS-NAMEDAY01240099
012500WHEN501250099
012600MOVE"FRIDAY"TOWS-NAMEDAY01260099
012700WHEN601270099
012800MOVE"SATURDAY"TOWS-NAMEDAY01280099
012900END-EVALUATE.01290099
013000MOVEWS-NAMEDAYTOWS-MESSAGE(1:10).01300099
013100MOVE','TOWS-MESSAGE(11:3).01310099
013200MOVEWS-DATETOWS-MESSAGE(14:10).01320099
013300MOVEWS-MESSAGETOCDAYO.01330099
013500*END-IF.01350099
013600020-CHOICE.01360099
013700*MOVEYITOYOUT.01370099
013701MOVELOW-VALUESTOWS-MESSAGE.01370199
013702MOVELOW-VALUESTOCARMAI.01370299
013751MOVEWS-MESSAGETOMSGO.01375199
013800PERFORMUNTILCH1='N'01380099
013900MOVELOW-VALUESTOCARMAI01390099
014000MOVESPACESTOCDAYI01400099
014100MOVESPACESTOCDAYO01410099
014200*MOVE0TOWCOUNTDUPL.01420099
014400MOVEWS-NAMEDAYTOWS-MESSAGE(1:10)01440099
014500MOVE','TOWS-MESSAGE(11:3)01450099
014600MOVEWS-DATETOWS-MESSAGE(14:10)01460099
014700MOVEWS-MESSAGETOCDAYO01470099
014701MOVE"OPTIONS|0:EXIT/1:NEWRECORD/2:SHOWALL"TOMSGO01470199
014702PERFORM030-SEND-MAP01470299
014703MOVELOW-VALUESTOMSGO01470399
014710MOVE"OPTIONS|3:SEARCHFORARECORD"TOMSGO01471099
014800PERFORM030-SEND-MAP01480099
014900*EXECCICS01490099
015000*SENDMAP('NAMEMA')MAPSET('NAMEMAP')01500099
015100*ERASE01510099
015200*END-EXEC01520099
015300PERFORM040-RECEIVE-MAP01530099
015400*EXECCICS01540099
015500*RECEIVEMAP('NAMEMA')MAPSET('NAMEMAP')01550099
015600*ASIS01560099
015700*END-EXEC01570099
015800MOVEOPTITOOPTION01580099
015900EVALUATEOPTION01590099
016000WHEN101600099
016100PERFORM050-ADD-RECORD01610099
016110MOVE'N'TOCH101611099
016200WHEN201620099
016300PERFORM060-SHOW-RECORDS01630099
016310WHEN301631099
016320PERFORM070-SEARCH-RECORD01632099
016400WHEN001640099
016500MOVE'N'TOCH101650099
016600END-EVALUATE01660099
016610END-PERFORM.01661099
016700030-SEND-MAP.01670099
016800EXECCICS01680099
016900SENDMAP('CARMA')MAPSET('CARMAP')01690099
017000ERASE01700099
017100END-EXEC.01710099
017110030-SEND-MAP-CURSOR.01711099
017120EXECCICS01712099
017130SENDMAP('CARMA')MAPSET('CARMAP')01713099
017140ERASE01714099
017141CURSOR01714199
017150END-EXEC.01715099
017200040-RECEIVE-MAP.01720099
017300EXECCICS01730099
017400RECEIVEMAP('CARMA')MAPSET('CARMAP')01740099
017500ASIS01750099
017600END-EXEC.01760099
017700050-ADD-RECORD.01770099
017800MOVELOW-VALUESTOCARMAI.01780099
017900MOVEWS-NAMEDAYTOWS-MESSAGE(1:10).01790099
018000MOVE','TOWS-MESSAGE(11:3).01800099
018100MOVEWS-DATETOWS-MESSAGE(14:10).01810099
018200MOVEWS-MESSAGETOCDAYO.01820099
018210MOVE0TOCARNO.01821099
018220*MOVEINFOLTOMSGO.01822099
018230*PERFORM030-SEND-MAP.01823099
019600*MOVELOW-VALUESTOCARMAI,CARMAO.01960099
019620MOVE"PLEASEREADTHEFOLLOWINGINSTRUCTIONS"TOMSGO.01962099
019630PERFORM030-SEND-MAP.01963099
019640MOVELOW-VALUESTOMSGO.01964099
019650MOVE"ONLYWRITEINTHEFIELDSATTHEEND"TOMSGO.01965099
019660PERFORM030-SEND-MAP.01966099
019670MOVELOW-VALUESTOMSGO.01967099
019700MOVE"WRITETHEDATEOFSALE(DD-MM-YYYY)"TOMSGO.01970099
019800PERFORM030-SEND-MAP.01980099
019801MOVELOW-VALUESTOMSGO.01980199
019802MOVE"WRITETHECARBRANDINTHEBRANDFIELD"TOMSGO.01980299
019803PERFORM030-SEND-MAP.01980399
019821MOVELOW-VALUESTOMSGO.01982199
019822MOVE"WRITETHECARMODELINTHEMODELFIELD"TOMSGO.01982299
019823PERFORM030-SEND-MAP.01982399
019824MOVELOW-VALUESTOMSGO.01982499
019825MOVE"WRITETHELICENSEPLATEINCARPLATEFIELD"TOMSGO.01982599
019826PERFORM030-SEND-MAP.01982699
019827MOVELOW-VALUESTOMSGO.01982799
019828MOVE"WRITETHENAMEOFTHECLIENTINCLIENTFIELD"TOMSGO.01982899
019829PERFORM030-SEND-MAP.01982999
019830MOVELOW-VALUESTOMSGO.01983099
019840MOVE"WRITETHEPHONEOFCLIENTINTHEPHONEFIELD"TOMSGO.01984099
019841PERFORM030-SEND-MAP.01984199
019842MOVELOW-VALUESTOMSGO.01984299
019843MOVE"WRITETHEYEARTHECARISMADEMADEINFIELD"TOMSGO.01984399
019844PERFORM030-SEND-MAP.01984499
019845MOVELOW-VALUESTOMSGO.01984599
019846MOVE"WRITETHEMILEAGEINTHEMILEAGEFIELD"TOMSGO.01984699
019847PERFORM030-SEND-MAP.01984799
019848MOVELOW-VALUESTOMSGO.01984899
019849MOVE"WRITETHEPRICEOFTHECARINPRICEFIELD"TOMSGO.01984999
019850PERFORM030-SEND-MAP.01985099
019851MOVELOW-VALUESTOMSGO.01985199
019852MOVELOW-VALUESTOWS-MESSAGE.01985299
019853MOVELOW-VALUESTOCARMAI.01985399
019854MOVEWS-NAMEDAYTOWS-MESSAGE(1:10).01985499
019855MOVE','TOWS-MESSAGE(11:3).01985599
019856MOVEWS-DATETOWS-MESSAGE(14:10).01985699
019857MOVEWS-MESSAGETOCDAYO.01985799
019858MOVE-1TOSALEL.01985899
019859MOVE"PLEASEWRITEINFIELDSASINSTRUCTEDABOVE"TOMSGO.01985999
019860PERFORM030-SEND-MAP-CURSOR.01986099
019870PERFORM040-RECEIVE-MAP.01987099
020000MOVESALEITODATESOLD.02000099
020500MOVEBRANDITOCARBRAND.02050099
021000MOVEMODELITOCARMODEL.02100099
021500MOVEPLATEITOREGISTRATION.02150099
022000MOVECLIENTITOCLIENTNAME.02200099
022400MOVEPHONEITOCONTACT.02240099
022800MOVECREATITOPRODUCTIONYEAR.02280099
023200MOVEMILESITOMILEAGE.02320099
023300MOVEPRICEITOCARPRICE.02330099
023700EXECCICSWRITE02370099
023800FILE('CARSDD')02380099
023900FROM(REGISTO)02390099
024010RIDFLD(CARNO)02401099
024100RBA02410099
024200END-EXEC.02420099
024210ADD1TOCAR-COUNT.02421099
024300*CLOSECAR.02430099
024400060-SHOW-RECORDS.02440099
024500*OPENINPUTCAR02450099
024501MOVELOW-VALUESTOWS-MESSAGE.02450199
024502MOVELOW-VALUESTOCARMAI.02450299
024510MOVEWS-MESSAGETOMSGO.02451099
024512MOVEWS-LENTOWS-KEY-LEN.02451299
024520MOVE0TOCARNO.02452099
024600EXECCICSSTARTBR02460099
024700FILE('CARSDD')02470099
024800RIDFLD(CARNO)02480099
024810RBA02481099
024820RESP(RESPONSE)02482099
024900END-EXEC.02490099
024910MOVELOW-VALUESTOWS-MESSAGE.02491099
024920MOVELOW-VALUESTOCARMAI.02492099
024930IFRESPONSENOT=DFHRESP(NORMAL)02493099
024960MOVE'FILEOPERATIONERROR'TOWS-MESSAGE(1:20)02496099
024970MOVE':'TOWS-MESSAGE(21:2)02497099
024980MOVERESPONSETOWS-MESSAGE(24:8)02498099
024991MOVEWS-MESSAGETOMSGO02499199
024992PERFORM030-SEND-MAP02499299
024993END-IF.02499399
024994PERFORMUNTILCH3='N'02499499
024995MOVE0TORESPONSE02499599
025100EXECCICSREADNEXT02510099
025200FILE('CARSDD')02520099
025300INTO(REGISTO)02530099
025320RIDFLD(CARNO)02532099
025330RBA02533099
025340RESP(RESPONSE)02534099
025400END-EXEC02540099
025500MOVELOW-VALUESTOWS-MESSAGE02550099
025600MOVELOW-VALUESTOCARMAI02560099
025601IFRESPONSE=DFHRESP(ENDFILE)02560199
025602MOVELOW-VALUESTOWS-MESSAGE02560299
025603MOVELOW-VALUESTOCARMAI02560399
025604MOVE'ENDOFFILEREACHED'TOWS-MESSAGE(1:19)02560499
025605MOVE':'TOWS-MESSAGE(21:2)02560599
025606MOVERESPONSETOWS-MESSAGE(24:8)02560699
025607MOVEWS-MESSAGETOMSGO02560799
025608PERFORM030-SEND-MAP02560899
025609MOVE'N'TOCH302560999
025610ELSE02561099
025611IFRESPONSENOT=DFHRESP(NORMAL)02561199
025612MOVELOW-VALUESTOWS-MESSAGE02561299
025613MOVELOW-VALUESTOCARMAI02561399
025620MOVE'FILEOPERATIONERROR'TOWS-MESSAGE(1:20)02562099
025630MOVE':'TOWS-MESSAGE(21:2)02563099
025640MOVERESPONSETOWS-MESSAGE(24:8)02564099
025641MOVEWS-MESSAGETOMSGO02564199
025642PERFORM030-SEND-MAP02564299
025643MOVE'N'TOCH302564399
025644END-IF02564499
025650END-IF02565099
025660IFRESPONSE=DFHRESP(NORMAL)02566099
026000ADD1TOREAD-COUNT02600099
026001MOVELOW-VALUESTOCARMAI02600199
026002MOVEWS-NAMEDAYTOWS-MESSAGE(1:10)02600299
026003MOVE','TOWS-MESSAGE(11:3)02600399
026004MOVEWS-DATETOWS-MESSAGE(14:10)02600499
026005MOVEWS-MESSAGETOCDAYO02600599
026010MOVE'READINGRECORDSINFILE'TOMSGO02601099
026100MOVEDATESOLDTOSALEO02610099
026200MOVECARBRANDTOBRANDO02620099
026500MOVECARMODELTOMODELO02650099
026600MOVEREGISTRATIONTOPLATEO02660099
026900MOVECLIENTNAMETOCLIENTO02690099
027000MOVECONTACTTOPHONEO02700099
027300MOVEPRODUCTIONYEARTOCREATO02730099
027400MOVEMILEAGETOMILESO02740099
027700MOVECARPRICETOPRICEO02770099
027800PERFORM030-SEND-MAP02780099
027801END-IF02780199
027810END-PERFORM.02781099
027900EXECCICSENDBR02790099
027910FILE('CARSDD')02791099
027920END-EXEC.02792099
028000*CLOSECAR.02800099
028100070-SEARCH-RECORD.02810099
028200MOVE0TOCARNO.02820099
028300EXECCICSSTARTBR02830099
028400FILE('CARSDD')02840099
028500RIDFLD(CARNO)02850099
028600RBA02860099
028700RESP(RESPONSE)02870099
028800END-EXEC.02880099
029100IFRESPONSENOT=DFHRESP(NORMAL)02910099
029110MOVELOW-VALUESTOWS-MESSAGE02911099
029120MOVELOW-VALUESTOCARMAI02912099
029200MOVE'FILEOPERATIONERROR'TOWS-MESSAGE(1:20)02920099
029300MOVE':'TOWS-MESSAGE(21:2)02930099
029400MOVERESPONSETOWS-MESSAGE(24:8)02940099
029500MOVEWS-MESSAGETOMSGO02950099
029600PERFORM030-SEND-MAP02960099
029700END-IF.02970099
029710MOVELOW-VALUESTOWS-MESSAGE.02971099
029720MOVELOW-VALUESTOCARMAI.02972099
029730MOVE"WRITERECORDSEARCHINTHEMADEINFIELD"TOMSGO.02973099
029740PERFORM030-SEND-MAP.02974099
029750MOVELOW-VALUESTOMSGO.02975099
029760MOVE"FOREXAMPLEWRITE0001FORFIRSTRECORD"TOMSGO.02976099
029761MOVE-1TOCREATL.02976199
029770PERFORM030-SEND-MAP-CURSOR.02977099
029780PERFORM040-RECEIVE-MAP.02978099
029790MOVECREATITOREAD-RECORD.02979099
029800PERFORMUNTILCH4='N'02980099
029900MOVE0TORESPONSE02990099
030000EXECCICSREADNEXT03000099
030100FILE('CARSDD')03010099
030200INTO(REGISTO)03020099
030300RIDFLD(CARNO)03030099
030400RBA03040099
030500RESP(RESPONSE)03050099
030600END-EXEC03060099
030900IFRESPONSE=DFHRESP(ENDFILE)03090099
031000MOVELOW-VALUESTOWS-MESSAGE03100099
031100MOVELOW-VALUESTOCARMAI03110099
031200MOVE'ENDOFFILEREACHED'TOWS-MESSAGE(1:19)03120099
031300MOVE':'TOWS-MESSAGE(21:2)03130099
031400MOVERESPONSETOWS-MESSAGE(24:8)03140099
031500MOVEWS-MESSAGETOMSGO03150099
031600PERFORM030-SEND-MAP03160099
031700MOVE'N'TOCH403170099
031800ELSE03180099
031900IFRESPONSENOT=DFHRESP(NORMAL)03190099
032000MOVELOW-VALUESTOWS-MESSAGE03200099
032100MOVELOW-VALUESTOCARMAI03210099
032200MOVE'FILEOPERATIONERROR'TOWS-MESSAGE(1:20)03220099
032300MOVE':'TOWS-MESSAGE(21:2)03230099
032400MOVERESPONSETOWS-MESSAGE(24:8)03240099
032500MOVEWS-MESSAGETOMSGO03250099
032600PERFORM030-SEND-MAP03260099
032700MOVE'N'TOCH403270099
032800END-IF03280099
032900END-IF03290099
033000IFRESPONSE=DFHRESP(NORMAL)03300099
033100ADD1TOREAD-COUNT03310099
033110MOVELOW-VALUESTOWS-MESSAGE03311099
033200MOVELOW-VALUESTOCARMAI03320099
033300MOVEWS-NAMEDAYTOWS-MESSAGE(1:10)03330099
033400MOVE','TOWS-MESSAGE(11:3)03340099
033500MOVEWS-DATETOWS-MESSAGE(14:10)03350099
033600MOVEWS-MESSAGETOCDAYO03360099
033700MOVE'READINGRECORDSINFILE'TOMSGO03370099
033800MOVEDATESOLDTOSALEO03380099
033900MOVECARBRANDTOBRANDO03390099
034000MOVECARMODELTOMODELO03400099
034100MOVEREGISTRATIONTOPLATEO03410099
034200MOVECLIENTNAMETOCLIENTO03420099
034300MOVECONTACTTOPHONEO03430099
034400MOVEPRODUCTIONYEARTOCREATO03440099
034500MOVEMILEAGETOMILESO03450099
034600MOVECARPRICETOPRICEO03460099
034700PERFORM030-SEND-MAP03470099
034710MOVECARNOTORBASTOP03471099
034711COMPUTESEARCH-REC=(READ-RECORD-1)*20003471199
034720IFRBASTOP=SEARCH-RECTHEN03472099
034721MOVELOW-VALUESTOMSGO03472199
034723MOVE'YOUGOTTHESEARCHEDRECORD'TOMSGO03472399
034727PERFORM030-SEND-MAP03472799
034730MOVE'N'TOCH403473099
034740END-IF03474099
034800END-IF03480099
034900END-PERFORM.03490099
035000EXECCICSENDBR03500099
035100FILE('CARSDD')03510099
035200END-EXEC.03520099



I've added another option, Search for a Record (070-SEARCH-RECORD).
If the user chooses option 3 the program asks the user to insert the number of the record he(or she) wants to find (0001 for the first record) and then the program will read all records from the start until it finds the record the person has inserted (or endfile appears).
If the record is located, the program will show that record with the message 'YOU GOT THE SEARCHED RECORD' in the MESSAGE field of the MAP.
I've already tested this part and it's working well.
So, my question is to Mr. Robert Sample and everybody else.

According to your previous sentence about map processing, can you please tell me if the paragraph 050-ADD-RECORD is processing the map according to what you've told me, or should I change it ?

Thank you,
Roger
rogerb
 
Posts: 64
Joined: Sat Jul 28, 2018 9:14 pm
Has thanked: 5 times
Been thanked: 0 time

Re: Some questions about MAP Processing and Data Validation

Postby enrico-sorichetti » Wed Aug 15, 2018 1:06 am

its a pity that after removing the spaces the program is unreadable
the suggestion was to drop all the TRAILING spaces
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico-sorichetti
Global moderator
 
Posts: 2790
Joined: Fri Apr 18, 2008 11:25 pm
Has thanked: 0 time
Been thanked: 148 times

PreviousNext

Return to IBM Cobol

 


  • Related topics
    Replies
    Views
    Last post