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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1%INDEX ;ISC/REL,GFT,GRK,RWF - INDEX & CROSS-REFERENCE ;08/11/94 13:29
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3 G ^%INDX6
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 ^%INDX1
8ALIVE ;enter here from taskman
9 D SETUP^%INDX6 ;Get ready to process
10A2 S RTN=$O(^UTILITY($J,RTN)) G ^%INDX5:RTN="" S INDLC=(RTN?1"|"1.4L.NP) D LOAD:'INDLC,BEG G A2
11 Q
12LOAD 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
13 Q
14BEG I $D(ZTQUEUED),$$S^%ZTLOAD S RTN="~",IND("QUIT")=1,ZTSTOP=1 Q
15 I 'INDDS,INDLC W !!?10,"Data Dictionaries",! S INDDS=1
16 S %=INDLC*5 W:$X+1+%>IOM ! W RTN,$J("",10+%-$L(RTN)) S LC=^UTILITY($J,1,RTN,0,0)
17 S LABO=0,LAB=$P($P(^UTILITY($J,1,RTN,0,1,0)," "),"(") I RTN'=LAB S ERR=17 D ^%INDX1
18 I 'INDLC,LC>2,$P(^UTILITY($J,1,RTN,0,2,0)," ",2,99)'?1";;".E1N.E S ERR=44 D ^%INDX1
19B5 S (IND("DO"),CCN)=0 F TXT=1:1:LC S LIN=^UTILITY($J,1,RTN,0,TXT,0),LN=$L(LIN),CCN=CCN+LN+2 D LN,ST
20 S LAB="",LABO=0,^UTILITY($J,1,RTN,0)=CCN_"^"_LC I CCN>5000,'INDLC S ERR=35,ERR(1)=CCN D ^%INDX1
21BC S LAB=$O(^UTILITY($J,1,RTN,"I",LAB)),L=LAB G:$E(L,1,2)="@(" BC I LAB="" Q
22 S:$E(L,1,2)="$$" L=$E(L,3,99) G BC:L']"",BC:$D(^UTILITY($J,1,RTN,"T",$P(L,"+",1))) S ERR=14 D ^%INDX1 G BC
23 ;Proccess one line.
24LN K V S (GRB,IND("COM"))="",IND("DO1")=0 I $P(LIN," ",1)="" S LABO=LABO+1 G CD
25 S X=$P(LIN," "),(IND("COM"),LAB)=$P(X,"("),GRB=$P($P(X,"(",2),")"),LABO=0,IND("PP")=X?1.8E1"(".E1")"
26 I $D(^UTILITY($J,1,RTN,"T",LAB)) S ERR=15 D ^%INDX1 G CD
27 S ^UTILITY($J,1,RTN,"T",LAB)="" I 'INDLC,'$$VT^%INDX2(LAB) S ERR=37 D ^%INDX1
28CD S ERR=19 D:LN>245 ^%INDX1 S ERR=18 D:LIN'?1.ANP ^%INDX1
29 S I=0,LIN=$P(LIN," ",2,999),IND("LCC")=1,ERR=42 G:LIN="" ^%INDX1 ;Watch the scope of I.
30 I " ."[$E(LIN) D S X=$L($E(LIN,1,I),".")-1,LIN=$E(LIN,I,999)
31 . F I=1:1:245 Q:". "'[$E(LIN,I)
32 . Q
33 S:'I IND("DO")=0 I I S ERR=51 D:X>IND("DO") ^%INDX1 S IND("DO")=X
34 ;Process commands on line.
35EE I LIN="" D ^%INDX2 Q
36 S COM=$E(LIN),GK="" I COM=";" S LIN="" G EE
37 I COM=" " S ERR=$S(LIN?1." ":13,1:0),LIN=$E(LIN,2,999) S:ERR LIN="" D:ERR ^%INDX1 G EE
38 D SEP
39 S CM=$P(ARG,":",1),POST=$P(ARG,":",2,999),IND("COM")=IND("COM")_$C(9)_COM,ERR=48 D:ARG[":"&(POST']"") ^%INDX1 S:POST]"" GRB=GRB_$C(9)_POST,IND("COM")=IND("COM")_":"
40 I CM?.E1L.E D CASE^%INDX52 S COM=$E(CM) I IND("LCC") S IND("LCC")=0,ERR=47 D ^%INDX1
41 I "BCDEFGHIJKLNOQRSUVWXZ"'[COM S ERR=1 G ^%INDX1
42 I $L(CM)>1,$E(CM)'="Z",$P($T(CMD),";;",2,999)'[(","_CM_",") S ERR=1 G ^%INDX1
43 D SEP I '$L(LIN),CH=" " S ERR=13 D ^%INDX1 ;trailing space
44 I ARG="","CGJORSUWX"[COM S ERR=49 G ^%INDX1
45 D:"BCDEFGHJKLNOQRSUVWXZ"[COM @COM S:ARG'="" GRB=GRB_$C(9)_ARG G EE
46B S ERR=25 G ^%INDX1
47C S ERR=29 G ^%INDX1
48D G DG1^%INDX4
49E Q:ARG="" S ERR=7 G ^%INDX1
50F G:ARG]"" FR^%INDX4 Q
51G G DG^%INDX4
52H Q:ARG'="" S ERR=32 G ^%INDX1
53J S ERR=36,ARG="" G ^%INDX1
54K S ERR=$S(ARG?1"(".E:22,ARG?." ":23,1:0) D:ERR ^%INDX1
55 G KL^%INDX3
56L G LO^%INDX4
57N G NE^%INDX3
58O S ERR=34 D ^%INDX1,O^%INDX3 Q
59P Q
60Q Q:ARG="" G Q^%INDX4
61R S RDTIME=0 G RD^%INDX3
62S G S^%INDX3
63U S ARG=$P(ARG,":") Q
64V S ARG="",ERR=20 G ^%INDX1
65W G WR^%INDX4
66X G XE^%INDX4
67Z S ERR=2 D ^%INDX1 G ZC^%INDX4
68CMD ;;,BREAK,CLOSE,DO,ELSE,FOR,GOTO,HALT,HANG,IF,KILL,NEW,LOCK,OPEN,PRINT,QUIT,READ,SET,USE,VIEW,WRITE,XECUTE,
69ST S R=LAB_$S(LABO:"+"_LABO,1:"")
70 ;Local variable, Global, Marked Items, Naked global, Internal ref, eXternal ref., Tag ref.
71 S LOC="" F S LOC=$O(V(LOC)),S="" Q:LOC="" F S S=$O(V(LOC,S)) Q:S="" D SET
72 S ^UTILITY($J,1,RTN,"COM",TXT)=IND("COM") Q
73SET S %=0
74 I V(LOC,S)]"","!~"[V(LOC,S),$G(^UTILITY($J,1,RTN,LOC,S))'[V(LOC,S) S ^(S)=$G(^(S))_V(LOC,S)
75SE2 S ARG=$G(^UTILITY($J,1,RTN,LOC,S,%)) I $L(ARG)>230 S %=%+1 G SE2
76 S ^UTILITY($J,1,RTN,LOC,S,%)=ARG_R_V(LOC,S)_"," Q
Note: See TracBrowser for help on using the repository browser.