Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTVGC1A

XTVGC1A.m

Go to the documentation of this file.
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