- %ZIS5 ;SFISC/STAFF --DEVICE LOOK-UP ;08/30/2011
- ;;8.0;KERNEL;**18,24,69,499,518,546,572**;JUL 10, 1995;Build 10
- ;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
- %ZIS5 ;SFISC/STAFF --DEVICE LOOK-UP ;08/30/2011
- +1 ;;8.0;KERNEL;**18,24,69,499,518,546,572**;JUL 10, 1995;Build 10
- +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 %ZIS5_source.html#xS">S(0)'["F" S5_source.html#xS">S:$S5_source.html#xS">S($D(DUZ)#2:$S5_source.html#xS">S(DUZ:1,1:0),1:0) ^DIS5_source.html#xS">SV(DUZ,"^%ZIS5_source.html#xS">S("_%ZIS5_source.html#xS">SDFN_",")=+%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
