ZISHUNT ;SFISC/AC - HUNT GROUP MANAGER ;11/29/89 15:52
;;8.0;KERNEL;;Jul 10, 1995
;
EDIT ;Edit Hunt Groups.
S DIC("A")="Select Hunt Group: ",ZISHG(0)="E" D DIC
Q
DEL ;Delete Hunt Groups
K ^TMP($J)
S DIC("A")="Delete which Hunt Group: ",ZISHG(0)="D",ZISHGK=0 D DIC
Q:'ZISHGK
W !,"You have selected for deletion the following Hunt Groups:",!
F ZISI=1:1:ZISHGK I $D(^TMP($J,"DEL",ZISI)) W !?20,$P(^(ZISI),"^",2)
W !!,"OK TO DELETE" S %=0,U="^" D YN^DICN
I %'=1 W *7," ??" K ^TMP($J),ZISI,ZISHGK Q
F ZISI=1:1:ZISHGK I $D(^TMP($J,"DEL",ZISI)) S ZISY=^(ZISI),DA=+ZISY,DIE="^%ZIS(1,",DR=".01///@" D ^DIE W !?20,$P(ZISY,"^",2)_" -- DELETED"
K ^TMP($J),ZISI,ZISHGK,ZISY
Q
DIC W !,DIC("A") R X:DTIME
G END:X["^",END:X=""
I X?1"?" W !," Enter name of Hunt Group",!!," DO YOU WANT THE ENTIRE HUNT GROUP LIST" S %=0,U="^" D YN^DICN G DIC:%'=1 S X="??" D LST G DIC
I X?2"?" D LST G DIC
S DIC="^%ZIS(1,",DIC(0)="EMZ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG"""
I X=$C(32) S X=$S($D(^DISV(DUZ,"^%ZIS(1,")):^("^%ZIS(1,"),1:"") G DIC:'X S X="`"_X
D ^DIC
I Y<0 S X1=$O(^%ZIS(1,"B",X)) I X1]"",$P(X1,X)="" G DIC
I Y<0 X:$D(^DD(3.5,.01,0)) $P(^(0),"^",5) I '$D(X) W *7," ??" G DIC
G @ZISHG(0)
;
LST S DIC="^%ZIS(1,",DIC(0)="EMZ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG""" D ^DIC Q
;
E I Y<0 W !?2,*7," ARE YOU ADDING '"_X_"' AS A NEW HUNT GROUP" S %=0,U="^" D YN^DICN W:%'=1 *7," ??" G DIC:%'=1 D ADD
Q:Y'>0
S DIE=DIC,DA=+Y,DR=30 D ^DIE
S DIC("A")="Select Hunt Group: ",ZISHG(0)="E" G DIC
;S DIC="^%ZIS(1,",DIC(0)="AEMZ",DIC("A")="Select Hunt Group: ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG""" D ^DIC
Q
ADD ;Add Hunt Groups
S DIC(0)="LMZ",DLAYGO=3,DIC("DR")="2////HG" D ^DIC I Y<0 W *7,"<"_X_" DELETED>" Q
Q
D I Y>0,$P(Y,"^",2)]"" S ZISHGK=ZISHGK+1,^TMP($J,"DEL",ZISHGK)=Y,DIC("A")="Another Hunt Group: "
W:Y'>0 *7," ??"
S DIC("A")="Delete which Hunt Group: ",ZISHG(0)="D" G DIC
END K DA,DIC,DIE,DR,X1,X,Y,ZISHG(0) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISHUNT 1991 printed Oct 16, 2024@18:15:54 Page 2
ZISHUNT ;SFISC/AC - HUNT GROUP MANAGER ;11/29/89 15:52
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;
EDIT ;Edit Hunt Groups.
+1 SET DIC("A")="Select Hunt Group: "
SET ZISHG(0)="E"
DO DIC
+2 QUIT
DEL ;Delete Hunt Groups
+1 KILL ^TMP($JOB)
+2 SET DIC("A")="Delete which Hunt Group: "
SET ZISHG(0)="D"
SET ZISHGK=0
DO DIC
+3 if 'ZISHGK
QUIT
+4 WRITE !,"You have selected for deletion the following Hunt Groups:",!
+5 FOR ZISI=1:1:ZISHGK
IF $DATA(^TMP($JOB,"DEL",ZISI))
WRITE !?20,$PIECE(^(ZISI),"^",2)
+6 WRITE !!,"OK TO DELETE"
SET %=0
SET U="^"
DO YN^DICN
+7 IF %'=1
WRITE *7," ??"
KILL ^TMP($JOB),ZISI,ZISHGK
QUIT
+8 FOR ZISI=1:1:ZISHGK
IF $DATA(^TMP($JOB,"DEL",ZISI))
SET ZISY=^(ZISI)
SET DA=+ZISY
SET DIE="^%ZIS(1,"
SET DR=".01///@"
DO ^DIE
WRITE !?20,$PIECE(ZISY,"^",2)_" -- DELETED"
+9 KILL ^TMP($JOB),ZISI,ZISHGK,ZISY
+10 QUIT
DIC WRITE !,DIC("A")
READ X:DTIME
+1 if X["^"
GOTO END
if X=""
GOTO END
+2 IF X?1"?"
WRITE !," Enter name of Hunt Group",!!," DO YOU WANT THE ENTIRE HUNT GROUP LIST"
SET %=0
SET U="^"
DO YN^DICN
if %'=1
GOTO DIC
SET X="??"
DO LST
GOTO DIC
+3 IF X?2"?"
DO LST
GOTO DIC
+4 SET DIC="^%ZIS(1,"
SET DIC(0)="EMZ"
SET DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG"""
+5 IF X=$CHAR(32)
SET X=$SELECT($DATA(^DISV(DUZ,"^%ZIS(1,")):^("^%ZIS(1,"),1:"")
if 'X
GOTO DIC
SET X="`"_X
+6 DO ^DIC
+7 IF Y<0
SET X1=$ORDER(^%ZIS(1,"B",X))
IF X1]""
IF $PIECE(X1,X)=""
GOTO DIC
+8 IF Y<0
if $DATA(^DD(3.5,.01,0))
XECUTE $PIECE(^(0),"^",5)
IF '$DATA(X)
WRITE *7," ??"
GOTO DIC
+9 GOTO @ZISHG(0)
+10 ;
LST SET DIC="^%ZIS(1,"
SET DIC(0)="EMZ"
SET DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG"""
DO ^DIC
QUIT
+1 ;
E IF Y<0
WRITE !?2,*7," ARE YOU ADDING '"_X_"' AS A NEW HUNT GROUP"
SET %=0
SET U="^"
DO YN^DICN
if %'=1
WRITE *7," ??"
if %'=1
GOTO DIC
DO ADD
+1 if Y'>0
QUIT
+2 SET DIE=DIC
SET DA=+Y
SET DR=30
DO ^DIE
+3 SET DIC("A")="Select Hunt Group: "
SET ZISHG(0)="E"
GOTO DIC
+4 ;S DIC="^%ZIS(1,",DIC(0)="AEMZ",DIC("A")="Select Hunt Group: ",DIC("S")="I $D(^(""TYPE"")),^(""TYPE"")=""HG""" D ^DIC
+5 QUIT
ADD ;Add Hunt Groups
+1 SET DIC(0)="LMZ"
SET DLAYGO=3
SET DIC("DR")="2////HG"
DO ^DIC
IF Y<0
WRITE *7,"<"_X_" DELETED>"
QUIT
+2 QUIT
D IF Y>0
IF $PIECE(Y,"^",2)]""
SET ZISHGK=ZISHGK+1
SET ^TMP($JOB,"DEL",ZISHGK)=Y
SET DIC("A")="Another Hunt Group: "
+1 if Y'>0
WRITE *7," ??"
+2 SET DIC("A")="Delete which Hunt Group: "
SET ZISHG(0)="D"
GOTO DIC
END KILL DA,DIC,DIE,DR,X1,X,Y,ZISHG(0)
QUIT
