ENARX24 ;(WASH ISC)/SAW/DH-2162 Archive ;5-29-91
;;7.0;ENGINEERING;;Aug 17, 1993
;
;
K ^UTILITY("DIFROM",$J) S DIC(0)="LX",(DIC,DLAYGO)=3.6,N="BULL" D ADD:$D(^XMB(3.6,0)) S X=0 F R=0:0 S X=$O(^UTILITY("DIFROM",$J,X)) Q:X="" W !,"'",X,"' BULLETIN FILED -- REMEMBER TO ADD ITS USER GROUPS"
I $D(^DIC(9.4,0))#2,^(0)?1"PACKAGE".E S N="PK",(DIC,DLAYGO)=9.4 D ADD S:$D(^DIC(9.4,DA,22,DIFROM,0)) ^(0)=$P(^(0)_U,U,1,2)_U_DT I $D(^DIC(9.4,DA,0))#2 S X=^(0),%=$P(X,U,4) I %]"" S %=$O(^DIC(9.2,"B",%,0)) S:%]"" ^DIC(9.4,DA,0)=$P(X,U,1,3)_U_%
K ^UTILITY("DIFROM",$J) I $D(^DIC(19,0))#2,^(0)?1"OPTION".E S (DIC,DLAYGO)=19,N="OPT" D ADD,OP
I $D(^DIC(19.1,0))#2,^(0)?1"SECUR".E S (DIC,DLAYGO)=19.1,N="SE" D ADD K ^UTILITY("DIFROM",$J)
S DIC=.5,DLAYGO=0,N="FUNC" D ADD
I $D(^DIC(9.8,0))#2,^(0)?1"ROUTINE^".E S (DIC,DLAYGO)=9.8,N="ROU" D ADD
S DIC("S")="I $P(^(0),U,4)=I" F N="DIPT","DIBT","DIE" S DIC=U_N_"(" D ADD
K ^UTILITY(U,$J),DIC,DLAYGO F DIR="DIE","DIPT" D DIEZ
Q
DIEZ S N=$O(^UTILITY("DIFROM",$J,DIR,0)) Q:N="" S Y=+^(N) K ^(N) I $D(@("^"_DIR_"(Y,""ROU"")")) K ^("ROU") I $D(^("ROUOLD")) S X=^("ROUOLD"),DMAX=^DD("ROU") I $D(^("OS",^DD("OS"),"ZS")),X]"" D @("EN^DI"_$E(DIR,3)_"Z")
G DIEZ
;
;
OP S R=$O(^UTILITY("DIFROM",$J,N,R)) I R="" K ^UTILITY("DIFROM",$J) S X="O" F R=0:0 S X=$O(^DIC(19,X)) G Q:X'?1"O".E K ^(X)
W !,"'"_R_"' Menu Option Filed" S DA=+^UTILITY("DIFROM",$J,N,R) G:$P(^(R),U,2,3)="XUCORE^" OP
S (DZ,DIX)=0,%=$P(^DIC(19,DA,0),U,7) S:%]"" %=$O(^DIC(9.2,"B",%,0)) S ^(0)=$P(^DIC(19,DA,0),U,1,6)_U_$S(%>0:%,1:"")_U_$P(^(0),U,8,99),%=$P(^(0),U,4)="M" K ^(10,"B"),^("C")
F X=0:0 S X=$O(^DIC(19,DA,10,X)) Q:X'>0 S I=$S($D(^(X,0)):^(0),1:0),Y=$S($D(^(U)):^(U),1:"") K ^DIC(19,DA,10,X) I Y]"",% S D=$O(^DIC(19,"B",Y,0)) I D>0 S ^DIC(19,DA,10,X,0)=D_U_$P(I,U,2,9),DZ=DZ+1,DIX=X
S:% ^DIC(19,DA,10,0)="^19.01PI^"_DZ_U_DIX D IX1^DIK G OP
;
ADD F R=0:0 S R=$O(^UTILITY(U,$J,N,R)) Q:R="" S X=$P(^(R,0),U,1),I=$P(^(0),U,4) W "." D ^DIC I Y>0,'$D(DIFQ(N))!$P(Y,U,3) S Y=Y_U D A
Q Q
A K:N'="SE"&(N'="OPT") @(DIC_"+Y)") S ^UTILITY("DIFROM",$J,N,X)=Y S:N="PK" DIFROM(0)=+Y Q:$P(Y,U,2,3)="XUCORE^"
I N="OPT",$O(^UTILITY(U,$J,N,R,1,0))>0 K @(DIC_"+Y,1)")
S %X="^UTILITY(U,$J,N,R,",%Y=DIC_"+Y,",DA=+Y,DIK=DIC D %XY^%RCR,IX1^DIK:N'="OPT"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARY24 2277 printed Dec 13, 2024@01:51:52 Page 2
ENARX24 ;(WASH ISC)/SAW/DH-2162 Archive ;5-29-91
+1 ;;7.0;ENGINEERING;;Aug 17, 1993
+2 ;
+3 ;
+4 KILL ^UTILITY("DIFROM",$JOB)
SET DIC(0)="LX"
SET (DIC,DLAYGO)=3.6
SET N="BULL"
if $DATA(^XMB(3.6,0))
DO ADD
SET X=0
FOR R=0:0
SET X=$ORDER(^UTILITY("DIFROM",$JOB,X))
if X=""
QUIT
WRITE !,"'",X,"' BULLETIN FILED -- REMEMBER TO ADD ITS USER GROUPS"
+5 IF $DATA(^DIC(9.4,0))#2
IF ^(0)?1"PACKAGE".E
SET N="PK"
SET (DIC,DLAYGO)=9.4
DO ADD
if $DATA(^DIC(9.4,DA,22,DIFROM,0))
SET ^(0)=$PIECE(^(0)_U,U,1,2)_U_DT
IF $DATA(^DIC(9.4,DA,0))#2
SET X=^(0)
SET %=$PIECE(X,U,4)
IF %]""
SET %=$ORDER(^DIC(9.2,"B",%,0))
if %]""
SET ^DIC(9.4,DA,0)=$PIECE(X,U,1,3)_U_%
+6 KILL ^UTILITY("DIFROM",$JOB)
IF $DATA(^DIC(19,0))#2
IF ^(0)?1"OPTION".E
SET (DIC,DLAYGO)=19
SET N="OPT"
DO ADD
DO OP
+7 IF $DATA(^DIC(19.1,0))#2
IF ^(0)?1"SECUR".E
SET (DIC,DLAYGO)=19.1
SET N="SE"
DO ADD
KILL ^UTILITY("DIFROM",$JOB)
+8 SET DIC=.5
SET DLAYGO=0
SET N="FUNC"
DO ADD
+9 IF $DATA(^DIC(9.8,0))#2
IF ^(0)?1"ROUTINE^".E
SET (DIC,DLAYGO)=9.8
SET N="ROU"
DO ADD
+10 SET DIC("S")="I $P(^(0),U,4)=I"
FOR N="DIPT","DIBT","DIE"
SET DIC=U_N_"("
DO ADD
+11 KILL ^UTILITY(U,$JOB),DIC,DLAYGO
FOR DIR="DIE","DIPT"
DO DIEZ
+12 QUIT
DIEZ SET N=$ORDER(^UTILITY("DIFROM",$JOB,DIR,0))
if N=""
QUIT
SET Y=+^(N)
KILL ^(N)
IF $DATA(@("^"_DIR_"(Y,""ROU"")"))
KILL ^("ROU")
IF $DATA(^("ROUOLD"))
SET X=^("ROUOLD")
SET DMAX=^DD("ROU")
IF $DATA(^("OS",^DD("OS"),"ZS"))
IF X]""
DO @("EN^DI"_$EXTRACT(DIR,3)_"Z")
+1 GOTO DIEZ
+2 ;
+3 ;
OP SET R=$ORDER(^UTILITY("DIFROM",$JOB,N,R))
IF R=""
KILL ^UTILITY("DIFROM",$JOB)
SET X="O"
FOR R=0:0
SET X=$ORDER(^DIC(19,X))
if X'?1"O".E
GOTO Q
KILL ^(X)
+1 WRITE !,"'"_R_"' Menu Option Filed"
SET DA=+^UTILITY("DIFROM",$JOB,N,R)
if $PIECE(^(R),U,2,3)="XUCORE^"
GOTO OP
+2 SET (DZ,DIX)=0
SET %=$PIECE(^DIC(19,DA,0),U,7)
if %]""
SET %=$ORDER(^DIC(9.2,"B",%,0))
SET ^(0)=$PIECE(^DIC(19,DA,0),U,1,6)_U_$SELECT(%>0:%,1:"")_U_$PIECE(^(0),U,8,99)
SET %=$PIECE(^(0),U,4)="M"
KILL ^(10,"B"),^("C")
+3 FOR X=0:0
SET X=$ORDER(^DIC(19,DA,10,X))
if X'>0
QUIT
SET I=$SELECT($DATA(^(X,0)):^(0),1:0)
SET Y=$SELECT($DATA(^(U)):^(U),1:"")
KILL ^DIC(19,DA,10,X)
IF Y]""
IF %
SET D=$ORDER(^DIC(19,"B",Y,0))
IF D>0
SET ^DIC(19,DA,10,X,0)=D_U_$PIECE(I,U,2,9)
SET DZ=DZ+1
SET DIX=X
+4 if %
SET ^DIC(19,DA,10,0)="^19.01PI^"_DZ_U_DIX
DO IX1^DIK
GOTO OP
+5 ;
ADD FOR R=0:0
SET R=$ORDER(^UTILITY(U,$JOB,N,R))
if R=""
QUIT
SET X=$PIECE(^(R,0),U,1)
SET I=$PIECE(^(0),U,4)
WRITE "."
DO ^DIC
IF Y>0
IF '$DATA(DIFQ(N))!$PIECE(Y,U,3)
SET Y=Y_U
DO A
Q QUIT
A if N'="SE"&(N'="OPT")
KILL @(DIC_"+Y)")
SET ^UTILITY("DIFROM",$JOB,N,X)=Y
if N="PK"
SET DIFROM(0)=+Y
if $PIECE(Y,U,2,3)="XUCORE^"
QUIT
+1 IF N="OPT"
IF $ORDER(^UTILITY(U,$JOB,N,R,1,0))>0
KILL @(DIC_"+Y,1)")
+2 SET %X="^UTILITY(U,$J,N,R,"
SET %Y=DIC_"+Y,"
SET DA=+Y
SET DIK=DIC
DO %XY^%RCR
if N'="OPT"
DO IX1^DIK
