- AZHLSCU3 ; IHS/ADC/GTH:KEU - UNDEF CHECKER. PROCESS SET/READ/KILL/NEW COMMANDS ;
- ;;5.0;AZHLSC;;JUL 10, 1996
- 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 (S,S1,CH)="" Q
- Q
- S S STR=ARG,ARG="",RHS=0 D ^AZHLSCU9
- S2 S GK="" D INC
- Q:S=""
- I CH="," S RHS=0 G S2
- I CH="=" S RHS=1 G S2
- I CH="^" D FL G S2
- I CH="@" S L="," D ASM S:Y'["=" RHS=1 D INC,ARG^AZHLSCU2 G S2
- I CH="(" D MULT G S2
- D FL
- G S2
- MULT D INC S NOA=S
- D DN S AC=AC+LI F Q:AC'>LI S GK="*" D INC,ARG^AZHLSCU2
- D UP Q
- FL S:'RHS GK="*" D ARG^AZHLSCU2
- Q
- KL ;Process KILL
- S STR=ARG,ARG(1)=ARG,ARG="" D ^AZHLSCU9
- 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^AZHLSCU2 Q
- KL2 S GK="!"
- G ARG^AZHLSCU2
- KL3 I "^DT^DTIME^DUZ^IOST^IOM^IOS^"[("^"_S_"^") S ERR(1)=S
- I "IO"=S D:S1="(" PEEKDN S ERR(1)=S_$S(S1["(":S1_Y_")",1:"")
- KL5 S GK="!" D ARG^AZHLSCU2 Q ;KILL SUBS
- Q
- KL4 S NOA=S1 D DN,ARGS^AZHLSCU2,UP,INC2 Q
- NE ;NEW
- S STR=ARG D ^AZHLSCU9
- N2 D INC Q:S="" G N2:CH="," S GK="~" D ARG^AZHLSCU2 G N2
- ;
- RD S STR=ARG D ^AZHLSCU9 S ARG=""
- RD1 D INC Q:S=""
- ;I (CH="!")!(CH=",")!(CH=Q)!(CH="#") G RD1
- I '((CH="%")!(CH?1A)!(CH="*")) D RD3 G RD1
- S L="," D ASM
- D RD2 G RD1
- RD2 Q:","[CH
- I "#:"[CH D INC,ARG^AZHLSCU2,INC G RD2
- I (CH="%")!(CH?1A) S LOC="L",GK="*" D ARG^AZHLSCU2,INC G RD2
- D INC G RD2
- RD3 Q:","[CH I "!#?"[CH D INC G RD3
- I (CH="%")!(CH?1A)!(CH="@") D ARG^AZHLSCU2,INC G RD3
- 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 N CH S Y="" F %=LI:1 S CH=$G(LV(LV,%)) Q:L[CH S Y=Y_" "_CH
- Q
- AZHLSCU3 ; IHS/ADC/GTH:KEU - UNDEF CHECKER. PROCESS SET/READ/KILL/NEW COMMANDS ;
- +1 ;;5.0;AZHLSC;;JUL 10, 1996
- 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 (S,S1,CH)=""
- QUIT
- +1 QUIT
- S SET STR=ARG
- SET ARG=""
- SET RHS=0
- DO ^AZHLSCU9
- S2 SET GK=""
- DO INC
- +1 IF S=""
- QUIT
- +2 IF CH=","
- SET RHS=0
- GOTO S2
- +3 IF CH="="
- SET RHS=1
- GOTO S2
- +4 IF CH="^"
- DO FL
- GOTO S2
- +5 IF CH="@"
- SET L=","
- DO ASM
- IF Y'["="
- SET RHS=1
- DO INC
- DO ARG^AZHLSCU2
- GOTO S2
- +6 IF CH="("
- DO MULT
- GOTO S2
- +7 DO FL
- +8 GOTO S2
- MULT DO INC
- SET NOA=S
- +1 DO DN
- SET AC=AC+LI
- FOR
- IF AC'>LI
- QUIT
- SET GK="*"
- DO INC
- DO ARG^AZHLSCU2
- +2 DO UP
- QUIT
- FL IF 'RHS
- SET GK="*"
- DO ARG^AZHLSCU2
- +1 QUIT
- KL ;Process KILL
- +1 SET STR=ARG
- SET ARG(1)=ARG
- SET ARG=""
- DO ^AZHLSCU9
- 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^AZHLSCU2
- QUIT
- KL2 SET GK="!"
- +1 GOTO ARG^AZHLSCU2
- KL3 IF "^DT^DTIME^DUZ^IOST^IOM^IOS^"[("^"_S_"^")
- SET ERR(1)=S
- +1 IF "IO"=S
- IF S1="("
- DO PEEKDN
- SET ERR(1)=S_$SELECT(S1["(":S1_Y_")",1:"")
- KL5 ;KILL SUBS
- SET GK="!"
- DO ARG^AZHLSCU2
- QUIT
- +1 QUIT
- KL4 SET NOA=S1
- DO DN
- DO ARGS^AZHLSCU2
- DO UP
- DO INC2
- QUIT
- NE ;NEW
- +1 SET STR=ARG
- DO ^AZHLSCU9
- N2 DO INC
- IF S=""
- QUIT
- IF CH=","
- GOTO N2
- SET GK="~"
- DO ARG^AZHLSCU2
- GOTO N2
- +1 ;
- RD SET STR=ARG
- DO ^AZHLSCU9
- SET ARG=""
- RD1 DO INC
- IF S=""
- QUIT
- +1 ;I (CH="!")!(CH=",")!(CH=Q)!(CH="#") G RD1
- +2 IF '((CH="%")!(CH?1A)!(CH="*"))
- DO RD3
- GOTO RD1
- +3 SET L=","
- DO ASM
- +4 DO RD2
- GOTO RD1
- RD2 IF ","[CH
- QUIT
- +1 IF "#:"[CH
- DO INC
- DO ARG^AZHLSCU2
- DO INC
- GOTO RD2
- +2 IF (CH="%")!(CH?1A)
- SET LOC="L"
- SET GK="*"
- DO ARG^AZHLSCU2
- DO INC
- GOTO RD2
- +3 DO INC
- GOTO RD2
- RD3 IF ","[CH
- QUIT
- IF "!#?"[CH
- DO INC
- GOTO RD3
- +1 IF (CH="%")!(CH?1A)!(CH="@")
- DO ARG^AZHLSCU2
- DO INC
- GOTO RD3
- +2 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 NEW CH
- SET Y=""
- FOR %=LI:1
- SET CH=$GET(LV(LV,%))
- IF L[CH
- QUIT
- SET Y=Y_" "_CH
- +1 QUIT
