XTVGC1A ;ISC-SF/JLI-SAVE DATA FOR ENTRIES BASED ON NAMESPACE ;12/13/93 13:45
;;7.3;TOOLKIT;;Apr 25, 1995
;;
ENTRY ;
F XTTYI=1:1:8 D
.S XTTY=$P("OPTIONS;DIC(19,^KEYS;DIC(19.1,^HELP FRAMES;DIC(9.2,^BULLETINS;XMB(3.6,^FUNCTIONS;DD(""FUNC"",^EDIT TEMPLATES;DIE(^SORT TEMPLATES;DIBT(^PRINT TEMPLATES;DIPT(^S;SCRE(",U,XTTYI)
.S XTNOD=U_$P(XTTY,";",2),XTTY=$P(XTTY,";"),XTBAS1="^XTV(8991.2,XTVPT,1,XTVD,2," D SAVE
.I XTXNUM>0 S @(XTBAS1_XTTYI_",1,0)")="^^"_XTXNUM_U_XTXNUM,@(XTBAS1_XTTYI_",0)")=XTTY,@(XTBAS1_"""B"","""_XTTY_""","_XTTYI_")")=""
K IX,X,X1,XTBAS1,XTBAS2,XTCNT,XTNOD,XTNS,XTNS1,XTNSI,XTNSL,XTNUM,XTTY,XTTYI,XTTYJ,XTVAL,XTVB,XTVPK,XTVPT,XTVTY,XTXNUM
Q
SAVE ;
S XTBAS2=XTBAS1_XTTYI_",1,"
S XTXNUM=0,XTVTY=XTTY
S:'$D(XTVPK) XTVPK=+^XTV(8991.2,XTVPT,0) S XTNS="" F XTNSI=0:0 S XTNSI=$O(^XTV(8991.19,XTVPK,2,XTNSI)) Q:XTNSI'>0 S XTNS=$P(^(XTNSI,0),U),XTNSL=$L(XTNS),XTNS1=$E(XTNS,1,XTNSL-1)_$C($A($E(XTNS,XTNSL))-1)_"z",XTVAL=XTNS1 D SAVE1
Q
SAVE1 ;
F XTTYJ=0:0 S XTVAL=$O(@(XTNOD_"""B"","""_XTVAL_""")")) Q:$E(XTVAL,1,XTNSL)'=XTNS F XTNUM=0:0 S XTNUM=$O(@(XTNOD_"""B"","""_XTVAL_""","_XTNUM_")")) Q:XTNUM'>0 S XTXNUM=XTXNUM+1 D
.I '$D(ZTQUEUED) W "."
.S @(XTBAS2_"""B"","""_XTVAL_""","_XTXNUM_")")=XTNUM
.S @(XTBAS2_XTXNUM_",0)")=XTVAL_U_XTNUM,XTVB=XTBAS2_XTXNUM_",1,",X=XTNOD_XTNUM_")",X1=XTNOD_XTNUM_",",XTCNT=0 D XPND
Q
XPND ;
F IX=0:0 S X=$Q(@X) S X=$S($E(X,1,2)="^|":U_$P(X,"|",3,99),$E(X,1,2)="^[":U_$P(X,"]",2,99),1:X) Q:X'[X1 I XTVTY'="E"!($P(X,",",2)'="""AB""") D
.S XTCNT=XTCNT+1,@(XTVB_XTCNT_",0)")=$P(XTNOD,U,2)_"~IEN~,"_$P(X,",",$L(XTNOD,",")+1,200),@(XTVB_XTCNT_",1)")=@X
I XTCNT>0 S @(XTVB_"0)")="^^"_XTCNT_U_XTCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVGC1A 1687 printed Dec 13, 2024@02:41:53 Page 2
XTVGC1A ;ISC-SF/JLI-SAVE DATA FOR ENTRIES BASED ON NAMESPACE ;12/13/93 13:45
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 ;;
ENTRY ;
+1 FOR XTTYI=1:1:8
Begin DoDot:1
+2 SET XTTY=$PIECE("OPTIONS;DIC(19,^KEYS;DIC(19.1,^HELP FRAMES;DIC(9.2,^BULLETINS;XMB(3.6,^FUNCTIONS;DD(""FUNC"",^EDIT TEMPLATES;DIE(^SORT TEMPLATES;DIBT(^PRINT TEMPLATES;DIPT(^S;SCRE(",U,XTTYI)
+3 SET XTNOD=U_$PIECE(XTTY,";",2)
SET XTTY=$PIECE(XTTY,";")
SET XTBAS1="^XTV(8991.2,XTVPT,1,XTVD,2,"
DO SAVE
+4 IF XTXNUM>0
SET @(XTBAS1_XTTYI_",1,0)")="^^"_XTXNUM_U_XTXNUM
SET @(XTBAS1_XTTYI_",0)")=XTTY
SET @(XTBAS1_"""B"","""_XTTY_""","_XTTYI_")")=""
End DoDot:1
+5 KILL IX,X,X1,XTBAS1,XTBAS2,XTCNT,XTNOD,XTNS,XTNS1,XTNSI,XTNSL,XTNUM,XTTY,XTTYI,XTTYJ,XTVAL,XTVB,XTVPK,XTVPT,XTVTY,XTXNUM
+6 QUIT
SAVE ;
+1 SET XTBAS2=XTBAS1_XTTYI_",1,"
+2 SET XTXNUM=0
SET XTVTY=XTTY
+3 if '$DATA(XTVPK)
SET XTVPK=+^XTV(8991.2,XTVPT,0)
SET XTNS=""
FOR XTNSI=0:0
SET XTNSI=$ORDER(^XTV(8991.19,XTVPK,2,XTNSI))
if XTNSI'>0
QUIT
SET XTNS=$PIECE(^(XTNSI,0),U)
SET XTNSL=$LENGTH(XTNS)
SET XTNS1=$EXTRACT(XTNS,1,XTNSL-1)_$CHAR($ASCII($EXTRACT(XTNS,XTNSL))-1)_"z"
SET XTVAL=XTNS1
DO SAVE1
+4 QUIT
SAVE1 ;
+1 FOR XTTYJ=0:0
SET XTVAL=$ORDER(@(XTNOD_"""B"","""_XTVAL_""")"))
if $EXTRACT(XTVAL,1,XTNSL)'=XTNS
QUIT
FOR XTNUM=0:0
SET XTNUM=$ORDER(@(XTNOD_"""B"","""_XTVAL_""","_XTNUM_")"))
if XTNUM'>0
QUIT
SET XTXNUM=XTXNUM+1
Begin DoDot:1
+2 IF '$DATA(ZTQUEUED)
WRITE "."
+3 SET @(XTBAS2_"""B"","""_XTVAL_""","_XTXNUM_")")=XTNUM
+4 SET @(XTBAS2_XTXNUM_",0)")=XTVAL_U_XTNUM
SET XTVB=XTBAS2_XTXNUM_",1,"
SET X=XTNOD_XTNUM_")"
SET X1=XTNOD_XTNUM_","
SET XTCNT=0
DO XPND
End DoDot:1
+5 QUIT
XPND ;
+1 FOR IX=0:0
SET X=$QUERY(@X)
SET X=$SELECT($EXTRACT(X,1,2)="^|":U_$PIECE(X,"|",3,99),$EXTRACT(X,1,2)="^[":U_$PIECE(X,"]",2,99),1:X)
if X'[X1
QUIT
IF XTVTY'="E"!($PIECE(X,",",2)'="""AB""")
Begin DoDot:1
+2 SET XTCNT=XTCNT+1
SET @(XTVB_XTCNT_",0)")=$PIECE(XTNOD,U,2)_"~IEN~,"_$PIECE(X,",",$LENGTH(XTNOD,",")+1,200)
SET @(XTVB_XTCNT_",1)")=@X
End DoDot:1
+3 IF XTCNT>0
SET @(XTVB_"0)")="^^"_XTCNT_U_XTCNT
+4 QUIT
