- %INDX3 ;ISC/REL,GRK,RWF - PROCESS SET/READ/KILL/NEW/OPEN COMMANDS ;8/5/93 12:38 ;
- ;;7.3;TOOLKIT;;Apr 25, 1995
- PEEK S Y=$G(LV(LV,LI+1)) Q
- PEEK2 S Y=$G(LV(LV,LI+2)) Q
- INC2 S LI=LI+1 ;Drop into INC
- INC S LI=LI+1,S=$G(LV(LV,LI)),S1=$G(LV(LV,LI+1)),CH=$E(S) G ERR:$A(S)=10 Q
- DN S LI(LV)=LI,LI(LV,1)=AC,LV=LV+1,LI=LI(LV),AC=NOA
- Q
- UP ;Inc LI as we save to skip the $C(10).
- D PEEK S:$A(Y)=10 LI=LI+1 S LI(LV)=LI,LV=LV-1,LI=LI(LV),AC=LI(LV,1) Q
- PEEKDN S Y=$G(LV(LV+1,LI(LV+1)+1)) Q
- FIND F Y=LI:1:AC Q:L[$G(LV(LV,Y))
- ERR S ERR=43 D ^%INDX1 S (S,S1,CH)="" Q
- Q
- Q
- S S ERR=10 G:ARG="" ^%INDX1 S STR=ARG,ARG="",RHS=0 D ^%INDX9
- S2 S GK="" D INC I S="" S ERR=10 D:'RHS ^%INDX1 Q
- I CH="," S RHS=0 G S2
- I CH="=" S RHS=1 S ERR=10 D:","[S1 ^%INDX1 G S2
- I CH="$",'RHS,S'["$P" S ERR=10 D ^%INDX1
- I CH="^" D FL G S2
- I CH="@" S Y=$$ASM(LV,LI,",") S:Y'["=" RHS=1 D INC,ARG^%INDX2 G S2
- I CH="(" D MULT G S2
- D FL G S2
- MULT D INC S NOA=S I S'>0 S ERR=5 G ^%INDX1
- D DN S AC=AC+LI F Q:AC'>LI S GK="*" D INC,ARG^%INDX2
- D UP Q
- FL ;
- S:'RHS GK="*" D ARG^%INDX2 Q
- VLN S ERR=0 I X'?1.8UN,X'?1.8LN,X'?1"%".7UN,X'?1"%".7LN S ERR=11 D ^%INDX1
- Q
- VGN S ERR=0 I X'?1.8UN,X'?1"%".7UN S ERR=12 D ^%INDX1
- Q
- KL ;Process KILL
- S STR=ARG,ARG(1)=ARG,ARG="" D ^%INDX9
- A D INC Q:S="" G A:CH="," S LOC="L" D @$S(CH="@":"KL1",CH="^":"KL2",CH="(":"KL4",1:"KL3") G A
- KL1 D INC,ARG^%INDX2 Q
- KL2 S GK="!"
- I S1'="(" S ERR=24 D ^%INDX1
- G ARG^%INDX2
- KL3 I "^DT^DTIME^DUZ^IOST^IOM^IOS^"[("^"_S_"^") S ERR=39,ERR(1)=S D ^%INDX1
- I "IO"=S D:S1="(" PEEKDN S ERR=39,ERR(1)=S_$S(S1["(":S1_Y_")",1:"") D:S1'="(" ^%INDX1 I S1="(",("QC"'[$E(Y,2)) D ^%INDX1
- KL5 S GK="!" D ARG^%INDX2 Q ;KILL SUBS
- Q
- KL4 S NOA=S1 D DN,ARGS^%INDX2,UP,INC2 Q
- NE ;NEW
- S ERR=$S("("[$E(ARG):26,1:0) I ERR G ^%INDX1 ;look for null or (
- S STR=ARG D ^%INDX9
- N2 D INC Q:S="" G N2:CH="," S GK="~" D ARG^%INDX2 G N2
- ;
- RD S STR=ARG D ^%INDX9 S ARG=""
- RD1 D INC Q:S=""
- ;I (CH="!")!(CH=",")!(CH=Q)!(CH="#") G RD1
- I CH="^" S ERR=11 D ^%INDX1
- I '((CH="%")!(CH?1A)!(CH="*")) D RD3 G RD1
- S Y=$$ASM(LV,LI,",") I Y'[":" S ERR=33,RDTIME=1 D ^%INDX1
- D RD2 G RD1
- RD2 Q:","[CH
- I "*#"[CH S ERR=41 D ^%INDX1
- I "#:"[CH D INC,ARG^%INDX2,INC G RD2
- I (CH="%")!(CH?1A) S LOC="L",GK="*" D ARG^%INDX2,INC G RD2
- D INC G RD2
- RD3 Q:","[CH I "!#?"[CH D INC G RD3
- I (CH="%")!(CH?1A)!(CH="@") D ARG^%INDX2,INC G RD3
- Q
- O S STR=ARG,AC=99 D ^%INDX9,INC S ARG="" I S["@" D ARGS^%INDX2 Q
- D ARG^%INDX2,INC D D INC,ARGS^%INDX2 Q
- . F D INC Q:":"[S
- . Q
- Q
- ERRCP S ERR=5 D ^%INDX1 Q
- ST ;
- S:'$D(V(LOC,S)) V(LOC,S)="" S:V(LOC,S)'[GK V(LOC,S)=V(LOC,S)_GK,GK="" Q
- Q
- ASM(WL,SI,L,SEP) ;
- N %,CH,Y S SEP=$G(SEP),Y="" F %=SI:1 S CH=$G(LV(WL,%)) Q:L[CH S Y=Y_SEP_CH
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZINDX3 2750 printed Apr 23, 2025@18:57:04 Page 2
- %INDX3 ;ISC/REL,GRK,RWF - PROCESS SET/READ/KILL/NEW/OPEN COMMANDS ;8/5/93 12:38 ;
- +1 ;;7.3;TOOLKIT;;Apr 25, 1995
- PEEK SET Y=$GET(LV(LV,LI+1))
- QUIT
- PEEK2 SET Y=$GET(LV(LV,LI+2))
- QUIT
- INC2 ;Drop into INC
- SET LI=LI+1
- INC SET LI=LI+1
- SET S=$GET(LV(LV,LI))
- SET S1=$GET(LV(LV,LI+1))
- SET CH=$EXTRACT(S)
- if $ASCII(S)=10
- GOTO ERR
- QUIT
- DN SET LI(LV)=LI
- SET LI(LV,1)=AC
- SET LV=LV+1
- SET LI=LI(LV)
- SET AC=NOA
- +1 QUIT
- UP ;Inc LI as we save to skip the $C(10).
- +1 DO PEEK
- if $ASCII(Y)=10
- SET LI=LI+1
- SET LI(LV)=LI
- SET LV=LV-1
- SET LI=LI(LV)
- SET AC=LI(LV,1)
- QUIT
- PEEKDN SET Y=$GET(LV(LV+1,LI(LV+1)+1))
- QUIT
- FIND FOR Y=LI:1:AC
- if L[$GET(LV(LV,Y))
- QUIT
- ERR SET ERR=43
- DO ^%INDX1
- SET (S,S1,CH)=""
- QUIT
- +1 QUIT
- +2 QUIT
- S SET ERR=10
- if ARG=""
- GOTO ^%INDX1
- SET STR=ARG
- SET ARG=""
- SET RHS=0
- DO ^%INDX9
- S2 SET GK=""
- DO INC
- IF S=""
- SET ERR=10
- if 'RHS
- DO ^%INDX1
- QUIT
- +1 IF CH=","
- SET RHS=0
- GOTO S2
- +2 IF CH="="
- SET RHS=1
- SET ERR=10
- if ","[S1
- DO ^%INDX1
- GOTO S2
- +3 IF CH="$"
- IF 'RHS
- IF S'["$P"
- SET ERR=10
- DO ^%INDX1
- +4 IF CH="^"
- DO FL
- GOTO S2
- +5 IF CH="@"
- SET Y=$$ASM(LV,LI,",")
- if Y'["="
- SET RHS=1
- DO INC
- DO ARG^%INDX2
- GOTO S2
- +6 IF CH="("
- DO MULT
- GOTO S2
- +7 DO FL
- GOTO S2
- MULT DO INC
- SET NOA=S
- IF S'>0
- SET ERR=5
- GOTO ^%INDX1
- +1 DO DN
- SET AC=AC+LI
- FOR
- if AC'>LI
- QUIT
- SET GK="*"
- DO INC
- DO ARG^%INDX2
- +2 DO UP
- QUIT
- FL ;
- +1 if 'RHS
- SET GK="*"
- DO ARG^%INDX2
- QUIT
- VLN SET ERR=0
- IF X'?1.8UN
- IF X'?1.8LN
- IF X'?1"%".7UN
- IF X'?1"%".7LN
- SET ERR=11
- DO ^%INDX1
- +1 QUIT
- VGN SET ERR=0
- IF X'?1.8UN
- IF X'?1"%".7UN
- SET ERR=12
- DO ^%INDX1
- +1 QUIT
- KL ;Process KILL
- +1 SET STR=ARG
- SET ARG(1)=ARG
- SET ARG=""
- DO ^%INDX9
- A DO INC
- if S=""
- QUIT
- if CH=","
- GOTO A
- SET LOC="L"
- DO @$SELECT(CH="@":"KL1",CH="^":"KL2",CH="(":"KL4",1:"KL3")
- GOTO A
- KL1 DO INC
- DO ARG^%INDX2
- QUIT
- KL2 SET GK="!"
- +1 IF S1'="("
- SET ERR=24
- DO ^%INDX1
- +2 GOTO ARG^%INDX2
- KL3 IF "^DT^DTIME^DUZ^IOST^IOM^IOS^"[("^"_S_"^")
- SET ERR=39
- SET ERR(1)=S
- DO ^%INDX1
- +1 IF "IO"=S
- if S1="("
- DO PEEKDN
- SET ERR=39
- SET ERR(1)=S_$SELECT(S1["(":S1_Y_")",1:"")
- if S1'="("
- DO ^%INDX1
- IF S1="("
- IF ("QC"'[$EXTRACT(Y,2))
- DO ^%INDX1
- KL5 ;KILL SUBS
- SET GK="!"
- DO ARG^%INDX2
- QUIT
- +1 QUIT
- KL4 SET NOA=S1
- DO DN
- DO ARGS^%INDX2
- DO UP
- DO INC2
- QUIT
- NE ;NEW
- +1 ;look for null or (
- SET ERR=$SELECT("("[$EXTRACT(ARG):26,1:0)
- IF ERR
- GOTO ^%INDX1
- +2 SET STR=ARG
- DO ^%INDX9
- N2 DO INC
- if S=""
- QUIT
- if CH=","
- GOTO N2
- SET GK="~"
- DO ARG^%INDX2
- GOTO N2
- +1 ;
- RD SET STR=ARG
- DO ^%INDX9
- SET ARG=""
- RD1 DO INC
- if S=""
- QUIT
- +1 ;I (CH="!")!(CH=",")!(CH=Q)!(CH="#") G RD1
- +2 IF CH="^"
- SET ERR=11
- DO ^%INDX1
- +3 IF '((CH="%")!(CH?1A)!(CH="*"))
- DO RD3
- GOTO RD1
- +4 SET Y=$$ASM(LV,LI,",")
- IF Y'[":"
- SET ERR=33
- SET RDTIME=1
- DO ^%INDX1
- +5 DO RD2
- GOTO RD1
- RD2 if ","[CH
- QUIT
- +1 IF "*#"[CH
- SET ERR=41
- DO ^%INDX1
- +2 IF "#:"[CH
- DO INC
- DO ARG^%INDX2
- DO INC
- GOTO RD2
- +3 IF (CH="%")!(CH?1A)
- SET LOC="L"
- SET GK="*"
- DO ARG^%INDX2
- DO INC
- GOTO RD2
- +4 DO INC
- GOTO RD2
- RD3 if ","[CH
- QUIT
- IF "!#?"[CH
- DO INC
- GOTO RD3
- +1 IF (CH="%")!(CH?1A)!(CH="@")
- DO ARG^%INDX2
- DO INC
- GOTO RD3
- +2 QUIT
- O SET STR=ARG
- SET AC=99
- DO ^%INDX9
- DO INC
- SET ARG=""
- IF S["@"
- DO ARGS^%INDX2
- QUIT
- +1 DO ARG^%INDX2
- DO INC
- Begin DoDot:1
- +2 FOR
- DO INC
- if "
- QUIT
- +3 QUIT
- End DoDot:1
- DO INC
- DO ARGS^%INDX2
- QUIT
- +4 QUIT
- ERRCP SET ERR=5
- DO ^%INDX1
- QUIT
- ST ;
- +1 if '$DATA(V(LOC,S))
- SET V(LOC,S)=""
- if V(LOC,S)'[GK
- SET V(LOC,S)=V(LOC,S)_GK
- SET GK=""
- QUIT
- +2 QUIT
- ASM(WL,SI,L,SEP) ;
- +1 NEW %,CH,Y
- SET SEP=$GET(SEP)
- SET Y=""
- FOR %=SI:1
- SET CH=$GET(LV(WL,%))
- if L[CH
- QUIT
- SET Y=Y_SEP_CH
- +2 QUIT Y
