%ZIS5 ;SFISC/STAFF --DEVICE LOOK-UP ;08/30/2011
;;8.0;KERNEL;**18,24,69,499,518,546,572**;JUL 10, 1995;Build 7
;Per VHA Directive 2004-038, this routine should not be modified
;Does a DIC like lookup. %XX,%YY are call in/out parameters
N %DO,%DIY,%DD,%DIX
S U="^",%DO="" K DUOUT
I $D(^%ZIS(%ZISDFN,0)) S %DO=^(0)
A G:%ZIS(0)'["A" X
;Ask Device
I $D(%ZIS("A")) S %DD=%ZIS("A") G B
S %DD="Select "_$P(%DO,U,1)_": "
B 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:%ZISDTIM G G:%XX]"" S %XX=%DIY G G
W !,%DD R %XX:%ZISDTIM
G G NO:'$T,NO:%XX["^" G:%XX?.N&(+%XX=%XX) NUM I %XX'?.ANP!($L(%XX)>30) W:%ZIS(0)["Q" *7," ??" G A
;Lookup
X ;**P572 START CJM
;I %XX=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS("_%ZISDFN_",")) S %YY=+^("^%ZIS("_%ZISDFN_",") D S G:'$T NO G GOT
I %XX=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"ZIS","^%ZIS("_%ZISDFN_","))!$D(^DISV(+DUZ,"^%ZIS("_%ZISDFN_",")) D D S G:'$T NO G GOT
.S %YY=$S($D(^DISV(+DUZ,"ZIS","^%ZIS("_%ZISDFN_",")):+^("^%ZIS("_%ZISDFN_","),1:^DISV(+DUZ,"^%ZIS("_%ZISDFN_","))
;**P572 END CJM
F G NO:%XX="" K %DS S %DS=0,%DS(0)=1,%DIX=%XX,%DIY=0
I $D(^%ZIS(%ZISDFN,%D,%XX)) G T1
TRY S %DIX=$O(^%ZIS(%ZISDFN,%D,%DIX)) G:$P(%DIX,%XX,1)'=""!(%DIX="") T2 S %DIY=0
T1 S %DIY=$O(^%ZIS(%ZISDFN,%D,%DIX,+%DIY)) G:%DIY'>0 TRY S %YY=+%DIY D S G:'$T T1
I %DS,'(%DS#10) D LST G NO:%XX=U,ADD:%YY<0,GOT:%YY>0
S %DS=%DS+1,%DS(%DS)=%DIY G T1
LSYN ;
S I $D(^%ZIS(%ZISDFN,%YY,0)) G S1
Q
S1 G S2:%ZISDFN'=1!(%D'="LSYN") I $P(^%ZIS(1,%YY,0),U,9)=%ZISV!($P(^(0),U,9)="") G S2
Q
S2 N Y S Y=%YY D:$D(%ZIS("S")) XS^ZISX Q
T2 G:'%DS NO S %DIY="" D LST G NO:%XX=U,ADD:%YY<1,GOT
LST I %DS=1,'$D(%ZISLST) S %YY=%DS(1) Q
S %YY=-1 Q:%ZIS(0)'["E" W !
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
. ;Show Location
. S %=$G(^(1)) W:$X+$L($P(%,U))>74 !?75-$L(X) W " "_$P(%,U)
L1 W:%DIY !,"Type '^' to Stop, or" W !,"Choose 1" W:%DS>1 "-",%DS
R "> ",%YY:%ZISDTIM S %ZISLST=1 I %YY="",%DIY S %DS(0)=%DS+1,%YY=0 W ! Q
I %YY=U!(%YY="") S %YY=-1,DUOUT=1 S:%YY=U %XX=U Q
I +%YY'=%YY!(%YY<1)!(%YY>%DS) W:%ZIS(0)["Q" *7," ??" G L1
S %YY=%DS(%YY) Q
GOT S %DZ=^%ZIS(%ZISDFN,+%YY,0)
W:%ZIS(0)["E" " ",$P(%DZ,U,1)
;**P572 START CJM
R ;
;I %ZIS(0)'["F" S:$S($D(DUZ)#2:$S(DUZ:1,1:0),1:0) ^DISV(DUZ,"^%ZIS("_%ZISDFN_",")=+%YY
I %ZIS(0)'["F" I '$D(IOP),$S($D(DUZ)#2:$S(DUZ:1,1:0),1:0) S ^DISV(DUZ,"ZIS","^%ZIS("_%ZISDFN_",")=+%YY
;**P572 END CJM
;
I %ZIS(0)["Z" S %YY(0)=^%ZIS(%ZISDFN,+%YY,0)
Q K %ZISDFN,%DO,%DD,%DIX,%DIY,%DZ Q
ADD ;can't add to files
NO S %YY=-1 G Q
NUM I $D(^%ZIS(%ZISDFN,%XX)) S %YY=%XX D S I $T G GOT
G F
;
1 ;Entry point for Device lookup
N %D,%DS,%ZISDFN,%ZISLST ;p518
F %D="B","LSYN" S %ZISDFN=1,%ZIS(0)=$S($D(IOP):"M",1:"EMQ") D %ZIS5 Q:(%YY>0)!$D(DUOUT)
Q
2 ;Entry point for Terminal type lookup
N %D,%DS,%ZISDFN,%ZISLST ;p518
S %D="B",%ZISDFN=2,%ZIS(0)=$S($D(IOP):"M",1:"EMQ") D %ZIS5
Q
;
;A=all printers, P=local printers, C=complete list, D=local devices
LD1 ;Called from %ZIS7
S %E=0,%Y=0 D LCPU:"PD"[$E(%X) S %E=0 W !
L 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))
G L:'$D(^%ZIS(1,%A,0)) ;,L:$P(^(0),"^",2)=46,L:$P(^(0),"^",2)=63 p546 Skip check for device numbers
I $D(%ZIS("S")) N Y S Y=%A D XS^ZISX G L:'$T ;Screen
I "AP"[$E(%X) G L:$P($G(^%ZIS(2,+$G(^%ZIS(1,%A,"SUBTYPE")),0)),U)'?1"P".E
W $P(^%ZIS(1,%A,0),"^",1) W:$D(^(1)) " ",$P(^(1),"^",1) I $D(^(90)),^(90) W " ** OUT OF SERVICE"
W ?39 I $X>40 W ! S %Y=%Y+1 I %Y>20 R "'^' TO STOP: ",%Y:%ZISDTIM,! G RESTART:%Y?1P S %Y=0
G L
;
LCPU S %A=%ZISV
LC1 S %A=$O(^%ZIS(1,"CPU",%A)) Q:$P(%A,".")'=%ZISV S %E=0
LC2 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
;
RESTART S:$D(%H) %E=+%H K %X,^UTILITY("ZIS",$J,"DEVLST")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZIS5 4073 printed Apr 09, 2024@21:18:34 Page 2
%ZIS5 ;SFISC/STAFF --DEVICE LOOK-UP ;08/30/2011
+1 ;;8.0;KERNEL;**18,24,69,499,518,546,572**;JUL 10, 1995;Build 7
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;Does a DIC like lookup. %XX,%YY are call in/out parameters
+4 NEW %DO,%DIY,%DD,%DIX
+5 SET U="^"
SET %DO=""
KILL DUOUT
+6 IF $DATA(^%ZIS(%ZISDFN,0))
SET %DO=^(0)
A if %ZIS(0)'["A"
GOTO X
+1 ;Ask Device
+2 IF $DATA(%ZIS("A"))
SET %DD=%ZIS("A")
GOTO B
+3 SET %DD="Select "_$PIECE(%DO,U,1)_": "
B IF $DATA(%ZIS("B"))
IF %ZIS("B")]""
SET %YY=%ZIS("B")
SET %XX=$ORDER(^%ZIS(%ZISDFN,%D,%YY))
SET %DIY=$SELECT($FIND(%XX,%YY)-1=$LENGTH(%YY):%XX,$DATA(^%ZIS(%ZISDFN,%YY,0)):$PIECE(^(0),U,1),1:%YY)
WRITE %DD,%DIY,"// "
READ %XX:%ZISDTIM
if %XX]""
GOTO G
SET %XX=%DIY
GOTO G
+1 WRITE !,%DD
READ %XX:%ZISDTIM
G if '$TEST
GOTO NO
if %XX["^"
GOTO NO
if %XX?.N&(+%XX=%XX)
GOTO NUM
IF %XX'?.ANP!($LENGTH(%XX)>30)
if %ZIS(0)["Q"
WRITE *7," ??"
GOTO A
+1 ;Lookup
X ;**P572 START CJM
+1 ;I %XX=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS("_%ZISDFN_",")) S %YY=+^("^%ZIS("_%ZISDFN_",") D S G:'$T NO G GOT
+2 IF %XX=" "
IF $DATA(DUZ)#2
IF $DATA(^DISV(+DUZ,"ZIS","^%ZIS("_%ZISDFN_","))!$DATA(^DISV(+DUZ,"^%ZIS("_%ZISDFN_","))
Begin DoDot:1
+3 SET %YY=$SELECT($DATA(^DISV(+DUZ,"ZIS","^%ZIS("_%ZISDFN_",")):+^("^%ZIS("_%ZISDFN_","),1:^DISV(+DUZ,"^%ZIS("_%ZISDFN_","))
End DoDot:1
DO S
if '$TEST
GOTO NO
GOTO GOT
+4 ;**P572 END CJM
F if %XX=""
GOTO NO
KILL %DS
SET %DS=0
SET %DS(0)=1
SET %DIX=%XX
SET %DIY=0
+1 IF $DATA(^%ZIS(%ZISDFN,%D,%XX))
GOTO T1
TRY SET %DIX=$ORDER(^%ZIS(%ZISDFN,%D,%DIX))
if $PIECE(%DIX,%XX,1)'=""!(%DIX="")
GOTO T2
SET %DIY=0
T1 SET %DIY=$ORDER(^%ZIS(%ZISDFN,%D,%DIX,+%DIY))
if %DIY'>0
GOTO TRY
SET %YY=+%DIY
DO S
if '$TEST
GOTO T1
+1 IF %DS
IF '(%DS#10)
DO LST
if %XX=U
GOTO NO
if %YY<0
GOTO ADD
if %YY>0
GOTO GOT
+2 SET %DS=%DS+1
SET %DS(%DS)=%DIY
GOTO T1
LSYN ;
S IF $DATA(^%ZIS(%ZISDFN,%YY,0))
GOTO S1
+1 QUIT
S1 if %ZISDFN'=1!(%D'="LSYN")
GOTO S2
IF $PIECE(^%ZIS(1,%YY,0),U,9)=%ZISV!($PIECE(^(0),U,9)="")
GOTO S2
+1 QUIT
S2 NEW Y
SET Y=%YY
if $DATA(%ZIS("S"))
DO XS^ZISX
QUIT
T2 if '%DS
GOTO NO
SET %DIY=""
DO LST
if %XX=U
GOTO NO
if %YY<1
GOTO ADD
GOTO GOT
LST IF %DS=1
IF '$DATA(%ZISLST)
SET %YY=%DS(1)
QUIT
+1 SET %YY=-1
if %ZIS(0)'["E"
QUIT
WRITE !
+2 FOR %DZ=%DS(0):1:%DS
WRITE !,$JUSTIFY(%DZ,2)," ",$PIECE(^%ZIS(%ZISDFN,%DS(%DZ),0),U,1)
if %ZISDFN=1
Begin DoDot:1
+3 ;Show Location
+4 SET %=$GET(^(1))
if $X+$LENGTH($PIECE(%,U))>74
WRITE !?75-$LENGTH(X)
WRITE " "_$PIECE(%,U)
End DoDot:1
IF $DATA(%ZIS("W"))
IF $DATA(^(0))
WRITE " "
DO XW^ZISX
L1 if %DIY
WRITE !,"Type '^' to Stop, or"
WRITE !,"Choose 1"
if %DS>1
WRITE "-",%DS
+1 READ "> ",%YY:%ZISDTIM
SET %ZISLST=1
IF %YY=""
IF %DIY
SET %DS(0)=%DS+1
SET %YY=0
WRITE !
QUIT
+2 IF %YY=U!(%YY="")
SET %YY=-1
SET DUOUT=1
if %YY=U
SET %XX=U
QUIT
+3 IF +%YY'=%YY!(%YY<1)!(%YY>%DS)
if %ZIS(0)["Q"
WRITE *7," ??"
GOTO L1
+4 SET %YY=%DS(%YY)
QUIT
GOT SET %DZ=^%ZIS(%ZISDFN,+%YY,0)
+1 if %ZIS(0)["E"
WRITE " ",$PIECE(%DZ,U,1)
+2 ;**P572 START CJM
R ;
+1 ;I %ZIS(0)'["F" S:$S($D(DUZ)#2:$S(DUZ:1,1:0),1:0) ^DISV(DUZ,"^%ZIS("_%ZISDFN_",")=+%YY
+2 IF %ZIS(0)'["F"
IF '$DATA(IOP)
IF $SELECT($DATA(DUZ)#2:$SELECT(DUZ:1,1:0),1:0)
SET ^DISV(DUZ,"ZIS","^%ZIS("_%ZISDFN_",")=+%YY
+3 ;**P572 END CJM
+4 ;
+5 IF %ZIS(0)["Z"
SET %YY(0)=^%ZIS(%ZISDFN,+%YY,0)
Q KILL %ZISDFN,%DO,%DD,%DIX,%DIY,%DZ
QUIT
ADD ;can't add to files
NO SET %YY=-1
GOTO Q
NUM IF $DATA(^%ZIS(%ZISDFN,%XX))
SET %YY=%XX
DO S
IF $TEST
GOTO GOT
+1 GOTO F
+2 ;
1 ;Entry point for Device lookup
+1 ;p518
NEW %D,%DS,%ZISDFN,%ZISLST
+2 FOR %D="B","LSYN"
SET %ZISDFN=1
SET %ZIS(0)=$SELECT($DATA(IOP):"M",1:"EMQ")
DO %ZIS5
if (%YY>0)!$DATA(DUOUT)
QUIT
+3 QUIT
2 ;Entry point for Terminal type lookup
+1 ;p518
NEW %D,%DS,%ZISDFN,%ZISLST
+2 SET %D="B"
SET %ZISDFN=2
SET %ZIS(0)=$SELECT($DATA(IOP):"M",1:"EMQ")
DO %ZIS5
+3 QUIT
+4 ;
+5 ;A=all printers, P=local printers, C=complete list, D=local devices
LD1 ;Called from %ZIS7
+1 SET %E=0
SET %Y=0
if "PD"[$EXTRACT(%X)
DO LCPU
SET %E=0
WRITE !
L SET %E=$SELECT("PD"[$EXTRACT(%X):$ORDER(^UTILITY("ZIS",$JOB,"DEVLST","B",%E)),1:$ORDER(^%ZIS(1,"B",%E)))
if %E=""
GOTO RESTART
SET %A=+$ORDER(^(%E,0))
+1 ;,L:$P(^(0),"^",2)=46,L:$P(^(0),"^",2)=63 p546 Skip check for device numbers
if '$DATA(^%ZIS(1,%A,0))
GOTO L
+2 ;Screen
IF $DATA(%ZIS("S"))
NEW Y
SET Y=%A
DO XS^ZISX
if '$TEST
GOTO L
+3 IF "AP"[$EXTRACT(%X)
if $PIECE($GET(^%ZIS(2,+$GET(^%ZIS(1,%A,"SUBTYPE")),0)),U)'?1"P".E
GOTO L
+4 WRITE $PIECE(^%ZIS(1,%A,0),"^",1)
if $DATA(^(1))
WRITE " ",$PIECE(^(1),"^",1)
IF $DATA(^(90))
IF ^(90)
WRITE " ** OUT OF SERVICE"
+5 WRITE ?39
IF $X>40
WRITE !
SET %Y=%Y+1
IF %Y>20
READ "'^' TO STOP: ",%Y:%ZISDTIM,!
if %Y?1P
GOTO RESTART
SET %Y=0
+6 GOTO L
+7 ;
LCPU SET %A=%ZISV
LC1 SET %A=$ORDER(^%ZIS(1,"CPU",%A))
if $PIECE(%A,".")'=%ZISV
QUIT
SET %E=0
LC2 SET %E=+$ORDER(^%ZIS(1,"CPU",%A,%E))
if %E'>0
GOTO LC1
if '$DATA(^%ZIS(1,%E,0))
GOTO LC1
SET ^UTILITY("ZIS",$JOB,"DEVLST","B",$PIECE(^(0),"^",1),%E)=""
GOTO LC2
+1 ;
RESTART if $DATA(%H)
SET %E=+%H
KILL %X,^UTILITY("ZIS",$JOB,"DEVLST")
+1 QUIT
