source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTVGC1A.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1XTVGC1A ;ISC-SF/JLI-SAVE DATA FOR ENTRIES BASED ON NAMESPACE ;12/13/93 13:45
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 ;;
4ENTRY ;
5 F XTTYI=1:1:8 D
6 .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)
7 .S XTNOD=U_$P(XTTY,";",2),XTTY=$P(XTTY,";"),XTBAS1="^XTV(8991.2,XTVPT,1,XTVD,2," D SAVE
8 .I XTXNUM>0 S @(XTBAS1_XTTYI_",1,0)")="^^"_XTXNUM_U_XTXNUM,@(XTBAS1_XTTYI_",0)")=XTTY,@(XTBAS1_"""B"","""_XTTY_""","_XTTYI_")")=""
9 K IX,X,X1,XTBAS1,XTBAS2,XTCNT,XTNOD,XTNS,XTNS1,XTNSI,XTNSL,XTNUM,XTTY,XTTYI,XTTYJ,XTVAL,XTVB,XTVPK,XTVPT,XTVTY,XTXNUM
10 Q
11SAVE ;
12 S XTBAS2=XTBAS1_XTTYI_",1,"
13 S XTXNUM=0,XTVTY=XTTY
14 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
15 Q
16SAVE1 ;
17 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
18 .I '$D(ZTQUEUED) W "."
19 .S @(XTBAS2_"""B"","""_XTVAL_""","_XTXNUM_")")=XTNUM
20 .S @(XTBAS2_XTXNUM_",0)")=XTVAL_U_XTNUM,XTVB=XTBAS2_XTXNUM_",1,",X=XTNOD_XTNUM_")",X1=XTNOD_XTNUM_",",XTCNT=0 D XPND
21 Q
22XPND ;
23 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
24 .S XTCNT=XTCNT+1,@(XTVB_XTCNT_",0)")=$P(XTNOD,U,2)_"~IEN~,"_$P(X,",",$L(XTNOD,",")+1,200),@(XTVB_XTCNT_",1)")=@X
25 I XTCNT>0 S @(XTVB_"0)")="^^"_XTCNT_U_XTCNT
26 Q
Note: See TracBrowser for help on using the repository browser.