AIBSDEV ;IBM STATISTICAL RECORD ROUTINES SELECT DEVICE ;[ 02/01/89 9:16 AM ]
;1.3; 1/13/89 SET AIBTONL TO "I 1"
;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
;1.1 ;MODIFY FOR USE BY BOTH MSM AND DSM
OUT ;ENTRY POINT FOR "OUTPUT" FILE
S AIBTXIO=" output ",IN=0 G:AIBOS="M" HFS S AIBDFLT=48
S (AIBBL,AIBRL)=AIBRLN S:AIBRLN>250 AIBRL=250
S AIBPARMS="("_"""EFU"""_":"_AIBRL_":"_AIBBL_")" D TAPE^AIBSDEV1 G EXIT
IN ;ENTRY POINT FOR "INPUT" FILE
S AIBTXIO=" input ",IN=1 G:AIBOS="M" HFS
S AIBDFLT=47,AIBPARMS="("_"""CALV4"""_":R)" D TAPE^AIBSDEV1 G EXIT
PR ;ENTRY POINT FOR PRINTER
S AIBDFLT=3 G TERMIO
P0 ;ENTRY POINT FOR "HOME" TERMINAL
S AIBDFLT=0 G TERMIO
CRT ;ENTRY POINT FOR CUURRENT DEVICE
S AIBDFLT=$I G TERMIO
TERMIO ;TERMINAL OUTPUT DEVICES SET
S IN=0,AIBTXIO=" output ",(AIBHL,AIBHH)="" G SELECT
HFS ;HOST FILE SERVER AS DEFAULT
S AIBDFLT="HFS"
S AIBHL=51,AIBHH=54,AIBTONL="I 1"
I $D(AIBFFN) I AIBFFN=2 S AIBDEV=AIBHL G OPENHFS
SELECT ;SELECT DEVICE
S:'$D(AIBDFLT) AIBDFLT="" W !!,"Enter",AIBTXIO,"device: ",AIBDFLT,"// "
R AIBDEV:DTIME S:AIBDEV="" AIBDEV=AIBDFLT S:AIBDEV=0 AIBDEV=$I
I AIBDEV="?" G HELP
I AIBDEV="^"!(AIBDEV="^Q") S AIBA="A" G QUIT
I $E(AIBDEV,1,$L(AIBDEV))='$E("HFS",1,$L(AIBDEV)) G CKDEV
W $E("HFS",$L(AIBDEV)+1,3)," Host File Server" S AIBDEV=AIBHL
CKDEV ;
I AIBDEV?1N.N!(AIBDEV<223) G SETDEV
W !,"Device number must be numeric, 0 to 223" G SELECT
SETDEV ;
I AIBDEV<AIBHL!(AIBDEV>AIBHH) G TERMDEV
G FILENAME
HELP ;
W !,"Enter 'HFS' for Host File Server or device #"
G SELECT
FILENAME ;READ FILENAME
I $D(AIBFN) I $D(AIBFFN) G OPENHFS
S:'$D(AIBFN) AIBFN=$S(IN:"/dev/rct",1:"/dev/rmt0")
W !,"Enter File Name : ",AIBFN,"// "
R X:DTIME S:X'="" AIBFN=X
G QUIT:AIBFN="",QUIT:AIBFN="Q^"!(AIBFN="q^") I AIBFN="^" S AIBA="C" G QUIT
G:AIBFN'="?" OPENHFS
W !!,?5,"Enter the name of the host oprating system file to "
W $S(IN:"read from on",1:"write to on"),AIBTXIO
W !,?5,"the file name should include the fully qualified path name "
W !,?5,"that identifies the location of the file",! G FILENAME
OPENHFS ;OPEN HOST FILE SERVER FILE
S:'$D(AIBT2) AIBT2=$S(IN:"R",1:"W") S AIBPARMS="(AIBFN:AIBT2)"
D OPEN I $T G EXIT
I AIBDEV=AIBHH G BUSY
S ZA=$ZA U AIBCDV
I ZA<0 W !,?5,"Open Failed on Device ",AIBDEV," for file ",AIBFN,*7 G FILENAME
G EXIT
BUSY ;
U AIBCDV W !!,"All Host File Server (HFS) devices are busy" G SELECT
TERMDEV ;TERMINAL DEVICES
G:AIBDEV=$I EXIT
S AIBT="",AIBT=$O(^%ZIS(1,"C",AIBDEV,AIBT))
I AIBT="" W !,"device doesn't exist" G SELECT
S AIBPARMS=":1" D OPEN I $T G EXIT
E W !!,"Device busy" G SELECT
G EXIT
ABEND ;ABNORMAL END OF JOB
S AIBA="A" G QUIT
OPCANCL ;OPERATOR CANCEL
S AIBA="C" G QUIT
QUIT ;KILL LOCAL VARIABLES AND QUIT
K AIBDEV,AIBPARMS S QUIT=1
EXIT ;KILL REMAINING LOCAL VARIABLES AND QUIT
K AIBRL,AIBBL,AIBPL,AIBPB,AIBDFLT,AIBOF,IN,AIBDR,AIBDEVTB,AIBTXIO,AIBHL,AIBHH,ZA,AIBT
RETURN ;RETURN TO CALLING ROUTINE
Q
OPEN ;OPEN SELECTED DEVICE/FILE
I AIBOS="M"!('IN) S AIBOPN="O "_AIBDEV_":"_AIBPARMS_":0" X AIBOPN K AIBOPN Q
E S IOP=AIBDEV D ^%ZIS
G RETURN
CLOSE ;CLOSE SELECTED DEVICE/FILE
I AIBOS="D" X ^%ZIS("C")
E G:'$D(AIBDEV)!($L(AIBDEV)<1) RETURN S AIBCLOSE="C "_AIBDEV X AIBCLOSE K AIBCLOSE
G RETURN
AIBSDEV ;IBM STATISTICAL RECORD ROUTINES SELECT DEVICE ;[ 02/01/89 9:16 AM ]
+1 ;1.3; 1/13/89 SET AIBTONL TO "I 1"
+2 ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
+3 ;1.1 ;MODIFY FOR USE BY BOTH MSM AND DSM
OUT ;ENTRY POINT FOR "OUTPUT" FILE
+1 SET AIBTXIO=" output "
SET IN=0
IF AIBOS="M"
GOTO HFS
SET AIBDFLT=48
+2 SET (AIBBL,AIBRL)=AIBRLN
IF AIBRLN>250
SET AIBRL=250
+3 SET AIBPARMS="("_"""EFU"""_":"_AIBRL_":"_AIBBL_")"
DO TAPE^AIBSDEV1
GOTO EXIT
IN ;ENTRY POINT FOR "INPUT" FILE
+1 SET AIBTXIO=" input "
SET IN=1
IF AIBOS="M"
GOTO HFS
+2 SET AIBDFLT=47
SET AIBPARMS="("_"""CALV4"""_":R)"
DO TAPE^AIBSDEV1
GOTO EXIT
PR ;ENTRY POINT FOR PRINTER
+1 SET AIBDFLT=3
GOTO TERMIO
P0 ;ENTRY POINT FOR "HOME" TERMINAL
+1 SET AIBDFLT=0
GOTO TERMIO
CRT ;ENTRY POINT FOR CUURRENT DEVICE
+1 SET AIBDFLT=$IO
GOTO TERMIO
TERMIO ;TERMINAL OUTPUT DEVICES SET
+1 SET IN=0
SET AIBTXIO=" output "
SET (AIBHL,AIBHH)=""
GOTO SELECT
HFS ;HOST FILE SERVER AS DEFAULT
+1 SET AIBDFLT="HFS"
+2 SET AIBHL=51
SET AIBHH=54
SET AIBTONL="I 1"
+3 IF $DATA(AIBFFN)
IF AIBFFN=2
SET AIBDEV=AIBHL
GOTO OPENHFS
SELECT ;SELECT DEVICE
+1 IF '$DATA(AIBDFLT)
SET AIBDFLT=""
WRITE !!,"Enter",AIBTXIO,"device: ",AIBDFLT,"// "
+2 READ AIBDEV:DTIME
IF AIBDEV=""
SET AIBDEV=AIBDFLT
IF AIBDEV=0
SET AIBDEV=$IO
+3 IF AIBDEV="?"
GOTO HELP
+4 IF AIBDEV="^"!(AIBDEV="^Q")
SET AIBA="A"
GOTO QUIT
+5 IF $EXTRACT(AIBDEV,1,$LENGTH(AIBDEV))='$EXTRACT("HFS",1,$LENGTH(AIBDEV))
GOTO CKDEV
+6 WRITE $EXTRACT("HFS",$LENGTH(AIBDEV)+1,3)," Host File Server"
SET AIBDEV=AIBHL
CKDEV ;
+1 IF AIBDEV?1N.N!(AIBDEV<223)
GOTO SETDEV
+2 WRITE !,"Device number must be numeric, 0 to 223"
GOTO SELECT
SETDEV ;
+1 IF AIBDEV<AIBHL!(AIBDEV>AIBHH)
GOTO TERMDEV
+2 GOTO FILENAME
HELP ;
+1 WRITE !,"Enter 'HFS' for Host File Server or device #"
+2 GOTO SELECT
FILENAME ;READ FILENAME
+1 IF $DATA(AIBFN)
IF $DATA(AIBFFN)
GOTO OPENHFS
+2 IF '$DATA(AIBFN)
SET AIBFN=$SELECT(IN:"/dev/rct",1:"/dev/rmt0")
+3 WRITE !,"Enter File Name : ",AIBFN,"// "
+4 READ X:DTIME
IF X'=""
SET AIBFN=X
+5 IF AIBFN=""
GOTO QUIT
IF AIBFN="Q^"!(AIBFN="q^")
GOTO QUIT
IF AIBFN="^"
SET AIBA="C"
GOTO QUIT
+6 IF AIBFN'="?"
GOTO OPENHFS
+7 WRITE !!,?5,"Enter the name of the host oprating system file to "
+8 WRITE $SELECT(IN:"read from on",1:"write to on"),AIBTXIO
+9 WRITE !,?5,"the file name should include the fully qualified path name "
+10 WRITE !,?5,"that identifies the location of the file",!
GOTO FILENAME
OPENHFS ;OPEN HOST FILE SERVER FILE
+1 IF '$DATA(AIBT2)
SET AIBT2=$SELECT(IN:"R",1:"W")
SET AIBPARMS="(AIBFN:AIBT2)"
+2 DO OPEN
IF $TEST
GOTO EXIT
+3 IF AIBDEV=AIBHH
GOTO BUSY
+4 SET ZA=$ZA
USE AIBCDV
+5 IF ZA<0
WRITE !,?5,"Open Failed on Device ",AIBDEV," for file ",AIBFN,*7
GOTO FILENAME
+6 GOTO EXIT
BUSY ;
+1 USE AIBCDV
WRITE !!,"All Host File Server (HFS) devices are busy"
GOTO SELECT
TERMDEV ;TERMINAL DEVICES
+1 IF AIBDEV=$IO
GOTO EXIT
+2 SET AIBT=""
SET AIBT=$ORDER(^%ZIS(1,"C",AIBDEV,AIBT))
+3 IF AIBT=""
WRITE !,"device doesn't exist"
GOTO SELECT
+4 SET AIBPARMS=":1"
DO OPEN
IF $TEST
GOTO EXIT
+5 IF '$TEST
WRITE !!,"Device busy"
GOTO SELECT
+6 GOTO EXIT
ABEND ;ABNORMAL END OF JOB
+1 SET AIBA="A"
GOTO QUIT
OPCANCL ;OPERATOR CANCEL
+1 SET AIBA="C"
GOTO QUIT
QUIT ;KILL LOCAL VARIABLES AND QUIT
+1 KILL AIBDEV,AIBPARMS
SET QUIT=1
EXIT ;KILL REMAINING LOCAL VARIABLES AND QUIT
+1 KILL AIBRL,AIBBL,AIBPL,AIBPB,AIBDFLT,AIBOF,IN,AIBDR,AIBDEVTB,AIBTXIO,AIBHL,AIBHH,ZA,AIBT
RETURN ;RETURN TO CALLING ROUTINE
+1 QUIT
OPEN ;OPEN SELECTED DEVICE/FILE
+1 IF AIBOS="M"!('IN)
SET AIBOPN="O "_AIBDEV_":"_AIBPARMS_":0"
XECUTE AIBOPN
KILL AIBOPN
QUIT
+2 IF '$TEST
SET IOP=AIBDEV
DO ^%ZIS
+3 GOTO RETURN
CLOSE ;CLOSE SELECTED DEVICE/FILE
+1 IF AIBOS="D"
XECUTE ^%ZIS("C")
+2 IF '$TEST
IF '$DATA(AIBDEV)!($LENGTH(AIBDEV)<1)
GOTO RETURN
SET AIBCLOSE="C "_AIBDEV
XECUTE AIBCLOSE
KILL AIBCLOSE
+3 GOTO RETURN
