source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/ZINDX2.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.0 KB
Line 
1%INDX2 ;ISC/REL,GRK,RWF - PROCESS "GRB" ;8/18/93 11:38 ;
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3% S LINE=GRB,COM="" F I=0:0 S STR=$P(LINE,$C(9),1),LINE=$P(LINE,$C(9),2,999),NOA=0 D:STR]"" ARGG Q:LINE']""
4 Q
5 ;Process argument
6ARGG D ^%INDX9 S I=0,AC=999 F %=0:0 S %=$O(LV(%)) Q:%'>0 S I(%)=0
7ARGS ;Proccess all agruments at this level
8 S AC=LI+AC F Q:AC'>LI D INC Q:S="" D ARG
9 Q
10 ;
11ARG ;Process one argument
12 I CH="," D PEEK,E^%INDX1(21):","[Y Q
13 Q:CH=Q
14 I (CH?1A)!(CH="%") D LOC Q
15 I CH="^" S LOC="G" G NAK:S="^",EXTGLO:S["[",GLO Q
16 I CH="$" D FUN Q
17 I CH="?" D PAT Q
18 I CH="(" D INC S NOA=S D DN,INC Q
19 Q
20 ;
21NAK S LOC="N" G GLO
22EXTGLO D E^%INDX1(50),EG,INC S S=U_S G GLO
23EG N GK,LOC S GK="",LOC="L" ;HANDLE EXTENDED GLOBAL
24 F D INC Q:"]"[CH D ARG
25 Q
26GLO S X=$E(S,2,99) I X]"",X'?1.8UN,X'?1"%".7UN D E^%INDX1(12)
27 I GK["*",$E(S,1,2)["^%" D E^%INDX1(45)
28 I S1="(" S S=S_S1 D PEEKDN S:(Y?1.N)!($A(Y)=34)!("^$J^$I^$H^"[(U_Y)) S=S_Y
29 D ST(LOC,S) I S1="(" D INC2 S NOA=S D DN,INC
30 Q
31LOC S LOC="L" I S'?1.8UN,S'?1"%".7UN,S'?1.8LN,S'?1"%".7LN D E^%INDX1(11)
32 I S1="(" S S=S_S1 D PEEKDN S:(Y?1.N)!($A(Y)=34) S=S_Y
33 D ST(LOC,S) I S1="(" D INC2 S NOA=S D DN,INC
34 Q
35PEEK S Y=$G(LV(LV,LI+1)) Q
36INC2 S LI=LI+1 ;Drop into INC
37INC S LI=LI+1,S=$G(LV(LV,LI)),S1=$G(LV(LV,LI+1)),CH=$E(S) G:$A(S)=10 ERR Q
38DN S LI(LV)=LI,LI(LV,1)=AC,LV=LV+1,LI=LI(LV),AC=NOA
39 D ARGS,UP Q
40UP ;Inc LI as we save to skip the $C(10).
41 D PEEK D:$A(Y)'=10 ERR S LI(LV)=LI+1,LV=LV-1,LI=LI(LV),AC=LI(LV,1) Q
42PEEKDN S Y=$G(LV(LV+1,LI(LV+1)+1)) Q
43ERR D E^%INDX1(43) S (S,S1,CH)="" Q
44 S Z=$P(LV(LV+1),$C(9),LI(LV+1),99),Z=$P(Z,$C(10)) W !,"COUNT=",$L(Z,",")
45 ;functions
46FUN N FUN S FUN=S G EXT:S["$$",SPV:S1'["(" S NOA=$P(S,"^",2)
47 D INC2 I S'>0 D E^%INDX1(43) ;Sit on NOA
48 G:FUN["$TE" TEXT I FUN["$N" D ST("MK","$N")
49 S Y=1 F Z1=LI(LV+1)+1:1 S X=$G(LV(LV+1,Z1)) Q:$A(X)=10!(X="") S:X="," Y=Y+1
50 I NOA,Y<NOA!(Y>$P(NOA,";",2)) D E^%INDX1(43)
51 S NOA=S D DN,INC Q
52 ;
53TEXT S Y=$$ASM^%INDX3(LV+1,LI(LV+1)+1,$C(10)) D ST("MK","$T("_$S($E(Y)'="+":Y,1:""))
54 I $$VT(Y) D ST("I",Y)
55 I Y["^",$$VT($P(Y,"^",2)) N X1,X2 S X1=$P(Y,"^"),X2=$P(Y,"^",2) D ST("X",X2_$S($$VT(X1):" "_X1,1:""))
56 D FLUSH(1) Q
57 ;special variables
58SPV ;
59 Q
60EXT ;Extrinsic functions
61 I $E(S1)="^" S Y=$E(S1,2,99)_" "_S D INC S S=Y ;Build S and fall thru
62 D ST($S(S[" ":"X",1:"I"),S) ;Internal, eXternal
63 I S1["(" D INC2 S NOA=S D DN,INC ;Process param.
64 Q
65PAT D INC I $E(S)="@" D INC,ARG Q
66 F D REPCNT,PATCODE Q:$E(S)=""
67 Q
68REPCNT F I=1:1 Q:("0123456789."'[$E(S,I))!($E(S,I)="")
69 S X=$E(S,1,I-1),S=$E(S,I,999) I ('$L(X))!($L(X,".")>2) S S="" D E^%INDX1(16)
70 Q
71PATCODE I $E(S)=Q S I=1 D PATQ S S=$E(S,I,999) Q
72 F I=1:1 Q:("ACELNPU"'[$E(S,I))!($E(S,I)="")
73 S X=$E(S,1,I-1),S=$E(S,I,999) I I=1 S S="" D E^%INDX1(16)
74 Q
75PATQ F I=I+1:1 S CH=$E(S,I) Q:CH=""!(CH=Q)
76 S I=I+1 D:CH="" E^%INDX1(6) S CH=$E(S,I) G:CH=Q PATQ Q
77ST(LOC,S) S:'$D(V(LOC,S)) V(LOC,S)="" I $D(GK),GK]"",V(LOC,S)'[GK S V(LOC,S)=V(LOC,S)_GK
78 S GK="" Q
79VT(X) ;Check if a valid name
80 Q (X?1A.7AN)!(X?1"%".7AN)!(X?1.8N)
81FLUSH(FL) ;Flush rest of list with this offset
82 N I S FL=LV+FL,I=LI(FL)+1 F I=I:1 Q:$C(10)[$G(LV(FL,I))
83 S LI(FL)=I Q
Note: See TracBrowser for help on using the repository browser.