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
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
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 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 ; 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 4 OXECUTE I $D(^%ZIS(2,%ZISIOST(0),2))=1 S %Y=^(2) D 2 5 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 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 12 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) 13 I %X S %Y=$S($D(^%ZIS(2,%ZISIOST(0),12.2)):$P(^(12.2),"^",%X),1:"") I %Y]"" W @%Y 14 QUIT U:%IS'[0 IO(0) 15 Q 16 2 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 19 OH 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 ; 23 SAY(%SAY) ; 24 Q:%IS[0 U IO(0) W %SAY U IO 25 Q 26 RES1 ;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 31 RES2 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 ; 35 R1 ;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 41 RESX L -^%ZISL(3.54,%ZISD0,0) Q 42 ; 43 RADD(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 ; 50 RESOK ;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 ; 59 Q G Q^%ZIS3 60 HG ; 61 Q 62 SPL N %E,%Z D MARGN^%ZIS3 W:'$D(IOP) ! D SPOOL^%ZIS4:%IS'["T" ;Spool type 63 G Q 64 MT D MARGN^%ZIS3,ASKPAR,AMTREW:'POP&'$D(IOP)&%ZISB W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Magtape type 65 G Q 66 SDP D MARGN^%ZIS3,ASKPAR W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Sequential disk processor type 67 G Q 68 HFS D MARGN^%ZIS3,HFS^%ZIS4 W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Host File Server type 69 G Q 70 RES 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 73 CHAN ;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 77 IMPC ;Imaging Work Station 78 BAR ;Bar Code 79 OTH D MARGN^%ZIS3:'POP,ASKPAR:'POP W:'$D(IOP) ! D O^%ZIS4:'POP&(%ZISB&(%IS'["T")) ;Other Device type 80 G Q 81 ; 82 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 83 I POP,%ZISB&(%ZTYPE["TRM") C IO K IO(1,IO) Q 84 Q:POP G SETPAR^%ZIS3 85 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 86 S:%=1 %ZISMTR=1 Q 87 MSG1 W !?5,"Enter the desired parameters needed to open the selected device.",!?25 Q 88 ;
Note:
See TracChangeset
for help on using the changeset viewer.