× 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.



Here is the flow.

OENT77 called and first screen display.

User prompts on Inv.Loc Code  first and calls program ILOC00/ILOC00W.

Using mouse to selected record from subfile. It moves in parms and INLR back
to OENT77.

User prompts on Vendor Number and calls program VNDR00/VNDR00W it has no
mouse button selection but Client access has left mouse click define as
enter key. They click around screen code performs loop around to exfmt of
screen doing @ENTKY/@SFLRD inbetween .It goes KaBOOOOM CPF5192. Permanant
I/O error after several clicks or just one. It does not happen to
VNDR00/VNDR00W if you go straight there only after windows with
mouse,push,scroll.

But I'm not seeing problem. And have searched net only to find others asking
similar but different question on CPF5192.

Please any ideas. Here is the code for programs/screens. Not the greatest
and I see other things I'm going to change.
I/O ERROR is the main issue. But will welcome all comments.

Sorry if to much INFO sent to post. Please let me know if to much for future
ref.

Thanks Bill Hopkins

Note: if mouse map change from IBM Def in Clnt A. to Mouse Position from
Enter for left click no problem??? But Push Button don't work with mouse.:(
Also STRDBG when step through no problems. STRDBG with no break EXFMT-KABOOM
debug opens???

Bhopkins@saurerinc.com <mailto:Bhopkins@saurerinc.com>

     A*  Display Name:      VNDR00W
*
     A                                      DSPSIZ(24 80 *DS3)
     A                                      REF(*LIBL/DDSFLDS)
     A                                      PRINT
     A          R DFTSFL                    SFL
     A                                      CHGINPDFT
     A            SSEL           1A  I  7  3DSPATR(UL)
     A                                      DSPATR(HI)
     A          R DFTCTL                    SFLCTL(DFTSFL)
     A                                      SFLSIZ(0005)
     A                                      SFLPAG(0005)
     A                                      WINDOW(DFTCMD)
     A                                      CF12
     A                                      PAGEDOWN
     A                                      PAGEUP
     A                                      KEEP
     A                                      BLINK
     A                                      OVERLAY
     A                                      USRRSTDSP
     A  32                                  SFLDSP
     A                                      SFLDSPCTL
     A  30                                  SFLCLR
     A  99                                  SFLEND(*MORE)
     A  60                                  SFLMSG('ROLL UP OR DOWN BEYOND
FIRS-
     A                                      T OR LAST RECORD IN SUBFILE.')
     A            SFLPSD         4S 0H      SFLRCDNBR(CURSOR)
     A                                  1 17'Prompt Selection Screen'
     A                                      COLOR(YLW)
     A                                  3  2'Type a (1), then press ENTER.'
     A                                  5  2'Position to..'
     A            SPOS1     R     S  B  5 16REFFLD(VNDR)
     A                                      COLOR(TRQ)
     A                                      CHECK(FE)
     A                                  5 23'(Vendor)'
     A                                  5 32'or'
     A            SPOS2         15A  B  5 35COLOR(TRQ)
     A                                      CHECK(FE)
     A                                  5 51'(Name)'
     A                                  6  2'Act'
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A          R DFTCMD
     A                                      KEEP
     A                                      OVERLAY
     A                                      WINDOW(8 6 14 60)
     A                                      WDWBORDER((*COLOR TRQ) (*DSPATR
RI)-
     A                                       (*CHAR '********'))
     A                                      RMVWDW
     A                                 13  2'F12-Cancel'
     A          R DUMMY
     A                                      ASSUME
     A                                  1  3' '

VNDR00

     FVENDMST1  IF   E           K DISK
     FVENDMST2  IF   E           K DISK    RENAME(VN:VX) PREFIX(VX:2)
     FVNDR00W   CF   E             WORKSTN INFDS(WSDS)
     F                                     SFILE(DFTSFL:SFLrnd)

     D @F12            C                   CONST(X'3C')
     D @Enter          C                   CONST(X'F1')
     D @Pagup          C                   CONST(X'F4')
     D @Pagdn          C                   CONST(X'F5')
     D @False          C                   CONST('0')
     D @True           C                   CONST('1')
      *
     D @Exit           S              1
     D Sflrnd          S              4  0
     D Endrn           S              4  0
     D EOFoffset       S              4  0
     D Positd1         S                   like(VNVNDR)
     D Positd2         S                   like(VNNAME)
     D P$co#           S                   like(VNCOMP)
     D P$plt#          S                   like(VNPLNT)
     D P$VNDR          S                   like(VNVNDR)
     D P$VNAM          S                   like(VNNAME)
     D Dftco#          S                   like(VNCOMP)
     D Dftplt#         S                   like(VNPLNT)
     D DftVNDR         S                   like(VNVNDR)
     D DftVNAM         S                   like(VNNAME)

     D PSDS           SDS
     D   Userid              254    263
     D WSDS            DS
     D  Key                  369    369
     D  Pagrrn               378    379B 0
      *
     C     *Entry        Plist
     C                   Parm                    P$co#
     C                   Parm                    P$plt#
     C                   Parm                    P$VNDR
     C                   Parm                    P$VNAM

     C                   Eval      P$co#    =    *Zeros
     C                   Eval      P$plt#   =    *Zeros
     C                   Eval      Dftco#   =    P$co#
     C                   Eval      Dftplt#  =    P$plt#
     C                   Eval      DftVNDR  =    P$VNDR
     C                   Eval      DftVNAM  =    P$VNAM
      *
     C                   Write     Dftcmd
      *
     C                   Reset                   @Exit
     C                   Exsr      @RESET
      *
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key1        Setll     VENDMST1
     C                   WHEN      P$VNAM > *blanks
     C     P$Key2        Setll     VENDMST2
     C                   OTHER
     C     P$Key3        Setll     VENDMST1
     C                   ENDSL
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key3        ReadE     VENDMST1                               99
     C                   WHEN      P$VNAM > *blanks
     C     P$Key3        Reade     VENDMST2                               99
     C                   OTHER
     C     P$Key3        ReadE     VENDMST1                               99
     C                   ENDSL
     C                   Exsr      @LOAD
     C                   Dou       @Exit = @True
     C                   Exfmt     Dftctl
     C                   Eval      *IN60     = *Off
     C                   Eval      SFLrnd    = Pagrrn
     C     Key           Caseq     @F12          @F12sr
     C     Key           Caseq     @pagup        @pagupSR
     C     Key           Caseq     @pagdn        @pagdnSR
     C     Key           Caseq     @Enter        @ENTKY
     C                   Endcs
     C                   Enddo
     C                   Eval      *InLR     = *On
     CSR   *INZSR        BEGSR
     C                   Eval      @Exit     = @False
     C                   Eval      SFLpsd    = 1
     C                   Clear                   Srrn
     C                   Clear                   Sflrnd
     C                   Clear                   Endrn
     C                   Clear                   Idxd
     C                   Clear                   Dftco#
     C                   Clear                   Dftplt#
     C                   Clear                   DftVNDR
     C                   Clear                   DftVNAM
     C     Dftkey1       Klist
     C                   Kfld                    Dftco#
     C                   Kfld                    Dftplt#
     C                   Kfld                    DftVNDR
     C     Dftkey2       Klist
     C                   Kfld                    Dftco#
     C                   Kfld                    Dftplt#
     C                   Kfld                    DftVNAM
     C     P$Key1        Klist
     C                   Kfld                    P$co#
     C                   Kfld                    P$plt#
     C                   Kfld                    P$VNDR
     C     P$Key2        Klist
     C                   Kfld                    P$co#
     C                   Kfld                    P$plt#
     C                   Kfld                    P$VNAM
     C     P$Key3        Klist
     C                   Kfld                    P$co#
     C                   Kfld                    P$plt#
     CSR                 ENDSR
     CSR   @LOAD         BEGSR
     C                   Eval      EOFoffset = *zeros
     C                   Do        5
     C                   SELECT
     C                   WHEN      P$VNDR    > *zeros
     C                   Eval      Sflrnd    = (Sflrnd + 1)
     C                   Write     Dftsfl
     C                   WHEN      P$VNAM > *blanks and
     C                             VXACOD    <>'D'
     C                   Eval      Sflrnd    = (Sflrnd + 1)
     C                   Write     Dftsfl
     C                   OTHER
     C                   Eval      Sflrnd    = (Sflrnd + 1)
     C                   Write     Dftsfl
     C                   ENDSL
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key3        ReadE     VENDMST1                               99
     C                   WHEN      P$VNAM > *blanks
     C     P$Key3        ReadE     VENDMST2                               99
     C                   OTHER
     C     P$Key3        ReadE     VENDMST1                               99
     C                   ENDSL
     C                   If        *in99     = *On
     C                   Eval      *in60     = *On
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key3        setgt     VENDMST1
     C                   WHEN      P$VNAM > *blanks
     C     P$Key3        setgt     VENDMST2
     C                   OTHER
     C     P$Key3        setgt     VENDMST1
     C                   ENDSL
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key3        ReadPE    VENDMST1                               98
     C                   WHEN      P$VNAM > *blanks
     C     P$Key3        ReadPE    VENDMST2                               98
     C                   OTHER
     C     P$Key3        ReadPE    VENDMST1                               98
     C                   ENDSL
     C                   Eval      EOFoffset = (-1)
     C                   leave
     C                   endIf
     C                   Enddo
     C                   If        Sflrnd = *Zeros
     C                   Eval      *in32     = *Off
     C                   Else
     C                   Eval      *in32     = *On
     C                   Eval      Endrn     = (Sflrnd + EOFoffset)
     C                   Endif
     CSR                 ENDSR
     CSR   @ENTKY        begSR
     C                   If        *in32 = *ON
     C                   Exsr      @SFLRD
     C                   IF        @Exit <> @True
     C                   SELECT
     C                   WHEN      Spos1 > *zeros
     C                   Eval      Positd1  = Spos1
     C                   Eval      Positd2  = *blanks
     C                   Eval      P$VNDR   = Spos1
     C                   Eval      P$VNAM   = *blanks
     C                   Exsr      @POSSR
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     C                   WHEN      Spos2 > *blanks
     C                   Eval      Positd2  = Spos2
     C                   Eval      Positd1  = *zeros
     C                   Eval      P$VNAM   = Spos2
     C                   Eval      P$VNDR   = *zeros
     C                   Exsr      @POSSR
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     C                   ENDSL
     C                   endIf
     C                   endIf
     CSR                 endSR
     CSR   @pagdnSR      begSR
     C                   Eval      *in92    = *Off
     C                   SELECT
     C                   WHEN      Spos1 > *zeros
     C                   Eval      Positd1  = SsVNDR
     C                   WHEN      Spos2 > *blanks
     C                   Eval      Positd2  = SsVNAM
     C                   ENDSL
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     CSR                 endSR
     CSR   @pagupSR      begSR
     C                   Eval      *in92    = *Off
     C                   Eval      *in60     = *Off
     C                   Eval      Endrn     = (Endrn + 5)
     C                   Do        Endrn
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key3        ReadPE    VENDMST1                               92
     C                   WHEN      P$VNAM > *blanks
     C     P$Key3        ReadPE    VENDMST2                               92
     C                   OTHER
     C     P$Key3        ReadPE    VENDMST1                               92
     C                   ENDSL
     C                   If        *in92 = *On
     C                   Eval      *in92     = *Off
     C                   Eval      *in60     = *On
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C     P$Key3        Setll     VENDMST1
     C     P$Key3        ReadE     VENDMST1                               92
     C                   WHEN      P$VNAM > *blanks
     C     P$Key3        Setll     VENDMST2
     C     P$Key3        ReadE     VENDMST2                               92
     C                   OTHER
     C     P$Key3        Setll     VENDMST1
     C     P$Key3        ReadE     VENDMST1                               92
     C                   ENDSL
     C                   Leave
     C                   Endif
     C                   endDo
     C                   SELECT
     C                   WHEN      P$VNDR > *zeros
     C                   Eval      Positd1  = VNVNDR
     C                   WHEN      P$VNAM > *blanks
     C                   Eval      Positd2  = VXNAME
     C                   OTHER
     C                   Eval      Positd1  = VNVNDR
     C                   ENDSL
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     CSR                 endSR
     CSR   @SFLRD        begSR
     C                   Readc     Dftsfl                                 98
     C                   Dow       *in98 = *OFF
     C                   Select
     C                   When      Ssel = '1'
     C                   Eval      P$VNDR    = SsVNDR
     C                   Eval      P$VNAM    = SsVNAM
     C                   Eval      @Exit     = @True
     C                   Endsl
     C                   Readc     Dftsfl                                 98
     C                   endDo
     CSR                 endSR
     CSR   @POSSR        BEGSR
     C                   Eval      DftVNDR   = Positd1
     C                   Eval      DftVNAM   = Positd2
     C                   SELECT
     C                   WHEN      SPOS1  > *zeros
     C     Dftkey1       setll     VENDMST1                               91
     C                   IF        SPOS1  <> 99999
     C                   Eval      *IN91  = *ON
     C                   ENDIF
     C                   WHEN      SPOS2  > *blanks
     C     Dftkey2       setll     VENDMST2                               91
     C                   IF        SPOS2  <> 'ZZZZZZZZZZZZZZZ'
     C                   Eval      *IN91  = *ON
     C                   ENDIF
     C                   OTHER
     C     Dftkey1       setll     VENDMST1                               91
     C                   ENDSL
     C                   If        *in91 = *OFF
     C                   SELECT
     C                   WHEN      SPOS1  > *zeros
     C     P$Key3        ReadPE    VENDMST1                               92
     C                   WHEN      SPOS2  > *blanks
     C     P$Key3        ReadPE    VENDMST2                               92
     C                   OTHER
     C     P$Key3        ReadPE    VENDMST1                               92
     C                   ENDSL
     C                   Eval      Endrn     = (Endrn - 1)
     C                   Eval      SFLpsd    = Endrn
     C                   Else
     C                   SELECT
     C                   WHEN      SPOS1  > *zeros
     C     P$Key3        ReadE     VENDMST1                               92
     C                   WHEN      SPOS2  > *blanks
     C     P$Key3        ReadE     VENDMST2                               92
     C                   OTHER
     C     P$Key3        ReadE     VENDMST1                               92
     C                   ENDSL
     C                   SELECT
     C                   WHEN      SPOS1  > *zeros
     C                   Eval      Positd1  = VNVNDR
     C                   WHEN      SPOS2  > *blanks
     C                   Eval      Positd2  = VXNAME
     C                   OTHER
     C                   Eval      Positd1  = VNVNDR
     C                   ENDSL
     C                   Endif
     CSR                 ENDSR
     CSR   @RESET        BEGSR
     C                   Eval      *In30     = *On
     C                   Write     Dftctl
     C                   Eval      *In30     = *Off
     C                   Eval      *In32     = *Off
     C                   Reset                   Sflrnd
     C                   Reset                   Sflpsd
     CSR                 ENDSR
     CSR   @F12SR        begSR
     C                   Eval      @Exit     = @True
     C                   Eval      P$VNDR    = *zeros
     C                   Eval      P$VNAM    = *blanks
     CSR                 endSR
 ***************************************************************************
OENT77D
     A                                      DSPSIZ(24 80 *DS3)
     A                                      REF(*LIBL/DDSFLDS)
     A          R SCRI1S                    SFL
     A  80                                  SFLNXTCHG
     A            #SSTYP    R        O 18  6REFFLD(STYP)
     A  50                                  DSPATR(ND)
     A                                      DSPATR(UL)
     A            #SUPRC    R     S  B 18 42REFFLD(UPRC)
     A  50                                  DSPATR(ND)
     A  50                                  DSPATR(PR)
     A N50 41
     AON50 42                               DSPATR(RI)
     A          R SCRI1C                    SFLCTL(SCRI1S)
     A                                      KEEP
     A                                      SFLSIZ(0005)
     A                                      SFLPAG(0004)
     A                                      CF01
     A                                      CF04
     A                                      CF07
     A                                      CF05
     A                                      RTNCSRLOC(&CSRRCD &CSRFLD)
     A                                      OVERLAY
     A  91                                  SFLDSP
     A  90                                  SFLDSPCTL
     A  92                                  SFLCLR
     A  98                                  SFLEND
     A            CSRRCD        10A  H      TEXT('Cursor file loc.')
     A            CSRFLD        10A  H      TEXT('Cursor field loc.')
     A            ##FNME    R        O  1 26REFFLD(FNME)
     A                                  1 72DATE
     A                                      EDTCDE(Y)
     A                                  2 72TIME
     A                                  3  2'Company Number  :'
     A            @@CO#     R        O  3 21REFFLD(CO#)
     A                                      DSPATR(HI)
     A            ##CNAM    R        O  3 39REFFLD(NAME)
     A                                      DSPATR(HI)
     A                                  4  2'Plant Number    :'
     A            @@PLT#    R        O  4 21REFFLD(PLT#)
     A                                      DSPATR(HI)
     A            ##PNAM    R        O  4 39REFFLD(NAME)
     A                                      DSPATR(HI)
     A                                  5  2'Vendor Number   :'
     A                                      DSPATR(HI)
     A            ##VNDR    R        B  5 21REFFLD(VNDR)
     A                                      EDTCDE(Z)
     A  70                                  DSPATR(RI)
     A  70                                  DSPATR(PC)
     A                                      CHECK(FE)
     A                                      CHECK(RZ)
     A                                      COLOR(BLU)
     A            ##VNAM    R   +4   O  5 39REFFLD(NAME)
     A                                      DSPATR(HI)
     A                                  6  2'Inv.Loc Code    :'
     A                                      DSPATR(HI)
     A            ##ILOC    R        B  6 21REFFLD(ILOC)
     A  71                                  DSPATR(RI)
     A  71
     AO 76                                  DSPATR(PC)
     A                                      CHECK(FE)
     A                                      EDTCDE(Z)
     A                                      CHECK(RZ)
     A                                      COLOR(BLU)
     A            ##INAM    R        O  6 39REFFLD(ILNM)
     A                                      DSPATR(HI)
     A                                  7  2'Currency Code   :'
     A            ##CURR    R        O  7 21REFFLD(CURR)
     A                                      DSPATR(HI)
     A            ##CDSC    R        O  7 39REFFLD(DDCR)
     A                                      DSPATR(HI)
     A                                  8  2'Item Number     :'
     A                                      DSPATR(HI)
     A            ##PART    R        B  8 21REFFLD(PART)
     A  72                                  DSPATR(RI)
     A  72
     AO 77                                  DSPATR(PC)
     A                                      CHECK(FE)
     A                                      CHECK(ER)
     A                                      COLOR(BLU)
     A            ##DSC1    R        O  8 39REFFLD(DDCR)
     A                                      DSPATR(HI)
     A            ##DSC2    R        O  9 39REFFLD(DDCR)
     A                                      DSPATR(HI)
     A                                 10  2'Machine Type    :'
     A                                      DSPATR(HI)
     A  49                                  DSPATR(ND)
     A            ##MTYP    R        B 10 21REFFLD(MTYP)
     A  73                                  DSPATR(RI)
     A  73
     AO 78                                  DSPATR(PC)
     A  49                                  DSPATR(ND)
     A  49                                  DSPATR(PR)
     A            ##MDSC    R        O 10 39REFFLD(MDSC)
     A                                      DSPATR(HI)
     A  49                                  DSPATR(ND)
     A                                 15  2'Enter or Update Values'
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A  50                                  DSPATR(ND)
     A            ##STYP    R        B 16  6REFFLD(STYP)
     A  50                                  DSPATR(ND)
     A  50                                  DSPATR(PR)
     A N50                                  DSPATR(PC)
     A                                 17  2'PO Shp Typ'
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A                                 17 42'Unit Price'
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A  50                                  DSPATR(ND)
     A          R SCRI1F
     A                                      OVERLAY
     A                                 23 20'F4-Prompt'
     A                                      COLOR(BLU)
     A                                 23 48'F7-Exit'
     A                                      COLOR(PNK)
     A            ##MSG     R        O 24  2REFFLD(MSG)
     A                                      COLOR(RED)
 OENT77

     FOENT77D CF  E                    WORKSTN
     F                                        ##RRN1KSFILE SCRI1S
     F                                        ##RRN2KSFILE SCRI2S
     C           SCRN1     BEGSR
     C           *INKG     DOWEQ*OFF
     C                     WRITESCRI1F
     C                     EXFMTSCRI1C
     C                     MOVE *BLANKS   ##MSG
     C                     MOVE 'N'       ERROR
     C                     MOVEA'000'     *IN,70
     C                     MOVEA'000'     *IN,76
     C                     SELEC
     C           *INKG     WHEQ *ON                        EXIT
     C                     LEAVE
      * F4 = Vendor# Selection
     C           *INKD     WHEQ *ON                        ITEM LOC SEL
     C           CSRFLD    IFEQ '##VNDR'
     C                     CALL 'VNDR00'
     C                     PARM           P$CO#
     C                     PARM           P$PLT#
     C                     PARM           P$VNDR
     C                     PARM           P$VNAM
      * F4 = Location Selection
     C           CSRFLD    IFEQ '##ILOC'
     C                     CALL 'ILOC00'
     C                     PARM           P$CO#
     C                     PARM           P$PLT#
     C                     PARM           P$ILOC
     C                     PARM           P$INAM
     C                     PARM           P$MORI
     C                     OTHER                           ON ENTER
     C                     ENDSL
     C                     ENDDO
     C                     MOVE *ON       *INLR
     C                     ENDSR
     C           *ENTRY    PLIST
     C                     PARM           @@PARM
     C                     EXSR $LOD1
     C                     EXSR SCRN1
     C                     ENDSR
ILOC00

     A                                      DSPSIZ(24 80 *DS3)
     A                                      REF(*LIBL/DDSFLDS)
     A                                      PRINT
     A          R DUMMY
     A                                      ASSUME
     A                                  1  3' '
     A          R DFTSFL                    SFL
     A                                      CHGINPDFT
     A            SSEL           1A  I  7  3DSPATR(UL)
     A                                      DSPATR(HI)
     A  88                                  DSPATR(ND)
     A  88                                  DSPATR(PR)
     A            SSILOC    R     Y  O  7  7REFFLD(ILOC)
     A                                      EDTCDE(3)
     A            SSINAM    R        O  7 12REFFLD(ILNM)
     A          R DFTCTL                    SFLCTL(DFTSFL)
     A                                      CF12
     A                                      PAGEDOWN
     A                                      PAGEUP
     A                                      KEEP
     A                                      BLINK
     A                                      OVERLAY
     A                                      SFLCSRRRN(&RRNA)
     A  32                                  SFLDSP
     A                                      SFLDSPCTL
     A  30                                  SFLCLR
     A  99                                  SFLEND(*SCRBAR *MORE)
     A                                      SFLSIZ(0005)
     A                                      SFLPAG(0005)
     A  60                                  SFLMSG('ROLL UP OR DOWN BEYOND
FIRS-
     A                                      T OR LAST RECORD IN SUBFILE.')
     A                                      WINDOW(DFTCMD)
     A                                      USRRSTDSP
     A                                      MOUBTN(*ULP *ULD ENTER)
     A            SFLPSD         4S 0H      SFLRCDNBR(CURSOR)
     A            RRNA           5S 0H
     A                                  1  7'Prompt Selection Screen'
     A                                      COLOR(YLW)
     A                                  3  2'Type a (1), then press ENTER.'
     A                                  5  5'Position to..'
     A            SPOS      R     S  I  5 19REFFLD(ILOC)
     A                                      COLOR(TRQ)
     A  88                                  DSPATR(PC)
     A                                  5 25'(Loc )'
     A                                  6  2'Act'
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A  88                                  DSPATR(ND)
     A                                  6  7'Loc '
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A                                  6 12'Inventory Location Name  '
     A                                      DSPATR(HI)
     A                                      DSPATR(UL)
     A          R DFTCMD
     A                                      KEEP
     A                                      OVERLAY
     A                                      WINDOW(8 6 14 41)
     A                                      WDWBORDER((*COLOR TRQ) (*DSPATR
RI)-
     A                                       (*CHAR '********'))
     A                                      RMVWDW
     A            F2             2Y 0B 13  2PSHBTNFLD
     A                                      CHCAVAIL((*COLOR PNK))
     A                                      PSHBTNCHC(1 'F>12-Cancel ' CF12)

ILOC00
     FVALILOC   IF   E           K DISK
     FINVLOC    IF   E           K DISK
     FILOC00W   CF   E             WORKSTN INFDS(WSDS)
     F                                     SFILE(DFTSFL:SFLrnd)
     D @F12            C                   CONST(X'3C')
     D @Enter          C                   CONST(X'F1')
     D @Pagup          C                   CONST(X'F4')
     D @Pagdn          C                   CONST(X'F5')
     D @False          C                   CONST('0')
     D @True           C                   CONST('1')
      *
     D @Exit           S              1
     D Sflrnd          S              4  0
     D Endrn           S              4  0
     D EOFoffset       S              4  0
     D Positd          S                   like(VIILOC)
     D P$co#           S                   like(VICO#)
     D P$plt#          S                   like(VIPLT#)
     D P$iloc          S                   like(VIILOC)
     D P$inam          S                   like(ILILNM)
     D P$mori          S              1
     D Dftco#          S                   like(VICO#)
     D Dftplt#         S                   like(VIPLT#)
     D Dftiloc         S                   like(VIILOC)
     D PSDS           SDS
     D   Userid              254    263
     D WSDS            DS
     D  Key                  369    369
     D  Pagrrn               378    379B 0
     C     *Entry        Plist
     C                   Parm                    P$co#
     C                   Parm                    P$plt#
     C                   Parm                    P$iloc
     C                   Parm                    P$inam
     C                   Parm                    P$mori
     C                   Eval      Dftco#   =    P$co#
     C                   Eval      Dftplt#  =    P$plt#
     C                   Eval      Dftiloc  =    P$iloc
     C                   If        P$mori   =    'I'
     C                   Eval      *IN88    =    *ON
     C                   Endif
     C                   Write     Dftcmd
     C                   Reset                   @Exit
     C                   Exsr      @RESET
     C                   If        P$iloc > *zeros
     C     P$Key1        Setll     VALILOC
     C                   Else
     C     P$Key2        Setll     VALILOC
     C                   endIf
     C     P$Key2        ReadE     VALILOC                                99
     C                   Exsr      @LOAD
     C                   Dou       @Exit = @True
     C                   Exfmt     Dftctl
     C                   Eval      *IN60     = *Off
     C                   Eval      SFLrnd    = Pagrrn
     C     Key           Caseq     @F12          @F12sr
     C     Key           Caseq     @pagup        @pagupSR
     C     Key           Caseq     @pagdn        @pagdnSR
     C     Key           Caseq     @Enter        @ENTKY
     C                   Endcs
     C                   Enddo
     C                   Eval      *InLR     = *On
     CSR   *INZSR        BEGSR
     C                   Eval      @Exit     = @False
     C                   Eval      SFLpsd    = 1
     C                   Clear                   Srrn
     C                   Clear                   Sflrnd
     C                   Clear                   Endrn
     C                   Clear                   Dftco#
     C                   Clear                   Dftplt#
     C                   Clear                   Dftiloc
     C     Dftkey        Klist
     C                   Kfld                    Dftco#
     C                   Kfld                    Dftplt#
     C                   Kfld                    Dftiloc
     C     P$Key1        Klist
     C                   Kfld                    P$co#
     C                   Kfld                    P$plt#
     C                   Kfld                    P$iloc
     C     P$Key2        Klist
     C                   Kfld                    P$co#
     C                   Kfld                    P$plt#
     CSR                 ENDSR
     CSR   @LOAD         BEGSR
     C                   Eval      EOFoffset = *zeros
     C                   Do        5
     C                   Eval      Ssiloc    = VIILOC
     C                   Clear                   SSinam
     C     VIILOC        Chain     INVLOC
     C                   If        %found(INVLOC) = '1'
     C                   Eval      SSinam    = ILILNM
     C                   Endif
     C                   Eval      Sflrnd    = (Sflrnd + 1)
     C                   Write     Dftsfl
     C     P$Key2        ReadE     VALILOC                                99
     C                   If        *in99     = *On
     C                   Eval      *in60     = *On
     C     P$Key2        setGT     VALILOC
     C     P$Key2        ReadPE    VALILOC                                98
     C                   Eval      EOFoffset = (-1)
     C                   leave
     C                   endIf
     C                   Enddo
     C                   If        Sflrnd = *Zeros
     C                   Eval      *in32     = *Off
     C                   Else
     C                   Eval      *in32     = *On
     C                   Eval      Endrn     = (Sflrnd + EOFoffset)
     C                   Endif
     CSR                 ENDSR
     CSR   @ENTKY        begSR
     C                   If        *in32 = *ON
     C                   If        Spos  > *zeros
     C                   Eval      Positd   = Spos
     C                   Exsr      @POSSR
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     C                   Else
     C                   Exsr      @SFLRD
     C                   endIf
     C                   endIf
     CSR                 endSR
     CSR   @pagdnSR      begSR
     C                   Eval      *in92    = *Off
     C                   Eval      Positd   = Ssiloc
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     CSR                 endSR
     CSR   @pagupSR      begSR
     C                   Eval      *in92    = *Off
     C                   Eval      *in60     = *Off
     C                   Eval      Endrn     = (Endrn + 5)
     C                   Do        Endrn
     C     P$Key2        ReadPE    VALILOC                                92
     C                   If        *in92 = *On
     C                   Eval      *in92     = *Off
     C                   Eval      *in60     = *On
     C     P$Key2        Setll     VALILOC
     C     P$Key2        ReadE     VALILOC                                99
     C                   Leave
     C                   Endif
     C                   endDo
     C                   Eval      Positd    = VIILOC
     C                   Exsr      @RESET
     C                   Exsr      @LOAD
     CSR                 endSR
     CSR   @SFLRD        begSR
     C                   If        *in98 = *Off
     C                   Readc     Dftsfl                                 98
     C                   Dow       *in98 = *OFF
     C                   Select
     C                   When      Ssel = '1'
     C                   Eval      P$iloc    = Ssiloc
     C                   Eval      P$inam    = Ssinam
     C                   Eval      @Exit     = @True
     C                   Endsl
     C                   Readc     Dftsfl                                 98
     C                   endDo
     C                   else
     C                   If        RRNA      > 0 And
     C                             P$mori   <>   'I'
     C     RRNA          Chain     Dftsfl                             69
     C                   If        *IN69     = *Off
     C                   Eval      P$iloc    = Ssiloc
     C                   Eval      P$inam    = Ssinam
     C                   Eval      @Exit     = @True
     C                   Endif
     C                   Endif
     C                   endIf
     CSR                 endSR
     CSR   @POSSR        BEGSR
     C                   Eval      Dftiloc   = Positd
     C     Dftkey        Setll     VALILOC                                91
     C                   If        *in91 = *OFF
     C     P$Key2        ReadPE    VALILOC                                92
     C                   Eval      Endrn     = (Endrn - 1)
     C                   Eval      SFLpsd    = Endrn
     C                   Else
     C     P$Key2        ReadE     VALILOC                                92
     C                   Eval      Positd    = VIILOC
     C                   Endif
     CSR                 ENDSR
     CSR   @RESET        BEGSR
     C                   Eval      *In30     = *On
     C                   Write     Dftctl
     C                   Eval      *In30     = *Off
     C                   Eval      *In32     = *Off
     C                   Reset                   Sflrnd
     C                   Reset                   Sflpsd
     CSR                 ENDSR
     CSR   @F12SR        begSR
     C                   Eval      @Exit     = @True
     C                   Eval      P$iloc    = *zeros
     C                   Eval      P$inam    = *blanks
     CSR                 endSR



As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

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.