Quelle  kaputt.rtf   Sprache: unbekannt

{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 Fixedsys;}{\f1\fmodern\fprq1\fcharset0 Fixedsys;}
{\colortbl;\red255\green0\blue0;\red0\green0\blue255;\red0\green0\blue128;\red0\green0\blue0;\red128\green0\blue0;\red0\green128\blue0;\red128\green128\blue128;\red0\green128\blue128;\red255\green0\blue255;}
{\*\generator Msftedit 5.41.15.1507;}
\viewkind4\uc1\pard\lang1031\f0\fs16}
\cf6 \f1       ******************************************************************\cf0\f0 
\par 
\cf6 \f1       *                                                                *\cf0\f0 
\par 
\cf6 \f1       *                 N A M E   W O R K   A R E A                    *\cf0\f0 
\par 
\cf6 \f1       *                                                                *\cf0\f0 
\par 
\cf6 \f1       ******************************************************************\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf3 \f1 01\cf0\f0   \cf4 \f1 NAME-WORK-AREA\cf0\f0 .
\par 
           03  NAW-NAME-WORK           PIC  X(34).
\par 
      *
\par 
           03  NAW-NAME-SPLIT.
\par 
               05  NAW-SPLIT-LAST      PIC  X(34).
\par 
               05  NAW-SPLIT-FIRST     PIC  X(34).
\par 
               05  NAW-SPLIT-PRE       PIC  X(34).
\par 
               05  NAW-SPLIT-POST      PIC  X(34).
\par 
      *
\par 
           03  NAW-NAME-CHARS.
\par 
               05  NAW-NAME-CHAR       OCCURS 34 TIMES
\par 
                                       INDEXED BY NAW-NCX 
\par 
                                           PIC  X(01).
\par 
      *
\par 
           03  NAW-TALLY               PIC  9(02)  COMP.
\par 
           03  NAW-COMMA-COUNT         PIC  9(02)  COMP.
\par 
           03  NAW-NAME-ERROR-FLAG     PIC  9(01)  COMP.
\par 
 }  \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf1 \f1 FILE-CONTROL\cf0\f0 \cf2 \f1 .\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf1 \f1 I-O-CONTROL\cf0\f0 \cf2 \f1 .\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf1 \f1 DATA\cf0\f0  \cf1 \f1 DIVISION\cf0\f0 \cf2 \f1 .\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf1 \f1 FILE\cf0\f0  \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf1 \f1 WORKING-STORAGE\cf0\f0  \cf1 \f1 SECTION\cf0\f0 \cf2 \f1 .\cf0\f0 
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf3 \f1 77\cf0\f0   \cf4 \f1 WS-NAME-ERROR-FLAG\cf0\f0           \cf2 \f1 PIC\cf0\f0   9(01) \cf1 \f1     \cf0\f0 C\cf1 \f1 OMP V\cf0\f0 A\cf3 \f1 L\cf0\f0 \cf2 \f1 U\cf0\f0 E 0.
\par 
       \cf3 \f1 77\cf0\f0   \cf4 \f1 WS-NAME\cf0\f0                      \cf2 \f1 PIC\cf0\f0   X(30)      \cf1 \f1     V\cf0\f0 A\cf1 \f1 LUE SP\cf0\f0 ACES.
\par 
\cf6 \f1       *\cf0\f0 
\par 
       \cf9 \f1 COPY\cf0\f0 \cf9 \f1  NAMEW.CO\cf0\f0 B.
\par 
      /
\par 
       PROCEDURE DIVISION.
\par 
      *
\par 
      *
\par 
      *             C O N T R O L   S E C T I O N
\par 
      *
\par 
       000000-CONTROL.
\par 
      *
\par 
           PERFORM 000100-PROCESS-NAME
\par 
              THRU 000100-EXIT
\par 
               UNTIL (WS-NAME = "END").
\par 
      *
\par 
       000000-EXIT.
\par 
           STOP RUN.
\par 
      *
\par 
      *                    P R O C E S S   N A M E
\par 
      *
\par 
       000100-PROCESS-NAME.
\par 
      *
\par 
           DISPLAY " ".
\par 
           DISPLAY "ENTER NAME (UP TO 30 CHARACTERS)".
\par 
           DISPLAY "123456789012345678901234567890 ('END' TO STOP)".
\par 
      *
\par 
           MOVE SPACES TO WS-NAME.
\par 
           ACCEPT WS-NAME.
\par 
      *
\par 
           IF  WS-NAME = "END"
\par 
               GO TO 000100-EXIT.
\par 
      *
\par 
      *
\par 
           MOVE WS-NAME TO NAW-NAME-WORK.
\par 
           PERFORM 006000-NAME-EDIT
\par 
              THRU 006000-EXIT
\par 
      *
\par 
           IF (WS-NAME-ERROR-FLAG = 1)
\par 
               DISPLAY "NAME INVALID"
\par 
               GO TO 000100-EXIT.
\par 
      *
\par 
      *
\par 
           MOVE WS-NAME TO NAW-NAME-WORK.
\par 
           PERFORM 006100-NAME-REVERSE
\par 
              THRU 006100-EXIT
\par 
      *
\par 
           DISPLAY NAW-NAME-WORK.
\par 
           DISPLAY "LAST:  " NAW-SPLIT-LAST.
\par 
           DISPLAY "FIRST: " NAW-SPLIT-FIRST.
\par 
           DISPLAY "PRE:   " NAW-SPLIT-PRE.
\par 
           DISPLAY "POST:  " NAW-SPLIT-POST.
\par