XTVGC1A.m

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

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