×

Good News Everybody!

The new search engine is LIVE!

Please report any problems to david (at) midrange.com.




     
just to be clear, I forgot to include the naming conventions, although I am sure
that they are easily figured out:
dspusridx = cmdsrc
v60uidx = dspf src
t60uidx = pf src
p60uidx = rpg src

jw

______________________________ Reply Separator _________________________________
Subject: Re: User Index
Author:  Jodi Walker at INFOSERV
Date:    01/29/2001 8:36 AM


     
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

This thread ...


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

This mailing list archive is Copyright 1997-2026 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.