source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XINDEX.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1XINDEX ;ISC/REL,GFT,GRK,RWF - INDEX & CROSS-REFERENCE ;10/23/2003 17:35
2 ;;7.3;TOOLKIT;**20,27,48,61,66,68**;Apr 25, 1995
3 G ^XINDX6
4SEP F I=1:1 S CH=$E(LIN,I) D QUOTE:CH=Q Q:" "[CH
5 S ARG=$E(LIN,1,I-1) S:CH=" " I=I+1 S LIN=$E(LIN,I,999) Q
6QUOTE F I=I+1:1 S CH=$E(LIN,I) Q:CH=""!(CH=Q)
7 Q:CH]"" S ERR=6 G ^XINDX1
8ALIVE ;enter here from taskman
9 D SETUP^XINDX7 ;Get ready to process
10A2 S RTN=$O(^UTILITY($J,RTN)) G ^XINDX5:RTN=""
11 S INDLC=(RTN?1"|"1.4L.NP) D LOAD:'INDLC
12 I $D(ZTQUEUED),$$S^%ZTLOAD S RTN="~",IND("QUIT")=1,ZTSTOP=1 G A2
13 I 'INDDS,INDLC W !!?10,"Data Dictionaries",! S INDDS=1
14 D BEG
15 G A2
16 ;
17LOAD S X=RTN,XCNP=0,DIF="^UTILITY("_$J_",1,RTN,0," X ^%ZOSF("TEST") Q:'$T X ^%ZOSF("LOAD") S ^UTILITY($J,1,RTN,0,0)=XCNP-1
18 Q
19BEG ;
20 S %=INDLC*5 W:$X+10+%>IOM ! W RTN,$J("",10+%-$L(RTN))
21 S (IND("DO"),IND("SZT"),IND("SZC"),LABO)=0,LC=$G(^UTILITY($J,1,RTN,0,0))
22 I LC="" W !,">>>Routine '",RTN,"' not found <<<",! Q
23 S TXT="",LAB=$P($P(^UTILITY($J,1,RTN,0,1,0)," "),"(") I RTN'=LAB D E^XINDX1(17)
24 I 'INDLC,LC>2 S LIN=$G(^UTILITY($J,1,RTN,0,2,0)) D
25 . I $P(LIN,";",3)'?1.2N1"."1.2N.1(1"T",1"V").2N D E^XINDX1(44)
26 . I $L(INP(11)) X INP(11) ;Version number check
27 . I $L(INP(12)) X INP(12) ;Patch number check
28B5 F TXT=1:1:LC S LIN=^UTILITY($J,1,RTN,0,TXT,0),LN=$L(LIN),IND("SZT")=IND("SZT")+LN+2 D LN,ST
29 S LAB="",LABO=0,TXT=0,^UTILITY($J,1,RTN,0)=IND("SZT")_"^"_LC_"^"_IND("SZC")
30 I IND("SZT")>INP("MAX"),'INDLC S ERR=35,ERR(1)=IND("SZT") D ^XINDX1
31 D POSTRTN
32 Q
33 ;Proccess one line, LN = Length, LIN = Line.
34LN K V S (ARG,GRB,IND("COM"))="",X=$P(LIN," ") I '$L(X) S LABO=LABO+1 G CD
35 S (IND("COM"),LAB)=$P(X,"("),ARG=$P($P(X,"(",2),")"),LABO=0,IND("PP")=X?1.8E1"(".E1")"
36 D:$L(ARG) NE^XINDX3 ;Process formal parameters as New list.
37 I 'INDLC,'$$VT^XINDX2(LAB) D E^XINDX1($S(LAB=$$CASE^XINDX52(LAB):11,1:55)) ;Check for lowercase tags
38 I $D(^UTILITY($J,1,RTN,"T",LAB)) D E^XINDX1(15) G CD
39 S ^UTILITY($J,1,RTN,"T",LAB)=""
40CD D:LN>245 E^XINDX1(19) D:LIN'?1.ANP E^XINDX1(18)
41 S I=0,LIN=$P(LIN," ",2,999),IND("LCC")=1,ERR=42 G:LIN="" ^XINDX1 ;Watch the scope of I.
42 I " ."[$E(LIN) D S X=$L($E(LIN,1,I),".")-1,LIN=$E(LIN,I,999)
43 . F I=1:1:245 Q:". "'[$E(LIN,I)
44 . Q
45 D:'I&$G(IND("DO1")) E^XINDX1(51) S IND("DO1")=0 S:'I IND("DO")=0 I I D:X>IND("DO") E^XINDX1(51) S IND("DO")=X
46 ;Process commands on line.
47EE I LIN="" D ^XINDX2 Q
48 S COM=$E(LIN),GK="",ARG=""
49 I COM=";" S:$E(LIN,2)'=";" IND("SZC")=IND("SZC")+$L(LIN) S LIN="" G EE
50 I COM=" " S ERR=$S(LIN?1." ":13,1:0),LIN=$S(ERR:"",1:$E(LIN,2,999)) D:ERR ^XINDX1 G EE
51 D SEP
52 S CM=$P(ARG,":",1),POST=$P(ARG,":",2,999),IND("COM")=IND("COM")_$C(9)_COM,ERR=48 D:ARG[":"&(POST']"") ^XINDX1 S:POST]"" GRB=GRB_$C(9)_POST,IND("COM")=IND("COM")_":"
53 I CM?.E1L.E S CM=$$CASE^XINDX52(CM),COM=$E(CM) I IND("LCC") S IND("LCC")=0 D E^XINDX1(47)
54 I CM="" D E^XINDX1(21) G EE ;Missing command
55 S CX=$G(IND("CMD",CM)) I CX="" D G:CX="" EE
56 . I $E(CM)="Z" S CX="^Z" Q ;Proccess Z commands
57 . D E^XINDX1(1) S LIN="" Q
58 S CX=$P(CX,"^",2,9)
59 D SEP I '$L(LIN),CH=" " D E^XINDX1(13) ;trailing space
60 I ARG="","CGJMORSUWX"[COM S ERR=49 G ^XINDX1
61 I CX>0 D E^XINDX1(CX) S CX=""
62 D:$L(CX) @CX S:ARG'="" GRB=GRB_$C(9)_ARG G EE
63B S ERR=25 G ^XINDX1
64C S ERR=29 G ^XINDX1
65D G DG1^XINDX4
66E Q:ARG="" S ERR=7 G ^XINDX1
67F G:ARG]"" FR^XINDX4 Q
68G G DG^XINDX4
69H Q:ARG'="" S ERR=32 G ^XINDX1
70J S ERR=36,ARG="" G ^XINDX1
71K S ERR=$S(ARG?1"(".E:22,ARG?." ":23,1:0) D:ERR ^XINDX1
72 G KL^XINDX3
73L G LO^XINDX4
74M G S^XINDX3
75N G NE^XINDX3
76O S ERR=34 D ^XINDX1,O^XINDX3 Q
77Q Q:ARG="" G Q^XINDX4
78R S RDTIME=0 G RD^XINDX3
79S G S^XINDX3
80U S ARG=$P(ARG,":") Q
81V S ARG="",ERR=20 G ^XINDX1
82W G WR^XINDX4
83X G XE^XINDX4
84Z S ERR=2 D ^XINDX1 G ZC^XINDX4
85 ;Save off items from line.
86ST S R=LAB_$S(LABO:"+"_LABO,1:"")
87 ;Local variable, Global, Marked Items, Naked global, Internal ref, eXternal ref., Tag ref.
88 S LOC="" F S LOC=$O(V(LOC)),S="" Q:LOC="" F S S=$O(V(LOC,S)) Q:S="" D SET
89 S ^UTILITY($J,1,RTN,"COM",TXT)=IND("COM")
90 Q
91SET I V(LOC,S)]"" F %="!","~" I V(LOC,S)[%,$G(^UTILITY($J,1,RTN,LOC,S))'[% S ^(S)=$G(^(S))_%
92 S %=0
93SE2 S ARG=$G(^UTILITY($J,1,RTN,LOC,S,%)) I $L(ARG)>230 S %=%+1 G SE2
94 S ^UTILITY($J,1,RTN,LOC,S,%)=ARG_R_V(LOC,S)_","
95 Q
96POSTRTN ;Do more overall checking
97 N V S LAB="",LABO=0
98 F S LAB=$O(^UTILITY($J,1,RTN,"I",LAB)),L=LAB Q:LAB="" D
99 . Q:$E(L,1,2)="@("
100 . S:$E(L,1,2)="$$" L=$E(L,3,99) I L]"",'$D(^UTILITY($J,1,RTN,"T",$P(L,"+",1))) D E^XINDX1(14)
101 . Q
102 S LAB="" I 'INDLC F S LAB=$O(^UTILITY($J,1,RTN,"T",LAB)) Q:LAB="" D
103 . D:'$$VT^XINDX2(LAB) E^XINDX1(37)
104 . Q
105 S LAB="" F S LAB=$O(^UTILITY($J,1,RTN,"L",LAB)) Q:LAB="" D
106 . D VLNF^XINDX3($P(LAB,"("))
107 . Q
108 Q
Note: See TracBrowser for help on using the repository browser.