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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1%ZIS5 ;SFISC/STAFF --DEVICE LOOK-UP ;11/5/97 09:29
2 ;;8.0;KERNEL;**18,24,69**;JUL 10, 1995
3 N %DO,%DIY,%DD,%DIX
4 S U="^",%DO="" K DUOUT
5 I $D(^%ZIS(%ZISDFN,0)) S %DO=^(0)
6A G:%ZIS(0)'["A" X I $D(%ZIS("A")) S %DD=%ZIS("A") G B
7 S %DD="Select "_$P(%DO,U,1)_": "
8B I $D(%ZIS("B")),%ZIS("B")]"" S %YY=%ZIS("B"),%XX=$O(^%ZIS(%ZISDFN,%D,%YY)),%DIY=$S($F(%XX,%YY)-1=$L(%YY):%XX,$D(^%ZIS(%ZISDFN,%YY,0)):$P(^(0),U,1),1:%YY) W %DD,%DIY,"// " R %XX:$S($D(DTIME):DTIME,1:9999) G G:%XX]"" S %XX=%DIY G G
9 W !,%DD R %XX:$S($D(DTIME):DTIME,1:9999)
10G G NO:'$T,NO:%XX["^" G:%XX?.N&(+%XX=%XX) NUM I %XX'?.ANP!($L(%XX)>30) W:%ZIS(0)["Q" *7," ??" G A
11X I %XX=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS("_%ZISDFN_",")) S %YY=+^("^%ZIS("_%ZISDFN_",") D S G:'$T NO G GOT
12F G NO:%XX="" K %DS S %DS=0,%DS(0)=1,%DIX=%XX,%DIY=0
13 I $D(^%ZIS(%ZISDFN,%D,%XX)) G T1
14TRY S %DIX=$O(^%ZIS(%ZISDFN,%D,%DIX)) G:$P(%DIX,%XX,1)'=""!(%DIX="") T2 S %DIY=0
15T1 S %DIY=$O(^%ZIS(%ZISDFN,%D,%DIX,+%DIY)) G:%DIY'>0 TRY S %YY=+%DIY D S G:'$T T1
16 I %DS,'(%DS#10) D LST G NO:%XX=U,ADD:%YY<0,GOT:%YY>0
17 S %DS=%DS+1,%DS(%DS)=%DIY G T1
18LSYN ;
19S I $D(^%ZIS(%ZISDFN,%YY,0)) G S1
20 Q
21S1 G S2:%ZISDFN'=1!(%D'="LSYN") I $P(^%ZIS(1,%YY,0),U,9)=%ZISV!($P(^(0),U,9)="") G S2
22 Q
23S2 N Y S Y=%YY D:$D(%ZIS("S")) XS^ZISX Q
24T2 G:'%DS NO S %DIY="" D LST G NO:%XX=U,ADD:%YY<1,GOT
25LST I %DS=1,'$D(%ZISLST) S %YY=%DS(1) Q
26 S %YY=-1 Q:%ZIS(0)'["E" W !
27 F %DZ=%DS(0):1:%DS W !,$J(%DZ,2)," ",$P(^%ZIS(%ZISDFN,%DS(%DZ),0),U,1) D:%ZISDFN=1 I $D(%ZIS("W")),$D(^(0)) W " " D XW^ZISX
28 . ;Show Location
29 . S %=$G(^(1)) W:$X+$L($P(%,U))>74 !?75-$L(X) W " "_$P(%,U)
30L1 W:%DIY !,"Type '^' to Stop, or" W !,"Choose 1" W:%DS>1 "-",%DS
31 R "> ",%YY:$S($D(DTIME):DTIME,1:9999) S %ZISLST=1 I %YY="",%DIY S %DS(0)=%DS+1,%YY=0 W ! Q
32 I %YY=U!(%YY="") S %YY=-1,DUOUT=1 S:%YY=U %XX=U Q
33 I +%YY'=%YY!(%YY<1)!(%YY>%DS) W:%ZIS(0)["Q" *7," ??" G L1
34 S %YY=%DS(%YY) Q
35GOT S %DZ=^%ZIS(%ZISDFN,+%YY,0)
36 W:%ZIS(0)["E" " ",$P(%DZ,U,1)
37R I %ZIS(0)'["F" S:$S($D(DUZ)#2:$S(DUZ:1,1:0),1:0) ^DISV(DUZ,"^%ZIS("_%ZISDFN_",")=+%YY
38 I %ZIS(0)["Z" S %YY(0)=^%ZIS(%ZISDFN,+%YY,0)
39Q K %ZISDFN,%DO,%DD,%DIX,%DIY,%DZ Q
40K K %D,%DS,%ZISLST Q
41ADD ;can't add to files
42NO S %YY=-1 G Q
43NUM I $D(^%ZIS(%ZISDFN,%XX)) S %YY=%XX D S I $T G GOT
44 G F
451 F %D="B","LSYN" S %ZISDFN=1,%ZIS(0)=$S($D(IOP):"M",1:"EMQ") D %ZIS5 Q:%YY>0
46 D K Q
472 S %D="B",%ZISDFN=2,%ZIS(0)=$S($D(IOP):"M",1:"EMQ") D %ZIS5 D K Q
48 ;
49LD1 S %E=0,%Y=0 D LCPU:"PD"[$E(%X) S %E=0 W !
50L S %E=$S("PD"[$E(%X):$O(^UTILITY("ZIS",$J,"DEVLST","B",%E)),1:$O(^%ZIS(1,"B",%E))) G:%E="" RESTART S %A=+$O(^(%E,0))
51 G L:'$D(^%ZIS(1,%A,0)),L:$P(^(0),"^",2)=46,L:$P(^(0),"^",2)=63 I $D(%ZIS("S")) N Y S Y=%A D XS^ZISX G L:'$T
52 I "AP"[$E(%X) G L:$P($G(^%ZIS(2,+$G(^%ZIS(1,%A,"SUBTYPE")),0)),U)'?1"P".E
53 W $J($P(^%ZIS(1,%A,0),"^",1),9) W:$D(^(1)) " ",$P(^(1),"^",1) I $D(^(90)),^(90) W " ** OUT OF SERVICE"
54 W ?39 I $X>40 W ! S %Y=%Y+1 I %Y>20 R "'^' TO STOP: ",%Y:$S($D(DTIME):DTIME,1:60),! G RESTART:%Y?1P S %Y=0
55 G L
56 ;
57LCPU S %A=%ZISV
58LC1 S %A=$O(^%ZIS(1,"CPU",%A)) Q:$P(%A,".")'=%ZISV S %E=0
59LC2 S %E=+$O(^%ZIS(1,"CPU",%A,%E)) G LC1:%E'>0,LC1:'$D(^%ZIS(1,%E,0)) S ^UTILITY("ZIS",$J,"DEVLST","B",$P(^(0),"^",1),%E)="" G LC2
60RESTART S:$D(%H) %E=+%H K %X,^UTILITY("ZIS",$J,"DEVLST") Q
Note: See TracBrowser for help on using the repository browser.