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

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1%INDX3 ;ISC/REL,GRK,RWF - PROCESS SET/READ/KILL/NEW/OPEN COMMANDS ;8/5/93 12:38 ;
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3PEEK S Y=$G(LV(LV,LI+1)) Q
4PEEK2 S Y=$G(LV(LV,LI+2)) Q
5INC2 S LI=LI+1 ;Drop into INC
6INC S LI=LI+1,S=$G(LV(LV,LI)),S1=$G(LV(LV,LI+1)),CH=$E(S) G ERR:$A(S)=10 Q
7DN S LI(LV)=LI,LI(LV,1)=AC,LV=LV+1,LI=LI(LV),AC=NOA
8 Q
9UP ;Inc LI as we save to skip the $C(10).
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
11PEEKDN S Y=$G(LV(LV+1,LI(LV+1)+1)) Q
12FIND F Y=LI:1:AC Q:L[$G(LV(LV,Y))
13ERR S ERR=43 D ^%INDX1 S (S,S1,CH)="" Q
14 Q
15 Q
16S S ERR=10 G:ARG="" ^%INDX1 S STR=ARG,ARG="",RHS=0 D ^%INDX9
17S2 S GK="" D INC I S="" S ERR=10 D:'RHS ^%INDX1 Q
18 I CH="," S RHS=0 G S2
19 I CH="=" S RHS=1 S ERR=10 D:","[S1 ^%INDX1 G S2
20 I CH="$",'RHS,S'["$P" S ERR=10 D ^%INDX1
21 I CH="^" D FL G S2
22 I CH="@" S Y=$$ASM(LV,LI,",") S:Y'["=" RHS=1 D INC,ARG^%INDX2 G S2
23 I CH="(" D MULT G S2
24 D FL G S2
25MULT D INC S NOA=S I S'>0 S ERR=5 G ^%INDX1
26 D DN S AC=AC+LI F Q:AC'>LI S GK="*" D INC,ARG^%INDX2
27 D UP Q
28FL ;
29 S:'RHS GK="*" D ARG^%INDX2 Q
30VLN S ERR=0 I X'?1.8UN,X'?1.8LN,X'?1"%".7UN,X'?1"%".7LN S ERR=11 D ^%INDX1
31 Q
32VGN S ERR=0 I X'?1.8UN,X'?1"%".7UN S ERR=12 D ^%INDX1
33 Q
34KL ;Process KILL
35 S STR=ARG,ARG(1)=ARG,ARG="" D ^%INDX9
36A D INC Q:S="" G A:CH="," S LOC="L" D @$S(CH="@":"KL1",CH="^":"KL2",CH="(":"KL4",1:"KL3") G A
37KL1 D INC,ARG^%INDX2 Q
38KL2 S GK="!"
39 I S1'="(" S ERR=24 D ^%INDX1
40 G ARG^%INDX2
41KL3 I "^DT^DTIME^DUZ^IOST^IOM^IOS^"[("^"_S_"^") S ERR=39,ERR(1)=S D ^%INDX1
42 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
43KL5 S GK="!" D ARG^%INDX2 Q ;KILL SUBS
44 Q
45KL4 S NOA=S1 D DN,ARGS^%INDX2,UP,INC2 Q
46NE ;NEW
47 S ERR=$S("("[$E(ARG):26,1:0) I ERR G ^%INDX1 ;look for null or (
48 S STR=ARG D ^%INDX9
49N2 D INC Q:S="" G N2:CH="," S GK="~" D ARG^%INDX2 G N2
50 ;
51RD S STR=ARG D ^%INDX9 S ARG=""
52RD1 D INC Q:S=""
53 ;I (CH="!")!(CH=",")!(CH=Q)!(CH="#") G RD1
54 I CH="^" S ERR=11 D ^%INDX1
55 I '((CH="%")!(CH?1A)!(CH="*")) D RD3 G RD1
56 S Y=$$ASM(LV,LI,",") I Y'[":" S ERR=33,RDTIME=1 D ^%INDX1
57 D RD2 G RD1
58RD2 Q:","[CH
59 I "*#"[CH S ERR=41 D ^%INDX1
60 I "#:"[CH D INC,ARG^%INDX2,INC G RD2
61 I (CH="%")!(CH?1A) S LOC="L",GK="*" D ARG^%INDX2,INC G RD2
62 D INC G RD2
63RD3 Q:","[CH I "!#?"[CH D INC G RD3
64 I (CH="%")!(CH?1A)!(CH="@") D ARG^%INDX2,INC G RD3
65 Q
66O S STR=ARG,AC=99 D ^%INDX9,INC S ARG="" I S["@" D ARGS^%INDX2 Q
67 D ARG^%INDX2,INC D D INC,ARGS^%INDX2 Q
68 . F D INC Q:":"[S
69 . Q
70 Q
71ERRCP S ERR=5 D ^%INDX1 Q
72ST ;
73 S:'$D(V(LOC,S)) V(LOC,S)="" S:V(LOC,S)'[GK V(LOC,S)=V(LOC,S)_GK,GK="" Q
74 Q
75ASM(WL,SI,L,SEP) ;
76 N %,CH,Y S SEP=$G(SEP),Y="" F %=SI:1 S CH=$G(LV(WL,%)) Q:L[CH S Y=Y_SEP_CH
77 Q Y
Note: See TracBrowser for help on using the repository browser.