× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



     
Attached, in simple text format, is source for creating a command called 
DSPUSRIDX.  There is code in DSPUSIDX of the cmdsrc that applies to functions 
that are not implemented in the underlying RPG, but can easily be added - 
functions such as controlling whether output is a dspf or splf, whether data 
values are in hex.

The basic are there - supply the user index name, library, key length, record 
length & max nu ber of entries to see, and the data appears on screen.

jw

______________________________ Reply Separator _________________________________
Subject: User Index
Author:  "Mike Smith" <msmith@unitycom.com> at Internet
Date:    01/29/2001 8:45 AM


I am interested in find a display utility for user index objects.  Has anyone 
any knowledge about this topic.
     
Thanks
     
Michael 
     
     
     
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META content="text/html; charset=iso-8859-1" http-equiv=Content-Type>
<META content="MSHTML 5.00.2614.3500" name=GENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=#ffffff>
<DIV><FONT face=Arial size=2>I am interested in find a display utility for user 
index objects.&nbsp; Has anyone any knowledge about this 
topic.<BR><BR>Thanks<BR><BR>Michael <BR><BR></FONT></DIV></BODY></HTML>
             CMD        PROMPT('Display User Index')

             PARM       KWD(USRIDX) TYPE(QUAL) MIN(1) +
                          PROMPT('User index')

             PARM       KWD(KEYLEN) TYPE(*CHAR) LEN(5) PROMPT('Key +
                          length')

             PARM       KWD(RECLEN) TYPE(*CHAR) LEN(5) +
                          PROMPT('Record length')

             PARM       KWD(MAXENT) TYPE(*DEC) LEN(5) DFT(9999) +
                          PROMPT('Maximum number of entries')

/*           PARM       KWD(OUTPUT) TYPE(*CHAR) LEN(6) RSTD(*YES) + */
/*                        DFT(*) VALUES(* *PRINT) PROMPT('Output')  */

/*           PARM       KWD(OUTFMT) TYPE(*CHAR) LEN(5) RSTD(*YES) + */
/*                        DFT(*CHAR) VALUES(*CHAR *HEX) +           */
/*                        PMTCTL(PMTCTL1) PROMPT('Output format')   */

/*           PARM       KWD(SPACEB) TYPE(*CHAR) LEN(4) RSTD(*YES) + */
/*                        DFT(*NO) VALUES(*NO *YES) +               */
/*                        PMTCTL(PMTCTL2) PROMPT('Space before')    */


/*...................................................................*/
/*    Prompt Controls                                                */
/*...................................................................*/

/*  PMTCTL1:    PMTCTL     CTL(OUTPUT) COND((*EQ *PRINT))  */

/*  PMTCTL2:    PMTCTL     CTL(OUTPUT) COND((*EQ *PRINT))  */


/*...................................................................*/
/*    Qualifiers                                                     */
/*...................................................................*/

 QUAL:       QUAL       TYPE(*NAME) LEN(10)

             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
                          SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
     A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT
     A                                      CA03
     A
     A*.........................................................................
     A
     A          R V60UIDXS                  SFL
     A
     A            $$SEQN         4Y 0O  6  2EDTCDE(Z)
     A            $$VALU        70A  O  6  8
     A
     A*.........................................................................
     A
     A          R V60UIDXC                  SFLCTL(V60UIDXS)
     A
     A                                      SFLSIZ(32)
     A                                      SFLPAG(16)
     A  34                                  CF10
     A                                      CF19
     A                                      CF20
     A  32                                  CF22
     A                                      BLINK
     A                                      OVERLAY
     A  20                                  SFLDSP
     A  21                                  SFLDSPCTL
     A  22                                  SFLCLR
     A  23                                  SFLEND(*MORE)
     A N23                                  PAGEDOWN(24 'PAGEDOWN')
     A            $$SRN          4S 0H      SFLRCDNBR
     A            $$SCID        10A  O  1  2
     A                                  1 30'Display User Index'
     A                                      DSPATR(HI)
     A                                  1 56'Columns . . .'
     A            $$COLS        11   O  1 70
     A                                  3  2'User Index . . . .'
     A            $$UIDX        10A  O  3 22
     A                                  3 41'Key length . . . . . .'
     A            $$KLEN         5Y 0O  3 65EDTCDE(Z)
     A                                  4  4'Library  . . . .'
     A            $$LIB         10A  O  4 24
     A                                  4 41'Record length  . . . .'
     A            $$RLEN         5Y 0O  4 65EDTCDE(Z)
     A                                  5  2'Seq.'
     A                                      DSPATR(HI)
     A            $$RUL         70A  O  5  8DSPATR(HI)
     A
     A*.........................................................................
     A
     A          R V60UIDXF
     A                                      OVERLAY
     A                                 23  2'F3=Exit'
     A                                      COLOR(BLU)
     A  34N35                          23 12'F10=Display hexadecimal'
     A                                      COLOR(BLU)
     A  34 35                          23 12'F10=Display character  '
     A                                      COLOR(BLU)
     A                                 23 38'F19=Left'
     A                                      COLOR(BLU)
     A                                 23 49'F20=Right'
     A                                      COLOR(BLU)
     A  32N33                          23 61'F22=Width 132'
     A                                      COLOR(BLU)
     A
     A*.........................................................................
     A
     A          R V60UIDXN
     A                                      OVERLAY
     A                                  8  4'(No data to display)'
     A
     A                                      UNIQUE
     A
     A          R I60UIDX                   TEXT('User Index Details')
     A
     A            UINAM         10A         TEXT('User Index Name')
     A                                      COLHDG('User' 'Index')
     A
     A            UILIB         10A         TEXT('Library')
     A                                      COLHDG('Library')
     A
     A            UIRLEN         5S 0       TEXT('Record Length')
     A                                      COLHDG('Record' 'Length')
     A                                      EDTCDE(Z)
     A
     A            UIKLEN         5S 0       TEXT('Key Length')
     A                                      COLHDG('Key' 'Length')
     A                                      EDTCDE(Z)
     A
     A            UIUSER        10A         TEXT('User Profile')
     A                                      COLHDG('User' 'Profile')
     A
     A            UIDATE         6S 0       TEXT('Update Date')
     A                                      COLHDG('Update' 'Date')
     A                                      EDTWRD('   /   ')
     A
     A            UITIME         6S 0       TEXT('Update Time')
     A                                      COLHDG('Update' 'Time')
     A                                      EDTWRD('  :  :  ')
     A
     A          K UINAM
     A          K UILIB
     H/TITLE DISPLAY USER INDEX
     F********************************************************************
     F*          F I L E   S P E C I F I C A T I O N S
     F********************************************************************
     FV60UIDX CF  E                    WORKSTN
     F                                        $$SRN KSFILE V60UIDXS
     FT60UIDX UF  E           K        DISK                      A    UC
     F/EJECT
     E********************************************************************
     E*          A R R A Y   S P E C I F I C A T I O N S
     E********************************************************************
     E                    ALF         5  1               Alpha
     E                    NUM         5  1               Numeric
     E*
     E                    RUL      1024  1               Ruler
     E*
     E                    VALU       70  1               Character Value
     E                    HEX1       70  1               Hex Value 1
     E                    HEX2       70  1               Hex Value 2
     E*
     E                    MSG     1  10 75               Messages
     E                    EOD    80  80  1               End Of Data
     E                    HEX     1  16  1   BIN     4
     E/EJECT
     I********************************************************************
     I*          C O N S T A N T S
     I********************************************************************
     I/EJECT
     I********************************************************************
     I*          D A T A   S T R U C T U R E S
     I********************************************************************
     IRULER      IDS
     I                                        11024 RUL
     IUIDS       IDS
     I                                        1  20 UIQUAL
     I                                        1  10 UINAM
     I                                       11  20 UILIB
     I                                       21  30 UIATR
     I                                    B  31  340UISIZ
     I                                       35  35 UIVAL
     I                                       36  45 UIAUT
     I                                       46  95 UITXT
     I                                       96 105 UIRPL
     I                                    B 106 1090UIPTR
     I                                    B 110 1130UILEN
     I                                      114 114 UIFXLN
     I                                    B 115 1180UIKLEN
     I                                      119 119 UIKIND
     I                                      120 120 UIIMUP
     I                                      121 121 UIOPTM
     I                                      122 122 UIACTN
     I                                      123 124 UIRULE
     I                                      125 125 UISTS
     IERRDS      IDS
     I                                    B   1   40ERRDSZ
     I                                    B   5   80ERRDLN
     I                                        9  15 ERRID
     I                                       16  16 ERR016
     I                                       17 272 ERRDTA
     I           IDS
     I                                        1  20 PSQUAL
     I                                        1  10 PSNAM
     I                                       11  20 PSLIB
     IPSKEY      IDS
     I                                        1 256 PSKEY1
     I                                      257 512 PSKEY2
     I                                      513 768 PSKEY3
     I                                      7691024 PSKEY4
     ISVKEY      IDS
     I                                        1 256 SVKEY1
     I                                      257 512 SVKEY2
     I                                      513 768 SVKEY3
     I                                      7691024 SVKEY4
     IPSREC      IDS
     I                                        1 256 PSREC1
     I                                      257 512 PSREC2
     I                                      513 768 PSREC3
     I                                      7691024 PSREC4
     I           IDS
     I                                        1   8 D@IN
     I                                        1   8 D@IN18
     I                                        1   4 D@IN14
     I                                        5   8 D@IN58
     I           SDS
     I                                     *PROGRAM S@PGM
     I                                      244 253 S@JOB
     I                                      254 263 S@USER
     I                                      264 269 S@NBR
     I/EJECT
     C********************************************************************
     C*          M A I N L I N E
     C********************************************************************
     C*
     C*  Retrieve User Index Details
     C*
     C           P@ERR     IFEQ *OFF
     C           $$KLEN    IFEQ *ZEROS
     C           $$RLEN    OREQ *ZEROS
     C                     EXSR SR0000
     C                     ENDIF
     C                     ENDIF
     C*
     C*  Load and display subfile
     C*
     C           P@ERR     IFEQ *OFF
     C                     MOVE 'Y'       BUILD
     C                     EXSR SR2000
     C                     ENDIF
     C*
     C*  Update User Index Details
     C*
     C           P@ERR     IFEQ *OFF
     C           OPEN      ANDEQ'Y'
     C                     EXSR SR3000
     C                     ENDIF
     C*
     C*  Function Key used to exit
     C*
     C                     SELEC
     C           *INKC     WHEQ *ON
     C                     MOVE 'C'       P@EXIT
     C           *INKL     WHEQ *ON
     C                     MOVE 'L'       P@EXIT
     C           *INKW     WHEQ *ON
     C                     MOVE 'W'       P@EXIT
     C                     OTHER
     C                     MOVE *BLANK    P@EXIT
     C                     ENDSL
     C*
     C*  Set up error message for CPP
     C*
     C           P@ERR     IFEQ *ON
     C           E         ANDGE1
     C           E         ANDLE10
     C                     MOVELMSG,E     P@MSG
     C                     ENDIF
     C*
     C                     MOVE *ON       *INLR
     C                     RETRN
     C/EJECT
     C********************************************************************
     C*          U S E R   I N D E X   D E T A I L S
     C********************************************************************
     C*
     C           SR0000    BEGSR
     C*
     C                     OPEN T60UIDX                99
     C*
     C           *IN99     IFEQ *ON
     C                     MOVE *ON       P@ERR
     C                     Z-ADD4         E
     C                     ELSE
     C*
     C                     MOVE 'Y'       OPEN
     C                     MOVEL$$UIDX    UINAM
     C                     MOVEL$$LIB     UILIB
     C*
     C           @KIDX1    CHAINI60UIDX             N90
     C           *IN90     IFEQ *ON
     C           @KIDX2    CHAINI60UIDX             N90
     C                     ENDIF
     C*
     C           *IN90     IFEQ *OFF
     C                     Z-ADDUIKLEN    $$KLEN
     C                     Z-ADDUIRLEN    $$RLEN
     C                     ELSE
     C                     Z-ADD3         E
     C                     MOVE *ON       P@ERR
     C                     ENDIF
     C*
     C                     ENDIF
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          L O A D   S U B F I L E
     C********************************************************************
     C*
     C           SR1000    BEGSR
     C*
     C*  First time - set up "ruler"
     C*
     C           *IN02     IFEQ *OFF
     C                     EXSR SR1100
     C                     MOVE *ON       *IN02
     C                     ENDIF
     C*
     C*....................................................
     C*
     C*  Clear subfile
     C*
     C           BUILD     IFEQ 'Y'
     C                     MOVE *ON       *IN22
     C                     WRITEV60UIDXC
     C                     MOVE *OFF      *IN20
     C                     MOVE *OFF      *IN21
     C                     MOVE *OFF      *IN22
     C                     MOVE *OFF      *IN10
     C                     CLEARCOUNT
     C                     MOVE *OFF      EOF
     C                     MOVE *OFF      *IN23
     C                     MOVE *OFF      *IN79
     C                     CLEAR$$SRN
     C                     CLEAR$$SEQN
     C                     CLEAR$$VALU
     C                     CLEARRECS
     C                     CLEARV60UIDXS
     C                     ENDIF
     C*
     C                     Z-ADDSTRCOL    S
     C           WIDTH     SUBSTRULER:S   $$RUL     P
     C*
     C           EOF       IFEQ *OFF
     C*
     C                     MOVE *OFF      *IN99
     C                     CLEARCOUNT
     C*
     C                     EXSR SR9200
     C*
     C           *IN99     DOWEQ*OFF
     C*
     C                     ADD  1         RECS
     C                     ADD  1         COUNT
     C*
     C           WIDTH     SUBSTPSREC:S   ##VALU    P
     C                     CLEARVALU
     C                     CLEARHEX1
     C                     CLEARHEX2
     C           $$RLEN    SUB  STRCOL    ENDCOL
     C                     ADD  1         ENDCOL
     C*
     C           ##VALU    IFNE *BLANKS
     C                     MOVEA##VALU    VALU      P
     C                     DO   70        X
     C           ##MODE    IFEQ 'H'
     C           X         ANDLEENDCOL
     C                     EXSR SR9100
     C                     ENDIF
     C           VALU,X    IFLT *BLANK
     C           VALU,X    ORGT '9'
     C                     MOVE *BLANK    VALU,X
     C                     ENDIF
     C                     ENDDO
     C                     ENDIF
     C*
     C                     DO   SFLREC    SRN
     C*
     C                     SELEC
     C           SRN       WHEQ 1
     C                     Z-ADDRECS      $$SEQN
     C                     MOVEAVALU      $$VALU    P
     C           SRN       WHEQ 2
     C                     CLEAR$$SEQN
     C                     MOVEAHEX1      $$VALU    P
     C           SRN       WHEQ 3
     C                     CLEAR$$SEQN
     C                     MOVEAHEX2      $$VALU    P
     C           SRN       WHEQ 4
     C                     CLEAR$$SEQN
     C                     CLEAR$$VALU
     C                     ENDSL
     C*
     C                     ADD  1         $$SRN
     C                     WRITEV60UIDXS
     C*
     C                     ENDDO
     C*
     C           RECS      IFGE MAX
     C                     MOVE *ON       EOF
     C                     MOVE *ON       *IN23
     C                     LEAVE
     C                     ENDIF
     C*
     C           COUNT     IFEQ SFLPAG
     C                     LEAVE
     C                     ENDIF
     C*
     C                     EXSR SR9200
     C*
     C                     ENDDO
     C*
     C                     ENDIF
     C*
     C*....................................................
     C*
     C           $$SRN     IFNE *ZEROS
     C           EOF       ANDEQ*ON
     C           *IN79     ANDEQ*OFF
     C                     Z-ADD*ZEROS    $$SEQN
     C                     MOVEAEOD       $$VALU    P
     C                     ADD  1         $$SRN
     C                     WRITEV60UIDXS
*****C*****                Z-ADD1         $$SRN
     C                     MOVE *ON       *IN79
     C                     ENDIF
     C*
     C                     MOVE *ON       *IN01
     C                     MOVE 'N'       BUILD
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          R U L E R
     C********************************************************************
     C*
     C           SR1100    BEGSR
     C*
     C                     CLEARY
     C*
     C                     DO   120       X
     C*
     C                     ADD  1         Y
     C           Y         IFGT 9
     C                     Z-ADD*ZERO     Y
     C                     ENDIF
     C*
     C                     MOVE Y         DIGIT
     C           ' ...+...'CAT  DIGIT:1   CHAR10    P
     C           RULER     CAT  CHAR10:0  RULER     P
     C*
     C                     ENDDO
     C*
     C*
     C                     MOVEL'*'       RULER
     C*
     C           $$RLEN    IFLT 1024
     C           $$RLEN    ADD  1         STRCOL
     C           STRCOL    DO   1024      X
     C                     MOVE *BLANK    RUL,X
     C                     ENDDO
     C                     ENDIF
     C*
     C                     Z-ADD1         STRCOL
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          D I S P L A Y   S U B F I L E
     C********************************************************************
     C*
     C           SR2000    BEGSR
     C*
     C           *LIKE     DEFN *INKC     EXIT
     C                     MOVE *OFF      EXIT
     C*
     C           *INKC     DOWEQ*OFF
     C           EXIT      ANDEQ*OFF
     C*
     C           BUILD     IFEQ 'Y'
     C           *IN24     OREQ *ON
     C                     EXSR SR1000
     C                     ENDIF
     C*
     C           $$SRN     IFEQ *ZEROS
     C                     MOVE *OFF      *IN20
     C                     WRITEV60UIDXN
     C                     ELSE
     C                     MOVE *ON       *IN20
     C                     ENDIF
     C*
     C                     EXSR SR2300
     C*
     C                     MOVE *ON       *IN21
     C                     WRITEV60UIDXF
     C                     EXFMTV60UIDXC
     C*
     C           *INKJ     CASEQ*ON       SR2400
     C           *INKT     CASEQ*ON       SR2100
     C           *INKU     CASEQ*ON       SR2100
     C           *INKW     CASEQ*ON       SR2200
     C                     ENDCS
     C*
     C           EXIT      IFEQ *ON
     C                     LEAVE
     C                     ENDIF
     C*
     C                     ENDDO
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          W I N D O W
     C********************************************************************
     C*
     C           SR2100    BEGSR
     C*
     C*  F19=Left
     C*
     C           *INKT     IFEQ *ON
     C                     SUB  WIDTH     STRCOL
     C                     ENDIF
     C*
     C*  F20=Right
     C*
     C           *INKU     IFEQ *ON
     C                     ADD  WIDTH     STRCOL
     C                     ENDIF
     C*
     C           STRCOL    IFGT PSLEN
     C           PSLEN     SUB  WIDTH     STRCOL
     C                     ADD  1         STRCOL
     C                     ENDIF
     C*
     C           STRCOL    IFLT 1
     C                     Z-ADD1         STRCOL
     C                     ENDIF
     C*
     C                     MOVE 'Y'       BUILD
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          W I D T H   1 2 0   O R   7 0
     C********************************************************************
     C*
     C           SR2200    BEGSR
     C*
     C                     MOVE *ON       EXIT
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          C O L U M N S
     C********************************************************************
     C*
     C           SR2300    BEGSR
     C*
     C                     CLEAR$$COLS
     C*
     C                     Z-ADDSTRCOL    DEC50
     C                     EXSR SR2310
     C*
     C           ALF5      CAT  '-':1     $$COLS    P
     C*
     C           STRCOL    ADD  WIDTH     DEC50
     C                     SUB  1         DEC50
     C           DEC50     IFGT $$RLEN
     C                     Z-ADD$$RLEN    DEC50
     C                     ENDIF
     C*
     C                     EXSR SR2310
     C*
     C           $$COLS    CAT  ALF5:1    $$COLS    P
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          L E F T  -  A D J U S T
     C********************************************************************
     C*
     C           SR2310    BEGSR
     C*
     C                     MOVE DEC50     ALF5
     C                     MOVEAALF5      NUM
     C*
     C                     CLEARALF
     C                     CLEARY
     C                     MOVE *OFF      *IN77
     C*
     C                     DO   5         Z
     C*
     C                     MOVE NUM,Z     CHAR
     C*
     C           CHAR      IFGT '0'
     C                     MOVE *ON       *IN77
     C                     ENDIF
     C*
     C           *IN77     IFEQ *ON
     C                     ADD  1         Y
     C                     MOVE CHAR      ALF,Y
     C                     ENDIF
     C*
     C                     ENDDO
     C*
     C                     MOVEAALF       ALF5
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          H E X   /   C H A R
     C********************************************************************
     C*
     C           SR2400    BEGSR
     C*
     C           ##MODE    IFEQ 'C'
     C                     MOVE 'H'       ##MODE
     C                     MOVE *ON       *IN35
     C                     Z-ADD4         SFLREC
     C                     Z-ADD4         SFLPAG
     C                     ELSE
     C                     MOVE 'C'       ##MODE
     C                     MOVE *OFF      *IN35
     C                     Z-ADD1         SFLREC
     C                     Z-ADD16        SFLPAG
     C                     ENDIF
     C*
     C                     MOVE 'Y'       BUILD
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          U S E R   I N D E X
     C********************************************************************
     C*
     C           SR3000    BEGSR
     C*
     C                     MOVEL$$UIDX    UINAM
     C                     MOVEL$$LIB     UILIB
     C*
     C           @KIDX1    CHAINI60UIDX              9091
     C*
     C                     Z-ADD$$KLEN    UIKLEN
     C                     Z-ADD$$RLEN    UIRLEN
     C                     MOVELS@USER    UIUSER
     C                     Z-ADD$DATJ     UIDATE
     C                     TIME           UITIME
     C*
     C           *IN90     IFEQ *ON
     C                     WRITEI60UIDX
     C                     ELSE
     C           *IN91     IFEQ *OFF
     C                     UPDATI60UIDX
     C                     ENDIF
     C                     ENDIF
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          H E X
     C********************************************************************
     C*
     C           SR9100    BEGSR
     C*
     C                     MOVE VALU,X    CHAR
     C*
     C                     TESTB'0'       CHAR           81
     C                     TESTB'1'       CHAR           82
     C                     TESTB'2'       CHAR           83
     C                     TESTB'3'       CHAR           84
     C                     TESTB'4'       CHAR           85
     C                     TESTB'5'       CHAR           86
     C                     TESTB'6'       CHAR           87
     C                     TESTB'7'       CHAR           88
     C*
     C                     MOVEA*IN,81    D@IN
     C*
     C                     Z-ADD1         Y
     C           D@IN14    LOKUPBIN,Y                    65
     C           *IN65     IFEQ *ON
     C                     MOVE HEX,Y     HEX1,X
     C                     ENDIF
     C*
     C                     Z-ADD1         Y
     C           D@IN58    LOKUPBIN,Y                    65
     C           *IN65     IFEQ *ON
     C                     MOVE HEX,Y     HEX2,X
     C                     ENDIF
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          U S E R   I N D E X
     C********************************************************************
     C*
     C           SR9200    BEGSR
     C*
     C                     Z-ADD$$KLEN    PSKLEN
     C                     Z-ADD$$RLEN    PSLEN
     C*
     C           *IN10     IFEQ *OFF
     C                     MOVEL'EQ'      PSRULE    P
     C                     MOVEL'*FIRST'  PSKEY     P
     C                     ELSE
     C                     MOVEL'GT'      PSRULE    P
     C                     MOVELSVKEY     PSKEY     P
     C                     ENDIF
     C*
     C                     CALL 'X00IDX'
     C                     PARM           PSQUAL
     C                     PARM 'I'       PSACTN
     C                     PARM           PSRULE
     C                     PARM           PSKLEN
     C                     PARM           PSKEY
     C                     PARM           PSLEN
     C                     PARM           PSREC
     C                     PARM           PSSTS
     C*
     C           PSSTS     IFGE '1'
     C                     MOVE *ON       *IN99
     C                     MOVE *ON       EOF
     C                     MOVE *ON       *IN23
     C                     ENDIF
     C*
     C           PSKLEN    SUBSTPSREC:1   SVKEY     P
     C*
     C                     MOVE *ON       *IN10
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          R E T R I E V E   U S E R   I N D E X
     C********************************************************************
     C*
     C           SR9977    BEGSR
     C*
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          N U M E R I C
     C********************************************************************
     C*
     C           SR9988    BEGSR
     C*
     C                     MOVE *ZERO     NUM
     C                     Z-ADD5         X
     C                     Z-ADD5         Y
     C*
     C                     DO   5         Z
     C                     MOVE ALF,X     CHAR
     C           CHAR      IFNE *BLANK
     C           CHAR      IFGE '0'
     C           CHAR      ANDLE'9'
     C                     MOVE CHAR      NUM,Y
     C                     SUB  1         Y
     C                     ELSE
     C                     MOVE *ON       P@ERR
     C                     Z-ADDF         E
     C                     ENDIF
     C                     ENDIF
     C                     SUB  1         X
     C                     ENDDO
     C*
     C                     MOVEANUM       ALF5
     C                     MOVE ALF5      DEC50
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          I N I T I A L I S A T I O N
     C********************************************************************
     C*
     C           *INZSR    BEGSR
     C*
     C                     MOVE *OFF      P@ERR
     C                     MOVE *BLANKS   P@MSG
     C*
     C*....................................................
     C*
     C           P@RLEN    IFNE '*CALC'
     C                     Z-ADD1         F
     C                     MOVEAP@RLEN    ALF
     C                     EXSR SR9988
     C                     Z-ADDDEC50     $$RLEN
     C                     ENDIF
     C*
     C           P@KLEN    IFNE '*CALC'
     C           P@ERR     ANDEQ*OFF
     C                     Z-ADD2         F
     C                     MOVEAP@KLEN    ALF
     C                     EXSR SR9988
     C                     Z-ADDDEC50     $$KLEN
     C                     ENDIF
     C*
     C*....................................................
     C*
     C                     MOVELP@UIDX    $$UIDX
     C                     MOVELP@LIB     $$LIB
     C                     MOVELP@UIDX    PSNAM
     C                     MOVELP@LIB     PSLIB
     C                     Z-ADDP@MAX     MAX
     C*
     C           MAX       IFEQ *ZEROS
     C           MAX       ORGT 9999
     C                     Z-ADD9999      MAX
     C                     ENDIF
     C*
     C*....................................................
     C*
     C                     Z-ADD1         STRCOL
     C                     Z-ADD70        WIDTH
     C*
     C           P@F22     IFEQ *ON
     C                     MOVE *ON       *IN32
     C                     MOVE *OFF      *IN33
     C                     ENDIF
     C*
     C*....................................................
     C*
     C*  Load system date
     C*
     C                     TIME           $WRK12
     C                     MOVE $WRK12    $$EDT
     C                     MOVE $$EDT     #SIDAT
     C                     MOVEL'*SYSVAL' #FFMT     P
     C                     MOVE *BLANKS   #EDAT
     C                     MOVEL'*JUL'    #TFMT     P
     C                     MOVEL'*NONE'   #SEP      P
     C                     MOVE *BLANK    $ERTST
     C*
     C                     CALL 'X0028  '
     C*                    ----  -----
     C                     PARM           #SIDAT
     C                     PARM           #EDAT
     C                     PARM           #FFMT
     C                     PARM           #TFMT
     C                     PARM           #SEP
     C                     PARM           $ERTST
     C*
     C                     MOVEL#SIDAT    $DATJ
     C*
     C*....................................................
     C*
     C                     MOVE *ON       *IN34
     C                     MOVE *OFF      *IN35
     C*
     C                     MOVE *OFF      EOF
     C                     MOVE X'20'     ENDATR
     C                     MOVE 'C'       ##MODE
     C*
     C                     Z-ADD1         SFLREC
     C                     Z-ADD16        SFLPAG
     C*
     C                     MOVE *BLANK    P@EXIT
     C                     MOVE 'N'       OPEN
     C*
     C                     ENDSR
     C/EJECT
     C********************************************************************
     C*          D E F I N I T I O N S
     C********************************************************************
     C*
     C           SR9999    BEGSR
     C*
     C           *ENTRY    PLIST
     C                     PARM           P@UIDX 10
     C                     PARM           P@LIB  10
     C                     PARM           P@KLEN  5
     C                     PARM           P@RLEN  5
     C                     PARM           P@MAX   50
     C                     PARM           P@F22   1
     C                     PARM           P@EXIT  1
     C                     PARM           P@ERR   1
     C                     PARM           P@MSG  75
     C*
     C*....................................................
     C*
     C           @KIDX1    KLIST
     C                     KFLD           UINAM
     C                     KFLD           UILIB
     C*
     C           @KIDX2    KLIST
     C                     KFLD           UINAM
     C*
     C*....................................................
     C*
     C                     Z-ADD*ZEROS    $$EDT   60
AK02 C                     Z-ADD*ZEROS    $DATJ   60
     C                     MOVE *BLANKS   $ERTST  1
     C                     Z-ADD*ZEROS    $WRK12 120
     C                     MOVE *BLANK    ##MODE  1
     C           *LIKE     DEFN $$VALU    ##VALU
     C                     MOVE *BLANKS   #EDAT   8
     C                     MOVE *BLANKS   #FFMT   7
     C                     MOVE *BLANKS   #SEP    7
     C                     MOVE *BLANKS   #SIDAT  6
     C                     MOVE *BLANKS   #TFMT   7
     C                     MOVE *BLANKS   ALF5    5
     C                     MOVE *BLANK    BUILD   1
     C                     MOVE *BLANK    CHAR    1
     C                     MOVE *BLANK    CHAR10 10
     C                     Z-ADD*ZEROS    COUNT   50
     C                     Z-ADD*ZEROS    DEC50   50
     C                     MOVE *BLANK    DIGIT   1
     C                     Z-ADD*ZEROS    E       50
     C                     MOVE *BLANK    ENDATR  1
     C                     Z-ADD*ZEROS    ENDCOL  50
     C           *LIKE     DEFN *IN99     EOF
     C                     Z-ADD*ZEROS    F       50
     C                     Z-ADD*ZEROS    L       50
     C                     Z-ADD*ZEROS    MAX     70
     C                     MOVE *BLANKS   OPEN    1
     C                     MOVE *BLANKS   PSACTN  1
     C                     Z-ADD*ZEROS    PSKLEN  30
     C                     Z-ADD*ZEROS    PSLEN   30
     C                     MOVE *BLANKS   PSRULE  2
     C                     MOVE *BLANKS   PSSTS   1
     C                     Z-ADD*ZEROS    RECS    50
     C                     Z-ADD*ZEROS    SRN     10
     C                     Z-ADD*ZEROS    S       50
     C                     Z-ADD*ZEROS    SFLREC  10
     C                     Z-ADD*ZEROS    SFLPAG  30
     C                     Z-ADD*ZEROS    STRCOL  50
     C                     Z-ADD*ZEROS    WIDTH   50
     C                     Z-ADD*ZEROS    X       50
     C                     Z-ADD*ZEROS    Y       50
     C                     Z-ADD*ZEROS    Z       50
     C*
     C                     ENDSR
     C/EJECT
**
Record length invalid.
Key length invalid.
Record and/or key length not found on file *LIBL/T60UIDX.
Error opening file *LIBL/T60UIDX.
Error(s) occurred.
Error(s) occurred.
Error(s) occurred.
Error(s) occurred.
Error(s) occurred.
Error(s) occurred.
**
                          ****** END OF DATA ******
**  Hex/Binary
00000
10001
20010
30011
40100
50101
60110
70111
81000
91001
A1010
B1011
C1100
D1101
E1110
F1111

As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.