H 1 Y/ 1
H****************************************************************
H* DISPLAY DATA IN D.B.F *
H* *
H* DSPD -> DSPDR8C -> * DSPDR8 -> DSPDR81 (RPG) *
H* (COMMAND) (CLP) (RPG) -> DSPDR82 (RPG) *
H* *
H****************************************************************
FARVF IF F 9000 DISK UC
F KINFDS INFARV
FKEYF IF F 9000 99AI 1 DISK UC
F KINFDS INFKEY
FQAFDACCPIF F 116 DISK UC
FDSPDR8D CF E WORKSTN
F KINFDS INFDSP
|
E******************************************************
E* A R R A Y T A B L E ;*
E******************************************************
E DT 9000 1 ;INPUT DATA
E PK 16 1 ;FOR PACK CONVERT
E OP 10 1 ;POINTER MARKED FIELDS
E AP 10 3 0 ;POINTER MARKED FIELDS
E KP 30 3 0 ;POINTER KEY-FIELDS
E KF 30 10 ;KEY FIELDS
E WK 73 1 ;WRK
E NM 30 1 ;FOR NUMERIC
E KV 78 1 ;KEY VALUE (CHAR)
E XZ 78 1 ;KEY (ZONE HEX)
E XD 78 1 ;KEY (DIGIT HEX)
E WL 78 1 ;LINE ON SFL
|
E LN 3900 78 ;LINE ON SFL
E TABHEX 6 6 1 TABDEC 2 0 ;HEX<->DEC
E GDE 1 5 78 ;CMD GIDE
I******************************************************
I* D E F I N E I N P U T F I E L D *
I******************************************************
IARVF AA 01
I 19000 DT
IKEYF AA 01
I 19000 DT
IQAFDACCPAA 01
I 101 110 APKEYF
I P 115 1160APKEYN
I******************************************************
I* D E F I N E C O N S T A N T *
|
I******************************************************
I 0 C #SETLL
I 1 C #READ
I 2 C #STORE
I 3 C #LOAD
I 4 C #RDDTL
I 9 C #END
I*
I 13 C #PGSIZ
I 16 C #MAXPK
I 30 C #MAXZN
I 30 C #MAXKF
I 10 C #MAXAP
I 78 C #MAXKL
I 77 C #MAXCM
|
I 9000 C #MAXIN
I 'Y' C #YES
I ' ' C #NO
I ' ' C #X40
I '.' C #PRIOD
I ',' C #COMMA
I 'D' C #DUPFL
I 'S' C #SGLFL
I 'X' C #TXTFL
I 'Z' C #CHDFL
I 'C' C #COLHG
I 'T' C #TEXT
I 'F' C #FIELD
I 'D' C #DTAOY
I 'B' C #BIN
|
I 'S' C #ZONE
I 'P' C #PACK
I '*' C #ASTRK
I '+' C #PLUS
I '-' C #MINUS
I '?' C #UNKWN
I* MAKE DSPATR
I X'24' C XUL
I X'22' C XHI
I X'21' C XRI
I X'26' C XHIUL
I X'20' C X20
I X'2E' C XHIBLU
I*
I X'31' C F1
|
I X'32' C F2
I X'33' C F3
I X'34' C F4
I X'35' C F5
I X'36' C F6
I X'37' C F7
I X'38' C F8
I X'39' C F9
I X'3A' C F10
I X'3B' C F11
I X'3C' C F12
I X'B1' C F13
I X'B2' C F14
I X'B3' C F15
I X'B4' C F16
|
I X'B5' C F17
I X'B6' C F18
I X'B7' C F19
I X'B8' C F20
I X'B9' C F21
I X'BA' C F22
I X'BB' C F23
I X'BC' C F24
I X'BD' C CLEAR
I X'F1' C RECENT
I X'F3' C HELP
I X'F4' C ROLDWN
I X'F5' C ROLUP
I X'F6' C PAGPRT
I X'F8' C BACKSP
|
I X'3F' C AUTINP
I*
I*
I 'DSPDR81' C #FDLST
I 'DSPDR82' C #PGKEY
I 'SZAPSB2' C #PTDTA
I 'QUSRTVUS' C #PGRTV
I 'QUSLFLD' C #PGFLD
I 'QUSRMBRD' C #PGMBR
I 'I' C #INQFG
I*
I ' BOTTOM ' C #BOTTM
I ' MORE...' C #MORE
I 'KEY=' C #KEYFD
I 'OVER FLOW OF INPUT- C #OVRFL
|
I ' BUFFER.'
I 'BEGINNING OF FILE DE-C #BOFMG
I 'TECTED.'
I 'END OF FILE DETECTED-C #EOFMG
I '.'
I 'NEXT RECORD HAS BEEN-C #NXTMG
I ' READ ...'
I 'PREVIOUS RECORD HAS -C #PRVMG
I 'BEEN READ ...'
I 'SELECTED RECORD HAS -C #SLTMG
I 'BEEN READ ...'
I ' DATA ' C #DTAMD
I 'COLHDG' C #CHDMD
I 'TEXT' C #TXTMD
I ' FIELD' C #FLDMD
|
I ' (ATR)' C #ATRMD
I 'ZERO-SPPR' C #ZSPMD
I ' .....' C #LEADR
I 'THERE IS NO DATA IN -C #NODTA
I 'THIS MEMBER.'
I 'FILE=' C #FL
I 'RECORD FORMAT=' C #RD
I 'TYPE=' C #TP
I******************************************************
I* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
I* INPUT DATA
IDSDTA DS
I 19000 DT
I* INFORMATION DS
|
IDSINFO DS
I 1 10 DSFILE
I 11 20 DSFLIB
I 1 20 DSFLLB
I B 43 440DSRLEN
I 47 56 V1MBRN
I B 74 770DSSIZE
I 78 79 DSACPH
IINFARV DS
I 83 161 DSARV
I B 397 4000DSARRN
IINFKEY DS
I 83 161 DSKEY
I B 393 3940DSKEYL
I B 397 4000DSKRRN
|
I 401 478 DSKYVL
I*
IINFDSP DS
I 369 369 PUSHED
I*
I* OTHER DS
IHEXDEC DS
I 1 1 HEXZNE
I 2 2 HEXDGT
IDSWLN DS
I 1 78 WL
IDSNUM DS
I 1 30 NM
IDSKVL DS
I 1 78 KV
|
IDSHXZ DS
I 1 78 XZ
IDSHXD DS
I 1 78 XD
IDSWRK DS
I 1 73 WK
IDSPCK DS
I 1 16 PK
I P 1 160DSPCKN
IDSBN2C DS
I B 1 20DSBIN2
IDSBN4C DS
I B 1 40DSBIN4
I DS
I B 1 40LENDTA
|
I B 5 80STRPOS
I B 9 120LENRCV
I*
I* FOR API PGM PARAMETER
IRCVVAR DS
I B 1 40OFFSTH
I B 5 80HDRSIZ
I B 9 120OFFSET
I B 17 200NOENTR
I B 21 240LSTSIZ
IRD100H DS
I 21 30 FILTYP
I 31 80 V1FTXT
IFLDLST DS
I 1 10 FLDNAM
|
I 11 11 DTATYP
I B 21 240BYTLEN
I B 25 280DIGITS
I B 29 320DECIML
I 33 82 DESCR
I 153 172 COLHD1
I 173 192 COLHD2
I 193 212 COLHD3
IMBD200 DS
I 59 71 CTDTTM
I 85 134 V1MTXT
I B 141 1440NBRRCD
I B 145 1480DLTRCD
I 161 173 CGDTTM
I B 213 2160NBRDAY
|
I 217 223 LSTUSD
I 224 230 RESDAT
C******************************************************
C* DEFINITION MODULE ( PLIST FIELD KLIST ) *
C******************************************************
C* ;
C* DEFINE PLIST ;
C* ;
C *ENTRY PLIST ;
C PARM PUSRSP 20 ;USER SPACE
C PARM KEYACP 1 ;'Y'=KEY FILE
C PARM TXTTYP 1 ;
C PARM DSPFMT 1 ;FORMAT OF DISPLAY
C PARM EDTFGR 1 ;EDIT FIGURES Y
C PARM DSPATR 1 ;FIELD ATTRIBUTE
|
C* ;
C* DEFINE PARM ;
C* ;
C* API "QUSRTVUS" ;
C PRMFLD PLIST ;RTV FIELDS LIST
C PARM USRSPC ;
C PARM STRPOS ;
C PARM 212 LENDTA ;
C PARM FLDLST ;
C* RETRIEVE HEADER FROM USER SPACE ;
C PRMRTV PLIST ;RTV RECORD FORMAT
C PARM USRSPC ;
C PARM 117 STRPOS ;
C PARM 24 LENDTA ;
C PARM RCVVAR ;
|
C******************************************************
C* M A I N - R O U T I N E ;
C******************************************************
C MOVE *ON *IN86 :OVRATR ON
C Z-ADD#SETLL CONTRL 10 :
C WRITEHDR01 ;
C* ;
B001 C CONTRL DOWEQ#SETLL ;
B002 C KEYACP CASEQ#YES @STLKY ;
+002 C CAS @STLAR ;
E002 C END ;
001 C MOVE #NO W1EOF 1 ;
001 C MOVE #NO W1BOF 1 ;
001 C ADD 1 CONTRL ;
B002 C CONTRL DOWEQ#READ ;
|
B003 C KEYACP CASEQ#YES @REDKY ;
+003 C CAS @REDAR ;
E003 C END ;
002 C ADD 1 CONTRL ;
B003 C CONTRL DOWEQ#STORE ;
003 C EXSR @STORE ;
003 C ADD 1 CONTRL ;
B004 C CONTRL DOWEQ#LOAD ;
004 C MOVE *ON *IN85 :OVRATR ON
004 C EXSR @LOAD ;
004 C ADD 1 CONTRL ;
B005 C CONTRL DOWEQ#RDDTL ;
005 C EXSR @RDDTL ;
B006 C CONTRL IFEQ #END :
006 C LEAVE :
|
E006 C END :
005 C MOVE *OFF *IN85 :OVRATR OFF
005 C MOVE *OFF *IN86 :OVRATR OFF
E005 C END ;
004 C* ;
E004 C END ;
E003 C END ;
E002 C END ;
E001 C END ;
C* ;
C MOVE *ON *INLR ;
C RETRN ;
C******************************************************
C* S U B - R O U T I N E ;
C******************************************************
|
C*----------------------------------------------------*
C *INZSR BEGSR :
C*----------------------------------------------------*
C* CALL API AND RETRIEVE RECORD FORMAT INFORMATION.AND:
C* CHECK SINGLE RECORD FORMAT OR NOT.IF IT IS NOT :
C* SINGLE RECORD FORMAT ,THIS PGM WILL BE ABORTED. :
C* :
C* INITIALIZE OF WORK FIELDS. :
C* :
C* FILE OPEN (ARVF OR KEYF) :
C* RETRIEVE BASIC INFORMATION OF THE FILE FROM :
C* INFROMATION DS. :
C* SAVE KEY-FIELD TO ARRAY.(I'M UNWILLING TO DO SO.BUT:
C* THERE IS NOT API THAT CAN RETRIEVE KEY FIELDS.) :
C* AND CREATE FIELDS LIST INTO USER SAPCE. :
|
C* :
C* RETRIEVE GENERAL HEADER OF RCDFMT INFROMATION. :
C MOVE PUSRSP USRSPC 20 :
C CALL #PGRTV PRMRTV :
C* CHECK SINGLE RECORD FORMAT :
C* NOENTR IFGT 1 :NOT SINGLE RCDFMT
C* MOVE *ON *INLR :EXIT IMMEDIATE
C* RETRN :
C* ELSE :
C* RETRIEVE HEADER SECTION OF RCDFMT INFORMATION. :
C OFFSTH ADD 1 STRPOS :SET INITIAL STRPOS
C CALL #PGRTV :
C PARM USRSPC :
C PARM STRPOS :
C PARM HDRSIZ LENDTA :
|
C PARM RD100H :
C* RETRIEVE LIST SECTION OF RCDFMT INFROMATION. :
C OFFSET ADD 1 STRPOS :SET INITIAL STRPOS
C CALL #PGRTV :
C PARM USRSPC :
C PARM STRPOS :
C PARM LSTSIZ LENDTA :
C PARM P1RFMT 10 :RECORD FORMAT
C* :
C Z-ADD0 DSARRN :
C Z-ADD0 WK2 50 :
C #PGSIZ SUB 1 PRELST 30 :
C MOVE ' ' WRKBYT 1 :
C* SET INITIAL DATA :
C MOVE TXTTYP WTYPE 1 :
|
C Z-ADD1 V1RRN :
C Z-ADD20 CHDMAX 30 :LENGTH OF COLHDG
C Z-ADD30 TXTMAX 30 :LENGTH OF TEXT
C* OPEN FILE :
B001 C KEYACP IFEQ #YES :
001 C OPEN KEYF 99 :INDEXED FILE
B002 C *IN99 IFEQ *ON :
002 C MOVE #NO KEYACP :
+002 C ELSE :
002 C MOVE *OFF *IN50 :CONTROL DSPF FLDS
002 C MOVELDSKEY DSINFO :
002 C MOVE *LOVAL V1KCHR :
002 C* SAVE KEY FIELDS INTO ARRAY (KF) :
002 C OPEN QAFDACCP :
002 C MOVEL#KEYFD V1HINF :
|
B003 C 1 DO #MAXKF :
003 C READ QAFDACCP 99:
B004 C *IN99 IFEQ *ON :
004 C LEAVE :
+004 C ELSE :
004 C ADD 1 KEYNBR 30 :
004 C Z-ADDAPKEYN FLD :
B005 C KEYNBR IFGT 1 :
005 C V1HINF CAT #COMMA:0 V1HINF :
E005 C END :
004 C V1HINF CAT APKEYF:0 V1HINF :
B005 C FLD IFLE #MAXKF :
005 C MOVE APKEYF KF,FLD :
E005 C END :
E004 C END :
|
E003 C END :
002 C V1HINF CAT #PRIOD:0 V1HINF :
E002 C END :
E001 C END :
C* :
B001 C KEYACP IFEQ #NO :
001 C OPEN ARVF 99 :
B002 C *IN99 IFEQ *ON :
002 C MOVE *ON *INLR :
002 C RETRN :
+002 C ELSE :
002 C MOVE *ON *IN50 :CNTROL DSPF FLDS
002 C MOVELDSARV DSINFO :
E002 C END :
E001 C END :
|
C* :
C Z-ADDDSRLEN V1RLEN :LENGTH OF RECORD
C Z-ADDDSSIZE V1SIZE :SIZE OF MEMBER
C* FILE INFORMATION OF DISPLAY HEADER :
C MOVE 'MBRD0200'MBR200 8 :
C* :
C #FL CAT DSFLIB V1HDR :
C V1HDR CAT '/':0 V1HDR :
C V1HDR CAT DSFILE:0 V1HDR :
C V1HDR CAT '(':0 V1HDR :
C V1HDR CAT V1MBRN:0 V1HDR :
C V1HDR CAT ')':0 V1HDR :
C V1HDR CAT #RD:2 V1HDR :
C V1HDR CAT P1RFMT:0 V1HDR :
C V1HDR CAT #TP:2 V1HDR :
|
C V1HDR CAT FILTYP:0 V1HDR :
C V1HDR CAT '/':0 V1HDR :
C* :
B001 C SELEC :
001 C DSACPH WHEQ 'KU' :
001 C V1HDR CAT 'UNIQ':0 V1HDR :
001 C DSACPH WHEQ 'KF' :
001 C V1HDR CAT 'FIFO':0 V1HDR :
001 C DSACPH WHEQ 'KL' :
001 C V1HDR CAT 'LIFO':0 V1HDR :
001 C DSACPH WHEQ 'AR' :
001 C V1HDR CAT 'ARIV':0 V1HDR :
001 C DSACPH WHEQ 'KN' :
001 C V1HDR CAT 'DUPK':0 V1HDR :
001 C DSACPH WHEQ 'KC' :
|
001 C V1HDR CAT 'FCFO':0 V1HDR :
+001 C OTHER :
001 C V1HDR CAT '????':0 V1HDR :
E001 C ENDSL :
C* SET NO DATA MESSAGE :
B001 C V1SIZE IFEQ 0 :
001 C MOVEL#NODTA V1MSG :
E001 C END :
C* SET FIELDS INFORMATION INTO USER SPACE :
C CALL #PGFLD :
C PARM USRSPC :
C PARM 'FLDL0100'OUTFMT 8 :
C PARM DSFLLB :
C PARM P1RFMT :
C PARM *OFF OVRRID 1 :
|
C* RETRIEVE HEADER SECTION OF FIELDS INFORMATION :
C CALL #PGRTV PRMRTV :
C Z-ADDNOENTR MAXFLD 50 :
C* END :
C Z-ADD1 FTRCTL 10 :
C MOVELGDE,1 V1CMD1 :
C MOVELGDE,2 V1CMD2 :
C MOVE *ON *IN86 :OVRATR ON
C WRITEFTR01 :
C MOVE *OFF *IN86 :OVRATR OFF
C* :
C ENDSR :
C*----------------------------------------------------*
C @STLAR BEGSR :SETLL
C*----------------------------------------------------*
|
C* IF NEW VALUE (KEY VALUE OR RRN) IS ENTERED, :
C* "SETLL" THE FILE WITH THE NEW VALUE. :
C* :
C V1RRN SETLLARVF 9091 :
C* :
B001 C *IN91 IFEQ *ON :
001 C READ ARVF 90:
001 C DSARRN SETLLARVF :
E001 C END :
C* :
B001 C *IN90 IFEQ *ON :
001 C READPARVF 90:
001 C Z-ADDDSARRN V1RRN :
001 C V1RRN SETLLARVF :
E001 C END :
|
C* :
B001 C V1MSG IFEQ *BLANK :
001 C MOVEL#SLTMG V1MSG :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @STLKY BEGSR :SETLL
C*----------------------------------------------------*
C* IF NEW VALUE (KEY VALUE OR RRN) IS ENTERED, :
C* "SETLL" THE FILE WITE THE NEW VALUE. :
C V1KCHR SETLLKEYF 9091 :
C* :
B001 C *IN91 IFEQ *ON :
001 C READ KEYF 90:
|
001 C DSKYVL SETLLKEYF :
E001 C END :
C* :
B001 C *IN90 IFEQ *ON :
001 C READPKEYF 90:
001 C DSKYVL SETLLKEYF :
E001 C END :
C* :
B001 C V1MSG IFEQ *BLANK :
001 C MOVEL#SLTMG V1MSG :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @REDAR BEGSR :READ FILE
|
C*----------------------------------------------------*
C* READ RECORD IN :
C* ARVF (IF ARRIVAL FILE) WITH RRN. :
C* YOU CAN RECEIVE KEY VALUE FROM INFORMATION DS. :
C* BUT THE VLAUE IN INFROMATION DS INCLUDES GARBAGE, :
C* IF YOU DISPLAY IT ON SCREEN,YOU'D BETTER CLEAR THEM:
C* :
B001 C V1SIZE IFEQ 0 :
001 C MOVE *LOVAL DSDTA :INITIALIZE DATA
E001 C END :
C* :
C MOVEA'00' *IN,98 :
C MOVE #NO W1EOF :
C MOVE #NO W1BOF :
C* :
|
B001 C ROLDWN IFNE PUSHED :R/DOWN OFF
001 C READ ARVF 99:
001 C 99 V1RRN SETLLARVF :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#NXTMG V1MSG :
E002 C END :
+001 C ELSE :
001 C READPARVF 98:
001 C 98 V1RRN SETGTARVF :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#PRVMG V1MSG :
E002 C END :
E001 C END :
C* :
B001 C *IN98 IFEQ *OFF :
|
*001 C *IN99 ANDEQ*OFF :
001 C Z-ADDDSARRN V1RRN :
001 C Z-ADDDSARRN V1CRRN :
E001 C END :
C* SET MESSAGES :
B001 C *IN99 IFEQ *ON :
001 C MOVE #YES W1EOF :
001 C MOVE *BLANK V1MSG :
001 C MOVEL#EOFMG V1MSG :EOF
+001 C ELSE :
B002 C *IN98 IFEQ *ON :
002 C MOVE #YES W1BOF :
002 C MOVE *BLANK V1MSG :
002 C MOVEL#BOFMG V1MSG :BOF
E002 C END :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @REDKY BEGSR :READ FILE
C*----------------------------------------------------*
C* READ RECORD IN :
C* KEYF (IF INDEXED FILE) WITH KEY VALUE. :
C* YOU CAN RECEIVE KEY VALUE FROM INFORMATION DS. :
C* BUT THE VLAUE IN INFROMATION DS INCLUDES GARBAGE, :
C* IF YOU DISPLAY IT ON SCREEN,YOU'D BETTER CLEAR THEM:
C* :
B001 C V1SIZE IFEQ 0 :
001 C MOVE *LOVAL DSDTA :INITIALIZE DATA
E001 C END :
|
C* :
C MOVEA'00' *IN,98 :
C MOVE #NO W1EOF :
C MOVE #NO W1BOF :
C* :
B001 C ROLDWN IFNE PUSHED :R/DOWN OFF
001 C READ KEYF 99:
001 C 99 DSKYVL SETLLKEYF :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#NXTMG V1MSG :
E002 C END :
+001 C ELSE :
001 C READPKEYF 98:
001 C 98 DSKYVL SETGTKEYF :
B002 C V1MSG IFEQ *BLANK :
|
002 C MOVEL#PRVMG V1MSG :
E002 C END :
E001 C END :
C* :
B001 C *IN98 IFEQ *OFF :
*001 C *IN99 ANDEQ*OFF :
B002 C KK IFEQ 0 :
002 C Z-ADDDSKEYL KK 30 :
B003 C KK IFGT #MAXKL :
003 C Z-ADD#MAXKL KK :
E003 C END :
002 C Z-ADDKK KEYLEN 30 :SAVE REAL LENGTH
E002 C END :
001 C MOVELDSKYVL DSKVL :
B002 C KK IFLT #MAXKL :CLEAR GARBAGE
|
002 C ADD 1 KK :
002 C MOVEA*BLANK KV,KK :
002 C SUB 1 KK :
E002 C END :
001 C Z-ADDKK COUNT :
001 C EXSR @KYCHR :CHAR -> HEX
001 C MOVELDSKVL KEYWRK 78 :SAVE TO WORK
001 C MOVELDSKVL V1KCHR :
001 C MOVELDSHXZ V1KHXZ :ZONE HEX
001 C MOVELDSHXD V1KHXD :DIGIT HEX
001 C Z-ADDDSKRRN V1CRRN :CURRENT RRN
E001 C END :
C* SET MESSAGES :
B001 C *IN99 IFEQ *ON :
001 C MOVE #YES W1EOF :
|
001 C MOVE *BLANK V1MSG :
001 C MOVEL#EOFMG V1MSG :EOF
+001 C ELSE :
B002 C *IN98 IFEQ *ON :
002 C MOVE #YES W1BOF :
002 C MOVE *BLANK V1MSG :
002 C MOVEL#BOFMG V1MSG :BOF
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MBINF BEGSR :DSP MBR INFO.
C*----------------------------------------------------*
B001 C F3 DOUEQPUSHED :
|
*001 C F12 OREQ PUSHED :
001 C EXSR @RTVMB :
001 C EXFMTMBRINF :
E001 C END :
C* :
C WRITEHDR01 :
C MOVE *ON *IN86 :OVRATR ON
C WRITEFTR01 :
C MOVE *OFF *IN86 :OVRATR OFF
C MOVE *BLANK V1MSG :
C* :
B001 C CONTRL IFGT #LOAD :
001 C Z-ADD#LOAD CONTRL :
E001 C END :
C* :
|
C ENDSR :
C*----------------------------------------------------*
C @RTVMB BEGSR :RTV MBR INFO.
C*----------------------------------------------------*
C CALL #PGMBR :
C PARM MBD200 :
C PARM LENRCV :
C PARM MBR200 :
C PARM DSFLLB :
C PARM V1MBRN :
C PARM OVRRID :
C* :
C MOVE CTDTTM V1CTDT :
C Z-ADDNBRRCD V1SIZE :
C Z-ADDDLTRCD V1DLRD :
|
C MOVE CGDTTM V1CGDT :
C Z-ADDNBRDAY V1MUSD :
C MOVE LSTUSD V1LTDT :
C MOVE RESDAT V1RTDT :
C* :
B001 C V1SIZE IFEQ 0 :
*001 C V1MSG ANDEQ*BLANK :
001 C MOVEL#NODTA V1MSG :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @STORE BEGSR :BUILD SFL
C*----------------------------------------------------*
C Z-ADD0 STRCLM 50 :START POS.
|
C Z-ADD0 ENDCLM 50 :END POS.
C Z-ADD0 CLM 50 :COLOM OF LINE
C Z-ADD0 LIN 50 :
C Z-ADD1 STRLIN 30 :
C Z-ADD0 BOTMLN 30 :
C MOVE #YES FIRST 1 :
C MOVE #NO ENDPOS 1 :
C* :
C* SET DATA INTO SFL BY EACH FIELD. :
B001 C 1 DO MAXFLD FLD 30 :
001 C EXSR @EDT :SET TEXT TO LINE
E001 C END :
C* IS IT ALL ? IF NOT, WRITE SFL. :
C EXSR @LIN :WRITE LINE TO SFL
C* :
|
C Z-ADDLIN LASTLN 50 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @LOAD BEGSR :WRITE DETAILE
C*----------------------------------------------------*
C MOVE *BLANK V1LN01 :
C MOVE *BLANK V1LN02 :
C MOVE *BLANK V1LN03 :
C MOVE *BLANK V1LN04 :
C MOVE *BLANK V1LN05 :
C MOVE *BLANK V1LN06 :
C MOVE *BLANK V1LN07 :
C MOVE *BLANK V1LN08 :
C MOVE *BLANK V1LN09 :
|
C MOVE *BLANK V1LN10 :
C MOVE *BLANK V1LN11 :
C MOVE *BLANK V1LN12 :
C MOVE *BLANK V1LN13 :
C* :
C Z-ADDSTRLIN LIN :
C* :
B001 C LIN IFLE LASTLN :
001 C MOVELLN,LIN V1LN01 ;
001 C ADD 1 LIN :
B002 C LIN IFLE LASTLN :
002 C MOVELLN,LIN V1LN02 ;
002 C ADD 1 LIN :
B003 C LIN IFLE LASTLN :
003 C MOVELLN,LIN V1LN03 ;
|
003 C ADD 1 LIN :
B004 C LIN IFLE LASTLN :
004 C MOVELLN,LIN V1LN04 ;
004 C ADD 1 LIN :
B005 C LIN IFLE LASTLN :
005 C MOVELLN,LIN V1LN05 ;
005 C ADD 1 LIN :
B006 C LIN IFLE LASTLN :
006 C MOVELLN,LIN V1LN06 ;
006 C ADD 1 LIN :
B007 C LIN IFLE LASTLN :
007 C MOVELLN,LIN V1LN07 ;
007 C ADD 1 LIN :
B008 C LIN IFLE LASTLN :
008 C MOVELLN,LIN V1LN08 ;
|
008 C ADD 1 LIN :
B009 C LIN IFLE LASTLN :
009 C MOVELLN,LIN V1LN09 ;
009 C ADD 1 LIN :
B010 C LIN IFLE LASTLN :
010 C MOVELLN,LIN V1LN10 ;
010 C ADD 1 LIN :
B011 C LIN IFLE LASTLN :
011 C MOVELLN,LIN V1LN11 ;
011 C ADD 1 LIN :
B012 C LIN IFLE LASTLN :
012 C MOVELLN,LIN V1LN12 ;
012 C ADD 1 LIN :
B013 C LIN IFLE LASTLN :
013 C MOVELLN,LIN V1LN13 ;
|
E013 C END :
E012 C END :
E011 C END :
E010 C END :
E009 C END :
E008 C END :
E007 C END :
E006 C END :
E005 C END :
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
C Z-ADDLIN BOTMLN :
|
C* :
B001 C LIN IFGE LASTLN :
001 C MOVEL#BOTTM ENDMDE :
+001 C ELSE :
001 C MOVEL#MORE ENDMDE :
E001 C END :
C* :
C WRITEDTL01 ;
C* :
C MOVE *BLANK V1MSG :
C* ;
C ENDSR :
C*----------------------------------------------------*
C @RDDTL BEGSR :READ SFL CTL
C*----------------------------------------------------*
|
C READ DTL01 99;
C* ;
B001 C KEYACP IFEQ #NO ;
*001 C V1RRN ANDLE0 ;
001 C Z-ADD1 V1RRN ;
E001 C END ;
C* ;
B001 C RECENT IFNE PUSHED ;
001 C EXSR @CMD ;COMMAND FUNCTION
E001 C END ;
C* ;
B001 C CONTRL IFNE #END ;
001 C EXSR @CNTRL ;
E001 C END ;
C* :
|
C ENDSR :
C*----------------------------------------------------*
C @CNTRL BEGSR :CONTROL
C*----------------------------------------------------*
B001 C RECENT IFEQ PUSHED :
*001 C W1EOF ANDEQ#NO :
*001 C CONTRL ANDGT#READ :
001 C Z-ADD#READ CONTRL :
E001 C END :
C* :
B001 C KEYACP IFEQ #YES :
001 C* :
B002 C *IN51 IFEQ *ON :
002 C MOVELV1KHXZ DSHXZ :
002 C MOVELV1KHXD DSHXD :
|
002 C Z-ADDKK COUNT :
002 C EXSR @KYHEX :HEX->CHARACTER
002 C MOVELDSKVL V1KCHR :
E002 C END :
001 C* :
B002 C V1KCHR IFNE KEYWRK :KEY IS CHNAGED
002 C Z-ADD#SETLL CONTRL :
E002 C END :
001 C* :
+001 C ELSE :
001 C* :
B002 C V1RRN IFNE V1CRRN :RRN IS CHNAGED
002 C Z-ADD#SETLL CONTRL :
E002 C END :
001 C* :
|
E001 C END :
C* :
C* IF DISPLAY MODE IS CHANGED,RESET FIELD WITHOUT READING.
C* :
B001 C WTYPE IFNE TXTTYP :
001 C MOVE TXTTYP WTYPE :
B002 C CONTRL IFGT #STORE :
002 C Z-ADD#STORE CONTRL :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @EDT BEGSR :EDIT TEXT
C*----------------------------------------------------*
|
C* DISPLAY FORMAT IS BELOW. :
C* XXXXXXXXXXXXX DDDDDDDDDDD :
C* ~~~~~~~~~~~ :
C* (A) (B) :
C* :
C* (A) MEANS 1.TEXT 2.COLUMN HEADING 3.FIELD ETC... :
C* (B) MEANS DATA ITSELF. :
C* THIS SUBROUTINE CREATES (A). :
C* :
C* 1. RETRIEVE FIELD INFORMATION BY API. :
C* 2. AND CHECK THE LENGTH OF (A) :
C* 3. IF IT IS LONGER THAN MAXIMUM OF DISPLAY FIELD :
C* WRITE IT INTO SFL. :
C* 4. SET (A) INTO LINE THAT WILL BE ONE OF SUBFILE. :
C* 5. IF ATTRIBUTES OF FIELD IS REQUESTED, SET THEM IN:
|
C* THE LINE. :
C* 6 IF FORMAT OF DISPLAY IS SINGLE FIELD PER LINE, :
C* SET '.'(PRIOD) TO LINE. :
C* (EX. XXXXXXXXX..........DDDDDDDDDDD) :
C* ~~~~~~~~~~~ :
C* 7. WORK FIELD "FLD" MEANS FIELD COUNTER :
C* :
B001 C FLD IFEQ 1 :
001 C OFFSET ADD 1 STRPOS :
+001 C ELSE :
001 C ADD LSTSIZ STRPOS :
E001 C END :
C* RETRIEVE LIST SECTION OF FIELDS INFROMATION. :
C CALL #PGRTV PRMFLD :
C* :
|
C Z-ADD0 CHKLEN 50 :LENGTH FOR PRECHECK
C Z-ADD0 DCPCNT 30 :COUNTER FOR DECIMAL
C Z-ADD0 DECPNT 30 :POSITION OF DECIMAL
C* :
B001 C DTATYP IFNE #ZONE :CHARACTER
*001 C DTATYP ANDNE#PACK :
*001 C DTATYP ANDNE#BIN :
001 C BYTLEN ADD 1 CHKLEN :
+001 C ELSE :NUMERIC
001 C Z-ADDDIGITS CHKLEN :
B002 C DECIML IFNE 0 :
002 C ADD 1 CHKLEN :FOR DEC.P
002 C CHKLEN SUB DECIML DECPNT :
E002 C END :
001 C ADD 2 CHKLEN :FOR SIGN + ATR.
|
E001 C END :
C* FIELD ATTRIBUTES LENGTH :
B001 C DSPATR IFEQ *ON :
001 C EXSR @MKATR :MAKE ATR INFORMATION
001 C Z-ADD0 ATRLEN 30 :LENGTH OF ATTR.
001 C Z-ADD10 COUNT :
001 C MOVELFLDATR DSWRK :
001 C EXSR @LEN :CHECK LENGTH
001 C Z-ADDCOUNT ATRLEN :
E001 C END :
C* :
C* PRECHECK LENGTH OF TEXT :
C* :
C MOVE *BLANK V1MODE :
C* :
|
B001 C TXTTYP IFNE #DTAOY :
001 C Z-ADD0 CHDLEN 30 :LENGTH OF COLHDG
001 C Z-ADD0 TXTLEN 30 :LENGTH OF TEXT
001 C Z-ADD0 FLDLEN 30 :LENGTH OF FIELD
001 C* COLUMN HEADING :
B002 C TXTTYP IFEQ #COLHG :
*002 C TXTTYP OREQ #CHDFL :
002 C MOVE *BLANK WCOLHD 62 :
002 C COLHD1 CAT COLHD2:1 WCOLHD :
002 C WCOLHD CAT COLHD3:1 WCOLHD :
002 C MOVELWCOLHD DSWRK :
002 C Z-ADD62 COUNT 30 :20+1+20+1+20=62
002 C EXSR @LEN :CHECK LENGTH
002 C Z-ADDCOUNT CHDLEN :LEN. OF COLHDG
E002 C END :
|
001 C* TEXT LENGTH :
B002 C TXTTYP IFEQ #TEXT :
*002 C TXTTYP OREQ #TXTFL :
B003 C DESCR IFNE *BLANK :
003 C Z-ADD50 COUNT :
003 C MOVELDESCR DSWRK :
003 C EXSR @LEN :CHECK LENGTH
003 C Z-ADDCOUNT TXTLEN :
E003 C END :
E002 C END :
001 C* FIELD LENGTH :
B002 C TXTTYP IFEQ #FIELD :
*002 C TXTTYP OREQ #TXTFL :
*002 C TXTTYP OREQ #CHDFL :
002 C Z-ADD10 COUNT :
|
002 C MOVELFLDNAM DSWRK :
002 C EXSR @LEN :CHECK LENGTH
002 C Z-ADDCOUNT FLDLEN :
E002 C END :
E001 C END :
C* CHECK LENGTH OF DATA.IF TOO LONG,WRITE IT INTO SFL.:
B001 C DSWLN IFNE *BLANK :
B002 C CHKLEN IFGT #MAXCM :
002 C EXSR @LIN :WRITE LINE TO SFL
+002 C ELSE :
002 C ADD CLM CHKLEN :
B003 C CHKLEN IFGE #MAXCM :
003 C EXSR @LIN :WRITE LINE TO SFL
E003 C END :
E002 C END :
|
E001 C END :
C* SET TEXT TO LINES :
C Z-ADD0 LEADER 50 :PERIOD LEADER LENGTH
C* :
B001 C TXTTYP IFNE #DTAOY :
B002 C TXTTYP CASEQ#COLHG @COLHG :COLHDG
+002 C TXTTYP CASEQ#TEXT @TEXT :TEXT
+002 C TXTTYP CASEQ#FIELD @FIELD :FIELD
+002 C TXTTYP CASEQ#TXTFL @TXTFL :TEXT+FIELD
+002 C TXTTYP CASEQ#CHDFL @CHDFL :COLHDG+FIELD
E002 C END :
E001 C END :
C* :
B001 C DSPATR CASEQ*ON @ATRFD :FIELD ATTRIBUTE
E001 C END :
|
C* :
C* SINGLE FIELD PER LINE :
C* SET LEADER LIKE XXXXX.......DDDDDDDD :
C* ~~~~~~~~ :
C* MAXIMUM LENGTH OF COLUMN HEADING AND FIELD TEXT :
C* :
B001 C DSPFMT IFEQ #SGLFL :SINGLE FIELD/LINE
001 C V1MODE CAT #LEADR:0 V1MODE :
B002 C LEADER IFLE 0 :
002 C Z-ADD2 LEADER :PERIOD LEADER LENGTH
E002 C END :
001 C MOVE X20 WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
001 C MOVE #PRIOD WRKBYT :
B002 C 1 DO LEADER :XXX....DDDDD
|
002 C EXSR @TOLIN :SET 1 CHR TO LIN
E002 C END :
E001 C END :
C* :
C V1MODE CAT #DTAMD:0 V1MODE :
C* :
B001 C EDTFGR IFEQ *ON :
001 C V1MODE CAT #ZSPMD:0 V1MODE :
E001 C END :
C* :
C* 1.CHECK START COLUMN POSTION AND LAST POSITION FOR :
C* EACH FIELD. :
C* 2.READ CHARACTER ONE BY ONE FROM "DTA"(ARY) WITHIN :
C* START AND END POSITION. :
C* 3.IF MARKED FIELD IS FOUND,SET DSPATR(HI UL) TO :
|
C* LINE. :
C* 4.IF KEY FIELD IS FOUND,SET DSPATR(HI BL) TO LINE. :
C* 5.IF DATA TYPE IS :
C* PACK NUMERIC, SUBR @PACK. :
C* ZONE NUMERIC, SUBR @ZONE. :
C* BINARY NUMERIC, SUBR @BIN. :
C* ELSE SUBR @CHAR. :
C* :
C* GET END POSITON COLUMN ON DBF :
C* :
C Z-ADD0 IGCCNT 10 :
C MOVE #NO CK0E0F 1 :
C* ZERO-SUPPRESS FOR NUMERIC DATA CONTROL. :
C MOVE #NO ZSPEND 1 :
C* PUT DISPLAY-ATTRIBUTE INTO SFL :
|
B001 C FLDRQS IFEQ #NO :
001 C MOVE XHIUL ATRDTA :
+001 C ELSE :
001 C MOVE *OFF *IN70 :
001 C FLD LOKUPAP 70:
B002 C *IN70 IFEQ *ON :
B003 C FIRST IFEQ #YES :
*003 C LIN ANDGE#PGSIZ :
003 C LIN ADD 1 STRLIN :
003 C MOVE #NO FIRST :
E003 C END :
002 C MOVE XHIUL ATRDTA 1 :
+002 C ELSE :
002 C MOVE XUL ATRDTA :
E002 C END :
|
E001 C END :
C* GET POSITION OF KEY FIELD IN USER SPACE ONE BY ONE :
B001 C KEYACP IFEQ #YES :INDEXED FILE
001 C Z-ADD1 KFD 30 :
001 C MOVE *OFF *IN70 :
001 C FLDNAM LOKUPKF,KFD 70:
B002 C *IN70 IFEQ *ON :
002 C Z-ADDFLD KP,KFD :
002 C MOVE XHIBLU ATRDTA :
E002 C END :
E001 C END :
C* :
C MOVE ATRDTA WRKBYT :
C EXSR @TOLIN :SET 1 CHR TO LIN
C* EDIT DATA FOR EACH FIELD :
|
C ENDCLM ADD 1 STRCLM :
C ADD BYTLEN ENDCLM :
C* :
B001 C STRCLM IFGT #MAXIN :
*001 C ENDCLM ORGT #MAXIN :
001 C ADD 1 CLM :
001 C MOVEA#OVRFL WL,CLM :OVER FLOW MESSAGE
001 C Z-ADD#MAXCM CLM :
001 C Z-ADDMAXFLD FLD :
001 C Z-ADDENDCLM FIL :
+001 C ELSE :
B002 C DTATYP CASEQ#PACK @PACK :PACK NUMERIC
+002 C DTATYP CASEQ#ZONE @ZONE :ZONE NUMERIC
+002 C DTATYP CASEQ#BIN @BIN :BINARY NUMERIC
+002 C CAS @CHAR :CHARACTER
|
E002 C END :
E001 C END :
C* MOVE TO LINE :
B001 C DSPFMT CASEQ#SGLFL @LIN :SINGLE FIELD/LINE
+001 C CLM CASEQ#MAXCM @LIN :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHAR BEGSR :CHECK CHARACTER
C*----------------------------------------------------*
C* CHECK FOR DBCS.DBCS STRING NEEDS SI,SO (X'0E' X'0F')
C* CODE. THE LACK OF THESE CODES CAUSES BROKEN DBCS :
C* STRING.THEN THIS PGM CHECK SI,SO CODE. :
C* :
|
C MOVE #NO ENDPOS :
C* :
B001 C STRCLM DO ENDCLM FIL 50 :
001 C* :
B002 C FIL IFEQ ENDCLM :
002 C MOVE #YES ENDPOS :
E002 C END :
001 C* :
B002 C DT,FIL IFEQ X'0E' :
002 C MOVE #YES CK0E0F :
+002 C ELSE :
B003 C DT,FIL IFEQ X'0F' :
003 C MOVE #NO CK0E0F :
003 C Z-ADD0 IGCCNT :
E003 C END :
|
E002 C END :
001 C* :
B002 C CK0E0F IFEQ #YES :
002 C ADD 5 IGCCNT :
E002 C END :
001 C* DISPLAYABLE DATA :
001 C* IF DATA IS MORE THAN X'40',MOVE IT INTO LINE. :
001 C ADD 1 CLM :
B002 C DT,FIL IFGT #X40 :
*002 C DT,FIL OREQ X'0E' :
*002 C DT,FIL OREQ X'0F' :
002 C MOVE DT,FIL WL,CLM :
E002 C END :
001 C* :
B002 C CLM IFEQ #MAXCM :GET TO MAX COLUMN
|
B003 C CK0E0F IFEQ #NO :X"0E0F" OK
003 C EXSR @LIN :WRITE LINE TO SFL
+003 C ELSE :X"0E0F" NG
B004 C IGCCNT IFNE 0 :ODD
004 C ADD 1 CLM :
004 C MOVE X'0F' WL,CLM :SET X"0F"
004 C EXSR @LIN :WRITE LINE TO SFL
004 C ADD 1 CLM :
004 C MOVE X'0E' WL,CLM :SET X"0E" TO NXT LIE
+004 C ELSE :
004 C MOVE X'0F' WL,CLM :REPLACE "0F" AT END
004 C EXSR @LIN :WRITE LINE TO SFL
004 C ADD 1 CLM :
004 C MOVE X'0E' WL,CLM :
004 C ADD 1 CLM :
|
004 C MOVE DT,FIL WL,CLM :
E004 C END :
E003 C END :
E002 C END :
001 C* :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @BIN BEGSR :BINARY NUMERIC
C*----------------------------------------------------*
C Z-ADDSTRCLM FIL :
C Z-ADD0 ZONE30 300 :
C MOVE *ZERO DSNUM :
C* :
|
B001 C BYTLEN IFEQ 2 :
001 C MOVE *LOVAL DSBN2C :
001 C MOVEADT,FIL DSBN2C :
001 C Z-ADDDSBIN2 ZONE30 :
+001 C ELSE :
001 C MOVE *LOVAL DSBN4C :
001 C MOVEADT,FIL DSBN4C :
001 C Z-ADDDSBIN4 ZONE30 :
E001 C END :
C* :
C MOVELZONE30 DSNUM :
C* :
C #MAXZN SUB DIGITS WRK :
C WRK ADD 1 STRNUM :
C EXSR @NUM :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @PACK BEGSR :PACK NUMERIC
C*----------------------------------------------------*
C MOVE *ZERO DSNUM :
C Z-ADD0 ZONE30 :
C Z-ADDSTRCLM FIL :
C #MAXPK SUB BYTLEN WRK :
C ADD 1 WRK :
C Z-ADD0 DSPCKN :
C MOVEADT,FIL PK,WRK :
C Z-ADD#MAXPK WRK :
C TESTB'45' PK,WRK 70:
C TESTB'7' PK,WRK 71:
|
C TESTB'67' PK,WRK 72 :
C* :
B001 C *IN70 IFEQ *ON :
*001 C *IN71 ANDEQ*ON :
*001 C *IN70 OREQ *ON :
*001 C *IN72 ANDEQ*ON :
001 C Z-ADDDSPCKN ZONE30 :
001 C MOVELZONE30 DSNUM :
+001 C ELSE :
001 C MOVE *ALL'?' DSNUM :
E001 C END :
C* :
C #MAXZN SUB DIGITS WRK :
C WRK ADD 1 STRNUM 30 :
C EXSR @NUM :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @ZONE BEGSR :ZONE NUMERIC
C*----------------------------------------------------*
C Z-ADDSTRCLM FIL :
C #MAXZN SUB DIGITS WRK :
C ADD 1 WRK :
C MOVE *ZERO DSNUM :
C MOVEADT,FIL NM,WRK :
C* :
C Z-ADDWRK STRNUM :
C EXSR @NUM :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @NUM BEGSR :NUMERIC
C*----------------------------------------------------*
C MOVE #NO ENDPOS :
C* :
B001 C STRNUM DO #MAXZN WRK :
001 C* :
B002 C WRK IFEQ #MAXZN :
002 C MOVE #YES ENDPOS :
E002 C END :
001 C* :
B002 C DECPNT IFNE 0 :
002 C ADD 1 DCPCNT :COUNT UP
B003 C DCPCNT IFEQ DECPNT :COUNTER=POS OF DEC.
003 C MOVE #PRIOD WRKBYT :
|
003 C EXSR @TOLIN :SET 1 CHR TO LIN
E003 C END :
E002 C END :
001 C* :
B002 C ENDPOS IFEQ #NO :
*002 C EDTFGR ANDEQ*ON :
002 C* :
002 C* SET A CHARACTER TO LINE ONE BY ONE.AND THIS LINE :
002 C* WILL BE WRITTEN INTO A SUB FILE RECORD. :
002 C* :
B003 C NM,WRK IFNE '0' :
*003 C DECPNT ORNE 0 :
*003 C DCPCNT ANDEQDECPNT :COUNTER=POS OF DEC.
003 C MOVE #YES ZSPEND :
+003 C ELSE :
|
B004 C ZSPEND IFEQ #NO :
004 C MOVE #X40 NM,WRK :
E004 C END :
E003 C END :
E002 C END :
001 C* :
001 C MOVE NM,WRK WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
001 C* :
E001 C END :
C* :
B001 C CLM IFNE 0
001 C MOVE WL,CLM SIGN 1 :
001 C EXSR @SIGN :SIGN
B002 C SIGN IFEQ #MINUS :
|
002 C BITON'0123' WL,CLM :
E002 C END :
001 C MOVE SIGN WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END
C* :
C ENDSR :
C*----------------------------------------------------*
C @COLHG BEGSR :SET COLHDG
C*----------------------------------------------------*
C* SET COLUMN HEADING IN TO LINE. :
C* :
C V1MODE CAT #CHDMD:0 V1MODE :
C ADD CHDMAX LEADER :PERIOD LEADER LENGTH
C SUB CHDLEN LEADER :PERIOD LEADER LENGTH
|
C* :
B001 C WCOLHD IFNE *BLANK :
001 C MOVELWCOLHD DSWRK :
B002 C CLM IFNE 0 :NOT 1ST OF COLUMN
002 C MOVE X20 WRKBYT :
002 C EXSR @TOLIN :SET 1 CHR TO LIN
E002 C END :
B002 C 1 DO CHDLEN WRK 50 :
002 C MOVE WK,WRK WRKBYT :
002 C EXSR @TOLIN :SET 1 CHR TO LIN
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @TEXT BEGSR :SET TEXT
C*----------------------------------------------------*
C* SET FIELD TEXT TO A LINE. :
C* :
C V1MODE CAT #TXTMD:0 V1MODE :
C ADD TXTMAX LEADER :PERIOD LEADER LENGTH
C SUB TXTLEN LEADER :PERIOD LEADER LENGTH
C* :
B001 C DESCR IFNE *BLANK :
001 C MOVELDESCR DSWRK :
B002 C CLM IFNE 0 :NOT 1ST OF COLUMN
002 C MOVE X20 WRKBYT :
002 C EXSR @TOLIN :SET 1 CHR TO LIN
E002 C END :
B002 C 1 DO TXTLEN WRK :
|
002 C MOVE WK,WRK WRKBYT :
002 C EXSR @TOLIN :SET 1 CHR TO LIN
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @FIELD BEGSR :SET FIELD
C*----------------------------------------------------*
C* SET FIELD NAME TO A LINE. :
C* :
C V1MODE CAT #FLDMD:0 V1MODE :
C ADD 10 LEADER :PERIOD LEADER LENGTH
C SUB FLDLEN LEADER :PERIOD LEADER LENGTH
C* :
|
C MOVELFLDNAM DSWRK :
C MOVE XRI WRKBYT :
C EXSR @TOLIN :SET 1 CHR TO LIN
B001 C 1 DO FLDLEN WRK :
001 C MOVE WK,WRK WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TXTFL BEGSR :TXT + FLD
C*----------------------------------------------------*
C* SET FIELD TEXT + FIELD TO A LINE. :
C* :
C V1MODE CAT #TXTMD:0 V1MODE :
|
C V1MODE CAT #FLDMD:0 V1MODE :
C TXTLEN ADD FLDLEN WK2 :
C ADD 1 WK2 :
C* :
C TXTMAX ADD 10 LEADER :PERIOD LEADER LENGTH
C SUB WK2 LEADER :PERIOD LEADER LENGTH
C* :
C MOVE *BLANK DSWRK :
C DESCR CAT XRI:0 DSWRK :
C DSWRK CAT FLDNAM:0 DSWRK :
C* :
B001 C CLM IFNE 0 :NOT 1ST OF COLUMN
001 C MOVE X20 WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
|
C* :
B001 C 1 DO WK2 WRK :
001 C MOVE WK,WRK WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHDFL BEGSR :CHD + FLD
C*----------------------------------------------------*
C* SET FIELD CHD + FIELD TO A LINE. :
C* :
C V1MODE CAT #CHDMD:0 V1MODE :
C V1MODE CAT #FLDMD:0 V1MODE :
C* :
|
C CHDLEN ADD FLDLEN WK2 :
C ADD 1 WK2 :
C* :
C CHDMAX ADD 10 LEADER :PERIOD LEADER LENGTH
C SUB WK2 LEADER :PERIOD LEADER LENGTH
C* :
C MOVE *BLANK DSWRK :
C WCOLHD CAT XRI:0 DSWRK :
C DSWRK CAT FLDNAM:0 DSWRK :
C* :
B001 C CLM IFNE 0 :NOT 1ST OF COLUMN
001 C MOVE X20 WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
C* :
|
B001 C 1 DO WK2 WRK :
001 C MOVE WK,WRK WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ATRFD BEGSR :SET FIELD ATR
C*----------------------------------------------------*
C* SET FIELD ATTRIBUTE TO A LINE. :
C* :
C V1MODE CAT #ATRMD:0 V1MODE :
C ADD 9 LEADER :PERIOD LEADER LENGTH
C SUB ATRLEN LEADER :PERIOD LEADER LENGTH
C* :
|
B001 C FLDRQS IFEQ #NO :NO MRAKED FLD
*001 C TXTTYP ANDNE#DTAOY :
001 C MOVE XHI WRKBYT :
+001 C ELSE :MARKED FLD
001 C MOVE X20 WRKBYT :NORMAL
E001 C END :
C EXSR @TOLIN :SET 1 CHR TO LIN
C MOVELFLDATR DSWRK :
B001 C 1 DO ATRLEN WRK :
001 C MOVE WK,WRK WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @LIN BEGSR :WRITE A LINE TO SFL
C*----------------------------------------------------*
C* WRITE A LINE TO SUBFILE. :
C* :
B001 C DSWLN IFNE *BLANK :
001 C* :
B002 C CLM IFLT 78 :
002 C ADD 1 CLM :
002 C MOVE X20 WL,CLM :
E002 C END :
001 C* :
001 C ADD 1 LIN :
001 C MOVE DSWLN LN,LIN :
001 C MOVE *BLANK DSWLN :
001 C* :
|
B002 C ENDPOS IFEQ #NO :NOT LAST COLM
002 C Z-ADD1 CLM :
002 C MOVE ATRDTA WL,CLM :
+002 C ELSE :
002 C Z-ADD0 CLM :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CMD BEGSR :COMMAND KEY
C*----------------------------------------------------*
C* COMMAND FUNCTION KEY :
B001 C SELEC :
001 C* :
|
001 C F3 WHEQ PUSHED :
*001 C F12 OREQ PUSHED :
001 C Z-ADD#END CONTRL :
001 C F6 WHEQ PUSHED :
001 C MOVE #COLHG TXTTYP :
001 C F7 WHEQ PUSHED :
001 C MOVE #TEXT TXTTYP :
001 C F8 WHEQ PUSHED :
001 C MOVE #FIELD TXTTYP :
001 C F9 WHEQ PUSHED :
001 C MOVE #TXTFL TXTTYP :
001 C F10 WHEQ PUSHED :
001 C MOVE #CHDFL TXTTYP :
001 C F13 WHEQ PUSHED :
001 C MOVE #DTAOY TXTTYP :
|
+001 C OTHER :
B002 C ROLUP CASEQPUSHED @ROLUP :
+002 C ROLDWN CASEQPUSHED @ROLDN :
+002 C F4 CASEQPUSHED @FDLST :
+002 C F11 CASEQPUSHED @KYLST :
+002 C F14 CASEQPUSHED @DPFMT :
+002 C F15 CASEQPUSHED @DPATR :
+002 C F16 CASEQPUSHED @EDTFG :
+002 C F21 CASEQPUSHED @MBINF :
+002 C F22 CASEQPUSHED @PRINT :
+002 C F23 CASEQPUSHED @DSLCT :
+002 C F24 CASEQPUSHED @MORKY :
E002 C ENDCS :
001 C* :
E001 C ENDSL :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @ROLUP BEGSR :ROLL UP CTER
C*----------------------------------------------------*
B001 C ENDMDE IFEQ #BOTTM :
B002 C W1EOF IFEQ #NO :
*002 C CONTRL ANDGT#READ :
002 C Z-ADD#READ CONTRL :
E002 C END :
+001 C ELSE :
001 C BOTMLN ADD 1 STRLIN :
B002 C STRLIN IFGT LASTLN :
002 C Z-ADDLASTLN STRLIN :
E002 C END :
|
B002 C CONTRL IFGT #LOAD :
002 C Z-ADD#LOAD CONTRL :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ROLDN BEGSR :ROLL DOWN CTER
C*----------------------------------------------------*
B001 C STRLIN IFEQ 1 :
B002 C W1BOF IFEQ #NO :
*002 C CONTRL ANDGT#READ :
002 C Z-ADD#READ CONTRL :
E002 C END :
+001 C ELSE :
|
001 C SUB #PGSIZ STRLIN :
B002 C STRLIN IFLT 1 :
002 C Z-ADD1 STRLIN :
E002 C END :
B002 C CONTRL IFGT #LOAD :
002 C Z-ADD#LOAD CONTRL :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @SIGN BEGSR :SIGN
C*----------------------------------------------------*
C* IF DATA IS X'40' (SPACE) THEN RETURN VALUE IS '*'. :
C* OR ,IF DATA IS NOT X'F' NOR X'D' THEN RETURN VALUE IS
|
C* '?'. :
C* X'F1' --> '1+' :
C* (CHECK ZONE HALF BYTE) X'D1' --> '1-' :
C* X'40' --> '*' :
C* OTHER --> '?' :
C* :
B001 C SIGN IFEQ X'40' :
001 C MOVE #ASTRK SIGN :'*'
+001 C ELSE :
001 C TESTB'0123' SIGN 70:
B002 C *IN70 IFEQ *ON :
002 C MOVE #PLUS SIGN :'+'
+002 C ELSE :
002 C TESTB'013' SIGN 70:
B003 C *IN70 IFEQ *ON :
|
003 C MOVE #MINUS SIGN :'-'
+003 C ELSE :
003 C MOVE #UNKWN SIGN :'?'
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @LEN BEGSR :CHECK LENGTH
C*----------------------------------------------------*
C* CHECK LENGTH OF DATA IN "WRK". AND SET THE LENGTH :
C* TO "COUNT" :
C* :
C* :
|
C* (1 2 3 4 5 6 7 8 9 0..) --> COUNT = 6.0 :
C* X X X X X X :
C* :
B001 C DSWRK IFEQ *BLANK :
001 C Z-ADD0 COUNT :
+001 C ELSE :
001 C Z-ADDCOUNT CNT 50 :
B002 C WK,CNT IFEQ #X40 :
B003 C WK,CNT DOUNE#X40 :
003 C SUB 1 CNT :
E003 C END :
E002 C END :
001 C Z-ADDCNT COUNT :
001 C ADD COUNT CHKLEN :LENGTH OF FLD ATR
001 C ADD 1 CHKLEN :ATR
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MKATR BEGSR :MAKE FLD ATR
C*----------------------------------------------------*
C* CREATE ATTRIBTES INFORMATION OF A FIELD. :
C* :
C* FORMAT IS (P,9.0) OR (A,50) :
C* (K99,X,999.99) :
C MOVE *BLANK FLDATR 13 :
C MOVEL'(' FLDATR :
C* :
B001 C KEYACP IFEQ #YES :INDEXED FILE
001 C Z-ADD1 KFD :
|
001 C MOVE *OFF *IN70 :
001 C FLDNAM LOKUPKF,KFD 70:
B002 C *IN70 IFEQ *ON :
002 C FLDATR CAT 'K':0 FLDATR :
002 C MOVELKFD DSWRK :
002 C Z-ADD3 ZROCNT :
002 C EXSR @ZSUPR :ZERO-SUPPRESS
002 C MOVELDSWRK KEYSEQ 3 :
002 C FLDATR CAT KEYSEQ:0 FLDATR :
002 C FLDATR CAT #COMMA:0 FLDATR :
E002 C END :
E001 C END :
C* :
C FLDATR CAT DTATYP:0 FLDATR :
C FLDATR CAT #COMMA:0 FLDATR :
|
B001 C DTATYP IFEQ #ZONE :NUMERIC LENGTH
*001 C DTATYP OREQ #PACK :
*001 C DTATYP OREQ #BIN :
001 C MOVE DIGITS LENGTH 3 :NUMERIC LENGTH
+001 C ELSE :
001 C MOVE BYTLEN LENGTH :CHARACTER LENGTH
E001 C END :
C MOVELLENGTH DSWRK :
C Z-ADD3 ZROCNT 10 :
C EXSR @ZSUPR :ZERO-SUPPRESS
C MOVELDSWRK LENGTH :
C FLDATR CAT LENGTH:0 FLDATR :
B001 C DTATYP IFEQ #ZONE :NUMERIC LENGTH
*001 C DTATYP OREQ #PACK :
*001 C DTATYP OREQ #BIN :
|
001 C FLDATR CAT #PRIOD:0 FLDATR :DECIMAL POINT
001 C MOVE DECIML DECLEN 2 :DECIMAL
B002 C DECLEN IFEQ '00' :'00' -> '0 '
002 C MOVE '0 ' DECLEN :
+002 C ELSE :
002 C MOVELDECLEN DSWRK :
002 C Z-ADD2 ZROCNT :
002 C EXSR @ZSUPR :ZERO-SUPPRESS
002 C MOVELDSWRK DECLEN :
E002 C END :
001 C FLDATR CAT DECLEN:0 FLDATR :
E001 C END :
C FLDATR CAT ')':0 FLDATR :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @ZSUPR BEGSR :ZERO-SUPRSS
C*----------------------------------------------------*
C* ZERO SPPRESS ROUTINE. LIKE '000100' ->'100 ' :
C* :
B001 C WK,1 IFEQ '0' :
001 C Z-ADD0 WK2 :
001 C MOVE *OFF *IN70 :
B002 C 1 DO ZROCNT WRK :
B003 C *IN70 IFEQ *OFF :
*003 C WK,WRK ANDNE'0' :
003 C MOVE *ON *IN70 :
E003 C END :
B003 C *IN70 IFEQ *ON :
003 C ADD 1 WK2 :
|
003 C MOVE WK,WRK WK,WK2 :
E003 C END :
002 C MOVE #X40 WK,WRK :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOLIN BEGSR :SET DATA TO LINE
C*----------------------------------------------------*
C* SET A CHARACTER TO LINE ONE BY ONE.AND THIS LINE :
C* WILL BE WRITTEN INTO A SUB FILE RECORD. :
C* :
C ADD 1 CLM :
C MOVE WRKBYT WL,CLM :
|
B001 C CLM CASEQ#MAXCM @LIN :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @EDTFG BEGSR :EDIT FIGURES
C*----------------------------------------------------*
B001 C EDTFGR IFEQ *OFF :
001 C MOVE *ON EDTFGR :EDIT FIGURES
+001 C ELSE :
001 C MOVE *OFF EDTFGR :EDIT FIGURES
E001 C END :
C* :
B001 C CONTRL IFGT #STORE :
001 C Z-ADD#STORE CONTRL :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DPFMT BEGSR :DISPLAY FORMAT
C*----------------------------------------------------*
B001 C DSPFMT IFEQ #DUPFL :
001 C MOVE #SGLFL DSPFMT :SINGLE FIELD/LINE
+001 C ELSE :
001 C MOVE #DUPFL DSPFMT :MULTIPLE FIELDS/LINE
E001 C END :
C* :
B001 C CONTRL IFGT #STORE :
001 C Z-ADD#STORE CONTRL :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @DPATR BEGSR :DISPLAY ATR.
C*----------------------------------------------------*
B001 C DSPATR IFEQ *OFF :
001 C MOVE *ON DSPATR :
+001 C ELSE :
001 C MOVE *OFF DSPATR :
E001 C END :
C* :
B001 C CONTRL IFGT #STORE :
001 C Z-ADD#STORE CONTRL :
E001 C END :
C* :
|
C ENDSR :
C*----------------------------------------------------*
C @DSLCT BEGSR :DESELECT
C*----------------------------------------------------*
C MOVE #NO FLDRQS :
C Z-ADD0 AP :
C MOVE *BLANK OP :
C* :
B001 C CONTRL IFGT #STORE :
001 C Z-ADD#STORE CONTRL :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MORKY BEGSR :MORE KEYS
|
C*----------------------------------------------------*
B001 C FTRCTL IFEQ 1 :
001 C Z-ADD2 FTRCTL :
001 C MOVELGDE,3 V1CMD1 :
001 C MOVE *BLANK V1CMD2 :
+001 C ELSE :
B002 C FTRCTL IFEQ 2 :
002 C Z-ADD3 FTRCTL :
002 C MOVELGDE,4 V1CMD1 :
002 C MOVELGDE,5 V1CMD2 :
+002 C ELSE :
002 C Z-ADD1 FTRCTL :
002 C MOVELGDE,1 V1CMD1 :
002 C MOVELGDE,2 V1CMD2 :
E002 C END :
|
E001 C END :
C* :
C MOVE *ON *IN86 :OVRATR ON
C WRITEFTR01 :
C MOVE *OFF *IN86 :OVRATR OFF
C* :
C ENDSR :
C*----------------------------------------------------*
C @FDLST BEGSR :FIELDS LIST
C*----------------------------------------------------*
C CALL #FDLST :
C PARM USRSPC :USER SPC
C PARM KEYACP :ACCESS PATH
C PARM FLDRQS 1 :ARE FIELDS MARKED ?
C PARM OP :MARKED INFORMATION
|
C PARM KP :KEY FIELDS
C PARM AP :MARKED INFORMATION
C* :
B001 C FLDRQS IFEQ #YES :
001 C MOVE #YES FLDSLC 1 :
B002 C CONTRL IFGT #STORE :
002 C Z-ADD#STORE CONTRL :
E002 C END :
001 C* :
+001 C ELSE :
B002 C FLDSLC IFEQ #YES :
002 C MOVE #NO FLDSLC :
B003 C CONTRL IFGT #STORE :
003 C Z-ADD#STORE CONTRL :
E003 C END :
|
+002 C ELSE :
002 C* :
B003 C CONTRL IFGT #LOAD :
003 C Z-ADD#LOAD CONTRL :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PRINT BEGSR :
C*----------------------------------------------------*
B001 C V1CRRN IFGT 0 :
001 C CALL #PTDTA ;
001 C PARM USRSPC ;USER SPACE
|
001 C PARM V1HDR HEADR1198 ;
001 C PARM HEADR2198 ;
001 C PARM #INQFG ARCTYP 1 ;
001 C PARM DT ;USER SPACE
001 C PARM V1CRRN RRNWRK 70 ;
001 C PARM TXTTYP ;
001 C PARM DSPFMT ;FORMAT OF DISPLAY
001 C PARM EDTFGR ;EDIT FIGURES Y
001 C PARM DSPATR ;FIELD ATTRIBUTE
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KYLST BEGSR :KEY VALUES LIST
C*----------------------------------------------------*
|
C MOVE #NO KEYRQS :
C* :
C CALL #PGKEY :
C PARM USRSPC :USER SPC
C PARM KEYACP :ACCESS PATH
C PARM KEYLEN :LENGTH OF KEY
C PARM KP :KEY FIELDS
C PARM KEYNBR :KEY NBR
C PARM KEYRQS 1 :SET NEW KEY ?
C PARM DSKYVL :KEY VALUE
C PARM V1RRN :RRN VALUE
C PARM AP :MARKED INFORMATION
C* :
B001 C KEYRQS IFEQ #YES :
001 C MOVELDSKYVL V1KCHR :THIS CAUSES "SETLL"
|
001 C MOVE *BLANK KEYWRK :IN @SETLL
001 C Z-ADD#SETLL CONTRL :
+001 C ELSE :
B002 C CONTRL IFGT #LOAD :
002 C Z-ADD#LOAD CONTRL :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KYHEX BEGSR :
C*----------------------------------------------------*
C* '4'+'0' --> CONVERT --> X'40' :
C* :
B001 C 1 DO COUNT WRK :
|
001 C MOVE XZ,WRK HEXZNE :ZONE HEX
001 C MOVE XD,WRK HEXDGT :DIGIT HEX
001 C EXSR @CHRHX :HEX -> DECIMAL
001 C MOVE WRKBYT KV,WRK :TO KEY VALUES
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KYCHR BEGSR :
C*----------------------------------------------------*
C* X'40' --> CONVERT --> '4'+'0' :
C* :
B001 C 1 DO COUNT WRK :
001 C MOVE KV,WRK WRKBYT 1 :
001 C EXSR @HXCHR :HEX -> DECIMAL
|
001 C MOVE HEXZNE XZ,WRK :TO HEX ZONE
001 C MOVE HEXDGT XD,WRK :TO HEX DIGIT
B002 C KV,WRK IFLT #X40 :
002 C MOVE #X40 KV,WRK :DISPLYABLE DATA
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @HXCHR BEGSR :DECIMAL -> HEX
C*----------------------------------------------------*
B001 C WRKBYT IFEQ #X40 :
001 C MOVE '40' HEXDEC :
+001 C ELSE :
B002 C WRKBYT IFGE '0' :
|
*002 C WRKBYT ANDLE'9' :
002 C MOVE 'F' HEXZNE :
002 C MOVE WRKBYT HEXDGT :
+002 C ELSE :
002 C* :
002 C MOVE #UNKWN HEXZNE :
002 C MOVE #UNKWN HEXDGT :
002 C* :
002 C MOVE *LOVAL DSBN2C :
002 C MOVE WRKBYT BITCHK 1 :
002 C BITOF'0123' BITCHK :
002 C MOVE BITCHK DSBN2C :
B003 C DSBIN2 IFGE 0 :
*003 C DSBIN2 ANDLE9 :
003 C MOVE DSBIN2 HEXDGT :'0'-'9'
|
+003 C ELSE :
003 C Z-ADDDSBIN2 WRKDEC 20 :'0'-'9'
003 C MOVE *OFF *IN70 :
003 C WRKDEC LOKUPTABDEC TABHEX 70:
B004 C *IN70 IFEQ *ON :
004 C MOVE TABHEX HEXDGT :'A'-'F'
E004 C END :
E003 C END :
002 C* :
002 C MOVE *LOVAL DSBN2C :
002 C MOVE WRKBYT BITCHK :
002 C BITOF'4567' BITCHK :
002 C MOVE BITCHK DSBN2C :
002 C MULT .0625 DSBIN2 :
B003 C DSBIN2 IFGE 0 :
|
*003 C DSBIN2 ANDLE9 :
003 C MOVE DSBIN2 HEXZNE :'0'-'9'
+003 C ELSE :
003 C Z-ADDDSBIN2 WRKDEC :'0'-'9'
003 C MOVE *OFF *IN70 :
003 C WRKDEC LOKUPTABDEC TABHEX 70:
B004 C *IN70 IFEQ *ON :
004 C MOVE TABHEX HEXZNE :'A'-'F'
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @CHRHX BEGSR :ZONE HALF BYTE
C*----------------------------------------------------*
B001 C HEXDEC IFEQ '40' :
001 C MOVE #X40 WRKBYT :
+001 C ELSE :
B002 C HEXZNE IFEQ 'F' :
*002 C HEXDGT ANDGE'0' :
*002 C HEXDGT ANDLE'9' :
002 C MOVE HEXDGT WRKBYT :
002 C* :
+002 C ELSE :
002 C* :
002 C Z-ADD0 DSBIN2 :'0'-'9'
B003 C HEXDGT IFGE '0' :
*003 C HEXDGT ANDLE'9' :
|
003 C MOVE HEXDGT DSBIN2 :'0'-'9'
+003 C ELSE :
003 C MOVE *OFF *IN70 :
003 C HEXDGT LOKUPTABHEX TABDEC 70:
B004 C *IN70 IFEQ *ON :
004 C Z-ADDTABDEC DSBIN2 :'A'-'F'
E004 C END :
E003 C END :
002 C MOVE DSBN2C WRKBYT :
002 C* :
002 C Z-ADD0 DSBIN2 :'0'-'9'
B003 C HEXZNE IFGE '0' :
*003 C HEXZNE ANDLE'9' :
003 C MOVE HEXZNE DSBIN2 :'0'-'9'
+003 C ELSE :
|
003 C MOVE *OFF *IN70 :
003 C HEXZNE LOKUPTABHEX TABDEC 70:
B004 C *IN70 IFEQ *ON :
004 C Z-ADDTABDEC DSBIN2 :'A'-'F'
E004 C END :
E003 C END :
002 C MULT 16 DSBIN2 :
002 C MOVE DSBN2C BITCHK :
002 C MHHZOBITCHK WRKBYT :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C *PSSR BEGSR :
|
C*----------------------------------------------------*
B001 C SWP IFEQ *ON :
001 C MOVE *ON *INH1 :
001 C RETRN :
+001 C ELSE :
001 C DUMP :
001 C MOVE *ON SWP 1 :
E001 C END :
C* :
C ENDSR'*DETC' :
** +....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
A10B11C12D13E14F15
** +....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
F3=EXIT F6=COLUMN HEADING F7=TEXT F8=FIELD REC/ENT=NEXT RECORD
F9=TEXT+FIELD F10=COLHDG+FIELD F13=ONLY DATA F24=MORE KEYS ...
|
F4=FIELDS LIST F11=RECORD SELECTION F24=MORE KEYS...
F14=MULTI/LINE<->SINGLE/LINE F15=FIELD ATTRIBUTES F16=ZERO SUPPRESS
F21=MEMBER INFOMATON F22=PRINT RECORD F23=DESELECT FIELDS F24=MORE KEYS...
|
H Y/ 1
H****************************************************************
H* DISPLAY FIELD LIST *
H* *
H* DSPD -> DSPDR8C -> DSPDR8 -> * DSPDR81 (RPG) *
H* (COMMAND) (CLP) (RPG) -> DSPDR82 (RPG) *
H* *
H* THIS PROGRAM WAS CALLED BY DSPDR8. *
H* *
H* THIS PROGRAM DISPLAY A LIST OF ALL FIELDS.AND IF YOU WANT TO *
H* CHASE SEVERAL FIELDS,YOU CAN MARK UP TO 10 FIELDS. IF YOU *
H* MARK SOME FIELDS,THESE INFORMATION SET INTO ARRAY "MK" AND *
H* RETURN TO DSPDR8 WITH THE ARRAY. *
H* AND DSPDR8 DISPLAYS MARKED FIELDS WITH HIGH INTENSITY,DSPDR82*
H* DISPLAY THE DATA IN MARKED FILEDS ON THE SCREEN. *
|
H* *
H*--------------------------------------------------------------*
H* *
H* PROGRAMMER - TADASHI KAKEFUDA *
H* MODIFIED - XX.XX.XX BY XXXXXXXXXXXX *
H* *
H****************************************************************
H* ENTRY PARAMETER LIST *
H*(SEND/RECEIVE) *
H* R 1 USRSPC A(20) USER SPACE FOR API *
H* R 2 KEYACP A(1) ACCESS PATH ('Y'= INDEXED FILE') *
H* R 3 KP P(3.0) X 30 POINTERS OF KEY FIELDS *
H* S 4 FLDRQS A(1) 'R'= MARK SOME FIELDS *
H* S 5 MK P(9.0) X 10 POINTERS OF MARKED FIELDS *
H* *
|
H****************************************************************
H* RESTRICTION OF THIS PROGRAM *
H*--------------------------------------------------------------*
H* 1. THIS PGM USES APIS,THEN THE RELEASE OF OS400 IS MORE THAN *
H* V1R3.0. *
H* 2. MAXIMUM OF NUMBER OF KEY-FIELDS ARE UP TO 30 FIELDS. *
H* *
H****************************************************************
FDSPDR81DCF E WORKSTN
F RRN01 KSFILE SFL01
F KINFDS DSINF
E******************************************************
E* A R R A Y T A B L E ;*
E******************************************************
E AP 10 3 0A ;POINTER MARKED FIELDS
|
E OP 10 1 ;POINTER MARKED FIELDS
E KP 30 3 0 ;POINTER KEY-FIELDS
E ED 4 1 ;EDIT OF NUM.
E TXT 1 6 78 ;EDIT OF NUM.
I******************************************************
I* D E F I N E C O N S T A N T *
I******************************************************
I 10 C MAXARY
I 10 C PAGSIZ
I ' ' C X40
I 'I' C INP
I 'O' C OUTP
I 'B' C BOTH
I 'S' C ZONE
I 'P' C PACK
|
I 'B' C BIN
I 'Y' C YES
I ' ' C NO
I X'31' C F1
I X'32' C F2
I X'33' C F3
I X'34' C F4
I X'35' C F5
I X'36' C F6
I X'37' C F7
I X'38' C F8
I X'39' C F9
I X'3A' C F10
I X'3B' C F11
I X'3C' C F12
|
I X'B1' C F13
I X'B2' C F14
I X'B3' C F15
I X'B4' C F16
I X'B5' C F17
I X'B6' C F18
I X'B7' C F19
I X'B8' C F20
I X'B9' C F21
I X'BA' C F22
I X'BB' C F23
I X'BC' C F24
I X'BD' C CLEAR
I X'F1' C RECENT
I X'F3' C HELP
|
I X'F4' C ROLDWN
I X'F5' C ROLUP
I X'F6' C PAGPRT
I X'F8' C BACKSP
I X'3F' C AUTINP
I******************************************************
I* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
I* INFROMATION DS
IDSINF DS
I 369 369 PUSHED
I B 378 3790DSSRRN
I DS
I B 1 40LENDTA
I B 5 80STRPOS
|
IDSEDT DS
I 1 4 ED
I* FOR API
IRCVVAR DS
I B 9 120OFFSET
I B 17 200NOENTR
I B 21 240LSTSIZ
IFLDLST DS
I 1 10 FLDNAM
I 11 11 DTATYP
I 12 12 USAGE
I B 13 160OUTBUF
I B 17 200INPBUF
I B 21 240BYTLEN
I B 25 280DIGITS
|
I B 29 320DECIML
I 33 82 DESCR
I 153 172 COLHD1
I 173 192 COLHD2
I 193 212 COLHD3
C******************************************************
C* DEFINITION MODULE ( PLIST FIELD KLIST ) *
C******************************************************
C* ;
C* DEFINE FILED ;
C* ;
C* DEFINE PLIST ;
C* ;
C *ENTRY PLIST ;
C PARM USRSPC 20 ;USER SPC
|
C PARM KEYACP 1 ;ACCESS PATH
C PARM FLDRQS 1 ;'R' MARKED
C PARM OP ;'R' MARKED
C PARM KP ;KEY POSTION
C PARM AP ;API POINT
C******************************************************
C* M A I N - R O U T I N E ;
C******************************************************
C****** W1FRST CABEQ*ON \SFL ;
C***** MOVE *ON W1FRST 1 :
C* ;
C MOVE *BLANK OP ;
C Z-ADD0 AP ;
C Z-ADD0 CNT 30 ;
C Z-ADD0 ARY 30 ;
|
C MOVE NO FLDRQS ;
C* ;
C Z-ADD0 APIPNT :
C* ;
C \RESTR TAG ;
C* ;
B001 C APIPNT IFLT 0 ;
001 C Z-ADD0 APIPNT :
E001 C END ;
C* ;
C APIPNT MULT LSTSIZ STRPOS :
C ADD OFFSET STRPOS :
C ADD 1 STRPOS :
C* ;
C \BDSFL TAG ;
|
C* CLEAR SUBFILE ;
C Z-ADD0 LINCNT 30 ;
C Z-ADD0 RRN01 ;
C MOVE *ON *IN62 ;
C WRITECTL01 ;SFLCLR
C MOVE *OFF *IN62 ;
C* ;
C* BUILD SFL RECORDS PAGE BY PAGE ;
C* ;
C MOVE *OFF *IN63 ;SFLEND
C MOVE *OFF *IN64 ;SFLNXTCHG *OFF
C MOVE *OFF *IN95 ;
C MOVE NO EOAPI 1 ;
C* ;
B001 C 1 DO PAGSIZ ;
|
B002 C APIPNT IFGE NOENTR ;END OF ENTRY ?
002 C LEAVE ;
+002 C ELSE ;
002 C ADD 1 APIPNT 30 ;
002 C EXSR @RVFDL ;RETRIEVE FIELD INFO.
002 C EXSR @TOSFL ;MOVE TO SFL FIELD
002 C WRITESFL01 ;
002 C ADD LSTSIZ STRPOS ;COUNT UP
E002 C END ;
E001 C END ;
C* ;
B001 C APIPNT IFGE NOENTR ;END OF ENTRY ?
001 C MOVE *ON *IN63 ;
001 C MOVE *ON *IN95 ;
001 C MOVE YES EOAPI ;
|
E001 C END ;
C* ;
C* DISPLAY CTLXX ;
C* ;
C \SFL TAG ;
C* ;
C MOVE *ON *IN64 ;SFLNXTCHG *ON
C RRN01 COMP 0 6060 ;
C MOVE *ON *IN61 ;SFLDSPCTL *ON
C WRITEFTR01 ;FOOTER
C EXFMTCTL01 ;CTL01
C MOVE *OFF *IN61 ;SFLDSPCTL *OFF
C* ;
C* RETRIEVE CHANGED RECORD FROM SUBFILE RECORD ;
C* ;
|
B001 C *IN95 DOUEQ*ON ;
001 C READCSFL01 95;
B002 C *IN95 IFEQ *OFF ;
*002 C S1OPT ANDNEX40 ;
*002 C ARY ANDLTMAXARY ;
002 C ADD 1 ARY ;
002 C Z-ADDH1API AP,ARY ;SET MARKED INFO.
002 C MOVE S1OPT OP,ARY ;SET MARKED INFO.
002 C MOVE YES FLDRQS ;SET RQS. *ON
002 C ARY COMP MAXARY 95;CNT GETS TOMAX
E002 C END ;
E001 C N95 END ;
C* ;
B001 C RECENT IFNE PUSHED ;
B002 C ROLUP IFEQ PUSHED ;
|
002 C EOAPI CABEQNO \BDSFL ;
002 C GOTO \SFL ;
E002 C END ;
B002 C ROLDWN IFEQ PUSHED ;
002 C SUB PAGSIZ APIPNT ;
002 C SUB LINCNT APIPNT ;
002 C GOTO \RESTR ;
E002 C END ;
B002 C F21 IFEQ PUSHED ;
*002 C F22 OREQ PUSHED ;
002 C EXSR @VIEW ;
002 C SUB LINCNT APIPNT ;
002 C GOTO \RESTR ;
E002 C END ;
E001 C END ;
|
C* ;
B001 C FLDRQS IFEQ YES ;
001 C SORTAAP ;
001 C Z-ADD0 ARY ;
B002 C AP,1 IFEQ 0 ;
B003 C 1 DO MAXARY CNT ;
B004 C AP,CNT IFNE 0 ;
004 C ADD 1 ARY ;
004 C Z-ADDAP,CNT AP,ARY ;
004 C Z-ADD0 AP,CNT ;
E004 C END ;
E003 C END ;
E002 C END ;
E001 C END ;
C* ;
|
C WRITECLRWDW ;
C* ;
C RETRN ;
C******************************************************
C* S U B - R O U T I N E ;
C******************************************************
C*----------------------------------------------------*
C *INZSR BEGSR :
C*----------------------------------------------------*
C Z-ADD7 P1LIN :
C Z-ADD1 P1POS :
C* :
C Z-ADD0 RRN01 50 :
C MOVE *ON *IN81 :
C MOVE 1 W1VIEW 10 :
|
C MOVELTXT,01 V1HEAD ;
C MOVELTXT,04 V1GDE ;
C* :
C EXSR @RVHED ;RTV HEAD
C* :
C ENDSR :
C*----------------------------------------------------*
C @VIEW BEGSR :CHANGE VIEW NO
C*----------------------------------------------------*
C MOVEA'000' *IN,81 :
C MOVE *BLANK V1HEAD ;
C MOVE *BLANK V1GDE ;
C* :
B001 C F21 IFEQ PUSHED :
001 C SELEC :
|
001 C W1VIEW WHEQ 1 :
001 C MOVE *ON *IN82 :
001 C MOVE 2 W1VIEW :
001 C MOVELTXT,02 V1HEAD ;
001 C MOVELTXT,05 V1GDE ;
001 C W1VIEW WHEQ 2 :
001 C MOVE *ON *IN81 :
001 C MOVE 1 W1VIEW :
001 C MOVELTXT,01 V1HEAD ;
001 C MOVELTXT,04 V1GDE ;
001 C OTHER :
001 C MOVE *ON *IN81 :
001 C MOVE 1 W1VIEW :
001 C MOVELTXT,01 V1HEAD ;
001 C MOVELTXT,04 V1GDE ;
|
E001 C ENDSL :
C ELSE :
B001 C F22 IFEQ PUSHED :
001 C SELEC :
001 C W1VIEW WHEQ 1 :
001 C MOVE *ON *IN83 :
001 C MOVE 3 W1VIEW :
001 C MOVELTXT,03 V1HEAD ;
001 C MOVELTXT,06 V1GDE ;
001 C W1VIEW WHEQ 2 :
001 C MOVE *ON *IN83 :
001 C MOVE 3 W1VIEW :
001 C MOVELTXT,03 V1HEAD ;
001 C MOVELTXT,06 V1GDE ;
001 C OTHER :
|
001 C MOVE *ON *IN82 :
001 C MOVE 2 W1VIEW :
001 C MOVELTXT,02 V1HEAD ;
001 C MOVELTXT,05 V1GDE ;
E001 C ENDSL :
C ENDIF :
C ENDIF :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOSFL BEGSR :MOVE TO SFL RECORD
C*----------------------------------------------------*
C ADD 1 RRN01 :
C ADD 1 LINCNT ;
C* :
|
C MOVE X40 S1OPT :
C Z-ADDAPIPNT H1API :SAVE TO HIDDEN
C MOVE *OFF *IN70 :
C H1API LOKUPAP 70:
B001 C *IN70 IFEQ *ON :
001 C MOVE '1' S1OPT :
E001 C END :
C* IF KEY FIELD,SET DSPATR(BL) *ON :
C Z-ADD0 S1KSEQ :
B001 C KEYACP IFEQ YES :
001 C Z-ADD1 KFD 30 :
001 C MOVE *OFF *IN70 :
001 C APIPNT LOKUPKP,KFD 70:
B002 C *IN70 IFEQ *ON :
002 C Z-ADDKFD S1KSEQ :
|
E002 C END :
E001 C END :
C* :
B001 C *IN81 IFEQ *ON :
001 C MOVE *BLANK S1INP :
001 C MOVE *BLANK S1OUTP :
001 C* :
001 C* CREATE INPUT / OUTPUT BUFFER INFORAMTION :
001 C* :
B002 C USAGE IFEQ INP :INPUT
*002 C USAGE OREQ BOTH :BOTH
002 C Z-ADD4 ZROCNT 10 :
002 C MOVE INPBUF DSEDT :
002 C EXSR @ZSPRS :ZERO-SUPPRESS
002 C MOVE DSEDT W1STR 4 :
|
002 C INPBUF ADD BYTLEN WRK 50 :
002 C SUB 1 WRK :
002 C Z-ADD4 ZROCNT :
002 C MOVE WRK DSEDT :
002 C EXSR @ZSPRS :ZERO-SUPPRESS
002 C MOVE DSEDT W1END 4 :
002 C W1STR CAT '-':0 S1INP :
002 C S1INP CAT W1END:0 S1INP :
E002 C END :
001 C* :
B002 C USAGE IFEQ OUTP :OUTPUT
*002 C USAGE OREQ BOTH :BOTH
002 C Z-ADD4 ZROCNT :
002 C MOVE OUTBUF DSEDT :
002 C EXSR @ZSPRS :ZERO-SUPPRESS
|
002 C MOVE DSEDT W1STR :
002 C OUTBUF ADD BYTLEN WRK :
002 C SUB 1 WRK :
002 C Z-ADD4 ZROCNT :
002 C MOVE WRK DSEDT :
002 C EXSR @ZSPRS :
002 C MOVE DSEDT W1END :
002 C W1STR CAT '-':0 S1OUTP :
002 C S1OUTP CAT W1END:0 S1OUTP :
E002 C END :
001 C* :
B002 C DTATYP IFEQ ZONE :PACK
*002 C DTATYP OREQ PACK :ZONE
*002 C DTATYP OREQ BIN :BINARY
002 C MOVE *OFF *IN58 :
|
002 C Z-ADDDIGITS S1DLEN :
002 C Z-ADDDECIML S1DECP :
+002 C ELSE :
002 C MOVE *ON *IN58 :
002 C Z-ADDBYTLEN S1DLEN :
002 C Z-ADD0 S1DECP :
E002 C END :
001 C* :
+001 C ELSE :
001 C* :
B002 C *IN82 IFEQ *ON :
002 C* COLUMN HEADING :
002 C MOVE *BLANK S1CHD :
002 C COLHD1 CAT COLHD2:1 S1CHD :
002 C CAT COLHD3:1 S1CHD :
|
E002 C END :
001 C* :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ZSPRS BEGSR :ZERO-SUPPRESS
C*----------------------------------------------------*
C* ZERO SPPRESS ROUTINE. LIKE '000100' ->' 100' :
C* :
B001 C ED,1 IFEQ '0' :
001 C SUB 1 ZROCNT :
B002 C 1 DO ZROCNT CNT :
B003 C ED,CNT IFNE '0' :
003 C LEAVE :
|
+003 C ELSE :
003 C MOVE X40 ED,CNT :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RVHED BEGSR :RETRIEVE HEADER
C*----------------------------------------------------*
C CALL 'QUSRTVUS' :
C PARM USRSPC :
C PARM 117 STRPOS :
C PARM 24 LENDTA :
C PARM RCVVAR :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @RVFDL BEGSR :RTV FIELDS LIST
C*----------------------------------------------------*
C CALL 'QUSRTVUS' :
C PARM USRSPC :
C PARM STRPOS :
C PARM 212 LENDTA :
C PARM FLDLST :
C* :
C ENDSR :
**
FIELD KY LEN. ATR. INPUT OUTPUT COLUMN HEADING (1)
FIELD COLUMN HEADING (1)(2)(3)
|
FIELD FIELD TEXT
F21=COLUMN HEADING F22=FIELD TEXT
F21=FIELD ATTRIBUTES F22=FIELD TEXT
F21=FIELD ATTRIBUTES F22=COLUMN HEADING
|
H Y/ 1
H****************************************************************
H* DISPLAY DATA IN D.B.F *
H* *
H* DSPD -> DSPDR8C -> DSPDR8 -> DSPDR81 (RPG) *
H* (COMMAND) (CLP) (RPG) -> * DSPDR82 (RPG) *
H* *
H* THIS PROGRAM WAS CALLED BY DSPDR8. *
H* *
H* THIS PROGRAM DISPLAY A LIST OF KEY VALUES AND DATA IN MARKED *
H* FIELDS ON A SCREEN. YOU CAN SELECT ONE RECORD ON SCREEN,AND *
H* RETURN TO DSPDR8 WITH THE INFORMATION OF SELECTED RECORD ,AND*
H* DSPDR8 DISPLAYS THAT RECORD. *
H* *
H*--------------------------------------------------------------*
|
H* *
H* PROGRAMMER - TADASHI KAKEFUDA *
H* MODIFIED - XX.XX.XX BY XXXXXXXXXXXX *
H* *
H****************************************************************
H* VARIABLE OF COUNTER (E.G. ELEMENTS OF ARRAY) *
H* *
H* FLD: COUNT UP FOR FIELDS IN DBF *
H* FIL: COUNT UP FOR DATA OF DBF (DT) *
H* CLM: COUNT UP FOR LINE OF SFL (LN) *
H* WRK: WORK *
H* *
H****************************************************************
H* ENTRY PARAMETER LIST *
H*(SEND/RECEIVE) *
|
H* R 1 USRSPC A(20) USER SPACE FOR API *
H* R 2 KEYACP A(1) ACCESS PATH ('Y'= INDEXED FILE') *
H* R 3 P1KLEN P(3.0) LENGTH OF KEY *
H* R 4 KP P(3.0) X 30 KEY FILEDS *
H* R 5 KEYNBR P(3.0) KEY NBR *
H* R 6 KEYRQS A(1) 'R'= MARK SOME FIELDS *
H* S/R 7 KEYVAR A(78) KEY VALUE *
H* S/R 8 RRN P(7.0) RRN VALUE *
H* R 9 AP P(3.0) X 10 MARK *
H* *
H****************************************************************
H* RESTRICTION OF THIS PROGRAM *
H*--------------------------------------------------------------*
H* 1. THIS PGM USES APIS,THEN THE RELEASE OF OS400 IS MORE THAN *
H* V1R3.0. *
|
H* 2. MAXIMUM OF INPUT BUFFER IS 9000 BYTES. *
H* 3. MAXIMUM OF KEY LENGTH IS 99 BYTES. AND ON DISPLAY FILE, *
H* UP TO 78 BUYES(CF. DDS SOURCE OF DISPLAY FILE). *
H* 4. MAXIMUM OF NUMBER OF KEY-FIELD IS UP TO 30 FIELDS. *
H* *
H****************************************************************
FARVF2 IF F 9000 DISK KRECNO ARVRRN UC
FKEYF2 IF F 9000 99AI 1 DISK UC
F KINFDS INFKEY
FDSPDR82DCF E WORKSTN
F RRN01 KSFILE SFL01
F KINFDS INFSFL
E******************************************************
E* A R R A Y T A B L E ;*
E******************************************************
|
E DT 9000 1 ;INPUT DATA
E KP 30 3 0 ;POINTER OF KEY-FIELDS
E PK 16 1 ;FOR PACK CONVERT
E AP 10 3 0 ;POINTER OF MARKED FLD
E WP 10 3 0 ;WORK OF MARK
E WK 30 1 ;WORK ARRAY
E LN 68 1 ;LIN OF SFL RCD
E KV 78 1 ;KEY VALUE CHARACTER
E XZ 78 1 ;KEY VALUE(UPPER HEX)
E XD 78 1 ;KEY VALUE(LOWER HEX)
E TABHEX 6 6 1 TABDEC 2 0 ;HEX<->DEC
I******************************************************
I* D E F I N E I N P U T F I E L D *
I******************************************************
IARVF2 AA 01
|
I 19000 DT
IKEYF2 AA 01
I 19000 DT
I******************************************************
I* D E F I N E C O N S T A N T *
I******************************************************
I X'31' C F1
I X'32' C F2
I X'33' C F3
I X'34' C F4
I X'35' C F5
I X'36' C F6
I X'37' C F7
I X'38' C F8
I X'39' C F9
|
I X'3A' C F10
I X'3B' C F11
I X'3C' C F12
I X'B1' C F13
I X'B2' C F14
I X'B3' C F15
I X'B4' C F16
I X'B5' C F17
I X'B6' C F18
I X'B7' C F19
I X'B8' C F20
I X'B9' C F21
I X'BA' C F22
I X'BB' C F23
I X'BC' C F24
|
I X'BD' C CLEAR
I X'F1' C RECENT
I X'F3' C HELP
I X'F4' C ROLDWN
I X'F5' C ROLUP
I X'F6' C PAGPRT
I X'F8' C BACKSP
I X'3F' C AUTINP
I*
I 12 C PAGSIZ
I 67 C MAXCLM
I 10 C MAXMRK
I 9000 C MAXARY
I 16 C MAXPAK
I 30 C MAXZNE
|
I 'O' C OPEN
I 'Y' C YES
I X'22' C XHI
I X'20' C X20
I X'1C' C X1C
I ' ' C X40
I ' ' C NO
I 'S' C ZONE
I 'P' C PACK
I 'B' C BIN
I '*' C ASTRSK
I '+' C PLUS
I '-' C MINUS
I '?' C UNKNWN
I 'YOUR MARKED FIELDS :'C SLTMG1
|
I '.' C SLTMG2
I******************************************************
I* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
IHEXDEC DS
I 1 1 HEXZNE
I 2 2 HEXDGT
IDSPCK DS
I 1 16 PK
I P 1 160DSPCKN
IDSWRK DS
I 1 30 WK
IS1LIN DS
I 1 68 LN
IDSKVL DS
|
I 1 78 KV
IDSHX1 DS
I 1 78 XZ
IDSHX2 DS
I 1 78 XD
IDSWAP DS
I 1 300WP
IDSBN2C DS
I B 1 20DSBIN2
IDSBN4C DS
I B 1 40DSBIN4
I* INFORMATION DS
IINFKEY DS
I B 397 4000DSKRRN
I 401 478 DSKYVL
|
IINFSFL DS
I 369 369 PUSHED
I B 378 3790SFLRRN
I* API
I DS
I B 1 40LENDTA
I B 5 80STRPOS
IRCVVAR DS
I B 9 120OFFSET
I B 17 200ENTRY#
I B 21 240LSTSIZ
IFLDLST DS
I 1 10 FLDNAM
I 11 11 DTATYP
I B 17 200INPBUF
|
I B 21 240BYTLEN
I B 25 280DIGITS
I B 29 320DECPOS
I 33 82 DESCR
C******************************************************
C* DEFINITION MODULE ( PLIST FIELD KLIST ) *
C******************************************************
C* ;
C* DEFINE PLIST ;
C* ;
C *ENTRY PLIST ;
C PARM USRSPC 20 ;USER SPC
C PARM KEYACP 1 ;ACCESS PATH
C PARM P1KLEN 30 ;LENGTH OF KEY
C PARM KP ;KEY FILEDS
|
C PARM KEYNBR 30 ;KEY NBR
C PARM KEYRQS 1 ;
C PARM KYVAL1 78 ;KEY VALUE
C PARM RRN 70 ;RRN VALUE
C PARM AP ;REF. NBRS
C******************************************************
C* M A I N - R O U T I N E ;
C******************************************************
C* IS THERE ACTIVE SFL ALREADY ? ;
C Z-ADDAP WP ;SAVE MARK TO WORK
B001 C KEYACP IFEQ YES ;
B002 C DSWAP IFEQ WRKAPI ;
*002 C KYVAL1 ANDEQWWVAL1 ;ACTIVE SFL EXISTS.
002 C Z-ADD1 H1SRCD ;SFL RECORD NO
002 C GOTO \DSPSF ; EXISTS.
|
E002 C END ;
001 C MOVE DSWAP WRKAPI 30 ;
001 C MOVELKYVAL1 WWVAL1 78 ;
001 C MOVELKYVAL1 V1KCHR ;
+001 C ELSE ;
001 C Z-ADDRRN V1RRN ;
E001 C END ;
C* SET MESSAGE INTO HEADER ;
C MOVE *BLANK V1HDR1 ;
C MOVE *BLANK V1HDR2 ;
B001 C AP,1 IFNE 0 ;
001 C MOVELSLTMG1 V1HDR1 ;
B002 C 1 DO MAXMRK FLD ;
B003 C AP,FLD IFNE 0 ;
003 C AP,FLD SUB 1 APIPNT 30 ;
|
003 C EXSR @RVFDL ;RTV FLD
B004 C FLD IFLE 6 ;
004 C V1HDR1 CAT FLDNAM:1 V1HDR1 ;
+004 C ELSE ;
004 C V1HDR2 CAT FLDNAM:1 V1HDR2 ;
E004 C END ;
E003 C END ;
E002 C END ;
001 C V1HDR2 CAT SLTMG2:0 V1HDR2 ;
E001 C END ;
C* ;
C WRITEHDR01 ;
C WRITEMSG01 ;
C* ;
C* RESET SUBFILE AND "SETLL" FILE ;
|
C* ;
C \SETLL TAG ;
C* ;
C Z-ADD1 H1SRCD ;SFL RECORD NO
C MOVE *OFF *IN64 ;SFLNXCHG *OFF
C Z-ADD0 RRN01 ;RRN OF SFL
C Z-ADD0 WRN01 ;WORK OF RRN01
C MOVE *ON *IN62 ;
C WRITECTL01 ;SFLCLR
C MOVE *OFF *IN62 ;
C* ;
B001 C V1RRN IFLE 0 ;
001 C Z-ADD1 V1RRN ;
E001 C END ;
C* ;
|
B001 C KEYACP IFNE YES ;ARV FILE
001 C V1RRN SETLLARVF2 9091 ;
B002 C *IN91 IFEQ *ON ;
002 C READ ARVF2 90;
002 C ARVRRN SETLLARVF2 ;
E002 C END ;
B002 C *IN90 IFEQ *ON ;
002 C READPARVF2 90;
002 C ARVRRN SETLLARVF2 ;
E002 C END ;
+001 C ELSE ;KEY FILE
001 C* ;
001 C V1KCHR SETLLKEYF2 9091 ;
B002 C *IN91 IFEQ *ON ;
002 C READ KEYF2 90;
|
002 C DSKYVL SETLLKEYF2 ;
E002 C END ;
B002 C *IN90 IFEQ *ON ;
002 C READPKEYF2 90;
002 C DSKYVL SETLLKEYF2 ;
E002 C END ;
E001 C END ;
C* ;
C* READ DATA AND SET IT TO SFL PAGE BY PAGE ;
C* ;
C \SET TAG ;
C* ;
C Z-ADDWRN01 RRN01 ;
C MOVE *BLANK S1LIN ;
B001 C 1 DO PAGSIZ ;
|
B002 C KEYACP IFNE YES ;
002 C READ ARVF2 90;
+002 C ELSE ;
002 C READ KEYF2 90;
E002 C END ;
B002 C *IN90 IFEQ *ON ;
002 C LEAVE ;
+002 C ELSE ;
B003 C KEYACP CASEQYES @KEY ;INDEXED FILE
+003 C CAS @ARV ;ARIVAL FILE
E003 C END ;
002 C ADD 1 RRN01 ;
002 C WRITESFL01 ;
002 C MOVE *BLANK S1LIN ;CLEAR LINE OF SFL
E002 C END ;
|
E001 C END ;
C* ;
C Z-ADDRRN01 WRN01 ;
B001 C RRN01 IFNE 0 ;
001 C Z-ADDRRN01 H1SRCD ;
E001 C END ;
C* WRITE EOF MESSAGE INTO SUBFILE ;
C MOVE *OFF *IN63 ;SFLEND(*MORE)
B001 C *IN90 IFEQ *OFF ;
B002 C KEYACP IFNE YES ;
002 C READ ARVF2 90;
002 C READPARVF2 91;
+002 C ELSE ;
002 C READ KEYF2 90;
002 C READPKEYF2 91;
|
E002 C END ;
E001 C END ;
C* ;
B001 C *IN90 IFEQ *ON ;EOF
001 C MOVE *ON *IN63 ;SFLEND(*MORE)
001 C MOVE *BLANK S1LIN ;CLEAR LINE
E001 C END ;
C* DISPLAY SUBFILE ;
C \DSPSF TAG ;
C* ;
C MOVE *ON *IN64 ;SFLNXCHG *ON
C RRN01 COMP 0 6060 ;SFLDSP
C MOVE *ON *IN61 ;SFLDSPCTL *ON
C WRITECTL01 ;
C MOVE *OFF *IN61 ;SFLDSPCTL *OFF
|
C* ;
B001 C F3 DOUEQPUSHED ;
*001 C F12 OREQ PUSHED ;
*001 C KEYRQS ORNE X40 ;
001 C* ;
001 C READ CTL01 99;
001 C* ;
B002 C *IN99 IFEQ *OFF ;
*002 C F3 ANDNEPUSHED ;
*002 C F12 ANDNEPUSHED ;
002 C* ;
B003 C SFLRRN IFNE 0 ;
003 C Z-ADDSFLRRN H1SRCD ;
E003 C END ;
002 C* ;
|
B003 C KEYACP IFNE YES ;ARV FILE
003 C V1RRN CABNEW1RRN \SETLL ;RRN IS CHANGED
+003 C ELSE ;KEY FILE
B004 C *IN56 IFEQ *ON ;KEY IS CHANGED
004 C MOVELV1KHX1 DSHX1 ;
004 C MOVELV1KHX2 DSHX2 ;
004 C Z-ADDKK COUNT 30 ;
004 C EXSR @KYHEX ;HEX -> DECIMAL
004 C MOVELDSKVL V1KCHR ;
E004 C END ;
003 C V1KCHR CABNEKEYWK2 \SETLL ;
E003 C END ;
002 C* ;
B003 C *IN90 IFEQ *OFF ;
003 C ROLUP CABEQPUSHED \SET ;ROLL UP
|
E003 C END ;
002 C* ;
002 C* READ CHANGED RECORD ON SUBFILE ;
002 C* ;
B003 C *IN97 DOUEQ*ON ;
003 C READCSFL01 97;
B004 C *IN97 IFEQ *OFF ;
*004 C S1OPT ANDNEX40 ;
004 C MOVE *ON *IN97 ;
004 C MOVE YES KEYRQS ;
004 C Z-ADDS1RRN RRN ;
004 C MOVELHSKEY KYVAL1 ;
004 C MOVE X40 S1OPT ;
004 C UPDATSFL01 ;
E004 C END ;
|
E003 C N97 END ;
002 C* ;
E002 C END ;
E001 C END ;
C* ;
C RETRN ;
C******************************************************
C* S U B - R O U T I N E ;
C******************************************************
C*----------------------------------------------------*
C *INZSR BEGSR :
C*----------------------------------------------------*
C* :
C Z-ADD0 RRN01 50 :
C Z-ADD0 WRN01 50 :
|
C Z-ADD0 W1RRN 70 :
C Z-ADD0 ARVRRN 70 :
C Z-ADDP1KLEN KK 30 :
B001 C KK IFGT 78 :
001 C Z-ADD78 KK :
E001 C END :
C* :
C KEYACP COMP YES 5050 :
C* :
C EXSR @RVHED :RETRIEVE HEADER
C* OPEN FILE :
B001 C #FISTS IFNE OPEN :
001 C MOVE OPEN #FISTS 1 :
B002 C KEYACP IFNE YES :
002 C OPEN ARVF2 :
|
+002 C ELSE :
002 C OPEN KEYF2 :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KEY BEGSR :SET SFL01
C*----------------------------------------------------*
C* PUT THE KEY VALUE OF INDEXED FILE INTO SFL. AND IF :
C* THERE ARE MARKED FIELDS,PUT THE DATA OF THESE FIELDS
C* INTO THE SFL. :
C MOVE *OFF *IN64 :SFLNXCHG *OFF
C Z-ADDDSKRRN S1RRN :SET RRN OF FILE
C MOVELDSKYVL DSKVL :DEAL WITH KEY VALUE
|
B001 C KK IFLT 78 :CLEAR GARBEGE
001 C ADD 1 KK :OF KEY VALUE
001 C MOVEA*BLANK KV,KK :
001 C SUB 1 KK :
E001 C END :
C* :
C Z-ADD0 STRCLM 90 :START COLUMN OF RCD
C Z-ADD0 ENDCLM 90 :END COLUMN OF RCD
C Z-ADD0 CLM 90 :
C* :
C MOVE *OFF *IN81 :GET OUT OF LOOP *OFF
B001 C 1 DO KEYNBR FLD 90 :
B002 C KP,FLD IFNE 0 :
002 C ADD 1 CLM :
002 C MOVE XHI LN,CLM :DSPATR(HI)
|
002 C KP,FLD SUB 1 APIPNT :
002 C EXSR @DTA :
E002 C END :
E001 C N81 END :
C* :
C* IF KEY VALUE IS MORE THAN DISPLAY SET MARK X'1C' :
C* TO THE LAST POSITION OF LINE. ELSE IF THERE ARE :
C* MARKED FIELDS,SET DATA IN THOSE FIELDS. :
C* :
B001 C *IN81 IFEQ *OFF :
B002 C P1KLEN IFGT KK :
*002 C P1KLEN ORGT CLM :
002 C MAXCLM ADD 1 CLM :
002 C MOVE X1C LN,CLM :
+002 C ELSE :
|
002 C EXSR @MARK :
E002 C END :
E001 C END :
C* SET KEY VALUE INTO A FIELD ON SCREEN :
C MOVELDSKVL HSKEY :
B001 C RRN01 IFEQ 0 :
001 C Z-ADDKK COUNT :
001 C EXSR @KYCHR :CHAR -> HEX
001 C MOVELDSKVL V1KCHR :
001 C MOVELDSHX1 V1KHX1 :
001 C MOVELDSHX2 V1KHX2 :
001 C MOVELV1KCHR KEYWK2 78 :
E001 C END :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @ARV BEGSR :SET SFL01
C*----------------------------------------------------*
C* ARRIVAL FILE HAS NO KEY,THE PUT THE RRN OF THE FILE:
C* INTO SFL.AND IF THERE ARE MARKED FILEDS,PUT THE DATA
C* IN THESE FILEDS INTO SFL. :
C* :
C MOVE *OFF *IN64 :SFLNXCHG *OFF
C Z-ADDV1RRN W1RRN :
C Z-ADDARVRRN S1RRN :
B001 C RRN01 IFEQ 0 :
001 C Z-ADDARVRRN V1RRN :
E001 C END :
C* :
C Z-ADD0 CLM :
|
C MOVE *OFF *IN81 :GET OUT FROM LOOP
C EXSR @MARK :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MARK BEGSR :
C*----------------------------------------------------*
B001 C AP,1 IFNE 0 :
B002 C 1 DO MAXMRK FLD :
B003 C AP,FLD IFNE 0 :
003 C ADD 1 CLM :
003 C MOVE X20 LN,CLM :
003 C AP,FLD SUB 1 APIPNT :
003 C EXSR @DTA :RTV MARKED FLD
E003 C END :
|
E002 C N81 END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DTA BEGSR :
C*----------------------------------------------------*
C EXSR @RVFDL :RTV FLD
C* :
B001 C DTATYP CASEQPACK @PACK :PACK NUMERIC
+001 C DTATYP CASEQZONE @ZONE :ZONE NUMERIC
+001 C DTATYP CASEQBIN @BIN :ZONE NUMERIC
+001 C CAS @CHAR :CHARACTER
E001 C END :
C* :
|
B001 C CLM IFGE MAXCLM :
001 C MOVE *ON *IN81 :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHAR BEGSR :CHARCTER
C*----------------------------------------------------*
C* CHECK FOR DBCS.DBCS STRING NEEDS SI,SO (X'0E' X'0F')
C* CODE. THE LACK OF THESE CODES CAUSES BROKEN DBCS :
C* STRING.THEN THIS PGM CHECK SI,SO CODE. :
C* :
C Z-ADDINPBUF STRCLM :
C STRCLM ADD BYTLEN ENDCLM :
C SUB 1 ENDCLM :
|
B001 C ENDCLM IFGT MAXARY :
001 C Z-ADDMAXARY ENDCLM :
E001 C END :
C* :
C Z-ADD0 IGCCNT 10 :
C MOVE NO CK0E0F 1 :
C* :
B001 C STRCLM DO ENDCLM FIL 50 :
001 C* :
B002 C DT,FIL IFEQ X'0E' :
002 C MOVE YES CK0E0F :
+002 C ELSE :
B003 C DT,FIL IFEQ X'0F' :
003 C MOVE NO CK0E0F :
003 C Z-ADD0 IGCCNT :
|
E003 C END :
E002 C END :
001 C* :
B002 C CK0E0F IFEQ YES :
002 C ADD 5 IGCCNT :
E002 C END :
001 C* DISPLAYABLE DATA :
001 C* IF DATA IS MORE THAN X'40',MOVE IT INTO LINE. :
001 C ADD 1 CLM :
001 C* :
B002 C DT,FIL IFGT X40 :
*002 C DT,FIL OREQ X'0E' :
*002 C DT,FIL OREQ X'0F' :
002 C MOVE DT,FIL LN,CLM :
E002 C END :
|
001 C* :
001 C CLM COMP MAXCLM 81 81:
E001 C N81 END :
C* :
B001 C *IN81 IFEQ *OFF :
B002 C CK0E0F IFEQ YES :0E0F OK
B003 C IGCCNT IFNE 0 :
003 C ADD 1 CLM :
003 C MOVE X'0F' LN,CLM :SET X'0F' NEXT RCD
+003 C ELSE :
003 C MOVE X'0F' LN,CLM :SET X'0F'
E003 C END :
E002 C END :
E001 C END :
C* :
|
C ENDSR :
C*----------------------------------------------------*
C @BIN BEGSR :BINARY NUMERIC
C*----------------------------------------------------*
C Z-ADDINPBUF FIL :
C* :
B001 C BYTLEN IFEQ 2 :
001 C MOVE *LOVAL DSBN2C :
001 C MOVEADT,FIL DSBN2C :
001 C Z-ADDDSBIN2 ZONE30 :
+001 C ELSE :
001 C MOVE *LOVAL DSBN4C :
001 C MOVEADT,FIL DSBN4C :
001 C Z-ADDDSBIN4 ZONE30 :
E001 C END :
|
C* :
C MOVELZONE30 DSWRK :
C MAXZNE SUB DIGITS WRK 30 :
C WRK ADD 1 STRNUM :
C EXSR @NUM :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PACK BEGSR :PACK NUMERIC
C*----------------------------------------------------*
C Z-ADDINPBUF FIL :
C MAXPAK SUB BYTLEN WRK :
C ADD 1 WRK :
C Z-ADD0 DSPCKN :
C MOVEADT,FIL PK,WRK :
|
C Z-ADDDSPCKN ZONE30 300 :
C MOVELZONE30 DSWRK :
C* :
C MAXZNE SUB DIGITS WRK :
C WRK ADD 1 STRNUM 30 :
C* :
C EXSR @NUM :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ZONE BEGSR :ZONE NUMERIC
C*----------------------------------------------------*
C Z-ADDINPBUF FIL :
C MAXZNE SUB DIGITS WRK :
C ADD 1 WRK :
|
C MOVEADT,FIL WK,WRK :
C* :
C Z-ADDWRK STRNUM :
C EXSR @NUM :
C* :
C ENDSR :
C*----------------------------------------------------*
C @NUM BEGSR :NUMERIC
C*----------------------------------------------------*
C MOVE NO ENDPOS :
C* :
B001 C STRNUM DO MAXZNE WRK :
001 C* :
B002 C WRK IFEQ MAXZNE :
002 C MOVE YES ENDPOS 1 :
|
E002 C END :
001 C* :
001 C ADD 1 CLM :
001 C MOVE WK,WRK LN,CLM :
001 C* :
001 C CLM COMP MAXCLM 81 81:
E001 C N81 END :
C* :
B001 C *IN81 IFEQ *OFF :
*001 C CLM ANDNE0 :
B002 C ENDPOS IFEQ YES :
002 C MOVE LN,CLM SIGN 1 :
002 C EXSR @SIGN :SIGN
B003 C SIGN IFEQ MINUS :
003 C BITON'0123' LN,CLM :
|
E003 C END :
002 C ADD 1 CLM :
002 C MOVE SIGN LN,CLM :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @SIGN BEGSR :SIGN
C*----------------------------------------------------*
C* IF DATA IS X'40' (SPACE) THEN RETURN VALUE IS '*'. :
C* OR ,IF DATA IS NOT X'F' NOR X'D' THEN RETURN VALUE IS
C* '?'. :
C* X'F1' --> '1+' :
C* (CHECK ZONE HALF BYTE) X'D1' --> '1-' :
|
C* X'40' --> '*' :
C* OTHER --> '?' :
C* :
B001 C SIGN IFEQ X'40' :
001 C MOVE ASTRSK SIGN :'*'
+001 C ELSE :
001 C TESTB'0123' SIGN 70:
B002 C *IN70 IFEQ *ON :
002 C MOVE PLUS SIGN :'+'
+002 C ELSE :
002 C TESTB'013' SIGN 70:
B003 C *IN70 IFEQ *ON :
003 C MOVE MINUS SIGN :'-'
+003 C ELSE :
003 C MOVE UNKNWN SIGN :'?'
|
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KYHEX BEGSR :
C*----------------------------------------------------*
C* '4'+'0' --> CONVERT --> X'40' :
C* :
B001 C 1 DO COUNT WRK :
001 C MOVE XZ,WRK HEXZNE 1 :ZONE HEX
001 C MOVE XD,WRK HEXDGT 1 :DIGIT HEX
001 C EXSR @CHRHX :HEX -> DECIMAL
001 C MOVE WRKBYT KV,WRK :TO KEY VALUES
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KYCHR BEGSR :
C*----------------------------------------------------*
C* X'40' --> CONVERT --> '4'+'0' :
C* :
B001 C 1 DO COUNT WRK :
001 C MOVE KV,WRK WRKBYT 1 :
001 C EXSR @HXCHR :HEX -> DECIMAL
001 C MOVE HEXZNE XZ,WRK :TO HEX ZONE
001 C MOVE HEXDGT XD,WRK :TO HEX DIGIT
B002 C KV,WRK IFLT X40 :
002 C MOVE X40 KV,WRK :DISPLYABLE DATA
|
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @HXCHR BEGSR :DECIMAL -> HEX
C*----------------------------------------------------*
B001 C WRKBYT IFEQ X40 :
001 C MOVE '40' HEXDEC :
+001 C ELSE :
B002 C WRKBYT IFGE '0' :
*002 C WRKBYT ANDLE'9' :
002 C MOVE 'F' HEXZNE :
002 C MOVE WRKBYT HEXDGT :
+002 C ELSE :
|
002 C* :
002 C MOVE UNKNWN HEXZNE :
002 C MOVE UNKNWN HEXDGT :
002 C* :
002 C MOVE *LOVAL DSBN2C :
002 C MOVE WRKBYT BITCHK 1 :
002 C BITOF'0123' BITCHK :
002 C MOVE BITCHK DSBN2C :
B003 C DSBIN2 IFGE 0 :
*003 C DSBIN2 ANDLE9 :
003 C MOVE DSBIN2 HEXDGT :'0'-'9'
+003 C ELSE :
003 C Z-ADDDSBIN2 WRKDEC 20 :'0'-'9'
003 C MOVE *OFF *IN70 :
003 C WRKDEC LOKUPTABDEC TABHEX 70:
|
B004 C *IN70 IFEQ *ON :
004 C MOVE TABHEX HEXDGT :'A'-'F'
E004 C END :
E003 C END :
002 C* :
002 C MOVE *LOVAL DSBN2C :
002 C MOVE WRKBYT BITCHK :
002 C BITOF'4567' BITCHK :
002 C MOVE BITCHK DSBN2C :
002 C MULT .0625 DSBIN2 :
B003 C DSBIN2 IFGE 0 :
*003 C DSBIN2 ANDLE9 :
003 C MOVE DSBIN2 HEXZNE :'0'-'9'
+003 C ELSE :
003 C Z-ADDDSBIN2 WRKDEC :'0'-'9'
|
003 C MOVE *OFF *IN70 :
003 C WRKDEC LOKUPTABDEC TABHEX 70:
B004 C *IN70 IFEQ *ON :
004 C MOVE TABHEX HEXZNE :'A'-'F'
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHRHX BEGSR :ZONE HALF BYTE
C*----------------------------------------------------*
B001 C HEXDEC IFEQ '40' :
001 C MOVE X40 WRKBYT :
|
+001 C ELSE :
B002 C HEXZNE IFEQ 'F' :
*002 C HEXDGT ANDGE'0' :
*002 C HEXDGT ANDLE'9' :
002 C MOVE HEXDGT WRKBYT :
002 C* :
+002 C ELSE :
002 C* :
002 C Z-ADD0 DSBIN2 :'0'-'9'
B003 C HEXDGT IFGE '0' :
*003 C HEXDGT ANDLE'9' :
003 C MOVE HEXDGT DSBIN2 :'0'-'9'
+003 C ELSE :
003 C MOVE *OFF *IN70 :
003 C HEXDGT LOKUPTABHEX TABDEC 70:
|
B004 C *IN70 IFEQ *ON :
004 C Z-ADDTABDEC DSBIN2 :'A'-'F'
E004 C END :
E003 C END :
002 C MOVE DSBN2C WRKBYT :
002 C* :
002 C Z-ADD0 DSBIN2 :'0'-'9'
B003 C HEXZNE IFGE '0' :
*003 C HEXZNE ANDLE'9' :
003 C MOVE HEXZNE DSBIN2 :'0'-'9'
+003 C ELSE :
003 C MOVE *OFF *IN70 :
003 C HEXZNE LOKUPTABHEX TABDEC 70:
B004 C *IN70 IFEQ *ON :
004 C Z-ADDTABDEC DSBIN2 :'A'-'F'
|
E004 C END :
E003 C END :
002 C MULT 16 DSBIN2 :
002 C MOVE DSBN2C BITCHK :
002 C MHHZOBITCHK WRKBYT :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RVHED BEGSR :RETRIEVE HEADER
C*----------------------------------------------------*
C CALL 'QUSRTVUS' :
C PARM USRSPC :
C PARM 117 STRPOS :
|
C PARM 24 LENDTA :
C PARM RCVVAR :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RVFDL BEGSR :RTV FROM FLD LST
C*----------------------------------------------------*
C APIPNT MULT LSTSIZ STRPOS :
C ADD OFFSET STRPOS :
C ADD 1 STRPOS :
C* :
C CALL 'QUSRTVUS' :
C PARM USRSPC :
C PARM STRPOS :
C PARM 82 LENDTA :
|
C PARM FLDLST :
C* :
C ENDSR :
** +....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
A10B11C12D13E14F15
|
H 1 Y/ 1
H****************************************************************
H* PRINT DATA IN D.B.F *
H* *
H****************************************************************
FQPRT198 O F 198 OF PRINTER
E******************************************************
E* A R R A Y T A B L E ;*
E******************************************************
E DT 9500 1 ;INPUT DATA
E PK 16 1 ;FOR PACK CONVERT
E WK 80 1 ;WRK
E NM 30 1 ;FOR NUMERIC
E LN 198 1 ;LINE ON PRT
E UL 198 1 ;LINE ON PRT
|
E HI 198 1 ;LINE ON PRT
E TABACT 1 6 1 TABNAM 50 ;
I******************************************************
I* D E F I N E C O N S T A N T *
I******************************************************
I 16 C #PKMAX
I 30 C #ZNMAX
I 190 C #CMMAX
I 9500 C #ARMAX
I 'Y' C #YES
I ' ' C #NO
I '.' C #PRIOD
I ',' C #COMMA
I 'D' C #DUPFL
I 'S' C #SGLFL
|
I 'X' C #TXTFL
I 'Z' C #CHDFL
I 'C' C #COLHG
I 'T' C #TEXT
I 'F' C #FIELD
I 'D' C #DTAOY
I 'B' C #BIN
I 'S' C #ZONE
I 'P' C #PACK
I '*' C #ASTRK
I '+' C #PLUS
I '-' C #MINUS
I '?' C #UNKWN
I*
I 'QUSRTVUS' C #PGRTV
|
I*
I 'OVER FLOW OF INPUT- C #OVRFL
I ' BUFFER'
I*
I ' DATA ' C #DTAMD
I 'COLHDG' C #CHDMD
I 'TEXT' C #TXTMD
I '*FIELD*' C #FLDMD
I '(ATR)' C #ATRMD
I ',ZERO-SPPR' C #ZSPMD
I ' ....' C #LEADR
I******************************************************
I* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
IDSPRT DS
|
I 1 198 LN
IDSHI DS
I 1 198 HI
IDSUL DS
I 1 198 UL
IDSNUM DS
I 1 30 NM
IDSDTA DS
I 19500 DT
IDSWRK DS
I 1 80 WK
IDSPCK DS
I 1 16 PK
I P 1 160DSPCKN
IDSBN2C DS
|
I B 1 20DSBIN2
IDSBN4C DS
I B 1 40DSBIN4
I DS
I B 1 40LENDTA
I B 5 80STRPOS
I B 9 120LENRCV
I*
I* FOR API PGM PARAMETER
IRCVVAR DS
I B 9 120OFFSET
I B 17 200NOENTR
I B 21 240LSTSIZ
IFLDLST DS
I 1 10 FLDNAM
|
I 11 11 DTATYP
I B 21 240BYTLEN
I B 25 280DIGITS
I B 29 320DECIML
I 33 82 DESCR
I 153 172 COLHD1
I 173 192 COLHD2
I 193 212 COLHD3
C******************************************************
C* DEFINITION MODULE ( PLIST FIELD KLIST ) *
C******************************************************
C* ;
C* DEFINE PLIST ;
C* ;
C *ENTRY PLIST ;
|
C PARM USRSPC 20 ;USER SPACE
C PARM HEADR1198 ;
C PARM HEADR2198 ;
C PARM ACTION 1 ;
C PARM DSDTA ;
C PARM FILRRN 70 ;
C PARM TXTTYP 1 ;
C PARM DSPFMT 1 ;FORMAT OF DISPLAY
C PARM EDTFGR 1 ;EDIT FIGURES Y
C PARM DSPATR 1 ;FIELD ATTRIBUTE
C* ;
C* DEFINE PARM ;
C* ;
C* API "QUSRTVUS" ;
C PRMFLD PLIST ;RTV FIELDS LIST
|
C PARM USRSPC ;
C PARM STRPOS ;
C PARM 212 LENDTA ;
C PARM FLDLST ;
C* RETRIEVE HEADER FROM USER SPACE ;
C PRMRTV PLIST ;RTV RECORD FORMAT
C PARM USRSPC ;
C PARM 117 STRPOS ;
C PARM 24 LENDTA ;
C PARM RCVVAR ;
C******************************************************
C* M A I N - R O U T I N E ;
C******************************************************
C EXSR @MODE ;
C* ;
|
C MOVE *OFF *IN70 ;
C ACTION LOKUPTABACT TABNAM 70;
C 70 MOVELTABNAM O1ANAM 50 ;
C* ;
C OF EXCPT#HED :
C EXCPT#DTLH :
C* :
C Z-ADD0 STRCLM 50 :START POS.
C Z-ADD0 ENDCLM 50 :END POS.
C Z-ADD0 CLM 50 :COLOM OF LINE
C MOVE X'40' PRTEDT 1 :RRN OF SFL03
C MOVE #YES FIRST 1 :RRN OF SFL03
C MOVE #NO ENDPOS 1 :
C* SET DATA INTO SFL BY EACH FIELD. :
B001 C 1 DO MAXFLD FLD 30 :
|
001 C EXSR @EDT :SET TEXT TO LINE
E001 C END :
C* IS IT ALL ? IF NOT, WRITE SFL. :
C EXSR @PRT :WRITE LINE TO SFL
C* ;
C RETRN ;
C******************************************************
C* S U B - R O U T I N E ;
C******************************************************
C*----------------------------------------------------*
C *INZSR BEGSR :
C*----------------------------------------------------*
C* RETRIEVE LIST SECTION OF RCDFMT INFROMATION. :
C* :
C Z-ADD0 WK2 50 :
|
C MOVE ' ' WRKBYT 1 :
C* SET INITIAL DATA :
C MOVE TXTTYP WTYPE 1 :
C Z-ADD20 CHDMAX 30 :LENGTH OF COLHDG
C Z-ADD30 TXTMAX 30 :LENGTH OF TEXT
C* RETRIEVE HEADER SECTION OF FIELDS INFORMATION :
C CALL #PGRTV PRMRTV :
C Z-ADDNOENTR MAXFLD 50 :
C* :
C EXCPT#HED :
C* :
C ENDSR :
C*----------------------------------------------------*
C @EDT BEGSR :EDIT TEXT
C*----------------------------------------------------*
|
C* DISPLAY FORMAT IS BELOW. :
C* XXXXXXXXXXXXX DDDDDDDDDDD :
C* ~~~~~~~~~~~ :
B001 C FLD IFEQ 1 :
001 C OFFSET ADD 1 STRPOS :
+001 C ELSE :
001 C ADD LSTSIZ STRPOS :
E001 C END :
C* RETRIEVE LIST SECTION OF FIELDS INFROMATION. :
C CALL #PGRTV PRMFLD :
C* :
C Z-ADD0 CHKLEN 50 :LENGTH FOR PRECHECK
C Z-ADD0 DCPCNT 30 :COUNTER FOR DECIMAL
C Z-ADD0 DECPNT 30 :POSITION OF DECIMAL
C* :
|
B001 C DTATYP IFNE #ZONE :CHARACTER
*001 C DTATYP ANDNE#PACK :
*001 C DTATYP ANDNE#BIN :
001 C BYTLEN ADD 1 CHKLEN :
+001 C ELSE :NUMERIC
001 C Z-ADDDIGITS CHKLEN :
B002 C DECIML IFNE 0 :
002 C ADD 1 CHKLEN :FOR DEC.P
002 C CHKLEN SUB DECIML DECPNT :
E002 C END :
001 C ADD 7 CHKLEN :FOR SIGN + ATR.+SPAC
E001 C END :
C* FIELD ATTRIBUTES LENGTH :
B001 C DSPATR IFEQ *ON :
001 C EXSR @MKATR :MAKE ATR INFORMATION
|
001 C Z-ADD0 ATRLEN 30 :LENGTH OF ATTR.
001 C Z-ADD10 COUNT :
001 C MOVELFLDATR DSWRK :
001 C EXSR @TXLEN :CHECK LENGTH
001 C Z-ADDCOUNT ATRLEN :
E001 C END :
C* :
C* PRECHECK LENGTH OF TEXT :
C* :
B001 C TXTTYP IFNE #DTAOY :
001 C Z-ADD0 CHDLEN 30 :LENGTH OF COLHDG
001 C Z-ADD0 TXTLEN 30 :LENGTH OF TEXT
001 C Z-ADD0 FLDLEN 30 :LENGTH OF FIELD
001 C* COLUMN HEADING :
B002 C TXTTYP IFEQ #COLHG :
|
*002 C TXTTYP OREQ #CHDFL :
002 C MOVE *BLANK WCOLHD 62 :
002 C COLHD1 CAT COLHD2:1 WCOLHD :
002 C WCOLHD CAT COLHD3:1 WCOLHD :
002 C MOVELWCOLHD DSWRK :
002 C Z-ADD62 COUNT 30 :20+1+20+1+20=62
002 C EXSR @TXLEN :CHECK LENGTH
002 C Z-ADDCOUNT CHDLEN :LEN. OF COLHDG
E002 C END :
001 C* TEXT LENGTH :
B002 C TXTTYP IFEQ #TEXT :
*002 C TXTTYP OREQ #TXTFL :
B003 C DESCR IFNE *BLANK :
003 C Z-ADD50 COUNT :
003 C MOVELDESCR DSWRK :
|
003 C EXSR @TXLEN :CHECK LENGTH
003 C Z-ADDCOUNT TXTLEN :
E003 C END :
E002 C END :
001 C* FIELD LENGTH :
B002 C TXTTYP IFEQ #FIELD :
*002 C TXTTYP OREQ #TXTFL :
*002 C TXTTYP OREQ #CHDFL :
002 C Z-ADD10 COUNT :
002 C MOVELFLDNAM DSWRK :
002 C EXSR @TXLEN :CHECK LENGTH
002 C Z-ADDCOUNT FLDLEN :
E002 C END :
E001 C END :
C* CHECK LENGTH OF DATA.IF TOO LONG,WRITE IT INTO SFL.:
|
B001 C DSPRT IFNE *BLANK :
B002 C CHKLEN IFGT #CMMAX :
002 C EXSR @PRT :WRITE LINE TO SFL
+002 C ELSE :
002 C ADD CLM CHKLEN :
B003 C CHKLEN IFGE #CMMAX :
003 C EXSR @PRT :WRITE LINE TO SFL
E003 C END :
E002 C END :
E001 C END :
C* SET TEXT TO LINES :
C Z-ADD0 LEADER 50 :PERIOD LEADER LENGTH
C* :
B001 C TXTTYP IFNE #DTAOY :
B002 C TXTTYP CASEQ#COLHG @COLHG :COLHDG
|
+002 C TXTTYP CASEQ#TEXT @TEXT :TEXT
+002 C TXTTYP CASEQ#FIELD @FIELD :FIELD
+002 C TXTTYP CASEQ#TXTFL @TXTFL :TEXT+FIELD
+002 C TXTTYP CASEQ#CHDFL @CHDFL :COLHDG+FIELD
E002 C END :
E001 C END :
C* :
B001 C DSPATR CASEQ*ON @ATRFD :FIELD ATTRIBUTE
E001 C END :
C* :
C* SET LEADER LIKE XXXXX.......DDDDDDDD :
C* MAXIMUM LENGTH OF COLUMN HEADING AND FIELD TEXT :
C* :
B001 C DSPFMT IFEQ #SGLFL :SINGLE FIELD/LINE
B002 C LEADER IFLE 0 :
|
002 C Z-ADD2 LEADER :PERIOD LEADER LENGTH
E002 C END :
001 C MOVE X'40' WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
001 C MOVE #PRIOD WRKBYT :
B002 C 1 DO LEADER :XXX....DDDDD
002 C EXSR @TOLIN :SET 1 CHR TO LIN
E002 C END :
E001 C END :
C* :
C* EDIT DATA :
C* :
C* GET END POSITON COLUMN ON DBF :
C* :
C Z-ADD0 IGCCNT 10 :
|
C MOVE #NO CK0E0F 1 :
C* ZERO-SUPPRESS FOR NUMERIC DATA CONTROL. :
C MOVE #NO ZSPEND 1 :
C* :
C* EDIT DATA FOR EACH FIELD :
C ENDCLM ADD 1 STRCLM :
C ADD BYTLEN ENDCLM :
C* :
C MOVE '_' PRTEDT :RRN OF SFL03
C* :
B001 C STRCLM IFLE #ARMAX :
*001 C ENDCLM ANDLE#ARMAX :
B002 C DTATYP CASEQ#PACK @PACK :PACK NUMERIC
+002 C DTATYP CASEQ#ZONE @ZONE :ZONE NUMERIC
+002 C DTATYP CASEQ#BIN @BIN :BINARY NUMERIC
|
+002 C CAS @CHAR :CHARACTER
E002 C END :
+001 C ELSE :
001 C ADD 1 CLM :
001 C MOVEA#OVRFL LN,CLM :OVER FLOW MESSAGE
001 C Z-ADDENDCLM FIL :
001 C Z-ADD#CMMAX CLM :
001 C Z-ADDMAXFLD FLD :
E001 C END :
C* :
B001 C 1 DO 5 :
001 C MOVE X'40' WRKBYT :
001 C MOVE X'40' PRTEDT :RRN OF SFL03
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
|
C* WRITE SFL03 :
B001 C DSPFMT CASEQ#SGLFL @PRT :SINGLE FIELD/LINE
+001 C CLM CASEQ#CMMAX @PRT :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MODE BEGSR :CHECK CHARACTER
C*----------------------------------------------------*
C MOVE *BLANK O1MODE 50 :
C* :
B001 C SELEC :
001 C* :
001 C TXTTYP WHEQ #COLHG :COLHDG
001 C O1MODE CAT #CHDMD:0 O1MODE :
|
001 C TXTTYP WHEQ #TEXT :TEXT
001 C O1MODE CAT #TXTMD:0 O1MODE :
001 C TXTTYP WHEQ #FIELD :FIELD
001 C O1MODE CAT #FLDMD:0 O1MODE :
001 C TXTTYP WHEQ #TXTFL :TEXT+FIELD
001 C O1MODE CAT #TXTMD:0 O1MODE :
001 C O1MODE CAT #FLDMD:0 O1MODE :
001 C TXTTYP WHEQ #CHDFL :COLHDG+FIELD
001 C O1MODE CAT #CHDMD:0 O1MODE :
001 C O1MODE CAT #FLDMD:0 O1MODE :
E001 C ENDSL :
C* :
B001 C DSPFMT IFEQ #SGLFL :SINGLE FIELD/LINE
001 C O1MODE CAT #LEADR:0 O1MODE :
E001 C END :
|
C* :
C O1MODE CAT #DTAMD:0 O1MODE :
C* :
B001 C EDTFGR IFEQ *ON : S E
001 C O1MODE CAT #ZSPMD:0 O1MODE :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHAR BEGSR :CHECK CHARACTER
C*----------------------------------------------------*
C MOVE #NO ENDPOS :
C* :
B001 C STRCLM DO ENDCLM FIL 50 :
001 C* :
|
B002 C FIL IFEQ ENDCLM :
002 C MOVE #YES ENDPOS :
E002 C END :
001 C* :
B002 C DT,FIL IFEQ X'0E' :
002 C MOVE #YES CK0E0F :
+002 C ELSE :
B003 C DT,FIL IFEQ X'0F' :
003 C MOVE #NO CK0E0F :
003 C Z-ADD0 IGCCNT :
E003 C END :
E002 C END :
001 C* :
B002 C CK0E0F IFEQ #YES :
002 C ADD 5 IGCCNT :
|
E002 C END :
001 C* DISPLAYABLE DATA :
001 C ADD 1 CLM :
001 C MOVE PRTEDT UL,CLM :
B002 C DT,FIL IFGT X'40' :
*002 C DT,FIL OREQ X'0E' :
*002 C DT,FIL OREQ X'0F' :
002 C MOVE DT,FIL LN,CLM :
002 C MOVE DT,FIL HI,CLM :
E002 C END :
001 C* :
B002 C CLM IFEQ #CMMAX :GET TO MAX COLUMN
B003 C CK0E0F IFEQ #NO :X"0E0F" OK
003 C EXSR @PRT :WRITE LINE TO SFL
+003 C ELSE :X"0E0F" NG
|
B004 C IGCCNT IFNE 0 :ODD
004 C ADD 1 CLM :
004 C MOVE X'0F' LN,CLM :SET X"0F"
004 C MOVE PRTEDT UL,CLM :
004 C EXSR @PRT :WRITE LINE TO SFL
004 C ADD 1 CLM :
004 C MOVE X'0E' LN,CLM :
004 C MOVE PRTEDT UL,CLM :
+004 C ELSE :
004 C MOVE X'0F' LN,CLM :REPLACE "0F" AT END
004 C MOVE PRTEDT UL,CLM :
004 C EXSR @PRT :WRITE LINE TO SFL
004 C ADD 1 CLM :
004 C MOVE X'0E' LN,CLM :
004 C MOVE PRTEDT UL,CLM :
|
004 C ADD 1 CLM :
004 C MOVE DT,FIL LN,CLM :
004 C MOVE DT,FIL HI,CLM :
004 C MOVE PRTEDT UL,CLM :
E004 C END :
E003 C END :
E002 C END :
001 C* :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @BIN BEGSR :BINARY NUMERIC
C*----------------------------------------------------*
C Z-ADDSTRCLM FIL :
|
C Z-ADD0 ZONE30 300 :
C MOVE *ZERO DSNUM :
C* :
B001 C BYTLEN IFEQ 2 :
001 C MOVE *LOVAL DSBN2C :
001 C MOVEADT,FIL DSBN2C :
001 C Z-ADDDSBIN2 ZONE30 :
+001 C ELSE :
001 C MOVE *LOVAL DSBN4C :
001 C MOVEADT,FIL DSBN4C :
001 C Z-ADDDSBIN4 ZONE30 :
E001 C END :
C* :
C MOVELZONE30 DSNUM :
C* :
|
C #ZNMAX SUB DIGITS WRK :
C WRK ADD 1 STRNUM :
C EXSR @NUM :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PACK BEGSR :PACK NUMERIC
C*----------------------------------------------------*
C MOVE *ZERO DSNUM :
C Z-ADD0 ZONE30 :
C Z-ADDSTRCLM FIL :
C #PKMAX SUB BYTLEN WRK :
C ADD 1 WRK :
C Z-ADD0 DSPCKN :
C MOVEADT,FIL PK,WRK :
|
C Z-ADD#PKMAX WRK :
C TESTB'45' PK,WRK 70:
C TESTB'7' PK,WRK 71:
C TESTB'67' PK,WRK 72 :
C* :
B001 C *IN70 IFEQ *ON :
*001 C *IN71 ANDEQ*ON :
*001 C *IN70 OREQ *ON :
*001 C *IN72 ANDEQ*ON :
001 C Z-ADDDSPCKN ZONE30 :
001 C MOVELZONE30 DSNUM :
+001 C ELSE :
001 C MOVE *ALL'?' DSNUM :
E001 C END :
C* :
|
C #ZNMAX SUB DIGITS WRK :
C WRK ADD 1 STRNUM 30 :
C EXSR @NUM :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ZONE BEGSR :ZONE NUMERIC
C*----------------------------------------------------*
C Z-ADDSTRCLM FIL :
C #ZNMAX SUB DIGITS WRK :
C ADD 1 WRK :
C MOVE *ZERO DSNUM :
C MOVEADT,FIL NM,WRK :
C* :
C Z-ADDWRK STRNUM :
|
C EXSR @NUM :
C* :
C ENDSR :
C*----------------------------------------------------*
C @NUM BEGSR :NUMERIC
C*----------------------------------------------------*
C MOVE #NO ENDPOS :
C* :
B001 C STRNUM DO #ZNMAX WRK :
001 C* :
B002 C WRK IFEQ #ZNMAX :
002 C MOVE #YES ENDPOS :
E002 C END :
001 C* :
B002 C DECPNT IFNE 0 :
|
002 C ADD 1 DCPCNT :COUNT UP
B003 C DCPCNT IFEQ DECPNT :COUNTER=POS OF DEC.
003 C MOVE #PRIOD WRKBYT :
003 C EXSR @TOLIN :SET 1 CHR TO LIN
E003 C END :
E002 C END :
001 C* :
B002 C ENDPOS IFEQ #NO :
*002 C EDTFGR ANDEQ*ON :
002 C* :
B003 C NM,WRK IFNE '0' :
*003 C DECPNT ORNE 0 :
*003 C DCPCNT ANDEQDECPNT :COUNTER=POS OF DEC.
003 C MOVE #YES ZSPEND :
+003 C ELSE :
|
B004 C ZSPEND IFEQ #NO :
004 C MOVE X'40' NM,WRK :
E004 C END :
E003 C END :
E002 C END :
001 C* :
001 C MOVE NM,WRK WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
001 C* :
E001 C END :
C* :
B001 C CLM IFNE 0 :
001 C MOVE LN,CLM SIGN 1 :
001 C EXSR @SIGN :SIGN
B002 C SIGN IFEQ #MINUS :
|
002 C BITON'0123' LN,CLM :
002 C BITON'0123' HI,CLM :
E002 C END :
001 C MOVE SIGN WRKBYT :
001 C EXSR @TOLIN :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @COLHG BEGSR :SET COLHDG
C*----------------------------------------------------*
C* SET COLUMN HEADING IN TO LINE. :
C* :
C ADD CHDMAX LEADER :PERIOD LEADER LENGTH
C SUB CHDLEN LEADER :PERIOD LEADER LENGTH
|
C* :
B001 C WCOLHD IFNE *BLANK :
001 C MOVE *BLANK DSWRK :
001 C WCOLHD CAT '=':0 DSWRK :
001 C Z-ADDCHDLEN COUNT :
001 C EXSR @STTXT :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TEXT BEGSR :SET TEXT
C*----------------------------------------------------*
C* SET FIELD TEXT TO A LINE. :
C* :
C ADD TXTMAX LEADER :PERIOD LEADER LENGTH
|
C SUB TXTLEN LEADER :PERIOD LEADER LENGTH
C* :
B001 C DESCR IFNE *BLANK :
001 C MOVE *BLANK DSWRK :
001 C DESCR CAT '=':0 DSWRK :
001 C Z-ADDTXTLEN COUNT :
001 C EXSR @STTXT :SET 1 CHR TO LIN
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @FIELD BEGSR :SET FIELD
C*----------------------------------------------------*
C* SET FIELD NAME TO A LINE. :
C* :
|
C ADD 10 LEADER :PERIOD LEADER LENGTH
C SUB FLDLEN LEADER :PERIOD LEADER LENGTH
C* :
C MOVE *BLANK DSWRK :
C '*' CAT FLDNAM:0 DSWRK :
C DSWRK CAT '*':0 DSWRK :
C DSWRK CAT '=':0 DSWRK :
C FLDLEN ADD 2 COUNT :
C EXSR @STTXT :SET 1 CHR TO LIN
C* :
C ENDSR :
C*----------------------------------------------------*
C @TXTFL BEGSR :TXT + FLD
C*----------------------------------------------------*
C* SET FIELD TEXT + FIELD TO A LINE. :
|
C* :
C TXTLEN ADD FLDLEN WK2 :
C* :
C TXTMAX ADD 10 LEADER :PERIOD LEADER LENGTH
C SUB WK2 LEADER :PERIOD LEADER LENGTH
C* :
C MOVE *BLANK DSWRK :
C MOVELDESCR DSWRK :
C DSWRK CAT '*':0 DSWRK :
C DSWRK CAT FLDNAM:0 DSWRK :
C DSWRK CAT '*':0 DSWRK :
C DSWRK CAT '=':0 DSWRK :
C WK2 ADD 2 COUNT :
C EXSR @STTXT :SET 1 CHR TO LIN
C* :
|
C ENDSR :
C*----------------------------------------------------*
C @CHDFL BEGSR :CHD + FLD
C*----------------------------------------------------*
C* SET FIELD CHD + FIELD TO A LINE. :
C* :
C CHDLEN ADD FLDLEN WK2 :
C* :
C CHDMAX ADD 10 LEADER :PERIOD LEADER LENGTH
C SUB WK2 LEADER :PERIOD LEADER LENGTH
C* :
C MOVE *BLANK DSWRK :
C MOVELWCOLHD DSWRK :
C DSWRK CAT '*':0 DSWRK :
C DSWRK CAT FLDNAM:0 DSWRK :
|
C DSWRK CAT '*':0 DSWRK :
C DSWRK CAT '=':0 DSWRK :
C WK2 ADD 2 COUNT :
C EXSR @STTXT :SET 1 CHR TO LIN
C* :
C ENDSR :
C*----------------------------------------------------*
C @ATRFD BEGSR :SET FIELD ATR
C*----------------------------------------------------*
C* SET FIELD ATTRIBUTE TO A LINE. :
C* :
C O1MODE CAT #ATRMD:0 O1MODE :
C* :
C ADD 9 LEADER :PERIOD LEADER LENGTH
C SUB ATRLEN LEADER :PERIOD LEADER LENGTH
|
C MOVE *BLANK DSWRK :
C MOVELFLDATR DSWRK :
C Z-ADDATRLEN COUNT :
C EXSR @STTXT :SET 1 CHR TO LIN
C* :
C ENDSR :
C*----------------------------------------------------*
C @STTXT BEGSR :WRITE A LINE TO SFL
C*----------------------------------------------------*
B001 C 1 DO COUNT WRK 50 :
001 C ADD 1 CLM :
001 C MOVE WK,WRK LN,CLM :
B002 C CLM CASEQ#CMMAX @PRT :
E002 C END :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @PRT BEGSR :WRITE A LINE TO SFL
C*----------------------------------------------------*
C* WRITE A LINE TO SUBFILE. :
C* :
B001 C DSPRT IFNE *BLANK :
001 C OF EXCPT#HED :
001 C EXCPT#DTLD :
001 C Z-ADD0 CLM :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @TXLEN BEGSR :CHECK LENGTH
C*----------------------------------------------------*
C* CHECK LENGTH OF DATA IN "WRK". AND SET THE LENGTH :
C* TO "COUNT" :
C* :
C* WRK :
C* (1 2 3 4 5 6 7 8 9 0..) --> COUNT = 6.0 :
C* X X X X X X :
C* :
B001 C DSWRK IFEQ *BLANK :
001 C Z-ADD0 COUNT :
+001 C ELSE :
001 C Z-ADDCOUNT CNT 50 :
B002 C WK,CNT IFEQ X'40' :
B003 C WK,CNT DOUNEX'40' :
|
003 C SUB 1 CNT :
E003 C END :
E002 C END :
001 C CNT ADD 1 COUNT :+ =
001 C ADD COUNT CHKLEN :LENGTH OF FLD ATR
001 C ADD 2 CHKLEN :ATR + =
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MKATR BEGSR :MAKE FLD ATR
C*----------------------------------------------------*
C* CREATE ATTRIBTES INFORMATION OF A FIELD. :
C* :
C* FORMAT IS (P,9.0) OR (A,50) :
|
C* :
C MOVE *BLANK FLDATR 10 :
C MOVEL'(' FLDATR :
C* :
C FLDATR CAT DTATYP:0 FLDATR :
C FLDATR CAT #COMMA:0 FLDATR :
B001 C DTATYP IFEQ #ZONE :NUMERIC LENGTH
*001 C DTATYP OREQ #PACK :
*001 C DTATYP OREQ #BIN :
001 C MOVE DIGITS LENGTH 3 :NUMERIC LENGTH
+001 C ELSE :
001 C MOVE BYTLEN LENGTH :CHARACTER LENGTH
E001 C END :
C MOVELLENGTH DSWRK :
C Z-ADD3 ZROCNT 10 :
|
C EXSR @ZSUPR :ZERO-SUPPRESS
C MOVELDSWRK LENGTH :
C FLDATR CAT LENGTH:0 FLDATR :
B001 C DTATYP IFEQ #ZONE :NUMERIC LENGTH
*001 C DTATYP OREQ #PACK :
*001 C DTATYP OREQ #BIN :
001 C FLDATR CAT #PRIOD:0 FLDATR :DECIMAL POINT
001 C MOVE DECIML DECLEN 2 :DECIMAL
B002 C DECLEN IFEQ '00' :'00' -> '0 '
002 C MOVE '0 ' DECLEN :
+002 C ELSE :
002 C MOVELDECLEN DSWRK :
002 C Z-ADD2 ZROCNT :
002 C EXSR @ZSUPR :ZERO-SUPPRESS
002 C MOVELDSWRK DECLEN :
|
E002 C END :
001 C FLDATR CAT DECLEN:0 FLDATR :
E001 C END :
C FLDATR CAT ')':0 FLDATR :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ZSUPR BEGSR :ZERO-SUPRSS
C*----------------------------------------------------*
C* ZERO SPPRESS ROUTINE. LIKE '000100' ->'100 ' :
C* :
B001 C WK,1 IFEQ '0' :
001 C Z-ADD0 WK2 :
001 C MOVE *OFF *IN70 :
B002 C 1 DO ZROCNT WRK :
|
B003 C *IN70 IFEQ *OFF :
*003 C WK,WRK ANDNE'0' :
003 C MOVE *ON *IN70 :
E003 C END :
B003 C *IN70 IFEQ *ON :
003 C ADD 1 WK2 :
003 C MOVE WK,WRK WK,WK2 :
E003 C END :
002 C MOVE X'40' WK,WRK :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOLIN BEGSR :SET DATA TO LINE
|
C*----------------------------------------------------*
C* SET A CHARACTER TO LINE ONE BY ONE.AND THIS LINE :
C* WILL BE WRITTEN INTO A SUB FILE RECORD. :
C* :
C ADD 1 CLM :
C MOVE WRKBYT LN,CLM :
C MOVE WRKBYT HI,CLM :
C MOVE PRTEDT UL,CLM :
B001 C CLM CASEQ#CMMAX @PRT :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @SIGN BEGSR :SIGN
C*----------------------------------------------------*
|
C* IF DATA IS X'40' (SPACE) THEN RETURN VALUE IS '*'. :
C* OR ,IF DATA IS NOT X'F' NOR X'D' THEN RETURN VALUE IS
C* '?'. :
C* X'F1' --> '1+' :
C* (CHECK ZONE HALF BYTE) X'D1' --> '1-' :
C* X'40' --> '*' :
C* OTHER --> '?' :
C* :
B001 C SIGN IFEQ X'40' :
001 C MOVE #ASTRK SIGN :'*'
+001 C ELSE :
001 C TESTB'0123' SIGN 70:
B002 C *IN70 IFEQ *ON :
002 C MOVE #PLUS SIGN :'+'
+002 C ELSE :
|
002 C TESTB'013' SIGN 70:
B003 C *IN70 IFEQ *ON :
003 C MOVE #MINUS SIGN :'-'
+003 C ELSE :
003 C MOVE #UNKWN SIGN :'?'
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C *PSSR BEGSR :
C*----------------------------------------------------*
B001 C SWP IFEQ *ON :
001 C MOVE *ON *INH1 :
|
001 C RETRN :
+001 C ELSE :
001 C MOVE *ON SWP 1 :
E001 C END :
C* :
C ENDSR'*DETC' :
O******************************************************
O* O U T P U T M O D U L E *
O******************************************************
OQPRT198 E 102 #HED
O 110 '** AUDIT LIST **'
O E 1 #HED
O HEADR1
O E 1 #HED
O HEADR2
|
O*
O E 21 #DTLH
O '* ACTION = '
O O1ANAM B
O '* PRINT MODE = '
O O1MODE
O '* RRN = '
O FILRRN B
O*
O E 00 #DTLD
O DSHI B
O E 00 #DTLD
O DSHI B
O E 00 #DTLD
O DSUL B
|
O E 00 #DTLD
O DSUL B
O E 00 #DTLD
O DSPRT B
O E 1 #DTLD
O E 1 #DTLD
**
AWRITE RECORD
BCHANGE RECORD (BEFORE IMAGE)
CCHANGE RECORD (AFTER IMAGE)
DDELETE RECORD
EERROR
IINQUIRY
|
