! SUFX01.BP     ISAM+ fix ARTRAN bum keys.
!
!                                 NOTICE
!
!All  rights  reserved.  This software is the property of Starr Computer Inc
!and the material contained herein is the  proprietary  property  and  trade
!secrets  of  Starr Computer Inc, embodying substantial creative efforts and
!confidential information, ideas and expressions, no part of  which  may  be
!reproduced  or  transmitted  in  any  form  or  by  any  means, electronic,
!mechanical,  or  otherwise,  including  photocopying  or  input  into   any
!information  storage  or  retrieval  system  without  the  express  written
!permission of Starr Computer Inc.
!
!CAUTION: Unauthorized distribution or reproduction  of  this  material  may
!subject you to legal action.
!
! 08/25/94 RJ.  4.0(100). New program.
!
       PROGRAM SUFX01,4.0(100)
       STRSIZ 50
++INCLUDE MBASIC
++INCLUDE MACSCO
++INCLUDE MASETP
++INCLUDE MCCHAR
++INCLUDE MEDDTE
++INCLUDE MESPDT
++INCLUDE MISAMP
++INCLUDE MMCTRL
++INCLUDE MMISC1
++INCLUDE MMISC2
++INCLUDE MSCTR0
++INCLUDE MSCTR1
++INCLUDE MVERAR
++INCLUDE MVERSA
++INCLUDE ARTRAN
! ISAM Plus.
++INCLUDE ISAMP
! ESP.
++INCLUDE SYSSTD
       MAP1 REC,X,128
18000   START:  ON ERROR GOTO 0
18010   ! Initialize.
18020           FALSE=0
18030           TRUE=NOT FALSE
18040   !
18050           ABO'PGM$="SUFX01"
18060           ALL$="ALL"
18070           DSH$="--------------------------------------------------"
18080           MRD$="##########.##"
18090           RECLEN1=ART'RECLEN
18100   !
18110   ! Master ctrl.
18120           FIL0$=MAC$
18130           FIL0=MAC
18140           FIL0R=ZRO:GCT'OPT=1:CALL GET'CTRL
18150           IF (GCT'RET<>ZRO) THEN &
                       GOTO CHAIN0
18160           MACTRL=CTRLX
18170   ! A/R file ctrl.
18180           FIL0R=MAC'ARF'REC:CALL GET'CTRL
18190           FLCTRL=CTRLX
18200   ! A/R transaction.
18210           FIL1$=FLC'DEV(3)+FLC'FIL(3)+MAC'FID+FLC'PPN(3)
18220           FIL1=203
18230   !
18240           CALL O'FIL1
18250   !
18260   MENU:
18270   ! Initialize the terminal.
18280           ? TAB(-1,0);"A/R Fix ARTRAN; load from SCSWRK:SUFX01.SEQ"
18290           ? TAB(-1,28)
18300           ? "Enter return to continue, or Control C to abort ";
18310           INPUT LINE;A$
18320           GOTO MAINL
18330   !
18340   CHAIN0: S$=CHAIN0$:GOTO CHAIN'NXT
18350   CHAIN1: S$="SUUTMU":GOTO FINISH
18360   FINISH:
18370           CFIL=FIL1:CALL C'FIL
18380   CHAIN'NXT:
18390           CHAIN S$
18400   !
18410   MAINL:
18420           INP'CNT=ZRO
18430           FIX'CNT=ZRO
18440   !
18450           OPEN #1,"SCSWRK:SUFX01.SEQ",INPUT
18460           OPEN #2,"SCSWRK:SUFX01.LST",OUTPUT
18470   ML'NXT1:
18480           INPUT RAW #1,REC
18490           IF (EOF(1)=1) THEN &
                       GOTO ML'END1
18500           INP'CNT=INP'CNT+1
18510           CREATE'RECORD #FIL1,REC
18520           IF (ISP'STATUS<>ZRO) THEN &
                       GOTO ML'NXT1
18530           FIX'CNT=FIX'CNT+1
18540   !
18550           GOTO ML'NXT1
18560   ML'END1:
18570           ? #2,INP'CNT;" records input"
18580           ? #2,FIX'CNT;" records fixed"
18590           CLOSE #1
18600           CLOSE #2
18610   !
18620           GOTO CHAIN1
18630   !
18640   ! ********** SUBROUTINES - IN ALPHABETICAL ORDER **********
18650   ! ******
18660   O'FIL1:
18670           OPEN #FIL1, &
                       FIL1$, &
                       INDEXED, &
                       FIL1R, &
                       ISP'STATUS, &
                       WAIT'FILE, &
                       WAIT'RECORD
18680           RETURN
++INCLUDE CABORT
++INCLUDE CCLFIL
++INCLUDE CCLEAR
++INCLUDE CDWMSG
++INCLUDE CEDDTE
++INCLUDE CGCTRL
++INCLUDE CFETH0
++INCLUDE CFETH1
++INCLUDE CFETH2
++INCLUDE CGFIDX
++INCLUDE CGTACS
++INCLUDE CGTIME
++INCLUDE CGTPSZ
++INCLUDE CGTPTR
++INCLUDE CGTWFN
++INCLUDE CISAMP
++INCLUDE CMSGER
++INCLUDE CMSGIF
++INCLUDE CMSGWR
++INCLUDE CSAPRT
++INCLUDE CSCTR0
++INCLUDE CSCTR1
++INCLUDE CSTTOF
! SUFX02.BP     Fix MB IVMAST.
!
!                                 NOTICE
!
!All  rights  reserved.  This software is the property of Starr Computer Inc
!and the material contained herein is the  proprietary  property  and  trade
!secrets  of  Starr Computer Inc, embodying substantial creative efforts and
!confidential information, ideas and expressions, no part of  which  may  be
!reproduced  or  transmitted  in  any  form  or  by  any  means, electronic,
!mechanical,  or  otherwise,  including  photocopying  or  input  into   any
!information  storage  or  retrieval  system  without  the  express  written
!permission of Starr Computer Inc.
!
!CAUTION: Unauthorized distribution or reproduction  of  this  material  may
!subject you to legal action.
!
! 08/25/94 RJ.  4.0(100). New program.
!
       PROGRAM SUFX02,4.0(100)
       STRSIZ 50
++INCLUDE MBASIC
++INCLUDE MACSCO
++INCLUDE MASETP
++INCLUDE MCCHAR
++INCLUDE MEDDTE
++INCLUDE MESPDT
++INCLUDE MISAMP
++INCLUDE MMCTRL
++INCLUDE MMISC1
++INCLUDE MMISC2
++INCLUDE MSCTR0
++INCLUDE MSCTR1
++INCLUDE MVERIV
++INCLUDE MVERSA
++INCLUDE IVMAST
! ISAM Plus.
++INCLUDE ISAMP
! ESP.
++INCLUDE SYSSTD
18000   START:  ON ERROR GOTO 0
18010   ! Initialize.
18020           FALSE=0
18030           TRUE=NOT FALSE
18040   !
18050           ABO'PGM$="SUFX02"
18060           ALL$="ALL"
18070           DSH$="--------------------------------------------------"
18080           MRD$="##########.##"
18082           MRQ$="############"
18090           RECLEN1=IVM'RECLEN
18100   ! Master ctrl.
18110           FIL0$=MAC$
18120           FIL0=MAC
18130           FIL0R=ZRO:GCT'OPT=1:CALL GET'CTRL
18140           IF (GCT'RET<>ZRO) THEN &
                       GOTO CHAIN0
18150           MACTRL=CTRLX
18160   ! INV file ctrl.
18170           FIL0R=MAC'IVF'REC:CALL GET'CTRL
18180           FLCTRL=CTRLX
18190   ! INV master.
18200           FIL1$=FLC'DEV(2)+FLC'FIL(2)+MAC'FID+FLC'PPN(2)
18210           FIL1=502
18220   !
18230           CALL O'FIL1
18240   !
18250   MENU:
18260   ! Initialize the terminal.
18270           ? TAB(-1,0);"INV fix MB IVMAST (reorder)"
18280           ? TAB(-1,28)
18290           ? "Enter return to continue, or Control C to abort ";
18300           INPUT LINE;A$
18310           GOTO MAINL
18320   !
18330   CHAIN0: S$=CHAIN0$:GOTO CHAIN'NXT
18340   CHAIN1: S$="SUUTMU":GOTO FINISH
18350   FINISH:
18360           CFIL=FIL1:CALL C'FIL
18370   CHAIN'NXT:
18380           CHAIN S$
18390   !
18400   MAINL:
18410           INP'CNT=ZRO
18420           FIX'CNT=ZRO
18430           OPEN #2,"SCSWRK:SUFX02.LST",OUTPUT
18440   ! Position ISAM.
18450           ISP'FILNUM=FIL1
18460           ISP'KEYNUM=IVM'ITEM'NO'KEYNUM
18470           ISP'REL=ISP'REL'GE
18480           ISP'KEYVAL$=NL$
18490           ABO'LOCAL=TRUE
18500           CALL ISP'FIND
18510           IF (ISP'STATUS<ISAM'OK) THEN &
                       GOTO ML'END1
18520   ML'NXT1:
18530   ! Read the next record.
18540           ISP'FILNUM=FIL1
18550           ABO'LOCAL=TRUE
18560           CALL ISP'GET'NEXT'LOCKED
18570           IF (ISP'STATUS<>ISAM'OK) THEN &
                       ISP'FILNUM=FIL1: &
                       CALL ISP'RELEASE'LAST: &
                       GOTO ML'END1
18580           IVMAST=ISP'RECBUF
18590   !
18600           INP'CNT=INP'CNT+1
18610   ! Fix it.
18660           IVM'REORDER'LOW=(IVM'REORDER'LOW*IVM'UNITS'MULT) USING MRQ$
18670           IVM'REORDER'HIGH=(IVM'REORDER'HIGH*IVM'UNITS'MULT) USING MRQ$
18680           FIX'CNT=FIX'CNT+1
18690   ! Write the changed record to the file.
18700           ISP'FILNUM=FIL1
18710           ISP'RECSIZ=RECLEN1
18720           ABO'LOCAL=TRUE
18730           ISP'RECBUF=IVMAST
18740           CALL ISP'UPDATE'RECORD
18750   ! Handle error conditions.
18760           IF (ISP'STATUS<>ISAM'OK) THEN &
                       ISP'FILNUM=FIL1: &
                       CALL ISP'RELEASE'LAST
18770   ! Release it.
18780           ISP'FILNUM=FIL1
18790           CALL ISP'RELEASE'LAST
18800   !
18810           GOTO ML'NXT1
18820   !
18830   ML'END1:
18840           ? #2,INP'CNT;" records input"
18850           ? #2,FIX'CNT;" records fixed"
18860           CLOSE #2
18870   !
18880           GOTO CHAIN1
18890   !
18900   ! ********** SUBROUTINES - IN ALPHABETICAL ORDER **********
18910   ! ******
18920   O'FIL1:
18930           OPEN #FIL1, &
                       FIL1$, &
                       INDEXED, &
                       FIL1R, &
                       ISP'STATUS, &
                       WAIT'FILE, &
                       WAIT'RECORD
18940           RETURN
++INCLUDE CABORT
++INCLUDE CCLFIL
++INCLUDE CCLEAR
++INCLUDE CDWMSG
++INCLUDE CEDDTE
++INCLUDE CGCTRL
++INCLUDE CFETH0
++INCLUDE CFETH1
++INCLUDE CFETH2
++INCLUDE CGFIDX
++INCLUDE CGTACS
++INCLUDE CGTIME
++INCLUDE CGTPSZ
++INCLUDE CGTPTR
++INCLUDE CGTWFN
++INCLUDE CISAMP
++INCLUDE CMSGER
++INCLUDE CMSGIF
++INCLUDE CMSGWR
++INCLUDE CSAPRT
++INCLUDE CSCTR0
++INCLUDE CSCTR1
++INCLUDE CSTTOF

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.