[628] | 1 | %ZIS6 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;1/24/08 16:09
|
---|
| 2 | ;;8.0;KERNEL;**24,49,69,118,127,136,440**;JUL 10, 1995;Build 13
|
---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified
|
---|
| 4 | ;Expect that IO is current device
|
---|
| 5 | OXECUTE ;Open Execute
|
---|
| 6 | I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2
|
---|
| 7 | ANSBAK ;Answer Back
|
---|
| 8 | I $D(^%ZIS(2,%ZISIOST(0),102)) S %Y=^(102) D 2 E S POP=1 D:'$D(IOP) SAY($C(7)_"[NOT ON LINE]") C:%ZISB IO K IO(1,IO) G QUIT
|
---|
| 9 | I $D(%ZISMTR) X ^%ZOSF("MAGTAPE") U IO W:$D(%MT("REW")) @%MT("REW") U IO(0) K %MT
|
---|
| 10 | G QUIT:'$D(IO("P"))
|
---|
| 11 | I $F(IO("P"),"B"),$D(^%ZIS(2,%ZISIOST(0),7)) S %Y=$P(^(7),"^",1) I %Y]"" W @%Y
|
---|
| 12 | S %Y=$F(IO("P"),"P") G QLTY:'%Y S %Y=+$E(IO("P"),%Y,99),%X=$S(%Y=16:12.1,%Y=10!(%Y=12):5,1:"") G QLTY:'%X
|
---|
| 13 | S %Y=$S($D(^%ZIS(2,%ZISIOST(0),%X)):$P(^(%X),"^",$S(%Y=12:2,1:1)),1:"")
|
---|
| 14 | I %Y]"" W @%Y
|
---|
| 15 | QLTY S %Y=$F(IO("P"),"Q") Q:'%Y S %Y=+$E(IO("P"),%Y,99),%X=$S(%Y<0!(%Y>2):0,1:%Y+1)
|
---|
| 16 | I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]"" W @%Y
|
---|
| 17 | QUIT U:%IS'[0 IO(0)
|
---|
| 18 | Q
|
---|
| 19 | 2 Q:%Y="" I %IS'[0,$D(^%ZIS(1,+%H,"TYPE")),^("TYPE")["TRM" D OH Q:POP
|
---|
| 20 | S %X=$T U IO D %Y^ZISX ;Q:'%X U IO(0)
|
---|
| 21 | Q
|
---|
| 22 | OH Q:$S($G(IO(0))]"":$D(IO(1,IO(0))),1:0)
|
---|
| 23 | N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP")
|
---|
| 24 | O IO(0)::0 S IO(1,IO(0))="" Q ;See that HOME DEVICE is open.
|
---|
| 25 | ;
|
---|
| 26 | SAY(%SAY) ;
|
---|
| 27 | Q:%IS[0 U IO(0) W %SAY U IO
|
---|
| 28 | Q
|
---|
| 29 | RES1 ;Allocate a resource slot, Release in %ZISC.
|
---|
| 30 | N A,L,X,%ZISD0
|
---|
| 31 | S %ZISD0=$O(^%ZISL(3.54,"B",IO,0))
|
---|
| 32 | I '%ZISD0 S %ZISD0=$$RADD(IO) ;New one
|
---|
| 33 | L +^%ZISL(3.54,%ZISD0,0):2 I '$T S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX
|
---|
| 34 | RES2 S X=$P(^%ZISL(3.54,%ZISD0,0),"^",2)
|
---|
| 35 | I X<1 S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX
|
---|
| 36 | S X=$S(X>0:X-1,1:0),$P(^%ZISL(3.54,%ZISD0,0),"^",2)=X
|
---|
| 37 | ;
|
---|
| 38 | R1 ;Grab a slot
|
---|
| 39 | S IO(1,IO)="RES",A=$G(^%ZISL(3.54,%ZISD0,1,0),"^3.542^^")
|
---|
| 40 | F L=1:1:%ZISRL I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q
|
---|
| 41 | I '$T K IO(1,IO) G RES2 ;No free slots
|
---|
| 42 | S ^%ZISL(3.54,%ZISD0,1,L,0)=L_"^"_%ZISV_"^"_$J_"^"_$G(ZTSK)_"^"_$H,^%ZISL(3.54,"AJ",$J,%ZISD0,L)="",^%ZISL(3.54,%ZISD0,1,"B",L,L)=""
|
---|
| 43 | S $P(A,"^",3,4)=L_U_($P(A,U,4)+1),^%ZISL(3.54,%ZISD0,1,0)=A
|
---|
| 44 | RESX L -^%ZISL(3.54,%ZISD0,0) Q
|
---|
| 45 | ;
|
---|
| 46 | RADD(X) ;Add Resource
|
---|
| 47 | N %1,%2
|
---|
| 48 | S %1=$G(^%ZISL(3.54,0),"RESOURCE^3.54^^"),%2=$P(%1,U,3)
|
---|
| 49 | F %2=%2:1 Q:'$D(^%ZISL(3.54,%2,0))
|
---|
| 50 | S $P(^%ZISL(3.54,0),U,3,4)=%2_U_($P(%1,U,4)+1),^%ZISL(3.54,%2,0)=X_"^"_$G(%ZISRL,1),^%ZISL(3.54,"B",X,%2)=""
|
---|
| 51 | Q %2
|
---|
| 52 | ;
|
---|
| 53 | RESOK ;DEVOK check for RES devices, for all OS's.
|
---|
| 54 | N %ZISD0,%ZISD1
|
---|
| 55 | S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
|
---|
| 56 | I '%ZISD0 S Y=-1,%ZISD0=$O(^%ZIS(1,"C",X,0)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q
|
---|
| 57 | S X1=$G(^%ZISL(3.54,+%ZISD0,0))
|
---|
| 58 | I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
|
---|
| 59 | S Y=999 F %ZISD1=0:0 S %ZISD1=$O(^%ZISL(3.54,%ZISD0,1,%ZISD1)) Q:%ZISD1'>0 I $D(^(%ZISD1,0)) S Y=$P(^(0),"^",3) Q
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | Q G Q^%ZIS3
|
---|
| 63 | HG ;
|
---|
| 64 | Q
|
---|
| 65 | SPL ;Spool type
|
---|
| 66 | N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T"
|
---|
| 67 | G Q
|
---|
| 68 | MT D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type
|
---|
| 69 | G Q
|
---|
| 70 | SDP ;Sequential disk processor type
|
---|
| 71 | D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
|
---|
| 72 | G Q
|
---|
| 73 | HFS ;Host File Server type
|
---|
| 74 | D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
|
---|
| 75 | G Q
|
---|
| 76 | RES ;Resources
|
---|
| 77 | G Q:%IS["T" N X,X1 I %IS'["R"!'$D(IOP) S POP=1 W:'$D(IOP) *7," [NOT AVAILABLE]" Q
|
---|
| 78 | G Q:$D(IO(1,IO)) I %IS["T" S X=IO,X1="RES" D DEVOK^%ZIS3 S:Y POP=1 G Q:POP
|
---|
| 79 | D:%ZISB RES1 G Q
|
---|
| 80 | CHAN ;Network Channel type devices -- DecNet or TCP/IP devices.
|
---|
| 81 | I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO ;DECNET Server Device
|
---|
| 82 | D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
|
---|
| 83 | G Q
|
---|
| 84 | IMPC ;Imaging Work Station
|
---|
| 85 | BAR ;Bar Code
|
---|
| 86 | OTH ;Other Device type
|
---|
| 87 | D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
|
---|
| 88 | G Q
|
---|
| 89 | ;
|
---|
| 90 | ASKPAR ;Ask Parameters
|
---|
| 91 | G SETPAR^%ZIS3:$D(IOP),SETPAR^%ZIS3:'$P(^%ZIS(1,%E,0),"^",4) W " ADDRESS/PARAMETERS: " W:%ZISOPAR]"" %ZISOPAR_"// " D SBR^%ZIS1 D MSG1:%X="?" G ASKPAR:%X="?" S:%X]"" %ZISOPAR=%X I $D(DTOUT)!$D(DUOUT) S POP=1
|
---|
| 92 | I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q
|
---|
| 93 | Q:POP G SETPAR^%ZIS3
|
---|
| 94 | ;
|
---|
| 95 | AMTREW ;Mag Tape Rewind
|
---|
| 96 | I %ZISB,%ZTYPE="MT",'$D(IOP) W " REWIND" S %=2,U="^",%ZISDTIM=60 D YN^%ZIS1 K %ZISDTIM G AMTREW:%=0 I %=-1 S POP=1 Q
|
---|
| 97 | S:%=1 %ZISMTR=1
|
---|
| 98 | Q
|
---|
| 99 | MSG1 W !?5,"Enter the desired parameters needed to open the selected device.",!?25
|
---|
| 100 | Q
|
---|
| 101 | ;
|
---|