- ZISETONT ;SF/AC - INITIALIZES DEVICE AND TERMINAL TYPES FOR INTERSYSTEMS ;03/05/97 16:51
- ;;8.0;KERNEL;;Jun 10, 1995
- W !,"This routine will setup some defaults for intersystems OpenM for NT.",!,"in the ^%ZIS files.",!!
- S X=0 I '$D(^%ZIS(1,0)) S X=1 W !!,"The device file is missing, Please install Kernel frist"
- I '$D(^%ZIS(2,0)) S X=1 W !!,"The Subtype file is missing, Please install Kernel frist"
- I X W !,"Then run this routine again." Q
- 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
- S $P(^%ZIS(1,0),U,3)=0,$P(^%ZIS(2,0),U,3)=0 ;Cause it to fillin.
- 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=0:0 S L=$O(^DISV(L)) Q:L'>0 K ^DISV(L,"^%ZIS(1,")
- BASIC ;Load some basic devices
- F IX=0:1 S X=$T(BX+IX) Q:$P(X,";",3)="" D
- . F J=3:1:7 S:$P(X,";",J)]"" DEV($P(";;NAME;$I;ASKD;TYPE;SUB;",";",J))=$P(X,";",J)
- . D ADDDEV(.DEV) Q ;FINISH
- Q
- BX ;;Principal device;|TNT|;1;TRM;C-VT102
- ;;Windows NT Console;|TRM|;1;VTRM;C-VT320
- ;;Principal device;|LAT|;1;VTRM;C-VT320
- ;
- 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
- ADDDEV(IS) ;Add an entry to the device file
- W I1,! S L=$P(^%ZIS(1,0),U,3) F L=L+1:1 I '$D(^%ZIS(1,L,0)) Q
- ;S ^%ZIS(1,"B",NAM,L)="",^%ZIS(1,"C",DI,L)="",^%ZIS(1,L,0)=NAM_U_DI_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
- S ^%ZIS(1,"B",IS("NAME"),L)="",^%ZIS(1,"C",IS("$I"),L)="",^%ZIS(1,L,0)=IS("NAME")_U_IS("$I")_U_$G(IS("ASKD")),^("TYPE")=IS("TYPE") ;,^("IOPAR")=$P(C,U,6),N=N+1 I X'?." " S ^(1)=X
- I '$D(^%ZIS(1,"G","SYS."_%ZISV_"."_IS("$I"))) S ^("SYS."_%ZISV_"."_IS("$I"),L)="",$P(^%ZIS(1,L,0),U,11)=1
- I '$D(^%ZIS(1,"CPU",%ZISV_"."_IS("$I"),L)) S ^(L)=""
- I IO("SUB")]"" S C=$O(^%ZIS(2,"B",IO("SUB"),0)) I $D(^%ZIS(2,+C,0)) S ^%ZIS(1,L,"SUBTYPE")=C
- 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[HZISETONT 3445 printed Apr 23, 2025@18:29:14 Page 2
- ZISETONT ;SF/AC - INITIALIZES DEVICE AND TERMINAL TYPES FOR INTERSYSTEMS ;03/05/97 16:51
- +1 ;;8.0;KERNEL;;Jun 10, 1995
- +2 WRITE !,"This routine will setup some defaults for intersystems OpenM for NT.",!,"in the ^%ZIS files.",!!
- +3 SET X=0
- IF '$DATA(^%ZIS(1,0))
- SET X=1
- WRITE !!,"The device file is missing, Please install Kernel frist"
- +4 IF '$DATA(^%ZIS(2,0))
- SET X=1
- WRITE !!,"The Subtype file is missing, Please install Kernel frist"
- +5 IF X
- WRITE !,"Then run this routine again."
- QUIT
- +6 READ "OK? ",X:$SELECT($DATA(DTIME):DTIME,1:60),!!
- if X'?1"Y".E
- GOTO EXIT
- +7 LOCK +^%ZIS:2
- if '$TEST
- WRITE !,"FILE IS IN USE. TRY AGAIN LATER!!!",*7
- if '$TEST
- QUIT
- +8 ;Cause it to fillin.
- SET $PIECE(^%ZIS(1,0),U,3)=0
- SET $PIECE(^%ZIS(2,0),U,3)=0
- +9 SET U="^"
- SET %ZISV=$SELECT($DATA(^%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
- +1 FOR L=0:0
- SET L=$ORDER(^DISV(L))
- if L'>0
- QUIT
- KILL ^DISV(L,"^%ZIS(1,")
- BASIC ;Load some basic devices
- +1 FOR IX=0:1
- SET X=$TEXT(BX+IX)
- if $PIECE(X,";",3)=""
- QUIT
- Begin DoDot:1
- +2 FOR J=3:1:7
- if $PIECE(X,";",J)]""
- SET DEV($PIECE(";;NAME;$I;ASKD;TYPE;SUB;",";",J))=$PIECE(X,";",J)
- +3 ;FINISH
- DO ADDDEV(.DEV)
- QUIT
- End DoDot:1
- +4 QUIT
- BX ;;Principal device;|TNT|;1;TRM;C-VT102
- +1 ;;Windows NT Console;|TRM|;1;VTRM;C-VT320
- +2 ;;Principal device;|LAT|;1;VTRM;C-VT320
- +3 ;
- 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
- ADDDEV(IS) ;Add an entry to the device file
- +1 WRITE I1,!
- SET L=$PIECE(^%ZIS(1,0),U,3)
- FOR L=L+1:1
- IF '$DATA(^%ZIS(1,L,0))
- QUIT
- +2 ;S ^%ZIS(1,"B",NAM,L)="",^%ZIS(1,"C",DI,L)="",^%ZIS(1,L,0)=NAM_U_DI_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
- +3 ;,^("IOPAR")=$P(C,U,6),N=N+1 I X'?." " S ^(1)=X
- SET ^%ZIS(1,"B",IS("NAME"),L)=""
- SET ^%ZIS(1,"C",IS("$I"),L)=""
- SET ^%ZIS(1,L,0)=IS("NAME")_U_IS("$I")_U_$GET(IS("ASKD"))
- SET ^("TYPE")=IS("TYPE")
- +4 IF '$DATA(^%ZIS(1,"G","SYS."_%ZISV_"."_IS("$I")))
- SET ^("SYS."_%ZISV_"."_IS("$I"),L)=""
- SET $PIECE(^%ZIS(1,L,0),U,11)=1
- +5 IF '$DATA(^%ZIS(1,"CPU",%ZISV_"."_IS("$I"),L))
- SET ^(L)=""
- +6 IF IO("SUB")]""
- SET C=$ORDER(^%ZIS(2,"B",IO("SUB"),0))
- IF $DATA(^%ZIS(2,+C,0))
- SET ^%ZIS(1,L,"SUBTYPE")=C
- +7 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
