ZISETUPM ;BB,SF/GFT,AC - INITIALIZES DEVICE AND TERMINAL TYPES FOR INTERSYSTEMS;1/12/88 12:45 PM ;1/20/93 15:47
;;7.1;KERNEL;;Jun 08, 1993
W !,"THIS ROUTINE WILL TAKE INTERSYSTEMS TERMINAL AND SUBTYPE FILES",!,"(IN ^%IS) AND MOVE THEM TO THE ^%ZIS FILES.",!!
R "OK? ",X:$S($D(DTIME):DTIME,1:60),!! G EXIT:X'?1"Y".E
L +^%ZIS:2 W:'$T !,"FILE IS IN USE. TRY AGAIN LATER!!!",*7 Q:'$T
I '$D(^%ZIS(1,0)) S ^%ZIS(1,0)="DEVICE^3.5"
S U="^",%ZISV=$S($D(^%ZOSF("VOL")):^("VOL"),1:"")
QUES I %ZISV]"" W !,"Please Enter a Prefix for New Devices: "_%ZISV_"//" R %ZISV1:$S($D(DTIME):DTIME,1:300) G EXIT:%ZISV1="^"!'$T S:%ZISV1="" %ZISV1=%ZISV I %ZISV1?1"?"."?" D HLP G QUES
F L=64:1:200,1 K ^DISV(L,"^%ZIS(1,")
SUB S (C,L,N)=0 I $D(^%ZIS(2,0)) S N=$P(^(0),U,4),L=$P(^(0),U,3)
W "TERMINAL TYPES:",!
A S C=$O(^%IS(0,"SUB",C))
I C="" S R=$S($D(^%ZIS(2,0)):^(0),1:"TERMINAL TYPE^3.2"),^(0)=$P(R,U,1,2)_U_L_U_N G DEVICE
S R=^(C),Z=$S($D(^(C,1)):^(1),1:"") G A:$D(^%ZIS(2,"B",C)) I Z?."^" S Z=""
F L=L+1:1 I '$D(^%ZIS(2,L,0)) S ^(0)=C,^(1)=R,^%ZIS(2,"B",C,L)="",N=N+1 W C,! Q
I Z]"" S X=$P(Z,U,1,5)_U_$P(Z,U,11),^%ZIS(2,L,6)=X,X=$P(Z,U,10,12) D X
W !,C G A
;
X I X?."^" Q
S X=$P(X,U,1)_U_$P(X,U,3) I '$D(^%ZIS(2,N,5)) S ^(5)=X
Q
;
DEVICE S U="^",(L,N)=0 I $D(^%ZIS(1,0)) S N=$P(^(0),U,4),L=$P(^(0),U,3)
W !!,"DEVICES:",!
S I=0 F Y=0:0 S I=$O(^%IS(I)) Q:I'>0 I $D(^(I,0)),$D(^(1)),^(1)]"" S C=^(1),X=^(0) D CHK
F I=0:0 S I=$O(^%ZIS(1,I)) Q:I'>0 I '$D(^(I,99)) S C=$P(^(0),U,1) I $D(^%IS(C,99)),^(99)]"" S C=$O(^%ZIS(1,"B",^(99),0)) I C>0 S ^%ZIS(1,I,99)=C
S C=$S($D(^%ZIS(1,0)):^(0),1:"DEVICE^3.5"),^(0)=$P(C,U,1,2)_U_L_U_N
C K ^%ZIS("C") S ^%ZIS("C")="G ^%ZISC"
W !!,"ALL SETUP"
EXIT L -^%ZIS K %ZISV,%ZISV1,C,I,I1,L,N,R,X,Y Q
;
CHK I $P(C,U,1)'=I,'$D(^%ZIS(1,"B",I)) S I1=I D ADD Q
I $P(C,U,1)=I,'$S(%ZISV]"":$S($O(^%ZIS(1,"G","SYS."_%ZISV_"."_$P(C,U,1),0))>0:1,$O(^%ZIS(1,"CPU",%ZISV_"."_$P(C,U,1),0))>0:1,1:0),$O(^%ZIS(1,"C",$P(C,U,1),0))>0:1,1:0) S I1=%ZISV1_I D ADD Q
Q
ADD W I1,! F L=L+1:1 I '$D(^%ZIS(1,L,0)) Q
S ^%ZIS(1,"C",$P(C,U,1),L)="",^%ZIS(1,"B",I1,L)="",^%ZIS(1,L,0)=I1_U_$P(C,U,1)_U_($P(C,U,4)'=1)_U_'$P(C,U,4),^("TYPE")=$P(C,U,2),^("IOPAR")=$P(C,U,6),N=N+1 I X'?." " S ^(1)=X
I '$D(^%ZIS(1,"G","SYS."_%ZISV_"."_$P(C,U,1))) S ^("SYS."_%ZISV_"."_$P(C,U,1),L)="",$P(^%ZIS(1,L,0),U,11)=1
I '$D(^%ZIS(1,"CPU",%ZISV_"."_$P(C,U,1),L)) S ^(L)=""
S C=$P(C,U,3) I C]"" S C=$O(^%ZIS(2,"B",C,0)) I $D(^%ZIS(2,+C,0)) S ^%ZIS(1,L,"SUBTYPE")=C
F X=90,91,95,"L","F" I $D(^%IS(I,X))#2,^(X)]"" S ^%ZIS(1,L,X)=^(X) S:+X'=X ^%ZIS(1,X,^(X),L)=""
Q
HLP ;HELP FOR PREFIX QUESTION
W !,"There must be a prefix for a new device"
W !,"becuase the Device Name and the $I cannot"
W !,"be the same." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISETUPM 2753 printed Dec 13, 2024@02:14:44 Page 2
ZISETUPM ;BB,SF/GFT,AC - INITIALIZES DEVICE AND TERMINAL TYPES FOR INTERSYSTEMS;1/12/88 12:45 PM ;1/20/93 15:47
+1 ;;7.1;KERNEL;;Jun 08, 1993
+2 WRITE !,"THIS ROUTINE WILL TAKE INTERSYSTEMS TERMINAL AND SUBTYPE FILES",!,"(IN ^%IS) AND MOVE THEM TO THE ^%ZIS FILES.",!!
+3 READ "OK? ",X:$SELECT($DATA(DTIME):DTIME,1:60),!!
if X'?1"Y".E
GOTO EXIT
+4 LOCK +^%ZIS:2
if '$TEST
WRITE !,"FILE IS IN USE. TRY AGAIN LATER!!!",*7
if '$TEST
QUIT
+5 IF '$DATA(^%ZIS(1,0))
SET ^%ZIS(1,0)="DEVICE^3.5"
+6 SET U="^"
SET %ZISV=$SELECT($DATA(^%ZOSF("VOL")):^("VOL"),1:"")
QUES IF %ZISV]""
WRITE !,"Please Enter a Prefix for New Devices: "_%ZISV_"//"
READ %ZISV1:$SELECT($DATA(DTIME):DTIME,1:300)
if %ZISV1="^"!'$TEST
GOTO EXIT
if %ZISV1=""
SET %ZISV1=%ZISV
IF %ZISV1?1"?"."?"
DO HLP
GOTO QUES
+1 FOR L=64:1:200,1
KILL ^DISV(L,"^%ZIS(1,")
SUB SET (C,L,N)=0
IF $DATA(^%ZIS(2,0))
SET N=$PIECE(^(0),U,4)
SET L=$PIECE(^(0),U,3)
+1 WRITE "TERMINAL TYPES:",!
A SET C=$ORDER(^%IS(0,"SUB",C))
+1 IF C=""
SET R=$SELECT($DATA(^%ZIS(2,0)):^(0),1:"TERMINAL TYPE^3.2")
SET ^(0)=$PIECE(R,U,1,2)_U_L_U_N
GOTO DEVICE
+2 SET R=^(C)
SET Z=$SELECT($DATA(^(C,1)):^(1),1:"")
if $DATA(^%ZIS(2,"B",C))
GOTO A
IF Z?."^"
SET Z=""
+3 FOR L=L+1:1
IF '$DATA(^%ZIS(2,L,0))
SET ^(0)=C
SET ^(1)=R
SET ^%ZIS(2,"B",C,L)=""
SET N=N+1
WRITE C,!
QUIT
+4 IF Z]""
SET X=$PIECE(Z,U,1,5)_U_$PIECE(Z,U,11)
SET ^%ZIS(2,L,6)=X
SET X=$PIECE(Z,U,10,12)
DO X
+5 WRITE !,C
GOTO A
+6 ;
X IF X?."^"
QUIT
+1 SET X=$PIECE(X,U,1)_U_$PIECE(X,U,3)
IF '$DATA(^%ZIS(2,N,5))
SET ^(5)=X
+2 QUIT
+3 ;
DEVICE SET U="^"
SET (L,N)=0
IF $DATA(^%ZIS(1,0))
SET N=$PIECE(^(0),U,4)
SET L=$PIECE(^(0),U,3)
+1 WRITE !!,"DEVICES:",!
+2 SET I=0
FOR Y=0:0
SET I=$ORDER(^%IS(I))
if I'>0
QUIT
IF $DATA(^(I,0))
IF $DATA(^(1))
IF ^(1)]""
SET C=^(1)
SET X=^(0)
DO CHK
+3 FOR I=0:0
SET I=$ORDER(^%ZIS(1,I))
if I'>0
QUIT
IF '$DATA(^(I,99))
SET C=$PIECE(^(0),U,1)
IF $DATA(^%IS(C,99))
IF ^(99)]""
SET C=$ORDER(^%ZIS(1,"B",^(99),0))
IF C>0
SET ^%ZIS(1,I,99)=C
+4 SET C=$SELECT($DATA(^%ZIS(1,0)):^(0),1:"DEVICE^3.5")
SET ^(0)=$PIECE(C,U,1,2)_U_L_U_N
C KILL ^%ZIS("C")
SET ^%ZIS("C")="G ^%ZISC"
+1 WRITE !!,"ALL SETUP"
EXIT LOCK -^%ZIS
KILL %ZISV,%ZISV1,C,I,I1,L,N,R,X,Y
QUIT
+1 ;
CHK IF $PIECE(C,U,1)'=I
IF '$DATA(^%ZIS(1,"B",I))
SET I1=I
DO ADD
QUIT
+1 IF $PIECE(C,U,1)=I
IF '$SELECT(%ZISV]"":$SELECT($ORDER(^%ZIS(1,"G","SYS."_%ZISV_"."_$PIECE(C,U,1),0))>0:1,$ORDER(^%ZIS(1,"CPU",%ZISV_"."_$PIECE(C,U,1),0))>0:1,1:0),$ORDER(^%ZIS(1,"C",$PIECE(C,U,1),0))>0:1,1:0)
SET I1=%ZISV1_I
DO ADD
QUIT
+2 QUIT
ADD WRITE I1,!
FOR L=L+1:1
IF '$DATA(^%ZIS(1,L,0))
QUIT
+1 SET ^%ZIS(1,"C",$PIECE(C,U,1),L)=""
SET ^%ZIS(1,"B",I1,L)=""
SET ^%ZIS(1,L,0)=I1_U_$PIECE(C,U,1)_U_($PIECE(C,U,4)'=1)_U_'$PIECE(C,U,4)
SET ^("TYPE")=$PIECE(C,U,2)
SET ^("IOPAR")=$PIECE(C,U,6)
SET N=N+1
IF X'?." "
SET ^(1)=X
+2 IF '$DATA(^%ZIS(1,"G","SYS."_%ZISV_"."_$PIECE(C,U,1)))
SET ^("SYS."_%ZISV_"."_$PIECE(C,U,1),L)=""
SET $PIECE(^%ZIS(1,L,0),U,11)=1
+3 IF '$DATA(^%ZIS(1,"CPU",%ZISV_"."_$PIECE(C,U,1),L))
SET ^(L)=""
+4 SET C=$PIECE(C,U,3)
IF C]""
SET C=$ORDER(^%ZIS(2,"B",C,0))
IF $DATA(^%ZIS(2,+C,0))
SET ^%ZIS(1,L,"SUBTYPE")=C
+5 FOR X=90,91,95,"L","F"
IF $DATA(^%IS(I,X))#2
IF ^(X)]""
SET ^%ZIS(1,L,X)=^(X)
if +X'=X
SET ^%ZIS(1,X,^(X),L)=""
+6 QUIT
HLP ;HELP FOR PREFIX QUESTION
+1 WRITE !,"There must be a prefix for a new device"
+2 WRITE !,"becuase the Device Name and the $I cannot"
+3 WRITE !,"be the same."
QUIT
