Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AIBSDEV

AIBSDEV.m

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