source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XTVGC1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1XTVGC1 ;ISC-SF/JLI - RECORD GLOBAL NODES FOR PACKAGE BEFORE MODIFICATION ;12/16/93 14:06 ; 01/16/89
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 W !!,"Record Current Global Nodes for Package for Future Comparison",!!
4ASK K DIC S DIC=8991.2,DIC(0)="AEQLM",DLAYGO=8991.2 D ^DIC Q:Y'>0 S XTVPT=+Y
5 S %DT("A")="Date current status is to be recorded as: ",%DT("B")="T",%DT="AEQXP" D ^%DT G:Y'>0 ASK S XTVDT=Y
6ASK1 R !,"Current Version Number (optional): ",X:DTIME Q:'$T!(X[U) S XTVVN=X I X'="",X'>0 W !!,$C(7),"Enter a version number (beginning with a number at least) or RETURN",! G ASK1
7 S ZTRTN="DQ^XTVGC1",ZTDESC="Package Globals Record",ZTIO="",ZTSAVE("XTVPT")="",ZTSAVE("XTVDT")="",ZTSAVE("XTVVN")="" D ^%ZTLOAD
8 K DIC,XTVPT,XTVDT,XTVVN,%DT,ZTRTN,ZTIO,ZTDESC,ZTSAVE
9 Q
10 ;
11DQ ;
12 K ^TMP($J),X
13 S XTVPK=+^XTV(8991.2,XTVPT,0)
14 S:'$D(^XTV(8991.2,XTVPT,1,0)) ^(0)="^8991.21^" S DIC="^XTV(8991.2,XTVPT,1,",DA(1)=XTVPT,DIC(0)="ML",DLAYGO=8991.2,DIC("P")=8991.21,X=XTVDT D ^DIC Q:Y'>0 S XTVD=+Y
15 S:XTVVN'="" ^(0)=^XTV(8991.2,XTVPT,1,XTVD,0)_U_XTVVN
16 F I=0:0 S I=$O(^XTV(8991.19,XTVPK,1,I)) Q:I'>0 S GLBN=+^(I,0) I '$D(^TMP($J,GLBN)) S ^(GLBN)=GLBN,^TMP($J,"A",GLBN)="" K X D CHK
17 S XTVNF=0 F I=0:0 S I=$O(^TMP($J,"A",I)) Q:I'>0 S XTVNM=$O(^DD(I,0,"NM",0)),XTVNM=$S(XTVNM'="":XTVNM,1:I),^XTV(8991.2,XTVPT,1,XTVD,1,I,0)=XTVNM,^XTV(8991.2,XTVPT,1,XTVD,1,"B",XTVNM,I)="" D GETFIL S XTVNF=XTVNF+1,XTVNL=I
18 I XTVNF>0 S ^XTV(8991.2,XTVPT,1,XTVD,1,0)="^^"_XTVNL_U_XTVNF
19 D ^XTVGC1A
20 K A,DA,DIC,DLAYGO,GLBN,I,IX,J,K,L,M,X,X1,XTBAS1,XTBAS2,XTCNA,XTCNL,XTCNT,XTNOD,XTNS,XTNS1,XTNSI,XTNSL,XTNUM,XTTY,XTTYI,XTTYJ,XTVA,XTVAL,XTVAB,XTVB,XTVB1,XTVD,XTVF,XTVNAM,XTVNF,XTVNL,XTVNM,XTVPK,XTVPT,XTVTY,XTVVN,XTXNUM,Y
21 Q
22 ;
23CHK S L=0 F J=0:0 S J=$O(^DD(GLBN,"SB",J)) Q:J'>0 S X(L,J)=""
24 F L=0:1 Q:'$D(X(L)) S M=L+1 F K=0:0 S K=$O(X(L,K)) Q:K'>0 F J=0:0 S J=$O(^DD(K,"SB",J)) Q:J'>0 S X(M,J)=""
25 F L=-1:0 S L=$O(X(L)) Q:L="" F J=0:0 S J=$O(X(L,J)) Q:J'>0 S:'$D(^TMP($J,J)) ^(J)=GLBN,^TMP($J,"A",GLBN,J)=""
26 Q
27 ;
28GETFIL S XTVF=I D DD,DIC ;,DIE,DIBT,DIPT
29 Q
30DD S XTVTY="D",XTVA="^XTV(8991.2,XTVPT,1,XTVD,1,I,""D"",0)",XTVAB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""D"",""B"",",XTVB1="^XTV(8991.2,XTVPT,1,XTVD,1,I,""D"",J,0)",XTVB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""D"",J,1,"
31 S (XTVF,J)=I S X="^DD("_XTVF_")",X1="^DD("_XTVF_",",XTVNAM=$S($O(^DD(I,0,"NM",0))'="":$O(^(0)),1:I),@XTVB1=XTVNAM,@(XTVAB_""""_XTVNAM_""","_J_")")="",XTCNA=1,XTCNL=I,XTCNT=0 D XPND
32 F J=0:0 S J=$O(^TMP($J,"A",I,J)) Q:J'>0 S XTCNT=0,X="^DD("_J_")",X1="^DD("_J_",",XTVNAM=$S($O(^DD(J,0,"NM",0))'="":$O(^(0)),1:J),@XTVB1=XTVNAM,@(XTVAB_""""_XTVNAM_""","_J_")")="" D XPND S XTCNA=XTCNA+1,XTCNL=J
33 I XTCNA>0 S @XTVA="^^"_XTCNL_U_XTCNA
34 Q
35 ;
36DIC S XTVTY="C",XTVF=I,X="^DIC("_I_")",X1="^DIC("_I_",0",XTVB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""C"",",XTCNT=0 D XPND
37 I XTCNT>0 S @(XTVB_"0)")="^^"_XTCNT_U_XTCNT
38 Q
39 ;
40DIE ;
41 S XTVA="^XTV(8991.2,XTVPT,1,XTVD,1,I,""E"",0)",XTVAB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""E"",""B"",",XTVB1="^XTV(8991.2,XTVPT,1,XTVD,1,I,""E"",J,0)",XTVB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""E"",J,1,"
42 S (XTVF,J)="F"_I,A="",XTCNA=0,XTVTY="E"
43 F K=0:0 S A=$O(^DIE(XTVF,A)) Q:A="" F J=0:0 S J=$O(^DIE(XTVF,A,J)) Q:J'>0 S X="^DIE("_J_")",X1="^DIE("_J_",",XTVNAM=A,@XTVB1=XTVNAM,@(XTVAB_""""_XTVNAM_""","_J_")")="",XTCNA=XTCNA+1,XTCNL=J,XTCNT=0 D XPND
44 I XTCNA>0 S @XTVA="^^"_XTCNL_U_XTCNA
45 Q
46 ;
47DIPT ;
48 S XTVA="^XTV(8991.2,XTVPT,1,XTVD,1,I,""P"",0)",XTVAB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""P"",""B"",",XTVB1="^XTV(8991.2,XTVPT,1,XTVD,1,I,""P"",J,0)",XTVB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""P"",J,1,"
49 S (XTVF,J)="F"_I,A="",XTCNA=0,XTVTY="P"
50 F K=0:0 S A=$O(^DIPT(XTVF,A)) Q:A="" F J=0:0 S J=$O(^DIPT(XTVF,A,J)) Q:J'>0 S X="^DIPT("_J_")",X1="^DIPT("_J_",",XTVNAM=A,@XTVB1=XTVNAM,@(XTVAB_""""_XTVNAM_""","_J_")")="",XTCNA=XTCNA+1,XTCNL=J,XTCNT=0 D XPND
51 I XTCNA>0 S @XTVA="^^"_XTCNL_U_XTCNA
52 Q
53 ;
54DIBT ;
55 S XTVA="^XTV(8991.2,XTVPT,1,XTVD,1,I,""S"",0)",XTVAB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""S"",""B"",",XTVB1="^XTV(8991.2,XTVPT,1,XTVD,1,I,""S"",J,0)",XTVB="^XTV(8991.2,XTVPT,1,XTVD,1,I,""S"",J,1,"
56 S (XTVF,J)="F"_I,A="",XTCNA=0,XTVTY="S"
57 F K=0:0 S A=$O(^DIBT(XTVF,A)) Q:A="" F J=0:0 S J=$O(^DIBT(XTVF,A,J)) Q:J'>0 S X="^DIBT("_J_")",X1="^DIBT("_J_",",XTVNAM=A,@XTVB1=XTVNAM,@(XTVAB_""""_XTVNAM_""","_J_")")="",XTCNA=XTCNA+1,XTCNL=J,XTCNT=0 D XPND
58 I XTCNA>0 S @XTVA="^^"_XTCNL_U_XTCNA
59 Q
60 ;
61XPND ;
62 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""") S XTCNT=XTCNT+1,@(XTVB_XTCNT_",0)")=$P(X,U,2,99),@(XTVB_XTCNT_",1)")=@X
63 I XTCNT>0 S @(XTVB_"0)")="^^"_XTCNT_U_XTCNT
64 Q
Note: See TracBrowser for help on using the repository browser.