Program Painter source:
IO INPUT-CUSTFILE
ASSIGN TO GARYDD
ORGANIZATION IS LINE SEQUENTIAL
IO OUTPUT-FILE
ASSIGN TO GARYOUT
ORGANIZATION IS LINE SEQUENTIAL
FD INPUT-CUSTFILE
RECORD CONTAINS 80 CHARACTERS.
01 INPUT-REC.
05 INP-ACTION-CODE PIC X(1).
05 INP-CUSTOMER-NO PIC X(6).
05 INP-CUSTOMER-NAME PIC X(20).
05 INP-CUSTOMER-ADDR PIC X(20).
05 INP-CUSTOMER-CITY PIC X(20).
05 INP-CUSTOMER-ZIP PIC X(9).
05 FILLER PIC X(4).
FD OUTPUT-CUSTFILE
RECORD CONTAINS 80 CHARACTERS.
01 OUTPUT-REC.
05 OUTPUT-STATUS PIC X(2).
05 OUTPUT-CUSTOMER-NO PIC X(6).
05 OUTPUT-CUSTOMER-NAME PIC X(20).
05 OUTPUT-CUSTOMER-ADDR PIC X(20).
05 OUTPUT-CUSTOMER-CITY PIC X(20).
05 OUTPUT-CUSTOMER-ZIP PIC X(9).
05 OUTPUT-FILLER PIC X(3).
PROC
OPEN INPUT INPUT-CUSTFILE
... OUTPUT OUTPUT-FILE
REPEAT
READ INPUT-CUSTFILE
WS-CUST-NO = INP-CUSTOMER-NO
UNTIL AT END ON INPUT-CUSTFILE
EVALUATE INP-ACTION-CODE
WHEN 'Q'
PERFORM QUERY-LOGIC
WHEN 'U'
PERFORM UPDATE-LOGIC
WHEN 'D'
PERFORM DELETE-LOGIC
CLOSE INPUT-CUSTFILE
... OUTPUT-FILE
PARA QUERY-LOGIC
DB-OBTAIN REC CUSTOMER-REC
... WHERE CM_CUSTOMER_NO = #WS-CUST-NO
IF OK-ON-REC
OUTPUT-STATUS = 'SQ'
PERFORM MOVE-COPYLIB-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'UQ'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
PARA UPDATE-LOGIC
PERFORM MOVE-INPUT-TO-COPYLIB
DB-MODIFY REC CUSTOMER-REC
... WHERE CM_CUSTOMER_NO = #WS-CUST-NO
IF OK-ON-REC
OUTPUT-STATUS = 'SM'
PERFORM MOVE-COPYLIB-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'UM'
PERFORM MOVE-COPYLIB-TO-OUTPUT
PERFORM WRITE-MSGOUT
PARA DELETE-LOGIC
DB-ERASE REC CUSTOMER-REC
... WHERE CM_CUSTOMER_NO = #WS-CUST-NO
IF OK-ON-REC
OUTPUT-STATUS = 'SE'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'UE'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
PARA ADD-LOGIC
PERFORM MOVE-INPUT-TO-COPYLIB
DB-STORE REC CUSTOMER-REC
... WHERE CM_CUSTOMER_NO = #WS-CUST-NO
IF OK-ON-REC
OUTPUT-STATUS = 'SS'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'BS'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
PARA MOVE-INPUT-TO-OUTPUT
OUTPUT-STATUS = OUTPUT-STATUS
OUTPUT-CUSTOMER-NO = INP-CUSTOMER-NO
OUTPUT-CUSTOMER-NAME = INP-CUSTOMER-NAME
OUTPUT-CUSTOMER-ADDR = INP-CUSTOMER-ADDR
OUTPUT-CUSTOMER-CITY = INP-CUSTOMER-CITY
OUTPUT-CUSTOMER-ZIP = INP-CUSTOMER-ZIP
PARA MOVE-COPYLIB-TO-OUTPUT
OUTPUT-CUSTOMER-NO = CM-CUSTOMER-NO
OUTPUT-CUSTOMER-NAME = CM-CUSTOMER-NAME
OUTPUT-CUSTOMER-ADDR = CM-CUSTOMER-ADDR
OUTPUT-CUSTOMER-CITY = CM-CUSTOMER-CITY
OUTPUT-CUSTOMER-ZIP = CM-CUSTOMER-ZIP
PARA MOVE-INPUT-TO-COPYLIB
CM-CUSTOMER-NO = INP-CUSTOMER-NO
CM-CUSTOMER-NAME = INP-CUSTOMER-NAME
CM-CUSTOMER-ADDR = INP-CUSTOMER-ADDR
CM-CUSTOMER-CITY = INP-CUSTOMER-CITY
CM-CUSTOMER-ZIP = INP-CUSTOMER-ZIP
PARA WRITE-MSGOUT
WRITE OUTPUT-REC
WS
01 THEFLDS.
05 WS-CUST-NO PIC X(6).
Generated AMB source:
% &AP-GEN-VER = 2200
% &AP-PGM-ID = "SAMPLPGM"
% &AP-MAIN-PROGRAM- = "NO"
% &AP-GEN-DC-TARGET = "MVS"
% &AP-GEN-DB-TARGET = "VSAM"
% &AP-GEN-USER-HELP = "NO"
% &AP-PROC-DIV-KYWD-SEEN = 1
% &AP-FILE-CONTROL-SEEN = 1
% &AP-SUBSCHEMA = "SAMPLSUB"
% &AP-APPLICATION-ID = "JOHND"
% &AP-GEN-DATE = "930407"
% &AP-GEN-TIME = "07244461"
%* --- SUBSCHEMA / PSB FROM APPLICATION DEFINITION ---
$DB-SUBSCHEMA("SAMPLSUB")
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLPGM.
AUTHOR. JOHND.
DATE-WRITTEN. 93/04/07.
DATE-COMPILED. &COMPILETIME.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. &SYSTEM.
OBJECT-COMPUTER. &SYSTEM.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-CUSTFILE
ASSIGN GARYDD
ORGANIZATION IS LINE SEQUENTIAL.
SELECT OUTPUT-FILE
ASSIGN GARYOUT
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD INPUT-CUSTFILE
RECORD CONTAINS 80 CHARACTERS.
01 INPUT-REC.
05 INP-ACTION-CODE PIC X(1).
05 INP-CUSTOMER-NO PIC X(6).
05 INP-CUSTOMER-NAME PIC X(20).
05 INP-CUSTOMER-ADDR PIC X(20).
05 INP-CUSTOMER-CITY PIC X(20).
05 INP-CUSTOMER-ZIP PIC X(9).
05 FILLER PIC X(4).
FD OUTPUT-FILE
RECORD CONTAINS 80 CHARACTERS.
01 OUTPUT-REC
05 OUTPUT-STATUS PIC X(2).
05 OUTPUT-CUSTOMER-NO PIC X(6).
05 OUTPUT-CUSTOMER-NAME PIC X(20).
05 OUTPUT-CUSTOMER-ADDR PIC X(20).
05 OUTPUT-CUSTOMER-CITY PIC X(20).
05 OUTPUT-CUSTOMER-ZIP PIC X(9).
05 OUTPUT-FILLER PIC X(3).
WORKING-STORAGE SECTION.
$TP-WS-MARKER
01 THEFLDS.
05 WS-CUST-NO PIC X(6).
01 TEXT-MSG PIC X(30)
VALUE &SQ+PLEASE ENTER NEXT TRANSID&SQ.
PROCEDURE DIVISION.
OPEN INPUT INPUT-CUSTFILE
... OUTPUT OUTPUT-FILE
REPEAT
READ INPUT-CUSTFILE
WS-CUST-NO = INP-CUSTOMER-NO
UNTIL AT END ON INPUT-CUSTFILE
EVALUATE INP-ACTION-CODE
WHEN 'Q'
PERFORM QUERY-LOGIC
WHEN 'U'
PERFORM UPDATE-LOGIC
WHEN 'D'
PERFORM DELETE-LOGIC
CLOSE INPUT-CUSTFILE
... OUTPUT-FILE
QUERY-LOGIC
$DB-OBTAIN ( "REC CUSTOMER-REC WHERE CM_CUSTOMER_NO = ",
%... "#WS-CUST-NO" )
IF OK-ON-REC
OUTPUT-STATUS = 'SQ'
PERFORM MOVE-COPYLIB-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'UQ'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
UPDATE-LOGIC
PERFORM MOVE-INPUT-TO-COPYLIB
$DB-MODIFY ( "REC CUSTOMER-REC WHERE CM_CUSTOMER_NO = ",
%... "#WS-CUST-NO" )
IF OK-ON-REC
OUTPUT-STATUS = 'SM'
PERFORM MOVE-COPYLIB-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'UM'
PERFORM MOVE-COPYLIB-TO-OUTPUT
PERFORM WRITE-MSGOUT
DELETE-LOGIC
$DB-ERASE ( "REC CUSTOMER-REC WHERE CM_CUSTOMER_NO = ",
%... "#WS-CUST-NO" )
IF OK-ON-REC
OUTPUT-STATUS = 'SE'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'UE'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
ADD-LOGIC
PERFORM MOVE-INPUT-TO-COPYLIB
$DB-STORE ( "REC CUSTOMER-REC WHERE CM_CUSTOMER_NO = ",
%... "#WS-CUST-NO" )
IF OK-ON-REC
OUTPUT-STATUS = 'SS'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
ELSE
OUTPUT-STATUS = 'BS'
PERFORM MOVE-INPUT-TO-OUTPUT
PERFORM WRITE-MSGOUT
MOVE-INPUT-TO-OUTPUT
OUTPUT-STATUS = OUTPUT-STATUS
OUTPUT-CUSTOMER-NO = INP-CUSTOMER-NO
OUTPUT-CUSTOMER-NAME = INP-CUSTOMER-NAME
OUTPUT-CUSTOMER-ADDR = INP-CUSTOMER-ADDR
OUTPUT-CUSTOMER-CITY = INP-CUSTOMER-CITY
OUTPUT-CUSTOMER-ZIP = INP-CUSTOMER-ZIP
MOVE-COPYLIB-TO-OUTPUT
OUTPUT-CUSTOMER-NO = CM-CUSTOMER-NO
OUTPUT-CUSTOMER-NAME = CM-CUSTOMER-NAME
OUTPUT-CUSTOMER-ADDR = CM-CUSTOMER-ADDR
OUTPUT-CUSTOMER-CITY = CM-CUSTOMER-CITY
OUTPUT-CUSTOMER-ZIP = CM-CUSTOMER-ZIP
MOVE-INPUT-TO-COPYLIB
CM-CUSTOMER-NO = INP-CUSTOMER-NO
CM-CUSTOMER-NAME = INP-CUSTOMER-NAME
CM-CUSTOMER-ADDR = INP-CUSTOMER-ADDR
CM-CUSTOMER-CITY = INP-CUSTOMER-CITY
CM-CUSTOMER-ZIP = INP-CUSTOMER-ZIP
WRITE-MSGOUT
WRITE OUTPUT-REC