source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/_ZIS6.m@ 701

Last change on this file since 701 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 4.1 KB
Line 
1%ZIS6 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;02/04/2000 08:14
2 ;;8.0;KERNEL;**24,49,69,118,127,136**;JUL 10, 1995
3 ;Expect that IO is current device
4OXECUTE I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2
5ANSBAK 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
6 I $D(%ZISMTR) X ^%ZOSF("MAGTAPE") U IO W:$D(%MT("REW")) @%MT("REW") U IO(0) K %MT
7 G QUIT:'$D(IO("P"))
8 I $F(IO("P"),"B"),$D(^%ZIS(2,%ZISIOST(0),7)) S %Y=$P(^(7),"^",1) I %Y]"" W @%Y
9 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
10 S %Y=$S($D(^%ZIS(2,%ZISIOST(0),%X)):$P(^(%X),"^",$S(%Y=12:2,1:1)),1:"")
11 I %Y]"" W @%Y
12QLTY 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)
13 I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]"" W @%Y
14QUIT U:%IS'[0 IO(0)
15 Q
162 Q:%Y="" I %IS'[0,$D(^%ZIS(1,+%H,"TYPE")),^("TYPE")["TRM" D OH Q:POP
17 S %X=$T U IO D %Y^ZISX ;Q:'%X U IO(0)
18 Q
19OH Q:$S($G(IO(0))]"":$D(IO(1,IO(0))),1:0)
20 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP")
21 O IO(0)::0 S IO(1,IO(0))="" Q ;See that HOME DEVICE is open.
22 ;
23SAY(%SAY) ;
24 Q:%IS[0 U IO(0) W %SAY U IO
25 Q
26RES1 ;Allocate a resource slot, Release in %ZISC.
27 N A,L,X,%ZISD0
28 S %ZISD0=$O(^%ZISL(3.54,"B",IO,0))
29 I '%ZISD0 S %ZISD0=$$RADD(IO) ;New one
30 L +^%ZISL(3.54,%ZISD0,0):2 I '$T S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX
31RES2 S X=$P(^%ZISL(3.54,%ZISD0,0),"^",2)
32 I X<1 S POP=1 W:'$D(IOP) *7," [NOT Available]" G RESX
33 S X=$S(X>0:X-1,1:0),$P(^%ZISL(3.54,%ZISD0,0),"^",2)=X
34 ;
35R1 ;Grab a slot
36 S IO(1,IO)="RES",A=$G(^%ZISL(3.54,%ZISD0,1,0),"^3.542^^")
37 F L=1:1:%ZISRL I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q
38 I '$T K IO(1,IO) G RES2 ;No free slots
39 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)=""
40 S $P(A,"^",3,4)=L_U_($P(A,U,4)+1),^%ZISL(3.54,%ZISD0,1,0)=A
41RESX L -^%ZISL(3.54,%ZISD0,0) Q
42 ;
43RADD(X) ;Add Resource
44 N %1,%2
45 S %1=$G(^%ZISL(3.54,0),"RESOURCE^3.54^^"),%2=$P(%1,U,3)
46 F %2=%2:1 Q:'$D(^%ZISL(3.54,%2,0))
47 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)=""
48 Q %2
49 ;
50RESOK ;DEVOK check for RES devices, for all OS's.
51 N %ZISD0,%ZISD1
52 S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
53 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
54 S X1=$G(^%ZISL(3.54,+%ZISD0,0))
55 I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
56 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
57 Q
58 ;
59Q G Q^%ZIS3
60HG ;
61 Q
62SPL N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T" ;Spool type
63 G Q
64MT D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type
65 G Q
66SDP D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Sequential disk processor type
67 G Q
68HFS D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Host File Server type
69 G Q
70RES G Q:%IS["T" N X,X1 I %IS'["R"!'$D(IOP) S POP=1 W:'$D(IOP) *7," [NOT AVAILABLE]" Q ;Resources
71 G Q:$D(IO(1,IO)) I %IS["T" S X=IO,X1="RES" D DEVOK^%ZIS3 S:Y POP=1 G Q:POP
72 D:%ZISB RES1 G Q
73CHAN ;Network Channel type devices -- DecNet or TCP/IP devices.
74 I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO ;DECNET Server Device
75 D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
76 G Q
77IMPC ;Imaging Work Station
78BAR ;Bar Code
79OTH D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Other Device type
80 G Q
81 ;
82ASKPAR 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
83 I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q
84 Q:POP G SETPAR^%ZIS3
85AMTREW 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
86 S:%=1 %ZISMTR=1 Q
87MSG1 W !?5,"Enter the desired parameters needed to open the selected device.",!?25 Q
88 ;
Note: See TracBrowser for help on using the repository browser.