Routine: AIBTCFLM

AIBTCFLM ;IHS/AAO/MFD;FRONT-END TELECOMM FILE GATHER BEFORE MERGE/CONVERT [ 02/01/89  9:08 AM ]

 ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE

 ;1.01 ;DFM ;10/1/88

 ;1.00 ;5/24/88 UNDER NAME OF AIBFILES

 ;Set AIBGLPRE=global prefix you wish to merge and AIBFILE="keytap"

 ;or "ibmjob" prior to doing this routine.

 ;This routine calls AIBMRG then goes to AIBCVT.

 ;Comment out DOEM+2 to do the merge only and not go right into convert.

 S AIBFILE="keytap" G INTRO

IBMJOB ;USE THIS ENTRY POINT TO CREATE TELECOM FILE FOR MAINFRAME

 S AIBFILE="ibmjob"

INTRO S:'$D(DTIME) DTIME=300 S AIBFFN=2

 I '$D(AIBGLPRE) R !!,"Enter Global Prefix (i.e. AGTX) for merge: ",AIBGLPRE:DTIME G ALLDONE:"^"[AIBGLPRE!(AIBGLPRE'?4A)

 W !!,"GLOBAL MERGE AND CONVERSION FOR "_AIBGLPRE_"DATA"

GFILES S AIBDEV=51,AIBPFN="/usr/spool/uucppublic/"_AIBGLPRE K CODENO,ZA,I

 R !!,"Enter Unix file suffixes, separated by commas",!,"(i.e. 202101.42,202401.36)  :  ",CODENOS:DTIME G ALLDONE:CODENOS=""!(CODENOS["^")!('$T) G:CODENOS["?" GFILES

 S AIBCC=1

SETCOD F N=1:1 S CODENO(AIBCC)=$P(CODENOS,",",N) Q:$P(CODENOS,",",N)=""  S AIBCC=AIBCC+1

 S AIBCC=AIBCC-1 K N W !

 F I=1:1:AIBCC W ! W ?4,AIBPFN_CODENO(I)

 W !!,"Are these the files you wish to extract from? ('^' to re-enter) (Y/N) Y// " R X:DTIME S:X="" X="Y" G ALLDONE:X["N",GFILES:X["^"

CHK F I=1:1:AIBCC D CHKHFS I ZA<0 G GFILES

WHATPRT S %IS("A")="Select Printer for Error Reports: ",%IS("B")=3,%IS="",IO="" D ^%ZIS G:IO="" ALLDONE S AIBPDV=IO

 K X,ZA S AIBOK=1,AIBGLOB="^"_AIBGLPRE_"GLOB" K @AIBGLOB,AIBGLOB

 K:AIBGLPRE="AGTX" ^AGDMGLOB,^AGHAGLOB,^AGELGLOB

DOEM F I=1:1:AIBCC D CHKHFS

 K I,CODENOS,CODENO,ZA,AIBDEV,AIBPFN,AIBFN

 S AIBGBLP=AIBGLPRE K AIBGLPRE D ^AIBCVT ;COMMENT OUT THIS LINE TO QUIT WITHOUT CONVERTION TO 9TRACK OR IBM TC FILE

 G ALLDONE

CHKHFS ;

 S AIBFN=AIBPFN_CODENO(I)

OPENHFS O AIBDEV:(AIBFN:"R"):0

 U AIBDEV S ZA=$ZA U 0 I ZA<0 W !,?5,"Open failed on device 51 for file",AIBFN,*7,!!,?30,"TRY AGAIN" Q

 D:$D(AIBOK) BEGIN^AIBMRG

 C AIBDEV

ALLDONE K AIBOK,AIBGLPRE,AIBFILE,I,CODENOS,CODENO,AIBCC,ZA,AIBDEV,AIBPFN,AIBFN,AIBFFN

 ;IHS/MFD ADDED AIBFFN ABOVE

AIBTCFLM  ;IHS/AAO/MFD;FRONT-END TELECOMM FILE GATHER BEFORE MERGE/CONVERT [ 02/01/89  9:08 AM ]

 +1       ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE

 +2       ;1.01 ;DFM ;10/1/88

 +3       ;1.00 ;5/24/88 UNDER NAME OF AIBFILES

 +4       ;Set AIBGLPRE=global prefix you wish to merge and AIBFILE="keytap"

 +5       ;or "ibmjob" prior to doing this routine.

 +6       ;This routine calls AIBMRG then goes to AIBCVT.

 +7       ;Comment out DOEM+2 to do the merge only and not go right into convert.

 +8        SET AIBFILE="keytap"

           GOTO INTRO

IBMJOB    ;USE THIS ENTRY POINT TO CREATE TELECOM FILE FOR MAINFRAME

 +1        SET AIBFILE="ibmjob"

INTRO      IF '$DATA(DTIME)

               SET DTIME=300

           SET AIBFFN=2

 +1        IF '$DATA(AIBGLPRE)

               READ !!,"Enter Global Prefix (i.e. AGTX) for merge: ",AIBGLPRE:DTIME

               IF "^"[AIBGLPRE!(AIBGLPRE'?4A)

                   GOTO ALLDONE

 +2        WRITE !!,"GLOBAL MERGE AND CONVERSION FOR "_AIBGLPRE_"DATA"

GFILES     SET AIBDEV=51

           SET AIBPFN="/usr/spool/uucppublic/"_AIBGLPRE

           KILL CODENO,ZA,I

 +1        READ !!,"Enter Unix file suffixes, separated by commas",!,"(i.e. 202101.42,202401.36)  :  ",CODENOS:DTIME

           IF CODENOS=""!(CODENOS["^")!('$TEST)

               GOTO ALLDONE

           IF CODENOS["?"

               GOTO GFILES

 +2        SET AIBCC=1

SETCOD     FOR N=1:1

               SET CODENO(AIBCC)=$PIECE(CODENOS,",",N)

               IF $PIECE(CODENOS,",",N)=""

                   QUIT

               SET AIBCC=AIBCC+1

 +1        SET AIBCC=AIBCC-1

           KILL N

           WRITE !

 +2        FOR I=1:1:AIBCC

               WRITE !

               WRITE ?4,AIBPFN_CODENO(I)

 +3        WRITE !!,"Are these the files you wish to extract from? ('^' to re-enter) (Y/N) Y// "

           READ X:DTIME

           IF X=""

               SET X="Y"

           IF X["N"

               GOTO ALLDONE

           IF X["^"

               GOTO GFILES

CHK        FOR I=1:1:AIBCC

               DO CHKHFS

               IF ZA<0

                   GOTO GFILES

WHATPRT    SET %IS("A")="Select Printer for Error Reports: "

           SET %IS("B")=3

           SET %IS=""

           SET IO=""

           DO ^%ZIS

           IF IO=""

               GOTO ALLDONE

           SET AIBPDV=IO

 +1        KILL X,ZA

           SET AIBOK=1

           SET AIBGLOB="^"_AIBGLPRE_"GLOB"

           KILL @AIBGLOB,AIBGLOB

 +2        IF AIBGLPRE="AGTX"

               KILL ^AGDMGLOB,^AGHAGLOB,^AGELGLOB

DOEM       FOR I=1:1:AIBCC

               DO CHKHFS

 +1        KILL I,CODENOS,CODENO,ZA,AIBDEV,AIBPFN,AIBFN

 +2       ;COMMENT OUT THIS LINE TO QUIT WITHOUT CONVERTION TO 9TRACK OR IBM TC FILE

           SET AIBGBLP=AIBGLPRE

           KILL AIBGLPRE

           DO ^AIBCVT

 +3        GOTO ALLDONE

CHKHFS    ;

 +1        SET AIBFN=AIBPFN_CODENO(I)

OPENHFS    OPEN AIBDEV:(AIBFN:"R"):0

 +1        USE AIBDEV

           SET ZA=$ZA

           USE 0

           IF ZA<0

               WRITE !,?5,"Open failed on device 51 for file",AIBFN,*7,!!,?30,"TRY AGAIN"

               QUIT

 +2        IF $DATA(AIBOK)

               DO BEGIN^AIBMRG

 +3        CLOSE AIBDEV

 +4        QUIT

ALLDONE    KILL AIBOK,AIBGLPRE,AIBFILE,I,CODENOS,CODENO,AIBCC,ZA,AIBDEV,AIBPFN,AIBFN,AIBFFN

 +1       ;IHS/MFD ADDED AIBFFN ABOVE

 +2        QUIT

AIBTCFLM.m