Context Navigation

← Previous Change
Next Change →

_ZIS6.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

: 1 edited

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 (modified) (1 diff)

Legend:

: Unmodified
: Added
: Removed

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

-              r613
+              r623
+%ZIS6   ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;1/24/08  16:09
+        ;;8.0;KERNEL;**24,49,69,118,127,136,440**;JUL 10, 1995;Build 13
+        ;Per VHA Directive 2004-038, this routine should not be modified
+        ;Expect that IO is current device
+OXECUTE ;Open Execute
+        I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2
+ANSBAK  ;Answer Back
+        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
+        I $D(%ZISMTR) X ^%ZOSF("MAGTAPE") U IO W:$D(%MT("REW")) @%MT("REW") U IO(0) K %MT
+        G QUIT:'$D(IO("P"))
+        I $F(IO("P"),"B"),$D(^%ZIS(2,%ZISIOST(0),7)) S %Y=$P(^(7),"^",1) I %Y]"" W @%Y
+        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
+        S %Y=$S($D(^%ZIS(2,%ZISIOST(0),%X)):$P(^(%X),"^",$S(%Y=12:2,1:1)),1:"")
+        I %Y]"" W @%Y
+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)
+        I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]""  W @%Y
+QUIT    U:%IS'[0 IO(0)
+        Q
+       Q:%Y=""  I %IS'[0,$D(^%ZIS(1,+%H,"TYPE")),^("TYPE")["TRM" D OH Q:POP
+        S %X=$T U IO D %Y^ZISX ;Q:'%X  U IO(0)
+        Q
+OH      Q:$S($G(IO(0))]"":$D(IO(1,IO(0))),1:0)
+        N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP")
+        O IO(0)::0 S IO(1,IO(0))="" Q  ;See that HOME DEVICE is open.
+        ;
+SAY(%SAY)       ;
+        Q:%IS[0  U IO(0) W %SAY U IO
+        Q
+RES1    ;Allocate a resource slot, Release in %ZISC.
+        N A,L,X,%ZISD0
+        S %ZISD0=$O(^%ZISL(3.54,"B",IO,0))
+        I '%ZISD0 S %ZISD0=$$RADD(IO) ;New one
+        L +^%ZISL(3.54,%ZISD0,0):2 I '$T S POP=1 W:'$D(IOP) *7,"  [NOT Available]" G RESX
+RES2    S X=$P(^%ZISL(3.54,%ZISD0,0),"^",2)
+        I X<1 S POP=1 W:'$D(IOP) *7,"  [NOT Available]" G RESX
+        S X=$S(X>0:X-1,1:0),$P(^%ZISL(3.54,%ZISD0,0),"^",2)=X
+        ;
+R1      ;Grab a slot
+        S IO(1,IO)="RES",A=$G(^%ZISL(3.54,%ZISD0,1,0),"^3.542^^")
+        F L=1:1:%ZISRL I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q
+        I '$T K IO(1,IO) G RES2 ;No free slots
+        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)=""
+        S $P(A,"^",3,4)=L_U_($P(A,U,4)+1),^%ZISL(3.54,%ZISD0,1,0)=A
+RESX    L -^%ZISL(3.54,%ZISD0,0) Q
+        ;
+RADD(X) ;Add Resource
+        N %1,%2
+        S %1=$G(^%ZISL(3.54,0),"RESOURCE^3.54^^"),%2=$P(%1,U,3)
+        F %2=%2:1 Q:'$D(^%ZISL(3.54,%2,0))
+        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)=""
+        Q %2
+        ;
+RESOK   ;DEVOK check for RES devices, for all OS's.
+        N %ZISD0,%ZISD1
+        S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
+        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
+        S X1=$G(^%ZISL(3.54,+%ZISD0,0))
+        I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
+        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
+        Q
+        ;
+Q       G Q^%ZIS3
+HG      ;
+        Q
+SPL     ;Spool type
+        N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T"
+        G Q
+MT      D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type
+        G Q
+SDP     ;Sequential disk processor type
+        D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
+        G Q
+HFS     ;Host File Server type
+        D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
+        G Q
+RES     ;Resources
+        G Q:%IS["T" N X,X1 I %IS'["R"!'$D(IOP) S POP=1 W:'$D(IOP) *7,"  [NOT AVAILABLE]" Q
+        G Q:$D(IO(1,IO)) I %IS["T" S X=IO,X1="RES" D DEVOK^%ZIS3 S:Y POP=1 G Q:POP
+        D:%ZISB RES1 G Q
+CHAN    ;Network Channel type devices -- DecNet or TCP/IP devices.
+        I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO ;DECNET Server Device
+        D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
+        G Q
+IMPC    ;Imaging Work Station
+BAR     ;Bar Code
+OTH     ;Other Device type
+        D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
+        G Q
+        ;
+ASKPAR  ;Ask Parameters
+        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
+        I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q
+        Q:POP  G SETPAR^%ZIS3
+        ;
+AMTREW  ;Mag Tape Rewind
+        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
+        S:%=1 %ZISMTR=1
+        Q
+MSG1    W !?5,"Enter the desired parameters needed to open the selected device.",!?25
+        Q
+        ;
+%ZIS6 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;02/04/2000  08:14
+ ;;8.0;KERNEL;**24,49,69,118,127,136**;JUL 10, 1995
+ ;Expect that IO is current device
+OXECUTE I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2
+ANSBAK 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
+ I $D(%ZISMTR) X ^%ZOSF("MAGTAPE") U IO W:$D(%MT("REW")) @%MT("REW") U IO(0) K %MT
+ G QUIT:'$D(IO("P"))
+ I $F(IO("P"),"B"),$D(^%ZIS(2,%ZISIOST(0),7)) S %Y=$P(^(7),"^",1) I %Y]"" W @%Y
+ 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
+ S %Y=$S($D(^%ZIS(2,%ZISIOST(0),%X)):$P(^(%X),"^",$S(%Y=12:2,1:1)),1:"")
+ I %Y]"" W @%Y
+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)
+ I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]""  W @%Y
+QUIT U:%IS'[0 IO(0)
+ Q
+Q:%Y=""  I %IS'[0,$D(^%ZIS(1,+%H,"TYPE")),^("TYPE")["TRM" D OH Q:POP
+ S %X=$T U IO D %Y^ZISX ;Q:'%X  U IO(0)
+ Q
+OH Q:$S($G(IO(0))]"":$D(IO(1,IO(0))),1:0)
+ N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP")
+ O IO(0)::0 S IO(1,IO(0))="" Q  ;See that HOME DEVICE is open.
+ ;
+SAY(%SAY) ;
+ Q:%IS[0  U IO(0) W %SAY U IO
+ Q
+RES1 ;Allocate a resource slot, Release in %ZISC.
+ N A,L,X,%ZISD0
+ S %ZISD0=$O(^%ZISL(3.54,"B",IO,0))
+ I '%ZISD0 S %ZISD0=$$RADD(IO) ;New one
+ L +^%ZISL(3.54,%ZISD0,0):2 I '$T S POP=1 W:'$D(IOP) *7,"  [NOT Available]" G RESX
+RES2 S X=$P(^%ZISL(3.54,%ZISD0,0),"^",2)
+ I X<1 S POP=1 W:'$D(IOP) *7,"  [NOT Available]" G RESX
+ S X=$S(X>0:X-1,1:0),$P(^%ZISL(3.54,%ZISD0,0),"^",2)=X
+ ;
+R1 ;Grab a slot
+ S IO(1,IO)="RES",A=$G(^%ZISL(3.54,%ZISD0,1,0),"^3.542^^")
+ F L=1:1:%ZISRL I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q
+ I '$T K IO(1,IO) G RES2 ;No free slots
+ 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)=""
+ S $P(A,"^",3,4)=L_U_($P(A,U,4)+1),^%ZISL(3.54,%ZISD0,1,0)=A
+RESX L -^%ZISL(3.54,%ZISD0,0) Q
+ ;
+RADD(X) ;Add Resource
+ N %1,%2
+ S %1=$G(^%ZISL(3.54,0),"RESOURCE^3.54^^"),%2=$P(%1,U,3)
+ F %2=%2:1 Q:'$D(^%ZISL(3.54,%2,0))
+ 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)=""
+ Q %2
+ ;
+RESOK ;DEVOK check for RES devices, for all OS's.
+ N %ZISD0,%ZISD1
+ S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
+ 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
+ S X1=$G(^%ZISL(3.54,+%ZISD0,0))
+ I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
+ 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
+ Q
+ ;
+Q G Q^%ZIS3
+HG ;
+ Q
+SPL N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T" ;Spool type
+ G Q
+MT D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type
+ G Q
+SDP D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Sequential disk processor type
+ G Q
+HFS D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Host File Server type
+ G Q
+RES G Q:%IS["T" N X,X1 I %IS'["R"!'$D(IOP) S POP=1 W:'$D(IOP) *7,"  [NOT AVAILABLE]" Q  ;Resources
+ G Q:$D(IO(1,IO)) I %IS["T" S X=IO,X1="RES" D DEVOK^%ZIS3 S:Y POP=1 G Q:POP
+ D:%ZISB RES1 G Q
+CHAN ;Network Channel type devices -- DecNet or TCP/IP devices.
+ I IO="SYS$NET",$I="SYS$INPUT:;" S IO(0)=IO U IO ;DECNET Server Device
+ D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T"))
+ G Q
+IMPC ;Imaging Work Station
+BAR ;Bar Code
+OTH D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Other Device type
+ G Q
+ ;
+ASKPAR 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
+ I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q
+ Q:POP  G SETPAR^%ZIS3
+AMTREW 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
+ S:%=1 %ZISMTR=1 Q
+MSG1 W !?5,"Enter the desired parameters needed to open the selected device.",!?25 Q
+ ;

Note: See TracChangeset for help on using the changeset viewer.

Context Navigation

Changeset 623 for 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

Legend:

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

Download in other formats: