H 1 Y/ 1
H****************************************************************
H* DISPLAY DATA IN D.B.F *
H* *
H*--------------------------------------------------------------*
H* *
H* PROGRAMMER - TADASHI KAKEFUDA *
H* MODIFIED - . . BY *
H* *
H****************************************************************
FSZAPSB1DCF E WORKSTN UC
F KINFDS INFSFL
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 73 1 ;WRK
E NM 30 1 ;FOR NUMERIC
E WL 78 1 ;LINE ON SFL
E LN 999 78 ;LINE ON SFL
E GDE 1 4 58 ;CMD GIDE
I******************************************************
I* D E F I N E C O N S T A N T *
I******************************************************
I 2 C #STORE
I 3 C #LOAD
I 4 C #RDDTL
I 9 C #END
I*
|
I 10 C #PGSIZ
I 16 C #PKMAX
I 30 C #ZNMAX
I 9500 C #ARMAX
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'20' C X20
I X'21' C XRI
I X'22' C XHI
I X'26' C XHIUL
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 '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 ' BOTTOM ' C #BOTTM
I ' MORE...' C #MORE
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
IDSWLN DS
I 1 78 WL
IDSNUM DS
I 1 30 NM
IDSDTA DS
I 19500 DT
IINFSFL DS
I 369 369 PUSHED
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 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 DSDTA ;USER SPACE
C PARM FILRRN ;
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******************************************************
|
B001 C W1OPEN IFEQ #NO ;
001 C OPEN SZAPSB1D ;
001 C MOVE #YES W1OPEN 1 ;
E001 C END ;
C* ;
C MOVE *ON *IN86 :OVRATR ON
C* ;
C EXSR @MODE ;
C Z-ADD#STORE DSPCTL 10 :
C* ;
B001 C DSPCTL DOWEQ#STORE ;
001 C EXSR @STORE ;
001 C ADD 1 DSPCTL ;
B002 C DSPCTL DOWEQ#LOAD ;
002 C MOVE *ON *IN85 :OVRATR ON
|
002 C EXSR @LOAD ;
002 C ADD 1 DSPCTL ;
B003 C DSPCTL DOWEQ#RDDTL ;
003 C EXSR @RDDTL ;
003 C MOVE *OFF *IN85 :OVRATR OFF
003 C MOVE *OFF *IN86 :OVRATR OFF
E003 C END ;
E002 C END ;
E001 C END ;
C* ;
B001 C W1OPEN IFEQ #YES ;
001 C CLOSESZAPSB1D ;
001 C MOVE #NO W1OPEN ;
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 Z-ADD7 P1LIN :
C Z-ADD17 P1POS :
C* RETRIEVE LIST SECTION OF RCDFMT INFROMATION. :
C* :
C Z-ADD1 LEFT 30 :
C Z-ADD57 RIGHT 30 :
C Z-ADD0 WK2 50 :
C MOVE X'40' 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 Z-ADD1 FTRCTL 10 :
C MOVELGDE,1 V1CMD1 :
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 LEFT SUB 1 CLM 50 :COLOM OF LINE
C Z-ADD0 LIN 30 :
C Z-ADD1 STRLIN 30 :
C Z-ADD0 BOTMLN 30 :
C* :
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 @TOLN :WRITE LINE TO SFL
C* :
|
C Z-ADDLIN LASTLN 30 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @LOAD BEGSR :WRITE SFL CTL
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* :
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 ;
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 IFGT LASTLN :
001 C MOVEL#BOTTM ENDMDE :
+001 C ELSE :
001 C MOVEL#MORE ENDMDE :
E001 C END :
C* :
C WRITEFMT01 ;
C* :
C ENDSR :
C*----------------------------------------------------*
C @RDDTL BEGSR :READ SFL CTL
C*----------------------------------------------------*
C READ FMT01 99;
C* ;
|
B001 C RECENT IFEQ PUSHED ;
001 C Z-ADD#END DSPCTL :
+001 C ELSE :
001 C EXSR @CMD ;COMMAND FUNCTION
B002 C WTYPE IFNE TXTTYP :
002 C MOVE TXTTYP WTYPE :
002 C EXSR @MODE :
B003 C DSPCTL IFGT #STORE :
003 C Z-ADD#STORE DSPCTL :
E003 C END :
E002 C END :
E001 C END ;
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @CMD BEGSR :COMMAND KEY
C*----------------------------------------------------*
C* COMMAND FUNCTION KEY :
C* :
B001 C SELEC :
001 C F3 WHEQ PUSHED :
*001 C F12 OREQ PUSHED :
001 C Z-ADD#END DSPCTL :
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 :
001 C* :
B002 C ROLUP CASEQPUSHED @ROLUP :
+002 C ROLDWN CASEQPUSHED @ROLDN :
+002 C F14 CASEQPUSHED @DPFMT :
+002 C F15 CASEQPUSHED @DPATR :
+002 C F16 CASEQPUSHED @EDTFG :
+002 C F24 CASEQPUSHED @FTR01 :
E002 C ENDCS :
001 C* :
|
E001 C ENDSL :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MODE BEGSR :CHECK CHARACTER
C*----------------------------------------------------*
C MOVE *BLANK V3MODE :
C* :
B001 C TXTTYP IFEQ #COLHG :COLHDG
001 C V3MODE CAT #CHDMD:0 V3MODE :
+001 C ELSE :
B002 C TXTTYP IFEQ #TEXT :TEXT
002 C V3MODE CAT #TXTMD:0 V3MODE :
+002 C ELSE :
B003 C TXTTYP IFEQ #FIELD :FIELD
|
003 C V3MODE CAT #FLDMD:0 V3MODE :
+003 C ELSE :
B004 C TXTTYP IFEQ #TXTFL :TEXT+FIELD
004 C V3MODE CAT #TXTMD:0 V3MODE :
004 C V3MODE CAT #FLDMD:0 V3MODE :
+004 C ELSE :
B005 C TXTTYP IFEQ #CHDFL :COLHDG+FIELD
005 C V3MODE CAT #CHDMD:0 V3MODE :
005 C V3MODE CAT #FLDMD:0 V3MODE :
E005 C END :
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
|
B001 C DSPATR IFEQ *ON :
001 C V3MODE CAT #ATRMD:0 V3MODE :
E001 C END :
C* :
B001 C DSPFMT IFEQ #SGLFL :SINGLE FIELD/LINE
001 C V3MODE CAT #LEADR:0 V3MODE :
E001 C END :
C* :
C V3MODE CAT #DTAMD:0 V3MODE :
C* :
B001 C EDTFGR IFEQ *ON :
001 C V3MODE CAT #ZSPMD:0 V3MODE :
E001 C END :
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 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* :
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 IFGE RIGHT :
002 C EXSR @TOLN :WRITE LINE TO SFL
+002 C ELSE :
002 C ADD CLM CHKLEN :
B003 C CHKLEN IFGE RIGHT :
003 C EXSR @TOLN :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 X20 WRKBYT :
001 C EXSR @TOWLN :SET 1 CHR TO LIN
001 C MOVE #PRIOD WRKBYT :
B002 C 1 DO LEADER :XXX....DDDDD
002 C EXSR @TOWLN :SET 1 CHR TO LIN
E002 C END :
E001 C END :
C* :
C* EDIT DATA :
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 :
C MOVE XHIUL ATRDTA 1 :
C MOVE ATRDTA WRKBYT :
C EXSR @TOWLN :SET 1 CHR TO LIN
C* EDIT DATA FOR EACH FIELD :
C ENDCLM ADD 1 STRCLM :
C ADD BYTLEN ENDCLM :
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 WL,CLM :OVER FLOW MESSAGE
001 C Z-ADDENDCLM FIL :
001 C Z-ADDRIGHT CLM :
001 C Z-ADDMAXFLD FLD :
E001 C END :
C* WRITE MDS :
B001 C DSPFMT CASEQ#SGLFL @TOLN :SINGLE FIELD/LINE
+001 C CLM CASGERIGHT @TOLN :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ROLUP BEGSR :ROLL UP CTER
C*----------------------------------------------------*
B001 C ENDMDE IFEQ #MORE :
001 C BOTMLN ADD 1 STRLIN :
B002 C STRLIN IFGT LASTLN :
002 C Z-ADDLASTLN STRLIN :
E002 C END :
B002 C DSPCTL IFGT #LOAD :
002 C Z-ADD#LOAD DSPCTL :
E002 C END :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @ROLDN BEGSR :ROLL DOWN CTER
C*----------------------------------------------------*
C SUB #PGSIZ STRLIN :
C* :
B001 C STRLIN IFLT 1 :
001 C Z-ADD1 STRLIN :
E001 C END :
C* :
B001 C DSPCTL IFGT #LOAD :
001 C Z-ADD#LOAD DSPCTL :
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 :
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 IFGE RIGHT :GET TO MAX COLUMN
B003 C CK0E0F IFEQ #NO :X"0E0F" OK
003 C EXSR @TOLN :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 @TOLN :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 @TOLN :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 #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 @TOWLN :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 #X40 NM,WRK :
E004 C END :
E003 C END :
E002 C END :
001 C* :
001 C MOVE NM,WRK WRKBYT :
001 C EXSR @TOWLN :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 @TOWLN :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 X20 CAT WCOLHD:0 DSWRK :
001 C CHDLEN ADD 1 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 X20 CAT DESCR:0 DSWRK :
001 C TXTLEN ADD 1 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 XRI CAT FLDNAM:0 DSWRK :
C FLDLEN ADD 1 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 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 X20 CAT DESCR:0 DSWRK :
C DSWRK CAT XRI:0 DSWRK :
C DSWRK CAT FLDNAM:0 DSWRK :
C WK2 ADD 1 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 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 X20 CAT WCOLHD:0 DSWRK :
C DSWRK CAT XRI:0 DSWRK :
C DSWRK CAT FLDNAM:0 DSWRK :
C WK2 ADD 1 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 ADD 9 LEADER :PERIOD LEADER LENGTH
C SUB ATRLEN LEADER :PERIOD LEADER LENGTH
C MOVE *BLANK DSWRK :
C XHI CAT FLDATR:0 DSWRK :
C ATRLEN ADD 1 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 WL,CLM :
B002 C CLM CASGERIGHT @TOLN :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOLN BEGSR :WRITE A LINE TO SFL
C*----------------------------------------------------*
C* WRITE A LINE TO SUBFILE. :
C* :
|
B001 C DSWLN IFNE *BLANK :
B002 C CLM IFLE RIGHT :
002 C ADD 1 CLM :
002 C MOVE X20 WL,CLM :
E002 C END :
001 C* :
001 C ADD 1 LIN :
001 C MOVELDSWLN LN,LIN :
001 C MOVE *BLANK DSWLN :
001 C* :
B002 C ENDPOS IFEQ #NO :NOT LAST COLM
002 C Z-ADDLEFT CLM :
002 C MOVE ATRDTA WL,CLM :
+002 C ELSE :
002 C LEFT SUB 1 CLM :
|
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* :
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 #X40 WK,WRK :
E002 C END :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOWLN 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 CASGERIGHT @TOLN :
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 E
+001 C ELSE :
001 C MOVE *OFF EDTFGR :EDIT FIGURES
E001 C END :
C* :
C EXSR @MODE :
C* :
B001 C DSPCTL IFGT #STORE :
001 C Z-ADD#STORE DSPCTL :
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* :
C EXSR @MODE :
C* :
B001 C DSPCTL IFGT #STORE :
001 C Z-ADD#STORE DSPCTL :
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* :
C EXSR @MODE :
C* :
B001 C DSPCTL IFGT #STORE :
001 C Z-ADD#STORE DSPCTL :
|
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 #X40 :
|
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 @FTR01 BEGSR :MORE KEYS
C*----------------------------------------------------*
B001 C FTRCTL IFEQ 1 :
001 C Z-ADD2 FTRCTL :
001 C MOVELGDE,2 V1CMD1 :
+001 C ELSE :
B002 C FTRCTL IFEQ 2 :
002 C Z-ADD3 FTRCTL :
002 C MOVELGDE,3 V1CMD1 :
+002 C ELSE :
B003 C FTRCTL IFEQ 3 :
003 C Z-ADD4 FTRCTL :
003 C MOVELGDE,4 V1CMD1 :
|
+003 C ELSE :
B004 C FTRCTL IFEQ 4 :
004 C Z-ADD1 FTRCTL :
004 C MOVELGDE,1 V1CMD1 :
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
C MOVE *ON *IN86 :OVRATR ON
C WRITEFMT01 :
C MOVE *OFF *IN86 :OVRATR OFF
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
F3=EXIT F6=COLUMN HEADING F7=TEXT F8=FIELD F24=MORE KEYS
F9=TEXT+FIELD F10=COLHDG+FIELD F24=MORE KEYS
F13=DATA ONLY F15=FIELD ATTRIBUTES F24=MORE KEYS
|
F14=SINGLE/MULTI F16=ZERO SUPPRESS F24=MORE KEYS
|
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
|
H 1 Y/ 1
H******************************************************************
H* *
H* PROGRAMMER ....... T.KAKEFUDA *
H* CREAT............. 89/05/30 *
H* MODYF............. 92/08/14 *
H* 98/08/14 *
H* *
H******************************************************************
FQRYF IF F 1 DISK KRECNO QRYRRN UC
F KINFDS INFQRY
F KINFSR @EXERR
FARVF IF F 9500 DISK KRECNO ARVRRN UC
F KINFDS INFARV
F KINFSR @EXERR
|
FKEYF IF F 9500 99AI 1 DISK UC
F KINFDS INFKEY
F KINFSR @EXERR
FUPDF UF F 9500 DISK A UC
F KINFDS INFUPF
F KINFSR @EXERR
FARCFILE O F 9521 DISK A UC
FSZAPD2 CF E WORKSTN
F RRN01 KSFILE SFL01
F RRN01 KSFILE SFL02
F KINFDS INFSFL
FQAFDACCPIF F 116 DISK UC
E******************************************************
E* A R R A Y T A B L E ;*
E******************************************************
|
E DT 9500 1 ;INPUT DATA
E* ;
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* ;
E IB 500 5 0A ;POSITION OF DATA
E SQ 68 3 0 ;REF. MAP
E SL 68 1 ;SCALE 1
E CH 68 1 ;CHARCTER
E XZ 68 1 ;HEX ZONE
E XD 68 1 ;HEX DIGIT
E FM 68 1 ;FLD. MAP
E TP 68 1 ;TYP. MAP
|
E KV 60 1 ;KEY VALUE CHR
E HV 30 2 ;KEY VALUE HEX
E RN 12 7 0 ;WRK RRN(OF FILE)
E WK 5 1 ;WORK ARRAY
E SG 20 1 ;SEARCH STRING
E SD 10 10 1 ;SCL. DTA
E MI 68 1 ;ID OF MAP
E TABEID 1 4 5 0 TABERR 50 ;ERR MESSAGE
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******************************************************
IARVF AA 01
I 19500 DT
IKEYF AA 02
|
I 19500 DT
IUPDF AA 03
I 19500 DT
IQRYF AA 04
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 #BDSFL
I 2 C #WTSFC
I 3 C #RDSFL
I 9 C #END
|
I*
I 12 C #LINE1
I 4 C #LINE2
I 6 C #DFTLN
I 13 C #DFTCM
I 66 C #DSPLN
I 1000 C #SHMAX
I 9500 C #ARMAX
I 500 C #ELMAX
I 60 C #KCMAX
I 30 C #KHMAX
I '?' C #UNKWN
I 'U' C #CHGMD
I 'D' C #DSPMD
I 'A' C #ACHR
|
I 'C' C #CHR
I 'H' C #HEX
I 'Y' C #YES
I ' ' C #NO
I '.' C #PRIOD
I ',' C #COMMA
I 'FILE=' C #FL
I 'RECORD FORMAT=' C #RD
I 'TYPE=' C #TP
I 'W' C #WTKSN
I 'C' C #CLKSN
I*
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* HEX WRK
I X'20' C X20
I X'22' C XHI
I X'2F' C X2F
I*
I 'SZAPSB1' C #DPDTA
I 'SZAPSB2' C #PTDTA
I 'DSPDR81' C #FDLST
I '#SRSTSCL' C #PGSTS
I 'QCLSCAN' C #PGSCN
|
I 'QUSRTVUS' C #PGRTV
I 'QUSLFLD' C #PGFLD
I 'QUSRMBRD' C #PGMBR
I*
I 'S' C #ZONE
I 'P' C #PACK
I 'B' C #BIN
I 'A' C #ALPH
I 'J' C #JPN
I 'E' C #EHR
I 'O' C #OPN
I*
I 'A' C #ADDFG
I 'B' C #BFRFG
I 'C' C #CHGFG
|
I 'D' C #DLTFG
I 'E' C #ERRFG
I 'I' C #INQFG
I 'RRN IS NOT FOUND NOW-C #CHNMG
I '.RRN NUMBER IS'
I 'BEGINNING OF FILE DE-C #BOFMG
I 'TECTED.'
I 'END OF FILE DETECTED-C #EOFMG
I '.'
I 'RE-DISPLAY WITHOUT C-C #RDSPI
I 'HANGING DATA.'
I 'DELETE RECORDS MODE -C #DLTM1
I 'IS CANCELED ...'
I 'IF YOU WANT TO DELET-C #DLTM2
I 'E THE MARKED RECORD,-
|
I 'PUSH F23 AGAIN.'
I 'WRITE RECORDS MODE I-C #ADDM1
I 'S CANCELED ...'
I 'IF YOU WANT TO WRITE-C #ADDM2
I ' THE RECORDS,PUSH F9-
I ' AGAIN. '
I 'IS BEING SEARCHED NO-C #SHING
I 'W.'
I 'IS BEING SEARCHED NO-C #SERCH
I 'W.TOTAL OF SEARCHED -
I 'REOCRDS COME TO'
I 'IS FOUND.POSITION (R-C #FOUND
I 'RN,COLUMN) IS ('
I 'STRING NOT FOUND. WR-C #NOFND
I 'AP AROUND.SEARCH STA-
|
I 'RTS AT BEGINNING OF -
I 'DATA.'
I 'TOTAL OF SEARCHED RE-C #LIMIT
I 'CORDS COME TO MAXIMU-
I 'M.SEARCH IS SUSPENDE-
I 'D AT'
I 'DISPLAY DATA FEATURE-C #DPDER
I ' IS CANCELED...'
I 'PRINT DATA FEATURE- C #PRTER
I ' IS CANCELED...'
I 'THERE IS NO DATA IN -C #NODTA
I 'THIS MEMBER.'
I 'TOTAL OF WRITTEN REC-C #ADDED
I 'ORDS COME TO'
I 'TOTAL OF CHANGED REC-C #CHGED
|
I 'ORDS COME TO'
I 'IS DELETED.TOTAL OF -C #DLTED
I 'DELETED RECORDS COME-
I ' TO'
I 'ERROR OCCURS IN DECI-C #DTER1
I 'MAL DATA TYPE.RRN IS'
I 'COLUMN IS' C #DTER2
I 'RECORDS.' C #MSGEN
I 'DISPLAY' C #DSPNM
I 'CHANGE ' C #CHGNM
I ' WRITE ' C #ADDNM
I 'DELETE ' C #DLTNM
I ' BOTTOM ' C #BOTTM
I ' MORE...' C #MORE
I 'F3=EXIT F4=FIELDS -C #CMD01
|
I 'F5=REFRESH F10=CHR/-
I 'HEX F13=SLIDE -
I ' F6=DATA -
I ' F24=MORE KEYS...'
I 'F16=FIND - C #CMD02
I 'F17=TOP F18=BOTTOM -
I ' F19=LEFT F20=RIGHT-
I ' F21=MEMBER -
I ' F24=MORE KEYS...'
I 'F17=TOP F18=BOTTOM -C #CMD03
I ' F19=LEFT F20=RIGHT-
I ' F21=MEMBER -
I 'F22=PRINT -
I ' F24=MORE KEYS ...'
I 'F9=WRITE MODE - C #CMD04
|
I 'F23=DELETE MODE -
I ' F24=MORE KEYS...'
I 'SMALL ZAP VER 1.0 - C #VER
I 'BY KAKEFUDA'
I 'ABCDEFGHIJKLMNOPQRST-C #MAPEG
I 'UVWXYZｱｲｳｴｵｶｷｸｹﾀﾁﾂﾃﾄ-
I 'ﾅﾆﾇﾈﾍﾎﾏﾐﾑﾒﾓﾔ@#\%|&*(-
I ')-+=<>$/'
I*
I 'ABCDEFGHIJKLMNOPQRST-C #MAPJP
I 'UVWXYZｱｲｳｴｵｶｷｸｹｺｻｼｽｾ-
I 'ｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒ-
I 'ﾒﾓﾔﾕﾖﾗﾘﾙﾚ'
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* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
IDSDTA DS 12
I 19500 DT
IDSWRK DS
I 1 5 WK
IV1KYVL DS
I 1 60 KV
IDSHXVL DS
I 1 60 HV
IV1STRG DS
I 1 20 SG
IV1SCL DS
|
I 1 68 SL
IV1TYP DS
I 1 68 TP
IS1DTA DS
I 1 68 CH
IS1HEX1 DS
I 1 68 XZ
IS1HEX2 DS
I 1 68 XD
IV1FMAP DS
I 1 68 FM
I DS
IHEXDEC DS
I 1 1 HEXZNE
I 2 2 HEXDGT
|
I SDS
I 1 10 ZZPGID
I 244 253 ZZJBID
I 254 263 ZZUSID
I 91 170 ZZCPF
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
|
IINFQRY DS
I 83 161 DSQRY
IINFKEY DS
I 83 161 DSKEY
I B 397 4000KEYRRN
I B 393 3940DSKEYL
I 401 460 DSKYVL
IINFUPF DS
I *STATUS STATUS
IINFSFL DS
I 289 289 ANKIGC
I 369 369 PUSHED
I 370 371 LINCLM
IDSBN2C DS
I B 1 20DSBIN2
|
I DS
I B 1 20DSLINE
I 2 2 DSLINB
I B 3 40DSCOLM
I 4 4 DSCOLB
I DS
I B 1 40LENDTA
I B 5 80STRPOS
I B 9 120LENRCV
IRCVHDR DS
I B 1 40OFSETH
I B 5 80LSTSZH
IRCVVAR DS
I B 1 40OFFSET
I B 9 120NOENTR
|
I B 13 160LSTSIZ
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
IFLDHDR DS
I 21 25 DSFTYP
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 320DECIML
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 SPACE NAME
C PARM PIMODE 1 ;DISPLAY OR UPDAT
C PARM KEYACP 1 ;'Y'=KEY FILE
|
C PARM PIARCV 1 ;ARCHIVE ?
C PARM PIDBCS 1 ;USE DBCS ?
C PARM PIVLDT 1 ;CHECK DATA VLD
C PARM PIQRYF 1 ;OPN QRYF
C PARM PIADTW 1 ;WRITE
C PARM PIADTC 1 ;CHANGE
C PARM PIADTD 1 ;DELETE
C PARM PIACNT 50 ;ADD RCDS COUNT
C PARM PICCNT 50 ;CHG RCDS COUNT
C PARM PIDCNT 50 ;DLT RCDS COUNT
C* ;
C* DEFINE PARM ;
C* ;
C PRTV01 PLIST ;
C PARM USRSPC ;
|
C PARM 125 STRPOS ;
C PARM 16 LENDTA ;
C PARM RCVVAR ;
C* ;
C PRTV02 PLIST ;
C PARM USRSPC ;
C PARM STRPOS ;
C PARM 82 LENDTA ;
C PARM FLDLST ;
C******************************************************
C* M A I N - R O U T I N E ;
C******************************************************
C Z-ADD#SETLL CONTRL 10 :
C Z-ADD#DFTLN H1LINE :LINE OF CURSOR
C Z-ADD#DFTCM H1COLM :COLUMN OF CURSOR
|
C Z-ADD1 M1COLM :COLUMN OF FILE
C* ;
B001 C CONTRL DOWEQ#SETLL ;
B002 C KEYACP CASEQ#YES @STKEY ;
+002 C PIQRYF CASEQ#NO @STARV ;
+002 C CAS @STQRY ;
E002 C END ;
001 C* ;
001 C ADD 1 CONTRL ;
001 C* ;
B002 C CONTRL DOWEQ#BDSFL ;
002 C EXSR @BDSFL ;BUILD SFL
002 C ADD 1 CONTRL ;
002 C* ;
B003 C CONTRL DOWEQ#WTSFC ;
|
003 C EXSR @WTSFC ;WRITE SFCTL
003 C ADD 1 CONTRL ;
003 C* ;
B004 C CONTRL DOWEQ#RDSFL ;
004 C EXSR @FIELD ;
004 C EXSR @RDSFC ;READ SFCTL
004 C EXSR @CHK1 ;CHECK INPUT
004 C* ;
B005 C CONTRL IFEQ #END ;
005 C LEAVE ;
+005 C ELSE ;
005 C MOVE #NO W1CHG :
B006 C PIMODE CASEQ#CHGMD @CHGCK ;
E006 C END ;
B006 C RECENT CASNEPUSHED @CMD ;
|
E006 C END ;
005 C EXSR @CHK2 ;READ CURSOR
E005 C END ;
004 C* ;
E004 C END ;
E003 C END ;
E002 C END ;
E001 C END ;
C* CLOSE ;
C EXSR @CLOSE ;CLOSE PROCESS
C* ;
C MOVE *ON *INLR ;
C RETRN ;
C******************************************************
C* S U B - R O U T I N E ;
|
C******************************************************
C*----------------------------------------------------*
C *INZSR BEGSR :INITIALIZE
C*----------------------------------------------------*
C* CHECK MAP FILED (LANGUAGE TYPE) :
C ZZJBID POST SZAPD2 ;
B001 C ANKIGC IFEQ 'A' ;
001 C MOVEA#MAPEG MI :
+001 C ELSE :
001 C MOVEA#MAPJP MI :
E001 C END :
C* DEFAULT VALUE FOR API :
C MOVE *OFF OVRRID 1 :
C Z-ADD230 LENRCV :
C MOVE 'MBRD0200'MBR200 8 :
|
C* GET OFFSET VALUE AND LIST SIZE VALUE OF HEADER FROM USER SPACE.
C CALL #PGRTV PRTV01 :
B001 C NOENTR IFGT 1 :
001 C MOVE #YES KEYACP :TERMINATE
001 C MOVE #DSPMD PIMODE ;DISPLAY OR UPDAT
001 C MOVE 'N' PIARCV ;ARCHIVE ?
E001 C END :
C* :
C OFFSET ADD 1 STRPOS :
C* GET HEADER OF RECORD FORMAT INFORMATION FROM USER-SPACE.
C CALL #PGRTV :
C PARM USRSPC :
C PARM STRPOS :
C PARM LSTSIZ LENDTA :
C PARM PIRFMT 10 :
|
C* OPEN FILE FOR DISPLAY. :
B001 C KEYACP IFEQ #YES :
001 C OPEN KEYF 90 :INDEXED FILE
B002 C *IN90 IFEQ *ON :
002 C MOVE #NO KEYACP :
+002 C ELSE :
002 C MOVE *ON *IN54 :CONTROL DSPF FLDS
002 C MOVE *LOVAL H1KYVL :
002 C MOVELDSKEY DSINFO :
002 C* SAVE KEY FIELDS INTO ARRAY (KF) :
002 C OPEN QAFDACCP :
B003 C 1 DO 30 :
003 C READ QAFDACCP 99:
B004 C *IN99 IFEQ *ON :
004 C LEAVE :
|
+004 C ELSE :
004 C Z-ADDAPKEYN FLD :
B005 C FLD IFLE 30 :
005 C MOVE APKEYF KF,FLD :
E005 C END :
E004 C END :
E003 C END :
002 C CLOSEQAFDACCP :
E002 C END :
E001 C END :
C* :
B001 C KEYACP IFNE #YES :
B002 C PIQRYF IFEQ #YES :
002 C OPEN QRYF :
002 C MOVELDSQRY DSINFO :
|
E002 C END :
001 C OPEN ARVF :
001 C MOVE *OFF *IN54 :CONTROL ARVF FLDS
001 C Z-ADD1 V1RRN# :RRN NO OF FILE
001 C MOVELDSARV DSINFO :
E001 C END :
C* :
C Z-ADD1 V1COLM :COLUMN OF FILE
C Z-ADDDSRLEN V1RLEN :INFO.DS
C Z-ADDDSSIZE V1SIZE :INFO.DS
C* SET FIELDS INFROAMTION TO USER-SPCE. :
C CALL #PGFLD :
C PARM USRSPC :
C PARM 'FLDL0100'OUTFMT 8 :
C PARM DSFLLB :
|
C PARM PIRFMT :
C PARM OVRRID :
C FREE #PGFLD :
C* GET OFFSET VALUE AND LIST SIZE VALUE OF HEADER FROM USER-SPACE.
C CALL #PGRTV :
C PARM USRSPC :
C PARM 117 STRPOS :
C PARM 8 LENDTA :
C PARM RCVHDR :
C* GET HEADER OF FIELDS LIST FROM USER-SPACE. :
C OFSETH ADD 1 STRPOS :
C CALL #PGRTV :
C PARM USRSPC :
C PARM STRPOS :
C PARM LSTSZH LENDTA :
|
C PARM FLDHDR :
C* GET OFFSET VALUE AND LIST SIZE VALUE OF LIST FROM USER SPACE
C CALL #PGRTV PRTV01 :
C Z-ADDNOENTR MAXFLD 50 :MAX FLD NBR.
C* :
B001 C MAXFLD IFGT #ELMAX :
001 C Z-ADD#ELMAX MAXFLD :
E001 C END :
C* GET LIST OF FIELDS FROM USER-SPACE. :
C OFFSET ADD 1 STRPOS :
C* SET INPUT BUFFERS TO ARRAY. :
C MOVE *HIVAL IB :
B001 C 1 DO MAXFLD CNT 50 :
001 C CALL #PGRTV PRTV02 :
001 C Z-ADDINPBUF IB,CNT :
|
001 C* GET POSITION OF KEY FIELD IN USER SPACE ONE BY ONE :
B002 C KEYACP IFEQ #YES :INDEXED FILE
002 C Z-ADD1 KFD 30 :
002 C MOVE *OFF *IN70 :
002 C FLDNAM LOKUPKF,KFD 70:
B003 C *IN70 IFEQ *ON :
003 C Z-ADDCNT KP,KFD :
E003 C END :
E002 C END :
001 C* :
001 C ADD LSTSIZ STRPOS :
001 C* :
E001 C END :
C* :
C* INITIALIZE DATA :
|
C* :
C #DFTLN ADD #LINE1 WMAXLN 30 :LIMIT OF DSP LINE
C SUB 1 WMAXLN :
C #DFTCM ADD #DSPLN WMAXCM 30 :LIMIT OF DSP COLUMN
C SUB 1 WMAXCM :
C MOVE X'40' WRKBYT 1 :
C #DSPLN ADD 2 AJC 30 :COLUMN FOR ADJUST
C* FOR DSPD :
C MOVE #COLHG TXTTYP 1 ;
C MOVE #DUPFL DSPFMT 1 ;FORMAT OF DISPLAY
C MOVE *OFF EDTFGR 1 ;EDIT FIGURES Y
C MOVE *OFF DSPATR 1 ;FIELD ATTRIBUTE
C* DISPLAY :
B001 C V1RLEN IFLT #DSPLN :
001 C Z-ADD0 V1STEP :
|
+001 C ELSE :
001 C Z-ADD50 V1STEP :
E001 C END :
C Z-ADD1 V1SHST :START COL.OF SCH
C* CHECK LENGTH OF RECORD FOR ARRAY :
B001 C V1RLEN IFLE #ARMAX :
001 C Z-ADDV1RLEN W1RLEN 50 :
+001 C ELSE :
001 C Z-ADD#ARMAX W1RLEN :
E001 C END :
C* LIMIT OF SEARCH :
C Z-ADDW1RLEN V1SHEN :
C Z-ADD#SHMAX V1SHMX :LIMIT OF SCH NBR
C* CONTROL CHARACTER :
C MOVE #ACHR MAPCHR 1 :
|
C MOVE #CHR CHRHEX 1 :
C MOVE #NO KEISEN 1 :
C MOVE #NO RTNCSR 1 :
C* :
C Z-ADD0 WRK 50 :
C Z-ADD0 RRN01 70 :
C Z-ADD0 QRYRRN 70 :
C Z-ADD0 ARVRRN 70 :
C Z-ADD0 DSLINE :
C Z-ADD0 DSCOLM :
C* FOR "KEISEN" :
C X2F CAT 'F':0 S#KBFR :
C* OPEN UPDATE FILE IF REQUESTED. :
B001 C PIMODE IFNE #CHGMD :
001 C MOVEL#DSPNM V1MODE :DISPLAY MODE
|
+001 C ELSE :
001 C OPEN UPDF 90 :
B002 C *IN90 IFEQ *ON :
002 C MOVE #DSPMD PIMODE ;DISPLAY OR UPDAT
002 C MOVE 'N' PIARCV ;ARCHIVE ?
+002 C ELSE :
002 C MOVE *ON *IN50 :UPDATE MODE
002 C MOVE *ON *IN51 :WRITE ON
002 C MOVE *ON *IN52 :DELETE ON
002 C MOVEL#CHGNM V1MODE :
E002 C END :
E001 C END :
C* FILE INFORMATION OF DISPLAY HEADER :
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 PIRFMT:0 V1HDR :
C V1HDR CAT #TP:2 V1HDR :
C V1HDR CAT DSFTYP: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 END :
C* SET NO DATA MESSAGE :
B001 C V1SIZE IFEQ 0 :
001 C MOVEL#NODTA V1MSG :
E001 C END :
|
C* :
C Z-ADDV1COLM W1COLM 40 :
C EXSR @HDR ;
C* :
C Z-ADD1 CMDCTL 10 :
C MOVEL#CMD01 V1CMD :
C WRITECMD01 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @HDR BEGSR :HEADER ON SCREEN
C*----------------------------------------------------*
C* GET START BUFFER OF FIELD :
C Z-ADD1 FLD 50 :
C MOVE *OFF *IN70 :
|
C MOVE *OFF *IN71 :
C V1COLM LOKUPIB,FLD 7071:
C Z-ADDIB,FLD STRBUF 50 :
C Z-ADDFLD FLDSEQ 50 :
C Z-ADDFLDSEQ APIPNT 30 :
C EXSR @RVAPI :RTV DATA BY API
C ADD 1 FLD :
C* :
C Z-ADD0 SQ :
C MOVE *BLANK V1SCL :
C MOVE *BLANK V1TYP :
C MOVE *BLANK V1FMAP :
C* CHECK END POSITION OF DISPLAY :
B001 C V1COLM IFGT 1 :
001 C MOVE '<' FM,1 :
|
001 C MOVE '<' SL,1 :
E001 C END :
C* :
C V1COLM ADD #DSPLN ENDCLM 50 :
C SUB 1 ENDCLM :
C* :
B001 C ENDCLM IFLT W1RLEN :
001 C MOVE '<' FM,AJC :
001 C MOVE '>' SL,AJC :
+001 C ELSE :
B002 C ENDCLM IFGT W1RLEN :
002 C Z-ADDW1RLEN ENDCLM :
E002 C END :
E001 C END :
C* :
|
C Z-ADD1 CNT :
C Z-ADD1 MID 30 :
C Z-ADD1 GG 30 :
C* SET FLD SEQ,TYP,ID .... :
B001 C V1COLM DO ENDCLM COLCNT 50 :
B002 C FLD IFLE #ELMAX :
002 C* :
B003 C COLCNT IFEQ IB,FLD :
003 C ADD 1 FLDSEQ :
003 C ADD 1 FLD :
003 C ADD 1 MID :
003 C Z-ADDFLDSEQ APIPNT 30 :
003 C EXSR @RVAPI :RTV DATA BY API
E003 C END :
002 C* :
|
002 C ADD 1 CNT :
002 C Z-ADDFLDSEQ SQ,CNT :
002 C MOVELDTATYP TP,CNT :
002 C MOVE MI,MID FM,CNT :
002 C* SET SCALE :
002 C Z-ADDCOLCNT ZCT 10 :
002 C Z-ADDZCT JJ 30 :
B003 C JJ IFEQ 0 :
003 C Z-ADD10 JJ :
E003 C END :
002 C* :
002 C ADD 1 GG :
002 C MOVE SD,JJ SL,GG :
002 C* :
B003 C JJ IFEQ 10 :
|
003 C GG SUB 5 CLM 50 :
B004 C CLM IFGT 0 :
004 C MOVE *OFF *IN70 :
004 C MOVELCOLCNT DSWRK :
B005 C 1 DO 5 WRK :
005 C ADD 1 CLM :
B006 C *IN70 IFEQ *OFF :
B007 C WK,WRK IFNE '0' :
007 C MOVE *ON *IN70 :
007 C MOVE WK,WRK SL,CLM :
E007 C END :
+006 C ELSE :
006 C MOVE WK,WRK SL,CLM :
E006 C END :
E005 C END :
|
E004 C END :
E003 C END :
002 C* :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @BDSFL BEGSR :BUILD SFL
C*----------------------------------------------------*
C Z-ADD0 RRN01 :
C* CLEAR SUB FILE :
C MOVE *ON *IN62 :SFLCLR ON
B001 C CHRHEX IFEQ #CHR :
001 C Z-ADD#LINE1 SFLPAG 30 :
|
001 C WRITECTL01 :FOR CHAR
+001 C ELSE :
001 C Z-ADD#LINE2 SFLPAG :
001 C WRITECTL02 :FOR HEX
E001 C END :
C MOVE *OFF *IN62 :SFLCLR OFF
C* :
C* BUILD ONE PAGE OF SUB-FILE :
C* :
B001 C MDSUSE CASEQ#YES @RDMDS :
+001 C KEYACP CASEQ#YES @RDKEY :
+001 C PIQRYF CASEQ#NO @RDARV :
+001 C CAS @RDQRY :
E001 C END :
C* END OF FILE REACHES :
|
B001 C ADDNOW IFEQ #YES :ADD NEW RECORDS
*001 C V1END ANDEQ#BOTTM :EOF
001 C EXSR @INZLN :INTIALIZE RCD
001 C EXSR @TOSFL :MOVE TO SFL
001 C EXSR @WRTLN :ADD RCDS FOR ADD MOD
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @STARV BEGSR :SET FILE CURSOR
C*----------------------------------------------------*
B001 C V1RRN# IFLT 1 :
001 C Z-ADD1 V1RRN# :
E001 C END :
C* :
|
C V1RRN# SETLLARVF 9091 :
C* :
B001 C *IN91 IFEQ *ON :
001 C READ ARVF 90:
001 C ARVRRN SETLLARVF :
E001 C END :
C* :
B001 C *IN90 IFEQ *ON :
001 C READPARVF 90:
001 C ARVRRN SETLLARVF :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @STKEY BEGSR :SET FILE CURSOR
|
C*----------------------------------------------------*
C H1KYVL SETLLKEYF 90 :INDEXED FILE
C* :
B001 C *IN90 IFEQ *ON :
B002 C DSACPH IFEQ 'KU' :
002 C READPKEYF 90:
002 C DSKYVL SETLLKEYF :INDEXED FILE
+002 C ELSE :
002 C MOVE #YES OVRSIZ :
002 C *HIVAL SETGTKEYF :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @STQRY BEGSR :SET FILE CURSOR
C*----------------------------------------------------*
B001 C V1RRN# IFLT 1 :
001 C Z-ADD1 V1RRN# :
E001 C END :
C* :
C V1RRN# SETLLQRYF 9091 :
B001 C *IN91 IFEQ *ON :
001 C READ QRYF 90:
001 C QRYRRN SETLLQRYF :
E001 C END :
B001 C *IN90 IFEQ *ON :
001 C READPQRYF 90:
001 C QRYRRN SETLLQRYF :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @RDMDS BEGSR :FROM MDS
C*----------------------------------------------------*
C* BUILD ONE PAGE OF SUB-FILE FROM MDS :
C Z-ADDLSTLIN W1LIN 30 :
C Z-ADD0 LSTLIN :
C* :
B001 C 1 DO W1LIN SLN :
001 C SLN OCUR DSDTA :
001 C ADD 1 LSTLIN :
001 C Z-ADDRN,SLN S1RRN :
001 C EXSR @TOSFL :MOVE TO SFL
001 C EXSR @WTSFL :WRITE SFL
|
E001 C END :
C* :
C MOVE #NO MDSUSE :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RDARV BEGSR :READ ARV.
C*----------------------------------------------------*
C Z-ADD0 LSTLIN 30 :
C Z-ADD0 RN :
C* BUILD ONE PAGE OF SUB-FILE :
B001 C 1 DO SFLPAG SLN 30 :
001 C SLN OCUR DSDTA :
001 C READ ARVF 99:
B002 C *IN99 IFEQ *ON :
|
002 C LEAVE :
+002 C ELSE :
002 C ADD 1 LSTLIN :
002 C Z-ADDARVRRN S1RRN :
002 C EXSR @TOSFL :MOVE TO SFL
002 C EXSR @WTSFL :WRITE SFL
E002 C END :
E001 C END :
C* :
B001 C *IN99 IFEQ *OFF :
001 C READ ARVF 99:
E001 C END :
C* :
B001 C *IN99 IFEQ *OFF :
001 C MOVEL#MORE V1END :
|
001 C READPARVF 99:
+001 C ELSE :
001 C MOVEL#BOTTM V1END :
001 C Z-ADD*HIVAL ARVRRN :
001 C ARVRRN SETGTARVF :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#EOFMG V1MSG :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RDKEY BEGSR :READ KEY
C*----------------------------------------------------*
C Z-ADD0 LSTLIN :
|
C Z-ADD0 RN :
C* BUILD ONE PAGE OF SUB-FILE :
B001 C KEYACP IFEQ #YES :
*001 C OVRSIZ ANDEQ#YES :
001 C MOVE #NO OVRSIZ 1 :
001 C Z-ADD1 SLN :
001 C Z-ADD1 LSTLIN :
001 C SLN OCUR DSDTA :
001 C READPKEYF 99:
B002 C *IN99 IFEQ *OFF :
002 C EXSR @TOSFL :MOVE TO SFL
002 C EXSR @WTSFL :WRITE SFL
E002 C END :
+001 C ELSE :
B002 C 1 DO SFLPAG SLN :
|
002 C SLN OCUR DSDTA :
002 C READ KEYF 99:INDEXED FILE
B003 C *IN99 IFEQ *ON :
003 C LEAVE :
+003 C ELSE :
003 C ADD 1 LSTLIN :
003 C Z-ADDKEYRRN S1RRN :
003 C EXSR @TOSFL :MOVE TO SFL
003 C EXSR @WTSFL :WRITE SFL
E003 C END :
E002 C END :
E001 C END :
C* :
B001 C *IN99 IFEQ *OFF :
001 C READ KEYF 99:INDEXED FILE
|
E001 C END :
C* :
B001 C *IN99 IFEQ *OFF :
001 C MOVEL#MORE V1END :
001 C READPKEYF 99:INDEXED FILE
+001 C ELSE :
001 C MOVEL#BOTTM V1END :
001 C *HIVAL SETGTKEYF :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#EOFMG V1MSG :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @RDQRY BEGSR :READ QRY.
C*----------------------------------------------------*
C Z-ADD0 LSTLIN :
C Z-ADD0 RN :
C* BUILD ONE PAGE OF SUB-FILE :
B001 C 1 DO SFLPAG SLN :
001 C SLN OCUR DSDTA :
001 C READ QRYF 99:
B002 C *IN99 IFEQ *OFF :
002 C QRYRRN CHAINARVF 98 :
B003 C *IN98 IFEQ *ON :
003 C LEAVE :
+003 C ELSE :
003 C ADD 1 LSTLIN :
003 C Z-ADDARVRRN S1RRN :
|
003 C EXSR @TOSFL :MOVE TO SFL
003 C EXSR @WTSFL :WRITE SFL
E003 C END :
E002 C END :
E001 C END :
C* :
B001 C *IN99 IFEQ *OFF :
001 C READ QRYF 99:
E001 C END :
C* :
B001 C *IN99 IFEQ *OFF :
001 C MOVEL#MORE V1END :
001 C READPQRYF 99:
+001 C ELSE :
001 C MOVEL#BOTTM V1END :
|
001 C Z-ADD*HIVAL QRYRRN :
001 C QRYRRN SETGTQRYF :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#EOFMG V1MSG :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @WTSFC BEGSR :
C*----------------------------------------------------*
C* WRITE CONTROL RECORD FO SUBFILE :
C RRN01 COMP 0 6060 :
C MOVE *ON *IN61 :
C* :
|
B001 C CHRHEX IFEQ #CHR :
001 C WRITECTL01 :FOR CHAR
+001 C ELSE :
001 C WRITECTL02 :FOR HEX
E001 C END :
C* :
C MOVEA'00' *IN,60 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @FIELD BEGSR :MAPPING OF FIELDS
C*----------------------------------------------------*
C H1COLM SUB #DFTCM FLD :
C ADD 2 FLD :
C* :
|
B001 C SQ,FLD IFNE W1FSEQ :
001 C Z-ADDSQ,FLD W1FSEQ 30 :
001 C Z-ADDSQ,FLD APIPNT :
001 C EXSR @RVAPI :RTV DATA BY API
001 C* CREATE FIELD INFORMATION :
001 C MOVE FM,FLD MAPCHR :MAP
001 C* :
001 C MOVE *BLANK V1INF1 :
001 C MOVE *BLANK DSWRK :
001 C MOVELW1FSEQ DSWRK :
001 C Z-ADD3 ZROCNT 10 :
001 C EXSR @ZSUPR :ZERO-SUPPRESS
001 C DSWRK CAT '/':0 V1INF1 :
001 C MOVE *BLANK DSWRK :
001 C MOVELMAXFLD DSWRK :
|
001 C Z-ADD5 ZROCNT :
001 C EXSR @ZSUPR :ZERO-SUPPRESS
001 C V1INF1 CAT DSWRK:0 V1INF1 :
001 C V1INF1 CAT 'ID=':1 V1INF1 :
001 C V1INF1 CAT MAPCHR:0 V1INF1 :
001 C MOVE *BLANK V1INF2 :
001 C XHI CAT FLDNAM:0 V1INF2 :
001 C V1INF2 CAT X20:0 V1INF2 :
001 C V1INF2 CAT '(':0 V1INF2 :
001 C V1INF2 CAT DTATYP:0 V1INF2 :
001 C V1INF2 CAT #COMMA:0 V1INF2 :
B002 C DTATYP IFEQ #ZONE :
*002 C DTATYP OREQ #PACK :
*002 C DTATYP OREQ #BIN :
002 C MOVE DIGITS LENGTH 3 :NUMERIC LENGTH
|
+002 C ELSE :
002 C MOVE BYTLEN LENGTH :CHARACTER LENGTH
E002 C END :
001 C MOVE *BLANK DSWRK :
001 C MOVELLENGTH DSWRK :
001 C Z-ADD3 ZROCNT :
001 C EXSR @ZSUPR :ZERO-SUPPRESS
001 C V1INF2 CAT DSWRK:0 V1INF2 :
B002 C DTATYP IFEQ #ZONE :
*002 C DTATYP OREQ #PACK :
*002 C DTATYP OREQ #BIN :
002 C V1INF2 CAT #PRIOD:0 V1INF2 :DECIMAL POINT
002 C MOVE DECIML DECLEN 2 :DECIMAL
B003 C DECLEN IFEQ '00' :'00' -> '0 '
003 C MOVE '0 ' DECLEN :
|
+003 C ELSE :
003 C MOVE *BLANK DSWRK :
003 C MOVELDECLEN DSWRK :
003 C Z-ADD2 ZROCNT :
003 C EXSR @ZSUPR :ZERO-SUPPRESS
003 C MOVELDSWRK DECLEN :
E003 C END :
002 C V1INF2 CAT DECLEN:0 V1INF2 :
E002 C END :
001 C V1INF2 CAT ')':0 V1INF2 :
001 C Z-ADDINPBUF W1BFRS 40 :
001 C INPBUF ADD BYTLEN W1BFRE 40 :
001 C SUB 1 W1BFRE :
001 C MOVE *BLANK DSWRK :
001 C MOVELW1BFRS DSWRK :
|
001 C Z-ADD4 ZROCNT :
001 C EXSR @ZSUPR :ZERO-SUPPRESS
001 C V1INF2 CAT DSWRK:1 V1INF2 :
001 C V1INF2 CAT '-':0 V1INF2 :
001 C MOVE *BLANK DSWRK :
001 C MOVELW1BFRE DSWRK :
001 C Z-ADD4 ZROCNT :
001 C EXSR @ZSUPR :ZERO-SUPPRESS
001 C V1INF2 CAT DSWRK:0 V1INF2 :
001 C V1INF2 CAT DESCR:1 V1INF2 :
B002 C SQ,FLD IFLT MAXFLD :
002 C INPBUF ADD BYTLEN NXTPOS 70 :
+002 C ELSE :
002 C Z-ADDINPBUF NXTPOS :
E002 C END :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RDSFC BEGSR :
C*----------------------------------------------------*
C* WRITE FOOTER :
C WRITEFTR01 :
C* :
C* READ SUBFILE (CTL & RCD) :
B001 C CHRHEX IFEQ #CHR :
001 C READ CTL01 99:FOR CHAR
+001 C ELSE :
001 C READ CTL02 99:FOR HEX
E001 C END :
|
C* :
C MOVELLINCLM DSLINB :
C MOVE LINCLM DSCOLB :
C Z-ADDDSLINE H1LINE :
C Z-ADDDSCOLM H1COLM :
C* CHECK INVALID :
B001 C H1LINE IFLT #DFTLN :
001 C Z-ADD#DFTLN H1LINE :
+001 C ELSE :
B002 C H1LINE IFGT WMAXLN :
002 C Z-ADDWMAXLN H1LINE :
E002 C END :
E001 C END :
C* SET H1COLM (CURSOR) :
B001 C H1COLM IFLT #DFTCM :
|
001 C Z-ADD#DFTCM H1COLM :
+001 C ELSE :
B002 C H1COLM IFGT WMAXCM :
002 C Z-ADDWMAXCM H1COLM :
E002 C END :
E001 C END :
C* :
C MOVE *BLANK V1MSG :
C MOVE #NO W1CANL 1 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CANCL BEGSR :
C*----------------------------------------------------*
C* IN DISPLAY MODE,F12 MEANS EXITS PROGRAM.BUT IN UPDATE MODE
|
C* F12 MEANS CANCEL CHANGE OR WRITE OR DELETE IN SUSPENSION.
C* :
B001 C PIMODE IFEQ #CHGMD :
001 C MOVEL#RDSPI V1MSG :CANCEL UPDATE
001 C MOVEL#CHGNM V1MODE :
001 C MOVE #NO ADDNOW :
001 C MOVE #NO DLTNOW :
001 C MOVE *ON *IN51 :
001 C MOVE *ON *IN52 :
001 C EXSR @REPOS :
+001 C ELSE :
001 C Z-ADD#END CONTRL :
E001 C END :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @CHK1 BEGSR :CHECK INPUT VALUES
C*----------------------------------------------------*
C* F3 = EXIT :
B001 C F3 IFEQ PUSHED :
001 C Z-ADD#END CONTRL :
+001 C ELSE :
001 C* F12 = CANCEL :
B002 C F12 IFEQ PUSHED :
002 C EXSR @CANCL :
+002 C ELSE :
002 C* SAVE CURRENT VALUES TO WORK FILEDS :
002 C MOVE CHRHEX WCHRHX 1 :
002 C* :
002 C* CHECK SEARCH OPTIONS IF MDT ON. :
|
B003 C *IN81 IFEQ *ON :MDT OF SEARCH OPTION
B004 C V1SHST IFLT 1 :
*004 C V1SHST ORGT V1SHEN :
004 C Z-ADD1 V1SHST :
E004 C END :
B004 C V1SHEN IFLT 1 :
*004 C V1SHEN ORGT W1RLEN :
004 C Z-ADDW1RLEN V1SHEN :
E004 C END :
B004 C V1SHMX IFLT 1 :
004 C Z-ADD#SHMAX V1SHMX :
E004 C END :
003 C V1SHEN SUB V1SHST W1SHLN 50 :
003 C ADD 1 W1SHLN :
B004 C V1STRG IFNE *BLANK :
|
004 C Z-ADD20 WRK :
B005 C SG,WRK IFEQ X'40' :
B006 C SG,WRK DOUNEX'40' :
006 C SUB 1 WRK :
E006 C END :
E005 C END :
004 C Z-ADDWRK SRGLEN 30 :
B005 C SRGLEN IFGT W1SHLN :
005 C Z-ADDW1SHLN SRGLEN :
005 C Z-ADDSRGLEN WRK :
005 C MOVEA*BLANK SG,WRK :
E005 C END :
E004 C END :
003 C V1SHEN SUB SRGLEN LSTPOS 30 :
003 C ADD 1 LSTPOS :
|
E003 C END :
002 C* :
B003 C *IN82 IFEQ *ON :MDT OF CTL01,02 ON
*003 C RTNCSR OREQ #YES :PUT CSR TO FIRST POS
003 C Z-ADD#DFTLN H1LINE :
003 C Z-ADD#DFTCM H1COLM :
003 C MOVE #NO RTNCSR :
E003 C END :
002 C* CANCEL SEARCH MODE. :
002 C**** F16 IFNE PUSHED :
B003 C *IN81 IFEQ *ON :
*003 C *IN83 OREQ *ON :
003 C MOVE #NO SRHLMT :
003 C MOVE #NO WRAP :
003 C Z-ADD0 SEARCH :
|
003 C Z-ADDV1SHST SRHPOS :
E003 C END :
002 C***** END :
002 C* :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHGCK BEGSR :
C*----------------------------------------------------*
C* CHANGE DATA. :
B001 C F9 IFNE PUSHED :
*001 C F23 ANDNEPUSHED :
*001 C ADDNOW ANDEQ#NO :
|
*001 C DLTNOW ANDEQ#NO :
*001 C RRN01 ANDNE0 :
001 C EXSR @CHG : ?_･ｷｨW･
|
+003 C ELSE :
003 C* WRITE MODE :
003 C EXSR @WRT :WRITE RECORD
003 C EXSR @REPOS :
003 C EXSR @RESUM :
E003 C END :
+002 C ELSE :
002 C* DELETE MODE :
B003 C F23 IFEQ PUSHED :
003 C MOVE *BLANK V1MSG :
003 C EXSR @RVRRN :GET RRN OF SUBFILE
B004 C RTVRRN IFNE 0 :
B005 C *IN51 IFEQ *ON :
005 C MOVE *OFF *IN51 :HOLD WRT MODE
005 C MOVE #YES DLTNOW 1 :
|
005 C Z-ADDRTVRRN DLTRRN 70 :DLT RRN
005 C MOVE *ON *IN55 :DSPATR(BL) ON
005 C MOVE '>' S1CHGF :
B006 C CHRHEX IFEQ #CHR :
006 C UPDATSFL01 :FOR CHAR
+006 C ELSE :
006 C UPDATSFL02 :FOR HEX
E006 C END :
005 C MOVE *OFF *IN55 :DSPATR(BL) OFF
005 C MOVE ' ' S1CHGF :
005 C MOVE *BLANK V1MSG :
005 C MOVEL#DLTM2 V1MSG :
005 C MOVEL#DLTNM V1MODE :
B006 C CONTRL IFGT #WTSFC :
006 C Z-ADD#WTSFC CONTRL :RE-DISPALY
|
E006 C END :
+005 C ELSE :
005 C* DELETE RECORD :
B006 C DLTRRN IFEQ RTVRRN :
006 C EXSR @DLT :DELETE RECORD
006 C EXSR @RESUM :
+006 C ELSE :
006 C EXSR @RESUM :
006 C MOVEL#DLTM1 V1MSG :
006 C EXSR @REPOS :
E006 C END :
E005 C END :
E004 C END :
+003 C ELSE :
003 C* CANCEL WRITE-MODE :
|
B004 C F9 IFNE PUSHED :CANCEL WRT MODE
*004 C *IN52 ANDEQ*OFF :
004 C Z-ADD#SETLL CONTRL :RE-DISPLAY
004 C EXSR @RESUM :
004 C MOVE *BLANK V1MSG :
004 C MOVEL#ADDM1 V1MSG :
+004 C ELSE :
004 C* CANCEL DELETE-MODE :
B005 C F23 IFNE PUSHED :CANCEL DLT MODE
*005 C *IN51 ANDEQ*OFF :
005 C EXSR @REPOS :
005 C EXSR @RESUM :
005 C MOVE *BLANK V1MSG :
005 C MOVEL#DLTM1 V1MSG :
E005 C END :
|
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RESUM BEGSR :RESUME CHANGE MODE
C*----------------------------------------------------*
C MOVE *ON *IN51 :RLS WRT MODE
C MOVE *ON *IN52 :RLS DLT MODE
C MOVE #NO ADDNOW :
C MOVE #NO DLTNOW :
C MOVEL#CHGNM V1MODE :
C* :
|
C ENDSR :
C*----------------------------------------------------*
C @CMD BEGSR :COMMAND FUNCTION
C*----------------------------------------------------*
B001 C SELEC :
001 C* ROLL UP :
001 C ROLUP WHEQ PUSHED :
*001 C V1END ANDEQ#MORE :
001 C Z-ADD#BDSFL CONTRL :
001 C* ROLL DOWN :
001 C ROLDWN WHEQ PUSHED :
001 C SFLPAG ADD LSTLIN ROLNBR 30 :
B002 C V1END IFEQ #BOTTM :
002 C ADD 1 ROLNBR :
E002 C END :
|
001 C* :
001 C EXSR @RLDWN :
001 C* F16 SEARCH :
001 C F16 WHEQ PUSHED :
*001 C V1STRG ANDNE*BLANK :
001 C EXSR @SRCH :
001 C* F19 SLIDE BY STEP TO LEFT :
001 C F19 WHEQ PUSHED :
*001 C V1COLM ANDGT1 :
001 C SUB V1STEP V1COLM :
001 C* F20 SLIDE BY STEP TO RIGHT :
001 C F20 WHEQ PUSHED :
*001 C V1COLM ANDLTW1RLEN :
001 C ADD V1STEP V1COLM :
001 C* :
|
+001 C OTHER :
001 C* :
B002 C F1 CASEQPUSHED @KEISN :KEISEN
+002 C F4 CASEQPUSHED @FDLST :FIELD LIST
+002 C F5 CASEQPUSHED @REPOS :RE-FRESH
+002 C F6 CASEQPUSHED @DSPD :DISPLAY DATA
+002 C F10 CASEQPUSHED @DPFMT :DSP FMT
+002 C F13 CASEQPUSHED @FDSLD :FIELD SLIDE
+002 C F17 CASEQPUSHED @TOP :GOTO TOP
+002 C F18 CASEQPUSHED @BOTOM :GOTO BOTTOM
+002 C F21 CASEQPUSHED @MBINF :MBR INF.
+002 C F22 CASEQPUSHED @PRINT :DISPLAY DATA
+002 C F24 CASEQPUSHED @MORKY :MORE KEYS
E002 C END :
001 C* :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @FDSLD BEGSR :
C*----------------------------------------------------*
C Z-ADDNXTPOS V1COLM :
C MOVE #YES RTNCSR :
C* :
C ENDSR :
C*----------------------------------------------------*
C @REPOS BEGSR :
C*----------------------------------------------------*
B001 C KEYACP IFEQ #NO :
*001 C DSACPH OREQ 'KU' :
|
001 C Z-ADD#SETLL CONTRL :
+001 C ELSE :
001 C Z-ADDLSTLIN ROLNBR :
B002 C V1END IFEQ #BOTTM :
002 C ADD 1 ROLNBR :
E002 C END :
001 C EXSR @RLDWN :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DSPD BEGSR :
C*----------------------------------------------------*
B001 C W1CHG IFEQ #YES :
001 C V1MSG CAT #DPDER:0 V1MSG :
|
+001 C ELSE :
001 C* :
001 C EXSR @GTRRN :
001 C* :
B002 C RRN01 IFGT 0 :
*002 C RRN01 ANDLELSTLIN :
002 C RRN01 OCUR DSDTA 94 :
B003 C *IN94 IFEQ *OFF :
003 C Z-ADDRRN01 WRK :
003 C CALL #DPDTA ;
003 C PARM USRSPC ;USER SPACE
003 C PARM DT ;USER SPACE
003 C PARM RN,WRK PIRRN 70 ;
003 C PARM TXTTYP ;
003 C PARM DSPFMT ;FORMAT OF DISPLAY
|
003 C PARM EDTFGR ;EDIT FIGURES Y
003 C PARM DSPATR ;FIELD ATTRIBUTE
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PRINT BEGSR :
C*----------------------------------------------------*
B001 C W1CHG IFEQ #YES :
001 C V1MSG CAT #PRTER:0 V1MSG :
+001 C ELSE :
001 C* :
001 C EXSR @GTRRN :
|
001 C* :
B002 C RRN01 IFGT 0 :
*002 C RRN01 ANDLELSTLIN :
002 C RRN01 OCUR DSDTA 94 :
B003 C *IN94 IFEQ *OFF :
003 C Z-ADDRRN01 WRK :
003 C CALL #PTDTA ;
003 C PARM USRSPC ;USER SPACE
003 C PARM V1HDR HEADR1 ;
003 C PARM HEADR2 ;
003 C PARM #INQFG ARCTYP ;
003 C PARM DT ;USER SPACE
003 C PARM RN,WRK RRNWRK ;
003 C PARM TXTTYP ;
003 C PARM DSPFMT ;FORMAT OF DISPLAY
|
003 C PARM EDTFGR ;EDIT FIGURES Y
003 C PARM DSPATR ;FIELD ATTRIBUTE
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOP BEGSR :
C*----------------------------------------------------*
C MOVE *LOVAL H1KYVL :
C Z-ADD1 V1RRN# :
C Z-ADD#SETLL CONTRL :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @BOTOM BEGSR :
C*----------------------------------------------------*
C MOVE *HIVAL H1KYVL :
C Z-ADD*HIVAL V1RRN# :
C Z-ADD#SETLL CONTRL :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DPFMT BEGSR :
C*----------------------------------------------------*
B001 C CHRHEX IFEQ #CHR :
001 C MOVE #HEX CHRHEX :
+001 C ELSE :
001 C MOVE #CHR CHRHEX :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @KEISN BEGSR :KEISEN
C*----------------------------------------------------*
C* KEISEN :
B001 C KEISEN IFEQ #NO :
001 C MOVE #YES KEISEN :
B002 C KEIMOD IFNE #WTKSN :
002 C WRITESCALE :
002 C MOVEL#WTKSN KEIMOD 1 :SCALE
E002 C END :
+001 C ELSE :
001 C MOVE #NO KEISEN :
|
B002 C KEIMOD IFNE #CLKSN :
002 C WRITECLRKSN :
002 C MOVEL#CLKSN KEIMOD :CLEAR
E002 C END :
E001 C END :
C* :
B001 C CONTRL IFGT #WTSFC :
001 C Z-ADD#WTSFC CONTRL :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @MORKY BEGSR :MORE KEYS
C*----------------------------------------------------*
C MOVE *BLANK V1CMD :
|
C* :
B001 C CMDCTL IFEQ 1 :
001 C Z-ADD2 CMDCTL :
B002 C KEYACP IFEQ #YES :
002 C MOVEL#CMD03 V1CMD :
+002 C ELSE :
002 C MOVEL#CMD02 V1CMD :
E002 C END :
+001 C ELSE :
B002 C CMDCTL IFEQ 2 :
B003 C PIMODE IFEQ #CHGMD :
003 C Z-ADD3 CMDCTL :
003 C MOVEL#CMD04 V1CMD :
+003 C ELSE :
003 C Z-ADD1 CMDCTL :
|
003 C MOVEL#CMD01 V1CMD :
E003 C END :
+002 C ELSE :
B003 C CMDCTL IFEQ 3 :
003 C Z-ADD1 CMDCTL :
003 C MOVEL#CMD01 V1CMD :
E003 C END :
E002 C END :
E001 C END :
C* :
C WRITECMD01 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RLDWN BEGSR :ROLL DOWN
|
C*----------------------------------------------------*
B001 C KEYACP IFEQ #YES :
B002 C 1 DO ROLNBR :
002 C READPKEYF 95:INDEXED FILE
E002 C N95 END :
+001 C ELSE :
B002 C PIQRYF IFEQ #YES :
B003 C 1 DO ROLNBR :
003 C READPQRYF 95:
E003 C N95 END :
+002 C ELSE :
B003 C 1 DO ROLNBR :
003 C READPARVF 95:
E003 C N95 END :
E002 C END :
|
E001 C END :
C* :
B001 C *IN95 IFEQ *ON :
001 C Z-ADD1 V1RRN# :
001 C MOVE *LOVAL H1KYVL :
B002 C KEYACP CASEQ#YES @STKEY ;
+002 C PIQRYF CASEQ#NO @STARV ;
+002 C CAS @STQRY ;
E002 C END :
B002 C V1MSG IFEQ *BLANK :
002 C MOVEL#BOFMG V1MSG :
E002 C END :
E001 C END :
C* :
B001 C CONTRL IFGT #BDSFL :
|
001 C Z-ADD#BDSFL CONTRL :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHK2 BEGSR : ｣ｶ｣ｰ｣ｿ｣ﾙｦDｦﾇ
C*----------------------------------------------------*
C* SET V1COLM :
B001 C V1COLM IFLT 1 :
001 C Z-ADD1 V1COLM :
+001 C ELSE :
B002 C V1COLM IFGT W1RLEN :
002 C Z-ADDW1RLEN V1COLM :
E002 C END :
E001 C END :
|
C* SET M1COLM :
C Z-ADD0 M1COLM :DISPLAY COLM.
C V1COLM ADD H1COLM M1COLM :
C SUB #DFTCM M1COLM :
B001 C M1COLM IFGT W1RLEN :
001 C M1COLM SUB W1RLEN ADJUST 30 :
001 C SUB ADJUST H1COLM :
001 C Z-ADDW1RLEN M1COLM :
E001 C END :
C* RETURN POINT :
B001 C V1RRN# IFNE W1RRN# :
*001 C KEYACP ANDEQ#NO :
*001 C *IN85 OREQ *ON :
001 C Z-ADDV1RRN# W1RRN# :
001 C Z-ADD#SETLL CONTRL : ｨ
|
001 C MOVE #NO MDSUSE 1 :
E001 C END :
C* :
B001 C *IN82 IFEQ *ON :MDT OF CTL01,02 ON
*001 C V1COLM ORNE W1COLM :
001 C Z-ADDV1COLM W1COLM :
001 C EXSR @HDR :
B002 C CONTRL IFGT #BDSFL :
B003 C W1CHG IFEQ #NO :
003 C MOVE #YES MDSUSE :
E003 C END :
002 C Z-ADD#BDSFL CONTRL :
E002 C END :
E001 C END :
C* :
|
B001 C CHRHEX CASNEWCHRHX @REPOS :
E001 C END :
C* :
B001 C *IN85 IFEQ *ON :
B002 C CHRHEX IFEQ #HEX :
B003 C V1KYVL IFEQ *BLANK :
003 C MOVE *ZERO V1KYVL :
003 C MOVE *LOVAL H1KYVL :
+003 C ELSE :
003 C EXSR @REDKY :
E003 C END :
+002 C ELSE :
B003 C V1KYVL IFEQ *BLANK :
003 C MOVE *LOVAL H1KYVL :
+003 C ELSE :
|
003 C MOVELV1KYVL H1KYVL :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CLOSE BEGSR :
C*----------------------------------------------------*
C* CLEAR KEISEN :
B001 C KEIMOD IFEQ #WTKSN :
001 C WRITECLRKSN :
E001 C END :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @RVAPI BEGSR :RTV DATA BY API
C*----------------------------------------------------*
C SUB 1 APIPNT :
C APIPNT MULT LSTSIZ STRPOS :
C ADD OFFSET STRPOS :
C ADD 1 STRPOS :
C CALL #PGRTV PRTV02 :
C ADD 1 APIPNT :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TOSFL BEGSR : ｣ｻ｣J｣ﾌ｣ｧ｣ｲ｣ﾙ､ﾍ
C*----------------------------------------------------*
C* CLEAR WORK FILED :
|
C MOVE #NO CK0E0F 1 :
C Z-ADD0 IGCCNT 10 :
C* CLEAR FILED OF DISPLAY :
C MOVE *BLANK S1DTA :
C MOVE *BLANK S1HEX1 :
C MOVE *BLANK S1HEX2 :
C Z-ADD0 H1AD0E :
C Z-ADD0 H1AD0F :
C* SET START-POINT :
B001 C SLN IFEQ 1 :
B002 C KEYACP IFEQ #YES :
002 C EXSR @WRTKY :
+002 C ELSE :
002 C Z-ADDS1RRN V1RRN# :
002 C Z-ADDV1RRN# W1RRN# 70 :
|
E002 C END :
E001 C END :
C* :
B001 C S1RRN IFNE 0 :
001 C Z-ADDS1RRN RN,SLN :
E001 C END :
C* :
C Z-ADD1 CLM :
C* :
C* SET DATA FROM START COLUMN TO LAST COLUMN :
C* :
B001 C PIDBCS IFEQ #YES :
*001 C V1COLM ANDNESTRBUF :
001 C EXSR @PDBCS :
E001 C END :
|
C* :
B001 C V1COLM DO ENDCLM FIL 50 :
001 C ADD 1 CLM :
001 C* :
B002 C CHRHEX IFEQ #HEX :
002 C MOVE DT,FIL WRKBYT :
002 C EXSR @HXCHR :HEX -> CHAR
002 C MOVE HEXZNE XZ,CLM :
002 C MOVE HEXDGT XD,CLM :
E002 C END :
001 C* :
B002 C TP,CLM IFNE #PACK :
*002 C TP,CLM ANDNE#BIN :
002 C* :
B003 C TP,CLM IFEQ #ZONE :
|
B004 C DT,FIL IFGT X'40' :
004 C MOVE DT,FIL CH,CLM :
E004 C END :
+003 C ELSE :
003 C* :
B004 C PIDBCS CASEQ#YES @DBCS :
E004 C END :
003 C* :
B004 C CLM IFNE H1AD0E :
*004 C CLM ANDNEH1AD0F :
B005 C DT,FIL IFGT X'40' :
005 C MOVE DT,FIL CH,CLM :
+005 C ELSE :
B006 C PIDBCS IFEQ #YES :
*006 C DT,FIL ANDEQX'0E' :
|
*006 C PIDBCS OREQ #YES :
*006 C DT,FIL ANDEQX'0F' :
006 C MOVE DT,FIL CH,CLM :
E006 C END :
E005 C END :
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
B001 C CK0E0F IFEQ #YES :
B002 C IGCCNT IFEQ 0 :
002 C Z-ADDCLM H1AD0F :
002 C MOVE X'0F' CH,CLM :
+002 C ELSE :
|
002 C Z-ADDAJC H1AD0F :
002 C MOVE X'0F' CH,AJC :
002 C Z-ADD0 IGCCNT :
E002 C END :
E001 C END :
C* :
C ADD 1 CLM :
B001 C CLM IFLE AJC :
*001 C CLM ANDNEH1AD0E :
*001 C CLM ANDNEH1AD0F :
001 C MOVE X20 CH,CLM :
001 C MOVE X20 XZ,CLM :
001 C MOVE X20 XD,CLM :
E001 C END :
C* :
|
B001 C PIMODE IFEQ #CHGMD :
001 C MOVE *OFF *IN55 :
001 C MOVE *OFF *IN56 :
001 C MOVE ' ' S1CHGF :
B002 C ADDNOW IFEQ #YES :
002 C MOVE *ON *IN56 :
+002 C ELSE :
B003 C DLTNOW IFEQ #YES :
*003 C ARVRRN ANDNE0 :
*003 C DLTRRN ANDEQARVRRN :DSPATR(BL)
003 C MOVE *ON *IN55 :
003 C MOVE '>' S1CHGF :
E003 C END :
E002 C END :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @WTSFL BEGSR : ｣ｻ｣J｣ﾌ｣ｧ｣ｲ｣ﾙｧﾊ･
|
C*----------------------------------------------------*
C MOVE *BLANK DSDTA :
C Z-ADD0 FIL :
C* :
B001 C 1 DO MAXFLD APIPNT :
001 C* :
001 C EXSR @RVAPI :RTV DATA BY API
B002 C DTATYP IFEQ #ZONE :
002 C MOVE '0' INZBYT 1 :
+002 C ELSE :
B003 C DTATYP IFEQ #PACK :
*003 C DTATYP OREQ #BIN :
003 C MOVE X'00' INZBYT :
+003 C ELSE :
003 C MOVE X'40' INZBYT :
|
E003 C END :
E002 C END :
001 C* :
B002 C 1 DO BYTLEN :
002 C ADD 1 FIL :
002 C FIL CABGT#ARMAX \INZDE :
002 C MOVE INZBYT DT,FIL :
E002 C END :
001 C* :
B002 C DTATYP IFEQ #PACK :
002 C MOVE X'0F' DT,FIL :
E002 C END :
001 C* :
E001 C END :
C* :
|
C \INZDE ENDSR :
C*----------------------------------------------------*
C @WRTLN BEGSR : ｩJ･ﾌ･
|
C*----------------------------------------------------*
C @ZSUPR BEGSR :ZERO-SUPRSS
C*----------------------------------------------------*
B001 C WK,1 IFEQ '0' :
001 C Z-ADD0 ZLN 10 :
001 C MOVE *OFF *IN70 :
B002 C 1 DO ZROCNT ZCT :
B003 C *IN70 IFEQ *OFF :
*003 C WK,ZCT ANDNE'0' :
003 C MOVE *ON *IN70 :
E003 C END :
B003 C *IN70 IFEQ *ON :
003 C ADD 1 ZLN :
003 C MOVE WK,ZCT WK,ZLN :
E003 C END :
|
002 C MOVE #NO WK,ZCT :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @WRT BEGSR : ｩJ･ﾌｨW･
|
002 C READCSFL02 91:FOR HEX
E002 C END :
001 C* :
B002 C *IN91 IFEQ *OFF :
002 C* :
002 C Z-ADDW1COLM STRCLM 70 :
B003 C CHRHEX CASEQ#CHR @TODBC : ｢D｢B､ﾍｧｫｧ､
+003 C CAS @TODBH : ｢D｢B､ﾍｧｫｧ､
E003 C END :
002 C* :
002 C EXCPT#ADD :
002 C ADD 1 PIACNT :
002 C MOVE #YES W1CHG 1 :
002 C* :
B003 C PIARCV IFEQ #YES :
|
003 C Z-ADDS1RRN RRNWRK :
003 C MOVE #ADDFG ARCTYP 1 :
003 C EXSR @ARCVS : ｣ﾛ｣Bｧﾊ･
|
001 C MOVE *BLANK V1MSG :
001 C MOVEL#ADDM1 V1MSG :
001 C MOVE #NO ADDNOW :
001 C MOVEL#CHGNM V1MODE :
001 C MOVE *ON *IN52 :
+001 C ELSE :
001 C MOVE #NO W1CHG 1 :
001 C MOVE *BLANK V1MSG :
001 C MOVE *BLANK DSWRK :
001 C MOVE PIACNT DSWRK :
001 C Z-ADD5 ZROCNT :
001 C EXSR @ZSUPR :ZERO-SUPPRESS
001 C #ADDED CAT DSWRK:1 V1MSG :
001 C V1MSG CAT #MSGEN:1 V1MSG :
001 C EXSR @RTVMB :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHG BEGSR :
C*----------------------------------------------------*
C MOVE *OFF *IN91 :
C* :
B001 C *IN91 DOUEQ*ON :
*001 C DTAERR OREQ #YES :
001 C* :
B002 C CHRHEX IFEQ #CHR :
002 C READCSFL01 91:FOR CHAR
+002 C ELSE :
002 C READCSFL02 91:FOR HEX
|
E002 C END :
001 C* :
B002 C *IN91 IFEQ *OFF :
002 C* :
002 C S1RRN CHAINUPDF 92 :
B003 C *IN92 IFEQ *ON :
003 C MOVELS1RRN RRNCHR 7 :
003 C MOVE *BLANK V1MSG :
003 C RRNCHR CAT #CHNMG:1 V1MSG :
+003 C ELSE :
003 C* :
B004 C PIARCV IFEQ #YES :
004 C Z-ADDS1RRN RRNWRK 70 :
004 C MOVE #BFRFG ARCTYP :
004 C EXSR @ARCVS : ｣ﾛ｣Bｧﾊ･
|
E004 C END :
003 C* :
B004 C PIADTC IFEQ #YES :
004 C Z-ADDS1RRN RRNWRK :
004 C MOVE #BFRFG ARCTYP :
004 C EXSR @AUDIT : ｣ﾛ｣Bｧﾊ･
|
B005 C DFFRNT IFEQ #NO :
005 C EXCPT##DMY :
+005 C ELSE :
005 C EXCPT#CHG :
005 C MOVE #YES W1CHG :
005 C ADD 1 PICCNT :
005 C* :
B006 C PIARCV IFEQ #YES :
006 C Z-ADDS1RRN RRNWRK :
006 C MOVE #CHGFG ARCTYP :
006 C EXSR @ARCVS : ｣ﾛ｣Bｧﾊ･
|
006 C MOVE #CHGFG ARCTYP :
006 C EXSR @AUDIT : ｣ﾛ｣Bｧﾊ･
|
001 C* :
B002 C W1CHG IFEQ #YES :
B003 C ROLUP IFNE PUSHED :
*003 C ROLDWN ANDNEPUSHED :
003 C EXSR @REPOS :
E003 C END :
002 C MOVE *BLANK V1MSG :
002 C MOVE *BLANK DSWRK :
002 C MOVE PICCNT DSWRK :
002 C Z-ADD5 ZROCNT :
002 C EXSR @ZSUPR :ZERO-SUPPRESS
002 C #CHGED CAT DSWRK:1 V1MSG :
002 C V1MSG CAT #MSGEN:1 V1MSG :
E002 C END :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @DLT BEGSR :
C*----------------------------------------------------*
C MOVELDLTRRN RRNCHR :
C DLTRRN CHAINUPDF 91 :
C* :
B001 C *IN91 IFEQ *ON :
001 C MOVE *BLANK V1MSG :
001 C RRNCHR CAT #CHNMG:1 V1MSG :
001 C MOVEL#CHGNM V1MODE :
+001 C ELSE :
001 C* :
001 C EXCPT#DLT :
|
001 C ADD 1 PIDCNT :
001 C* :
B002 C PIARCV IFEQ #YES :
002 C Z-ADDDLTRRN RRNWRK :
002 C MOVE #DLTFG ARCTYP :
002 C EXSR @ARCVS : ｣ﾛ｣Bｧﾊ･
|
C MOVE *BLANK V1MSG :
C MOVE *BLANK DSWRK :
C MOVE PIDCNT DSWRK :
C Z-ADD5 ZROCNT :
C EXSR @ZSUPR :ZERO-SUPPRESS
C MOVEL'RRN' V1MSG :
C V1MSG CAT RRNCHR:1 V1MSG :
C V1MSG CAT #DLTED:1 V1MSG :
C V1MSG CAT DSWRK:1 V1MSG :
C V1MSG CAT #MSGEN:1 V1MSG :
C* :
C EXSR @RTVMB :
C EXSR @REPOS :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @TODBC BEGSR : ｢D｢B､ﾍｧｫｧ､
C*----------------------------------------------------*
C Z-ADD1 CLM :
C MOVE #NO DFFRNT 1 :
C* :
B001 C STRCLM DO ENDCLM FIL :
001 C ADD 1 CLM :
B002 C TP,CLM IFNE #PACK :
*002 C TP,CLM ANDNE#BIN :
*002 C CLM ANDNEH1AD0E :
*002 C CLM ANDNEH1AD0F :
002 C* :
B003 C CH,CLM IFNE DT,FIL :
003 C MOVE CH,CLM WRKBYT :
|
B004 C PIVLDT IFEQ #YES :
B005 C TP,CLM CASEQ#ZONE @ZNVLD :
+005 C CAS @CHVLD :
E005 C END :
E004 C END :
B004 C DTAERR IFEQ #NO :
004 C MOVE WRKBYT DT,FIL :
004 C MOVE #YES DFFRNT :
E004 C END :
E003 C END :
002 C* :
B003 C DTAERR IFEQ #YES :
B004 C RRNERR IFEQ *BLANK :
004 C MOVE S1RRN RRNERR :
004 C MOVE FIL CLMERR :
|
E004 C END :
003 C Z-ADDENDCLM FIL :
E003 C END :
002 C* :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @TODBH BEGSR : ｢D｢B､ﾍｧｫｧ､
C*----------------------------------------------------*
C Z-ADD1 CLM :
C MOVE #NO DFFRNT :
C Z-ADD0 ENDPOS 50 :
C* :
|
B001 C STRCLM DO ENDCLM FIL :
001 C ADD 1 CLM :
B002 C CLM IFNE H1AD0E :
*002 C CLM ANDNEH1AD0F :
002 C* :
002 C MOVE XZ,CLM HEXZNE :
002 C MOVE XD,CLM HEXDGT :
002 C EXSR @CHRHX :16 ｦ
|
E005 C END :
B005 C DTAERR IFEQ #NO :
005 C MOVE WRKBYT DT,FIL :
005 C MOVE #YES DFFRNT :
E005 C END :
E004 C END :
E003 C END :
E002 C END :
001 C* :
B002 C DTAERR IFEQ #YES :
B003 C RRNERR IFEQ *BLANK :
003 C MOVE S1RRN RRNERR :
003 C MOVE FIL CLMERR :
E003 C END :
002 C Z-ADDENDCLM FIL :
|
E002 C END :
001 C* :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PDBCS BEGSR :
C*----------------------------------------------------*
C V1COLM SUB 1 BEFORE 50 :
C* :
B001 C STRBUF DO BEFORE FIL :
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 :
B002 C CK0E0F IFEQ #YES :
002 C ADD 5 IGCCNT :
E002 C END :
E001 C END :
C* :
B001 C CK0E0F IFEQ #YES :
B002 C IGCCNT IFEQ 0 :
002 C Z-ADD2 H1AD0E :
002 C MOVE X'0E' CH,2 :
+002 C ELSE :
002 C Z-ADD1 H1AD0E :
|
002 C Z-ADD5 IGCCNT :
002 C MOVE X'0E' CH,1 :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DBCS BEGSR :CHECK 0E-0F
C*----------------------------------------------------*
C* :
B001 C DT,FIL IFEQ X'0E' :
001 C MOVE #YES CK0E0F :
+001 C ELSE :
B002 C DT,FIL IFEQ X'0F' :
002 C MOVE #NO CK0E0F :
|
002 C Z-ADD0 IGCCNT :
E002 C END :
E001 C END :
C* :
B001 C CK0E0F IFEQ #YES :
001 C ADD 5 IGCCNT :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @WRTKY BEGSR :
C*----------------------------------------------------*
C* X'40' --> CONVERT --> '4'+'0' :
C* :
C MOVELDSKYVL V1KYVL :
|
C MOVELDSKYVL H1KYVL :
C* :
C DSKEYL ADD 1 CNT :
B001 C CNT IFGT #KCMAX :
001 C Z-ADD#KCMAX KEYLEN :
+001 C ELSE :
001 C MOVEA*LOVAL KV,CNT :
001 C CNT SUB 1 KEYLEN 30 :
E001 C END :
C* :
B001 C CHRHEX IFEQ #HEX :
B002 C KEYLEN IFGT #KHMAX :
002 C Z-ADD#KHMAX KEYLEN :
E002 C END :
001 C Z-ADD0 HEX 30 :
|
001 C MOVE *BLANK DSHXVL :
B002 C 1 DO KEYLEN WRK :
002 C MOVE KV,WRK WRKBYT :
002 C EXSR @HXCHR :HEX -> DECIMAL
002 C ADD 1 HEX :
002 C MOVE HEXDEC HV,HEX :
E002 C END :
001 C MOVE *BLANK V1KYVL :
001 C MOVELDSHXVL V1KYVL :
+001 C ELSE :
B002 C 1 DO KEYLEN WRK :
B003 C KV,WRK IFLT X'40' :
003 C MOVE X'40' KV,WRK :DISPLYABLE DATA
E003 C END :
E002 C END :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @REDKY BEGSR :
C*----------------------------------------------------*
C* '4'+'0' --> CONVERT --> X'40' :
C* :
C MOVELV1KYVL DSHXVL :
C Z-ADDDSKEYL KEYLEN :
B001 C KEYLEN IFGT #KHMAX :
001 C Z-ADD#KHMAX KEYLEN :
E001 C END :
C* :
B001 C 1 DO KEYLEN WRK :
|
001 C MOVE HV,WRK HEXDEC :
001 C EXSR @CHRHX :HEX -> DECIMAL
001 C MOVE WRKBYT KV,WRK :TO KEY VALUES
E001 C END :
C* :
C MOVE *LOVAL H1KYVL :TO KEY VALUES
C MOVELV1KYVL H1KYVL :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ZNVLD BEGSR :
C*----------------------------------------------------*
C TESTN WRKBYT 70 :
B001 C *IN70 IFEQ *OFF :
001 C MOVE #YES DTAERR :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @PKVLD BEGSR :
C*----------------------------------------------------*
B001 C HEXZNE IFLT '0' :
*001 C HEXZNE ORGT '9' :
001 C MOVE #YES DTAERR :
+001 C ELSE :
001 C* :
001 C SQ,CLM ADD 1 WRK :
B002 C WRK IFGT #ELMAX :
002 C Z-ADD#ELMAX WRK :
E002 C END :
|
B002 C SQ,CLM IFEQ MAXFLD :
002 C Z-ADDW1RLEN ENDPOS :
+002 C ELSE :
B003 C IB,WRK IFGT 1 :
003 C IB,WRK SUB 1 ENDPOS :
E003 C END :
E002 C END :
B002 C FIL IFNE ENDPOS :
B003 C HEXDGT IFLT '0' :
*003 C HEXDGT ORGT '9' :
003 C MOVE #YES DTAERR :
E003 C END :
+002 C ELSE :
002 C* :
B003 C HEXDGT IFNE 'F' :
|
*003 C HEXDGT ANDNE'D' :
*003 C HEXDGT ANDNE'C' :
003 C MOVE #YES DTAERR :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHVLD BEGSR :
C*----------------------------------------------------*
B001 C WRKBYT IFLT X'40' :
*001 C WRKBYT ANDNEX'0E' :
*001 C WRKBYT ANDNEX'0F' :
001 C MOVE #YES DTAERR :
|
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @DTAER BEGSR :
C*----------------------------------------------------*
C MOVE *BLANK V1MSG :
C #DTER1 CAT RRNERR:1 V1MSG :
C V1MSG CAT #COMMA:0 V1MSG :
C V1MSG CAT #DTER2:0 V1MSG :
C V1MSG CAT CLMERR:1 V1MSG :
C V1MSG CAT #PRIOD:0 V1MSG :
C* :
C MOVE *BLANK RRNERR 7 :
C MOVE *BLANK CLMERR 5 :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @ARCVS BEGSR : ｣ﾛ｣Bｧﾊ･
|
C*----------------------------------------------------*
C @AUDIT BEGSR : ｣ﾛ｣Bｧﾊ･
|
C ENDSR :
C*----------------------------------------------------*
C @SRCH BEGSR : ?ﾕｧ<4ｨ : B001 C SRHLMT IFEQ #YES : 001 C MOVE #NO SRHLMT : 001 C Z-ADD0 SEARCH +001 C ELSE : 001 C* B002 C WRAP IFEQ #YES : 002 C MOVE #NO WRAP : 002 C Z-ADD1 SRHRRN 70 : 002 C Z-ADD0 SEARCH : +002 C ELSE :
|
002 C EXSR @RVRRN :
B003 C RTVRRN IFLT 1 :
003 C Z-ADD1 RTVRRN :
E003 C END :
002 C* :
B003 C RTVRRN IFNE SRHRRN :
003 C MOVE #NO WRAP 1 :
003 C MOVE #NO SRHLMT 1
003 C Z-ADDRTVRRN SRHRRN 70 :
003 C Z-ADDV1SHST SRHPOS :
003 C Z-ADD0 SEARCH :
E003 C END :
E002 C END :
E001 C END :
C* :
|
B001 C SEARCH IFGT 0 :
001 C SEARCH ADD 1 SRHPOS :
E001 C END :
C* :
C SRHRRN SETLLARVF :
C* :
C Z-ADD0 W1SHMX 50 :
C MOVE *OFF *IN99 :
C* :
B001 C *IN99 DOUEQ*ON :
*001 C SRHLMT OREQ #YES :
*001 C WRAP OREQ #YES :
*001 C SEARCH ORGT 0 :
001 C* :
001 C READ ARVF 99:
|
001 C* ｦ
|
003 C Z-ADD#SETLL CONTRL :
+003 C ELSE :
003 C* :
003 C ADD 1 W1SHMX :
003 C Z-ADDARVRRN SRHRRN :
003 C* :
B004 C W1SHMX IFEQ 1 :
004 C MOVE ARVRRN W1RRNC :
E004 C END :
B004 C STSDSP IFEQ #NO :
*004 C W1SHMX ANDEQ10 :
004 C EXSR @SHTMG :
E004 C END :
003 C W1SHMX MULT .002 W2EVEN 33 :
B004 C W2EVEN IFEQ 0 :
|
004 C EXSR @LNGMG :
E004 C END :
003 C* :
B004 C W1RLEN IFLE 999 :
*004 C SG,1 ANDNE'*' :
004 C EXSR @FIND1 :
+004 C ELSE :
004 C EXSR @FIND2 :
E004 C END :
B004 C SEARCH IFLE 0 :
004 C Z-ADD0 SEARCH 50 :
004 C Z-ADDV1SHST SRHPOS 50 :
+004 C ELSE :
004 C EXSR @FOUND :
E004 C END :
|
E003 C END :
E002 C END :
E001 C END :
C* :
B001 C STSDSP IFEQ #YES :
001 C CALL #PGSTS 93 :
001 C PARM *BLANK STSMSG :
001 C MOVE #NO STSDSP :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @FIND1 BEGSR :
C*----------------------------------------------------*
C CALL #PGSCN :
|
C PARM DT :
C PARM V1SHEN DTALEN 30 :
C PARM SRHPOS SCNPOS 30 :
C PARM V1STRG :
C PARM SRGLEN PATLEN 30 :
C PARM *OFF TRNSLT 1 :
C PARM *OFF TRIM 1 :
C PARM '*' WILD 1 :
C PARM SCNRLT 30 :
C* :
B001 C SCNRLT IFLE V1SHEN :
001 C Z-ADDSCNRLT SEARCH :
+001 C ELSE :
001 C Z-SUB1 SEARCH :
E001 C END :
|
C* :
C ENDSR :
C*----------------------------------------------------*
C @FIND2 BEGSR :
C*----------------------------------------------------*
C Z-ADD0 STG 50 :
C Z-ADD0 FSTPOS 50 :
C Z-SUB1 SEARCH :
C* :
B001 C SRHPOS DO V1SHEN SCH 50 :
001 C ADD 1 STG :
B002 C SG,STG IFNE DT,SCH :
002 C Z-ADD0 STG :
002 C Z-ADD0 FSTPOS :
+002 C ELSE :
|
B003 C FSTPOS IFEQ 0 :
003 C Z-ADDSCH FSTPOS :
E003 C END :
E002 C END :
B002 C STG IFEQ SRGLEN :
002 C Z-ADDFSTPOS SEARCH :
002 C GOTO \FNDEN :
+002 C ELSE :
B003 C SCH IFGT LSTPOS :
003 C GOTO \FNDEN :
E003 C END :
E002 C END :
E001 C END :
C* :
C \FNDEN ENDSR :
|
C*----------------------------------------------------*
C @FOUND BEGSR :
C*----------------------------------------------------*
C* ･ﾏ :
C Z-ADD1 LIN 50 :
C MOVE *OFF *IN70 :
C ARVRRN LOKUPRN,LIN 70:
B001 C *IN70 IFEQ *ON :
B002 C CHRHEX IFEQ #CHR :
002 C LIN ADD 5 H1LINE :
+002 C ELSE :
002 C LIN MULT 3 H1LINE :
002 C ADD 3 H1LINE :
E002 C END :
+001 C ELSE :
|
001 C Z-ADDARVRRN V1RRN# :
001 C Z-ADD#DFTLN H1LINE : ｦ{ｨｬ･ﾏ
E001 C END :
C* &O :
B001 C SEARCH IFLT V1COLM :
*001 C SEARCH ORGT ENDCLM :
001 C SEARCH SUB 3 V1COLM :
001 C* :
B002 C V1COLM IFLT 1 :
002 C Z-ADD1 V1COLM :
E002 C END :
001 C* :
001 C EXSR @HDR :
B002 C CONTRL IFGT #BDSFL :
B003 C W1CHG IFEQ #NO :
|
003 C MOVE #YES MDSUSE :
003 C Z-ADD#BDSFL CONTRL : ｨ
|
C MOVE *BLANK V1MSG :
C 'STRING' CAT V1STRG:1 V1MSG :
C V1MSG CAT #FOUND:1 V1MSG :
C V1MSG CAT W1RRNC:0 V1MSG :
C V1MSG CAT #COMMA:0 V1MSG :
C V1MSG CAT W1COLC:0 V1MSG :
C V1MSG CAT ').':0 V1MSG :
C* :
C ENDSR :
C*----------------------------------------------------*
C @SHTMG BEGSR :
C*----------------------------------------------------*
C MOVE #YES STSDSP :
C* :
C MOVE *BLANK STSMSG :
|
C 'STRING' CAT V1STRG:1 STSMSG :
C STSMSG CAT #SHING:1 STSMSG :
C STSMSG CAT 'FROM':1 STSMSG :
C STSMSG CAT W1RRNC:1 STSMSG :
C STSMSG CAT '...':1 STSMSG :
C CALL #PGSTS 93 :
C PARM STSMSG :
C* :
C ENDSR :
C*----------------------------------------------------*
C @LNGMG BEGSR :
C*----------------------------------------------------*
C MOVE #YES STSDSP 1 :
C* :
C MOVE *BLANK STSMSG256 :
|
C MOVE W1SHMX COUNT 5 :
C MOVELSRHRRN STSMSG :
C STSMSG CAT #SERCH:1 STSMSG :
C STSMSG CAT COUNT:1 STSMSG :
C STSMSG CAT '...':1 STSMSG :
C CALL #PGSTS 93 :
C PARM STSMSG :
C* :
C ENDSR :
C*----------------------------------------------------*
C @RVRRN BEGSR :
C*----------------------------------------------------*
C Z-ADD0 RTVRRN 70 :
C EXSR @GTRRN :
C* :
|
B001 C RRN01 IFGT 0 :
*001 C RRN01 ANDLELSTLIN :
B002 C CHRHEX IFEQ #CHR :
002 C RRN01 CHAINSFL01 90 :FOR CHAR
+002 C ELSE :
002 C RRN01 CHAINSFL02 90 :FOR HEX
E002 C END :
B002 C *IN90 IFEQ *OFF :
*002 C S1RRN ANDNE0 :"ADD" LINE
002 C Z-ADDS1RRN RTVRRN :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
|
C @GTRRN BEGSR :
C*----------------------------------------------------*
C Z-ADD0 RRN01 :
C* :
B001 C H1LINE IFGE #DFTLN :
*001 C H1LINE ANDLEWMAXLN :
001 C H1LINE SUB #DFTLN RRN01 : ｦ{ｨｬ･ﾏ
001 C ADD 1 RRN01 : ｦ{ｨｬ･ﾏ
B002 C CHRHEX IFEQ #HEX :
002 C ADD 2 RRN01 :
002 C MULT .34 RRN01 :
E002 C END :
E001 C END :
C* :
C ENDSR :
|
C*----------------------------------------------------*
C @FDLST BEGSR :FIELD MAP
C*----------------------------------------------------*
C MOVE #NO FLDRQS :
C MOVE *BLANK OP :
C Z-ADD0 AP :
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 AP,1 IFNE 0 :
001 C MOVE #YES RTNCSR :
001 C Z-ADD#SETLL CONTRL :
001 C Z-ADDAP,1 APIPNT :
001 C EXSR @RVAPI :RTV DATA BY API
B002 C OP,1 IFEQ 'S' :
002 C Z-ADDINPBUF V1COLM :
002 C Z-ADDINPBUF V1SHST :
002 C INPBUF ADD BYTLEN V1SHEN :
002 C SUB 1 V1SHEN :
+002 C ELSE :
B003 C OP,1 IFEQ '1' :
003 C Z-ADDINPBUF V1COLM :
E003 C END :
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 WRITECMD01 :
C* :
B001 C CONTRL IFGT #WTSFC :
|
001 C Z-ADD#WTSFC 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 @HXCHR BEGSR :DECIMAL -> HEX
C*----------------------------------------------------*
B001 C WRKBYT IFEQ X'40' :
001 C MOVE '40' HEXDEC :
+001 C ELSE :
001 C* :
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'
+004 C ELSE :
004 C MOVE #YES DTAERR :
|
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'
+004 C ELSE :
004 C MOVE #YES DTAERR :
E004 C END :
E003 C END :
E002 C END :
E001 C END :
C* :
C ENDSR :
C*----------------------------------------------------*
C @CHRHX BEGSR :HEX-->DECIMAL
C*----------------------------------------------------*
B001 C HEXDEC IFEQ '40' :
001 C MOVE X'40' WRKBYT :
|
+001 C ELSE :
001 C* :
B002 C HEXZNE IFEQ 'F' :
*002 C HEXDGT ANDGE'0' :
*002 C HEXDGT ANDLE'9' :
002 C MOVE HEXDGT WRKBYT :
+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'
+004 C ELSE :
004 C MOVE #YES DTAERR :
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'
+004 C ELSE :
004 C MOVE #YES DTAERR :
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 DUMP :
001 C MOVE *ON *INH1 :
001 C RETRN :
+001 C ELSE :
001 C MOVE *ON SWP 1 :
E001 C END :
C* :
C ENDSR'*DETC' :
C*----------------------------------------------------*
C @EXERR BEGSR :EXCPTION ERROR
C*----------------------------------------------------*
B001 C W1CANL IFEQ #YES :
001 C MOVEL'*CANCL' RETURN :
|
+001 C ELSE :
001 C MOVE #YES W1CANL :
001 C MOVEL'*DETC' RETURN 6 :
B002 C ZZCPF IFNE *BLANK :
002 C MOVE *BLANK V1MSG :
002 C MOVELZZCPF V1MSG :
+002 C ELSE :
002 C MOVE *BLANK V1MSG :
002 C MOVELSTATUS V1MSG :
002 C MOVE *OFF *IN70 :
002 C STATUS LOKUPTABEID TABERR 70:
B003 C *IN70 IFEQ *ON :
003 C V1MSG CAT TABERR:1 V1MSG :
E003 C END :
E002 C END :
|
B002 C PIARCV IFEQ #YES :
002 C MOVE #ERRFG ARCTYP :
002 C EXSR @ARCVS : ｣ﾛ｣Bｧﾊ･
|
O* O U T P U T M O D U L E *
O******************************************************
OUPDF E ##DMY
O EADD #ADD
O DT
O E #CHG
O DT
O EDEL #DLT
O*
OARCFILE EADD #ARC
O RRNWRK
O TIMES
O ARCTYP
O ':'
O DT
|
**
....+....*
** ....+....1....+....2....+....3....+....4....+....5
00012CHAIN OPERATION FOUNDED IN NO-RECORD-FOUND.(FSTS)
01011UNDEFINED RECORD TYPE.(FSTS)
01021DUPLICATE INDEX VALUE.(FSTS)
01218UNABLE TO ALLOCATE RECORD.(FSTS)
**
A10B11C12D13E14F15
|
