SAMPLE PROGRAM
================
BEGIN NAME=OG43,VERSION=C0,AMODE=31,SHR=NONE,XCL=NONE
---------------------------------------------------------------------*
* DEVELOPED BY SANG BAEK
KIM 1998.5.11
*
*---------------------------------------------------------------------*
* #SPM LEVEL=NO,PRINT=GEN
#SPM LEVEL=NO
SYSOP
FACEQ
SPACE 2
* FUNCTION: TO DISPLAY AND AMEND OZ-06-WBR
*
* WRITTEN BY: S B kim - SYSTEMS ASSURANCE
1995
*
*======( START POINT OF PROGRAM ) =========================
CR91OZ REG=RG1
CR91OZ REG=RGA,SUFFIX=A
PRINT GEN
*
CR92OZ REG=RGB
PRINT NOGEN
CR92OZ REG=RGC,SUFFIX=A
*SET DDI ITEM
LA
RGA,EBW000
LA
RDA,#CR91L80
STH RDA,CR91SIZA
MVI CR91KEYA,#CR91K80
MVC EBW003(30),=C'ABCDEFGHIJKLMNOPQRSTUVWXYZ*****'
MVC EBW090(8),=X'0000000000000000'
* GET DDR RECORD
GCFLC D3,L,Q1
GET DDR RECORD
MVC CR91ADRA,CE1FM3
MOVE ddr ADR TO TEMP DDR REC
MVC CE1FA3(2),=C'D5'
SAVE ID
DLAYC
MVC 0(2,RDA),=C'D5'
SAVE ID
FILEC D3
RELEASE CORE
CRUSA S0=3,S1=8
* OPEN DDR RECORD
DBOPN REF=CR92OZ,HOLD,FADDR=CR91ADRA
-
SPACE=(200,RGD)
*****************************
* INSERT ITEM TO DDR RECORD
*****************************
* ADD ITEM TO DDR RECORD
LA
RGC,EBX000 POINT WORK AREA
FOR DDR RECORD ITEM
MVC CR92PFXA(2),=C'98'
PFX
MVC CR92AWBA,=C'BLNO'
NO
MVC CR92FNOA(8),=C'OZ999/12DEC
' FLT NO
XR
RDA,RDA
LA
RDA,#CR92L80 MOVE SIZE
STH RDA,CR92SIZA
MOVE SIZE
MVI CR92KEYA,#CR92K80
MOVE KEY
DBADD REF=CR92OZ,
-
NEWLREC=CR92RECA,
-
NOKEY,
-
ERROR=PROGERR
* ADD REMARK
XC
EBX000(50),EBX000
MVC CR92RMKA(15),=C'THIS
IS REMARKS'
MVC CR92KEYA,=X'40'
MVC CR92SIZA,=H'19'
DBADD REF=CR92OZ,
-
NEWLREC=CR92RECA,
-
NOKEY,
-
ERROR=PROGERR
#IF CLI,SW00RTN,EQ,X'00'
IF MATCH FOUND DO
DBCLS REF=CR92OZ,RELEASE
RELEASE DDR
#ELSE
SERRC E,EEEEEE
#EIF
#IF R0,NZ
ERROR ?
#IF EBXSW0,BIT0,OFF
ITEM NOT FOUND ?
LA R0,#KANO52
SET ITM NOT FOUND
#ELSE
PRINTER REQUIRED
#EIF
PRINTER REQUIRED
#EIF
*
*****************************
* INSERT ITEM TO DDI RECORD
*****************************
DLAYC 1
DBOPN REF=CR91OZ,HOLD,ALG=EBW090
DBADD REF=CR91OZ,NEWLREC=CR91RECA
-
ERROR=PROGERR,
-
KEY1=(R=CR91KEY,S=CR91KEYA)
DLAYC 2
#IF CLI,SW00RTN,EQ,X'00'
IF MATCH FOUND DO
DBCLS REF=CR91OZ,RELEASE
RELEASE DDR
#ELSE
SERRC E,EEEEEE
#EIF
TTTT EQU *
#IF R0,NZ
ERROR ?
#IF EBXSW0,BIT0,OFF
ITEM NOT FOUND ?
LA R0,#KANO52
SET ITM NOT FOUND
B OG43MSG
#ELSE
PRINTER REQUIRED
#EIF
PRINTER REQUIRED
#EIF
**********************************************************************
* SEND OK - SENT TO PRINTER
**********************************************************************
LA
R0,#KANO1AB
OG43MSG EQU *
XR
R1,R1
CRUSA S0=2,S1=3,S2=6,S3=8
CMSGA ACT=(START,(R0),CARGO,SEND,EXIT),WKA=(EBX000),
X
SCREEN=(BELOW-INP,TEMP)
*
*
*
* ????? DBRED REF=CR91OZ,ALG==C'12345678',KEY1=(PKEY=#CR91K80),PATH=1
************************************************************
* ERROR HANDLING
************************************************************
#LOCA PROGERR
SERRC E,000000
CATASTROPHIC ERROR
EJECT
LTORG
FINIS
END
SAMPLE MACRO
============
MACRO
&LABEL CR91OZ ®=,&SUFFIX=,&ORG=,&ACPDB=
.**********************************************************************
.*
*
.* DELIVERY INDEX RECORD
*
.*
*
.**********************************************************************
.* Cargo macro,
*
.* created by S B KIM 13
MAY 1998 *
.**********************************************************************
* WHO * WHEN * WHAT *CHANGE
***********************************************************************
*KSB * 13MAY98 * CREATRE
*
***********************************************************************
GBLB &CR91OZ1
1ST TIME CALLED SWITCH
COPY DBGBL COPY
ACPDB GLOBAL DEFINITIONS
COPY DBLCL COPY
ACPDB LOCAL DEFINITIONS
&NAM SETC 'OZ-06-DIR'
DOC NAME
&DATE SETC '13DEC95'
UPDATE DATE
.**********************************************************************
.* DEFINITIONS FOR ACPDB
*
.**********************************************************************
&SW00WID SETC 'D4'
FILE ID
&SW00WRS SETC 'L2'
PRIMARY BLOCK SIZE
&SW00RCT SETC '#KWBIR'
FACE FILE TYPE
&SW00RBV SETC '#TPFDB09'
'#ACPDBS1'? ACPDB ALGORITHM
&SW00BOR SETC '0'
ORDINAL NUMBER OF FIRST RECORD
&SW00EOR SETC '-1'
ORDINAL NUMBER OF LAST RECORD
&SW00PTN SETC '0'
NUMBER OF PARTITIONS
CG0042
&SW01EO# SETC '&SW00EOR'
RECOUP END ORDINAL
&SW02FIL SETC 'CR91OZ'
FILE DSECT NAME
&SW00OP2 SETC '00000100'
HOLD INDICATORS
.**********************************************************************
.* COPY DSECT DEFINITION FUNCTIONS
*
.**********************************************************************
COPY DBCOD
SPACE
AIF ('&CR91OZ1' EQ '1').NOT1ST
AIF ('&SW00WRS' EQ '').CHECKID
#CR91OZS EQU &SW00WRS
BLOCK SIZE
.CHECKID AIF ('&SW00WID' EQ
'').NOT1ST
#CR91OZI EQU C'&SW00WID'
FILE ID
SPACE
.NOT1ST ANOP
.**********************************************************************
.* DEFINITION OF CR91HDR FOR BA RECOUP PURPOSES:
*
.**********************************************************************
CR91HDR&CG1 DS 0CL16 STANDARD
FILE HEADER
CR91BID&CG1 DS CL2 FILE
ID
CR91CHK&CG1 DS X BLOCK
CHECK CHARACTER
CR91CTL&CG1 DS B CONTROL
BYTE
CR91PGM&CG1 DS F LAST
FILING PROGRAM STAMP
CR91FCH&CG1 DS F FORWARD
CHAIN ADDRESS
CR91BCH&CG1 DS F BACKWARD
CHAIN ADDRESS
DS 0CL10
STANDARD ACPDB HEADER
CR91NAB&CG1 DS H NEXT
AVAILABLE BYTE POINTER
CR91SEQ&CG1 DS H UPDATE
SEQUENCE NUMBER (ACPDB)
CR91SBA&CG1 DS F LAST
SORT BATCH PRIME FILE ADDR
CR91SBC&CG1 DS XL1 LAST
SORT BATCH FILE CHECK CODE
DS XL1
SPARE
CR91VAR&CG1 EQU * START
OF VARIABLE USER-AREA
CR91HDL&CG1 EQU CR91VAR&CG1-CR91HDR&CG1
* HEADER-LENGTH UP TO CR91VAR
ORG CR91HDR&CG1
CR91REC&CG1 DS 0CL1 1ST
RCD START (1=VARIABLE,ELSE SIZE)
CR91SIZ&CG1 DS H SIZE
OF LOGICAL RECORD
CR91KEY&CG1 DS X LOGICAL
RECORD IDENTIFIER
AIF ('&CR91OZ1' EQ '1').KEYEQ
.* GO IF NOT FIRST ISSUE
SPACE
.**********************************************************************
.* EQUATE ALL LOGICAL RCD KEYS HERE. KEYS 00-0F
AND F0-FF *
.* ARE RESERVED; IF ONLY 1 KEY, USE KEY 80.
*
.**********************************************************************
#CR91K80 EQU X'80'
LOGICAL RCD KEY '80'
#CR91L80 EQU CR91E80&CG1-CR91REC&CG1
* LENGTH OF LOGICAL RCD KEY '80'
&CR91OZ1 SETB (1)
INDICATE 1ST TIME THROUGH
.KEYEQ ANOP GENERATE
DSECT NAME
SPACE
CR91ORG&CG1 EQU * START
OF LOGICAL RECORD DESCRIPTION
.**********************************************************************
.* KEY 80 ITEM (FLIGHT RANGE INDEX):
*
.**********************************************************************
CR91PFX&CG1 DS XL3 BILL
PREFIX
CR91SP1&CG1 DS X SPARE
BYTE
CR91BLN&CG1 DS XL8 BILL
NO (CHAR FORMAT)
CR91ADR&CG1 DS XL4 ADDRES
OF 06-WBR WHOSE BILL REC
CR91IN1&CG1 DS X BILL
PREFIX
* BIT 0 : CNCL , 1:HOUSE , 2:DUMMY , 3:PARTIAL
4:PFX ALPHA
CR91IN2&CG1 DS X BILL
PREFIX
* BIT 0 : IMPRT, 1:EXPRT , 2:T/S
CR91LCI&CG1 DS XL2 LOCATION
IN DATE
CR91LCO&CG1 DS XL2 LOCATION
OUT DATE
CR91SP2&CG1 DS XL4 SPARE
BYTES
CR91E80&CG1 EQU *
ORG CR91ORG&CG1
.**********************************************************************
AIF (&BG1).MACEXIT
GO IF INTERNAL USAGE
&SYSECT CSECT
AIF ('®' EQ '').MACEXIT
.* GO IF REG= NOT SPECIFIED
.GEUSING ANOP GENERATE USING
USING &DSN,®
.MACEXIT ANOP
MEND
MACRO
&LABEL CR92OZ ®=,&SUFFIX=,&ORG=,&ACPDB=
.**********************************************************************
.*
*
.* WAREHOUSE
BILL RECORD
*
.*
*
.**********************************************************************
.* THIS DATA
CONTAINS TRM / TRUCKING DATA
*
.* CREATED BY
SANG BAEK KIM
18 MAY 1998
*
.**********************************************************************
.**********************************************************************
* WHO * WHEN * WHY
*
***********************************************************************
*SBKIM * 14DEC95 * SANG-BAEK KIM CREATE THIS RECORD
*
***********************************************************************
GBLB &CR92OZ1
1ST TIME CALLED SWITCH
COPY DBGBL
COPY ACPDB GLOBAL DEFINITIONS
COPY DBLCL
COPY ACPDB LOCAL DEFINITIONS
&NAM SETC
'OZ-06-DDR' DOC NAME
&DATE SETC '14DEC95'
UPDATE DATE
.**********************************************************************
.* DEFINITIONS
FOR ACPDB
*
.**********************************************************************
&SW00WID SETC 'D5'
FILE ID
&SW00WRS SETC 'L2'
PRIMARY BLOCK SIZE
&SW00RBV SETC '#ACPDB05'
ACPDB ALGORITHM
&SW02FIL SETC 'CR92OZ'
FILE DSECT NAME
&SW00OP2 SETC '00000100'
HOLD INDICATORS
.**********************************************************************
.* COPY DSECT
DEFINITION FUNCTIONS
*
.**********************************************************************
COPY DBCOD
SPACE
AIF ('&CR92OZ1' EQ '1').NOT1ST
AIF ('&SW00WRS' EQ '').CHECKID
#CR92OZS EQU &SW00WRS
BLOCK SIZE
.CHECKID AIF ('&SW00WID' EQ
'').NOT1ST
#CR92OZI EQU C'&SW00WID'
FILE ID
SPACE
.NOT1ST ANOP
.**********************************************************************
.* DEFINITION
OF CR92HDR FOR BA RECOUP PURPOSES:
*
.**********************************************************************
CR92HDR&CG1 DS 0CL16
STANDARD FILE HEADER
CR92BID&CG1 DS CL2
FILE ID
CR92CHK&CG1 DS X
BLOCK CHECK CHARACTER
CR92CTL&CG1 DS B
CONTROL BYTE
CR92PGM&CG1 DS F
LAST FILING PROGRAM STAMP
CR92FCH&CG1 DS F
FORWARD CHAIN ADDRESS
CR92BCH&CG1 DS F
BACKWARD CHAIN ADDRESS
DS 0CL10
STANDARD ACPDB HEADER
CR92NAB&CG1 DS H
NEXT AVAILABLE BYTE POINTER
CR92SEQ&CG1 DS H
UPDATE SEQUENCE NUMBER (ACPDB)
CR92SBA&CG1 DS F
LAST SORT BATCH PRIME FILE ADDR
CR92SBC&CG1 DS XL1
LAST SORT BATCH FILE CHECK CODE
DS XL1
SPARE
CR92VAR&CG1 EQU *
START OF VARIABLE USER-AREA
CR92HDL&CG1 EQU CR92VAR&CG1-CR92HDR&CG1
*
HEADER-LENGTH UP TO CR92VAR
ORG CR92HDR&CG1
CR92REC&CG1 DS 0CL1
1ST RCD START (1=VARIABLE,ELSE SIZE)
CR92SIZ&CG1 DS H
SIZE OF LOGICAL RECORD
CR92KEY&CG1 DS X
LOGICAL RECORD IDENTIFIER
AIF ('&CR92OZ1' EQ '1').KEYEQ
.*
GO IF NOT FIRST ISSUE
SPACE
.**********************************************************************
.* EQUATE ALL
LOGICAL RCD KEYS HERE. KEYS 00-0F AND F0-FF *
.* ARE RESERVED;
IF ONLY 1 KEY, USE KEY 80.
*
.**********************************************************************
#CR92K80 EQU X'80'
LOGICAL RCD KEY '80'
#CR92L80 EQU CR92E80&CG1-CR92REC&CG1
*
LENGTH OF LOGICAL RCD KEY '80'
#CR92K40 EQU X'40'
LOGICAL RCD KEY '40'
#CR92L40 EQU CR92E40&CG1-CR92REC&CG1
*
LENGTH OF LOGICAL RCD KEY '40'
&CR92OZ1 SETB (1)
INDICATE 1ST TIME THROUGH
.KEYEQ ANOP
GENERATE DSECT NAME
SPACE
CR92ORG&CG1 EQU *
START OF LOGICAL RECORD DESCRIPTION
.**********************************************************************
.* KEY 80 ITEM
( WAREHOUSE BILL RECORD ):
*
.**********************************************************************
CR92SP0&CG1 DS X
SPARE 0
CR92PFX&CG1 DS XL2
PREFIX
CR92AWB&CG1 DS XL4
BILL NO
CR92AWT&CG1 DS XL1
BILL NOTAIL
CR92SP1&CG1 DS XL1
CR92CCD&CG1 DS CL2
CARRCODE
CR92SP2&CG1 DS CL2
SPARE CARRCODEFOR EXPANSION
CR92FNO&CG1 DS XL2
FLT NO(OUT)
CR92MDT&CG1 DS XL2
MOVEMENT DATE
CR92TAP&CG1 DS CL3
TRANSFER AIRPORT
CR92SP3&CG1 DS CL1
CR92AAP&CG1 DS CL3
ARRIVAL AIRPORT
CR92SP4&CG1 DS CL1
CR92SDC&CG1 DS XL1
SHIPMENT DESCRIPTION CODE(T,P)
CR92SPF&CG1 DS XL1
CR92PCS&CG1 DS XL2
NO OF PIECES
CR92WGT&CG1 DS XL2
PCS
CR92WCD&CG1 DS XL1
WEGHT CODE
CR92SP5&CG1 DS XL1
CR92IFT&CG1 DS XL2
INFLT CARRIER
CR92SP6&CG1 DS XL2
CR92IDT&CG1 DS XL2
INFLT (DATE )
CR92DLV&CG1 DS XL2
DELIVERY TIME
CR92DLP&CG1 DS XL50
DELIVERY PERSON
CR92SP7&CG1 DS XL6
SPARE BYTES
CR92E80&CG1 EQU *
END OF KEY 80 ITEM
ORG CR92ORG&CG1
.**********************************************************************
.* KEY 40 ITEM
( REMARK ITEMS )
*
.**********************************************************************
CR92RID&CG1 DS XL1
REMARK ID-THIS KEY IS USED
CR92RMK&CG1 DS 0CL1
TXT
CR92E40&CG1 EQU *
END OF KEY 40 ITEM
ORG CR92ORG&CG1
.**********************************************************************
.* ALGORITHM
AREA PART
*
.**********************************************************************
CR92@0BEG&CG1 EQU *
CR92@0END&CG1 EQU *
.**********************************************************************
AIF (&BG1).MACEXIT GO IF INTERNAL USAGE
&SYSECT CSECT
AIF ('®' EQ '').MACEXIT
.*
GO IF REG= NOT SPECIFIED
.GEUSING ANOP
GENERATE USING
USING &DSN,®
.MACEXIT ANOP
MEND
============================ ANOTHER SAMPLE
PROGRAM FOR TPF DF ===============
================================================================================
BEGIN NAME=OG45,VERSION=C0,XCL=NONE,SHR=NONE,AMODE=31
TITLE 'DISPLAY CTF ALL RECORD
-
COPYRIGHT ASIANA AIRLINES '
***********************************************************************
* WRITTEN BY SANG BAEK KIM DATE - JUL'98
*
***********************************************************************
* AMENDED BY - DATE -
*
* CORRECTED BY - DATE -
*
***********************************************************************
* OZC0330 DISPLAY CTF RECORD Y*CTF
*
* THIS PROGRAM IS VERY NICE TO REVIEW &
PREVENT DEVELOPING *
* ENERGY AND ERROR
*
* SEE FSU/FFM STATUS MESSAGES
*
* SANG BAEK KIM
JUN 98 *
***********************************************************************
* METHOD
*
* ------
*
* ENTERED BY OGQ1 TO Y*CTF
*
* DISPLAY.
*
* 1. OPEN CTF
*
* 2. WHILE REQUIRED ITEMS FOUND
*
* ADD DETAILS TO OUTPUT
*
* 3. IF THIS ENTRY IS FOR FFM DETAILS
*
* CHECK WHETHER FSU DETAILS EXIST (WHILE WE HAVE
THE RECORD OPEN) *
* 4. CLOSE CTF
*
*
*
***********************************************************************
* COPYRIGHT ASIANA AIRLINES CARGO SYSTEM
*
***********************************************************************
SPACE
SYSOP
SPACE
CR05BA REG=RGC
CTD
SPACE
CR06BA REG=RGD
CTF - FSU DATA RECORD
SPACE
QWXTI REG=RGE - O2T WORKAREA
SPACE
QY0AA REG=RDB
CAA
SPACE
UI2PF REG=RGA
OUTPUT
EJECT
***********************************************************************
* COMMAND MODULE
*
***********************************************************************
GETCC D0,L2
GET WORK AREA
L RGE,CE1CR0 BASE WORK AREA
XR RG1,RG1
CLEAR REGISTER
XR RGA,RGA
CLEAR REGISTER
LA RDA,0
@@@@ START ORD @@@@
STH RDA,QWXALG
SAVE START ORD NO TO WRK AREA
LMSGA ACT=(START),WKA=(DF,L2)
LMSGA '*ALL MESSAGES IN CTF RECORD*',/
OG45LOOP EQU *
LOOP
DBOPN REF=CR05BA,DATA=DE,PARAM=AUTO,DETAC,SPACE=(100)
DBRED REF=CR05BA,REG=RGC,ALG=QWXALG,UP,
-
ERROR=ACPDB_ERROR,
-
KEY1=(PKY=#CR05K80)
*
#IF TM,SW00RTN,#TPFDBER,NZ
IF READ ERROR
#GOTO ACPDB_ERROR
GO TO ERROR ROUTINE
#EIF
#DO WHILE=(TM,SW00RTN,#TPFDBNR,Z) WHILE RECORDS
FOUND
* CHANGE CAL
DATE
ST RGE,EBX000
SAVE RGE FOR UCDR
LA RGE,EBW000
MVI 0(RGE),X'FF'
LH RGF,CR05DAT
ENTRC UCDR
LTR RGE,RGE
BZ SERROR
L RGE,EBX000 LOAD RGE FOR THIS
PROGRAM
*
LMSGA ' ',/,'--MESSAGE-'
LMSGA 'ARRIVED ON '
LMSGA (EBW000,7),' ',/
MVC QWXAWB,CR05AWB
* FOR RETRIEVE CR06BA
MVC QWXDAT,CR05DAT SET ALG *
MVC QWXCAR,CR05CAR
DBOPN REF=CR06BA,NOHOLD,UP,ALG=QWXALG,PATH=0
DBRED REF=CR06BA,REG=RGD,BEGIN,UP,
X
KEY1=(PKY=#CR06K80),
FOR 1 ST READ X
ERROR=ACPDB_ERROR
#DO WHILE=(TM,SW00RTN,#TPFDBNR,Z)
WHILE RECORDS FOUND
LH RDA,CR06SIZ GET ITEM SIZE
SH RDA,=Y(CR06ORG-CR06REC) MINUS LENGTH OF
FIXED DATA
STH RDA,EBX000
LA RGF,CR06ORI
MVC EBW000,0(RGF) MOVE U OR F INDICATOR
LMSGA EBW000,1,/ PRINT U OR F INDICATOR
LA RGF,1(RGF)
LH RDA,EBX000
SH RDA,=H'1'
#DO TIMES=(RDA)
#IF (CLI,0(RGF),NE,X'6C')
IF X'6C' THEN SKIP CHAR
MVC 0(1,RG1),0(RGF)
MOVE TO OM WORK BLOCK
LA RG1,1(RG1)
#EIF
LA RGF,1(RGF)
#EDO
LMSGA ,/
DBRED REF=CR06BA,REG=RGD,UP,
X
KEY1=(PKY=#CR06K80),
FOR TO READ NEXT RECORD X
ERROR=ACPDB_ERROR
#EDO
DBCLS REF=CR06BA,RELEASE CLOSE CTF
DBRED REF=CR05BA,REG=RGC,ERROR=ACPDB_ERROR READ NEXT CTD
#EDO
LMSGA ' ',/,/
DBCLS REF=CR05BA,RELEASE
* INCRMNT NEXT ORD FOR CTD
LH RDA,QWXALG LOAD
RECORD ORDINAL NO
LA RDA,1(RDA) ADD
ONE FOR NEXT RECORD
STH RDA,QWXALG STORE TO
WORK AREA
CH RDA,=H'500'
END OF RECORD ?@@@@@@@@
BL OG45LOOP
NO GO FOR READ NEXT CTD
*
LMSGA ACT=(SEND,EXIT)
SERROR EQU *
SERRC E,300FFF DATE ERROR
#LOCA LMSGA-ERROR-ROUTINE TIDY UP AFTER
ERROR
#LOCA ACPDB_ERROR TIDY UP AFTER
ERROR
SERRC E,300FFF
******END OF KSB ROUTINE***********************************************
SPACE
LTORG
SPACE
FINIS
END
============================================== MACROS SAMPLE
============
CR05BA :
&SW00WID SETC '6E'
FILE ID
&SW00WRS SETC 'L2'
BLOCK SIZE
&SW00ARS SETC 'L2'
ALTERNATE BLOCK SIZE
&SW00RCT SETC '#KCTDR' FACE
FILE TYPE
&SW00RBV SETC '#ACPDB0C' FILE ALGORITHM
(SEE SRSA-07-ACPDB)
&SW00BOR SETC '0'
BASE ORDINAL NUMBER
&SW00EOR SETC '-1'
END ORDINAL NBR
&SW00ILV SETC '0'
MAXIMUM INTERLEAVING FACTOR IF APPLIC
CR06BA :
.********************************************************************
.*
DEFINITIONS FOR ACPDB
*
.********************************************************************
&SW00WID SETC '6B'
FILE ID
&SW00WRS SETC 'L2'
BLOCK SIZE
&SW00RBV SETC '#ACPDBFF' FILE ALGORITHM
=> INDEXED RECORD
&SW02FIL SETC 'CR06BA'
FILE DSECT NAME
&SW00OP2 SETC '00000110' OPT BYTE2
P: FIWHC, C: FINWC [ DB010C
.********************************************************************
============== DB DEF PROGRAM (UP1M) ======================================
FILE ID C'6E'
PRINT GEN
DBDEF FILE=CR05BA,
&
(INDEX=(CR06BA))
EJECT
*
* FILE ID C'6B'
DBDEF FILE=CR06BA,
&
(IID=CR05BA,IKY=#CR05K80,IPA=0,ILA=2,PTH=0,IPK=2,ILK=9, &
KEY1=(R=CR05AWB,S=2,UP),
&
KEY2=(R=CR05DAT,S=8,NOORG),
&
KEY3=(R=CR05CAR,S=10,NOORG)),
&
(IID=CR05BA,IKY=#CR05K80,IPA=0,ILA=2,IMI=10000000,PTH=1,&
IPK=8,ILK=3,
&
KEY1=(R=CR05DAT,S=8,C=LT,NOORG),
&
KEY2=(R=CR05CAR,S=10,C=EQ,NOORG)),
&
(IID=CR05BA,IKY=#CR05K80,IPA=0,ILA=2,IMI=10000000,PTH=2,&
IPK=2,ILK=6,
&
KEY1=(R=CR05AWB,S=2,UP))
EJECT
*
=============================================================================