| [613] | 1 | %INDX4 ;ISC/REL,GRK - PROCESS DO, GO TO, WRITE & FOR COMMANDS ;8/17/92 16:32 ;
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | DG1 I ARG="" S:'IND("DO1") IND("DO")=IND("DO")+1,IND("DO1")=1 Q
|
|---|
| 4 | DG S (LBL,PGM,OFF,PRM)="",S=1,L="+^:," S:$E(ARG,1,2)="@^" S=3
|
|---|
| 5 | D LOOP S LBL=$E(ARG,1,I-1)
|
|---|
| 6 | I CH="+" S (J,S)=I+1,ERR=30 D ^%INDX1:$E(ARG)'="@" S:$E(ARG,I)="^" S=I+1 D LOOP S OFF=$E(ARG,J,I-1) I OFF'?.N S GRB=GRB_$C(9)_OFF
|
|---|
| 7 | I CH="^" S S=I+1 D LOOP S PGM=$E(ARG,S,I-1)
|
|---|
| 8 | I CH=":" S S=I+1,L="," D LOOP S S=$E(ARG,S,I-1) I S'="" S GRB=GRB_$C(9)_S
|
|---|
| 9 | S ARG=$E(ARG,I+1,999)
|
|---|
| 10 | I $E(LBL)="@" S GRB=GRB_$C(9)_$E(LBL,2,999),LBL="@("
|
|---|
| 11 | I $E(PGM)="@" S GRB=GRB_$C(9)_$E(PGM,2,999),PGM="@("
|
|---|
| 12 | I LBL[")" S PRM=$$INSIDE(LBL,"(",")"),LBL=$P(LBL,"(")
|
|---|
| 13 | I PGM[")" S PRM=$$INSIDE(PGM,"(",")"),PGM=$P(PGM,"(")
|
|---|
| 14 | I PRM]"" S GRB=GRB_$C(9)_PRM D PC
|
|---|
| 15 | S:OFF'="" LBL=LBL_"+"_OFF
|
|---|
| 16 | S S="",LOC="I" I PGM'="" S S=S_PGM_" ",LOC="X"
|
|---|
| 17 | S:LBL'="" S=S_LBL I S'="" D ST
|
|---|
| 18 | G:ARG'="" DG K LBL,PGM,OFF,PRM Q
|
|---|
| 19 | LOOP F I=S:1 S CH=$E(ARG,I) D QUOTE:CH=Q,PAREN:CH="(",ERRCP:CH=")" Q:L[CH
|
|---|
| 20 | Q
|
|---|
| 21 | PAREN S PC=1
|
|---|
| 22 | F I=I+1:1 S CH=$E(ARG,I) Q:PC=0!(CH="") I "()"""[CH D QUOTE:CH=Q S PC=PC+$S("("[CH:1,")"[CH:-1,1:0)
|
|---|
| 23 | S ERR=5 D:PC ^%INDX1 Q
|
|---|
| 24 | QUOTE F I=I+1:1 S CH=$E(ARG,I) Q:CH=""!(CH=Q)
|
|---|
| 25 | I CH="" S ERR=6 G ^%INDX1
|
|---|
| 26 | Q
|
|---|
| 27 | ST S R=$F(S,"(") S:R>1 S=$E(S,1,R-1) S:"IX"[LOC IND("COM")=IND("COM")_","_S
|
|---|
| 28 | S:'$D(V(LOC,S)) V(LOC,S)="" S:LOC="L"&(V(LOC,S)'["*") V(LOC,S)=V(LOC,S)_"*" Q
|
|---|
| 29 | Q
|
|---|
| 30 | FR Q:$E(ARG,1)="@" S S=2,L="=" D LOOP I CH="" S ERR=8 G ^%INDX1
|
|---|
| 31 | S GK="*",STR=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999) D ARGG^%INDX2
|
|---|
| 32 | Q
|
|---|
| 33 | WR S STR=ARG D ^%INDX9 S ARG=""
|
|---|
| 34 | F D INC^%INDX2 Q:S="" D
|
|---|
| 35 | . I S="?" S ERR=49 D:","[S1 ^%INDX1 Q
|
|---|
| 36 | . D ARG^%INDX2
|
|---|
| 37 | . Q
|
|---|
| 38 | Q
|
|---|
| 39 | ERRCP S ERR=5 D ^%INDX1 Q
|
|---|
| 40 | SET S ARG=$E(ARG,1,I-1)_","_$E(ARG,I+1,999) Q
|
|---|
| 41 | XE S GRB=GRB_$C(9)_ARG,ARG="" Q
|
|---|
| 42 | REP S L=",:",S=1 D LOOP I CH=":" S ARG=$E(ARG,I+1,999),L="," D LOOP
|
|---|
| 43 | S ARG=$E(ARG,I+1,999) Q:ARG="" G REP
|
|---|
| 44 | ZC I "ILRS"'[$E(CM,2)!($E(CM,2)="") S ARG="" Q ;Zcommands
|
|---|
| 45 | S COM=$E(CM,1,2) Q:CM="ZI" G:CM="ZR" ZR
|
|---|
| 46 | U1 S L=",",S=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999)
|
|---|
| 47 | S:$E(S,1)="@" S=$E(S,2,999),GRB=GRB_$C(9)_S Q:ARG="" G U1
|
|---|
| 48 | ZR Q:ARG="" S L=":,",S=1 D LOOP S S=$E(ARG,1,I-1),ARG=$E(ARG,I+1,999)
|
|---|
| 49 | I $E(S,1)="@" S GRB=GRB_$C(9)_S G ZR
|
|---|
| 50 | S:S["+" GRB=GRB_$C(9)_$P(S,"+",2,999) G ZR
|
|---|
| 51 | LO S GRB=GRB_$C(9)_ARG,ARG="" Q
|
|---|
| 52 | Q ;QUIT
|
|---|
| 53 | D SEP(LIN," ",.S)
|
|---|
| 54 | I IND("PP") S ERR=$S(ARG?1A&(S>1):9,$E(ARG)=";":49,1:0) D:ERR ^%INDX1 Q
|
|---|
| 55 | S ERR=$S(ARG?1A&(S>1):9,$E(ARG)=";":9,$L(ARG)>1&(S<2):0,S=0:0,1:9) S:ERR LIN=ARG_" "_LIN,ARG="" S:$E(ARG)=";" ARG="" G:ERR ^%INDX1
|
|---|
| 56 | Q
|
|---|
| 57 | PT(X) ;Tag for parameter passing
|
|---|
| 58 | S ^UTILITY($J,1,RTN,"P",LAB)=X Q
|
|---|
| 59 | PC ;Parameter passing call
|
|---|
| 60 | N LOC S LOC="P" D ST Q
|
|---|
| 61 | INSIDE(X,X1,X2) ;Return the data inside the param x1,x2
|
|---|
| 62 | S J=$L(X,X2)-1,J=$S(J<1:1,1:J)
|
|---|
| 63 | Q $P($P(X,X2,1,J),X1,2,99)
|
|---|
| 64 | SEP(ST,SP,RV) ;String,Separters,Return array)
|
|---|
| 65 | ;N M,N
|
|---|
| 66 | F N=1:1 S %=$E(ST,N) D SQT:%=Q Q:SP[%
|
|---|
| 67 | S RV=N-1,RV(1)=$E(ST,1,N) Q
|
|---|
| 68 | SQT F N=N+1:1 Q:Q[$E(ST,N)
|
|---|
| 69 | Q
|
|---|
