1 | BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
|
---|
2 | ;;2.31;BMX;;Jul 25, 2011
|
---|
3 | ;
|
---|
4 | ;Below is dead code, but keep for later
|
---|
5 | SETX2 ;Don't need this unless porting to machine with
|
---|
6 | ;local variable size limitations
|
---|
7 | N F,LVL,ROOT,START
|
---|
8 | S LVL=1,START=1
|
---|
9 | S ROOT="BMXY"
|
---|
10 | F F=1:1:BMXFF D Q:$D(BMXERR)
|
---|
11 | . S BMX=BMXFF(F)
|
---|
12 | . I BMX="(" D Q ;Increment level
|
---|
13 | . . S LVL=LVL+1
|
---|
14 | . . ;S ROOT=$S(ROOT["(":$P(ROOT,")")_","_0_")",1:ROOT_"("_0_")")
|
---|
15 | . . ;Get operator following close paren corresponding to this open
|
---|
16 | . . ;If op = OR then set up FOR loop in zeroeth node
|
---|
17 | . . ;if op = AND then set up
|
---|
18 | . I BMX=")" D Q ;Decrement level
|
---|
19 | . . S LVL=LVL-1
|
---|
20 | . . I LVL=1,$D(BMXFF(F+1)),BMXFF(F+1)="&" D Q
|
---|
21 | . . . S BMXX=BMXX+1
|
---|
22 | . . . S BMXX(BMXX)=""
|
---|
23 | . . . F J=START:1:F S BMXX(BMXX)=BMXX(BMXX)_BMXFF(J)
|
---|
24 | . . . S START=F+2
|
---|
25 | . . . ;S BMXX(BMXX)="I "_BMXX(BMXX)_" X BMXX("_BMXX+1_")"
|
---|
26 | . I BMX="AND" D Q ;Chain to previous expression at current level
|
---|
27 | . I BMX="OR" D Q ;Create FOR-loop to execute screens
|
---|
28 | ;
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | ;
|
---|
32 | ;S F=0 F S F=$O(BMXMFL(F)) Q:'+F S:'$D(BMXMFL(F,"SUBFILE")) BMXMFL("NOSUBFILE",F)=""
|
---|
33 | ;I $D(BMXMFL("NOSUBFILE")) S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D MAKEC1
|
---|
34 | ;I $D(BMXMFL("SUBFILE")) S F=0 F S F=$O(BMXMFL("SUBFILE",F)) Q:'+F D MAKEC1 ;S BMXROOTZ=BMXZ+100
|
---|
35 | ;
|
---|
36 | Q
|
---|
37 | MAKEC1 ;
|
---|
38 | I '$D(BMXMFL(F,"SUBFILE")),'$D(BMXMFL(F,"MULT")) S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" Q
|
---|
39 | Q:'$D(BMXMFL(F,"SUBFILE"))
|
---|
40 | Q:$D(BMXMFL(F,"MULT"))
|
---|
41 | S BMXROOT=F
|
---|
42 | S BMXROOTZ=BMXZ+100
|
---|
43 | S BMXROOTC=BMXCID
|
---|
44 | D MCNT(F)
|
---|
45 | Q
|
---|
46 | ;
|
---|
47 | MCNT(F) ;
|
---|
48 | N S
|
---|
49 | ;B ;MCNT
|
---|
50 | I '$D(BMXMFL(F,"SUBFILE")) D MCNT2 Q
|
---|
51 | S S=0 F S S=$O(BMXMFL(F,"SUBFILE",S)) Q:'+S S:'$D(BMXCFN(BMXCID,BMXZ,F)) BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,F)="" S BMXZ=BMXZ+100,BMXCFN(BMXCID,BMXZ,S)="",BMXCFNX(S,F)="" D MCNT(S)
|
---|
52 | Q
|
---|
53 | ;
|
---|
54 | MCNT2 ;
|
---|
55 | ;B ;Back-chain
|
---|
56 | ;TODO: RESTART HERE -- $O(BMXCFN(BMXCID,0)) NEEDS TO BE CHANGED TO SOMETHING BESIDES 0
|
---|
57 | N BMXFTOP,BMXFBACK
|
---|
58 | F S BMXFTOP=$O(BMXCFN(BMXROOTC,BMXROOTZ,0)) Q:BMXFTOP=BMXROOT S BMXFBACK=$O(BMXCFNX(BMXFTOP,0)) S BMXROOTZ=BMXROOTZ-1,BMXCFN(BMXCID,BMXROOTZ,BMXFBACK)=""
|
---|
59 | S BMXCID=BMXCID+1,BMXROOTC=BMXCID
|
---|
60 | ;Get the root files
|
---|
61 | I $D(BMXMFL("NOSUBFILE")) D
|
---|
62 | . N F
|
---|
63 | . S F=0 F S F=$O(BMXMFL("NOSUBFILE",F)) Q:'+F D
|
---|
64 | . . Q:$D(BMXMFL(F,"MULT"))
|
---|
65 | . . Q:F=BMXROOT
|
---|
66 | . . S BMXZ=BMXZ+100
|
---|
67 | . . S BMXCFN(BMXCID,BMXZ,F)=""
|
---|
68 | S BMXROOTZ=BMXZ+100
|
---|
69 | Q
|
---|
70 | ;
|
---|
71 | ;
|
---|
72 | ITER ;Iterate through result array A
|
---|
73 | S BMXCNT=BMXFLDO ;Field count
|
---|
74 | S F=0
|
---|
75 | S:BMXNUM ^BMXTEMP($J,I)=IEN0_"^"
|
---|
76 | S BMXCNTB=0
|
---|
77 | S BMXORD=BMXNUM
|
---|
78 | N BMXONOD
|
---|
79 | N BMXINT
|
---|
80 | ;B ;WRITE Before REORG
|
---|
81 | N M,N S N=0
|
---|
82 | D REORG
|
---|
83 | ;B ;WRITE After REORG
|
---|
84 | F S N=$O(M(N)) Q:'+N D
|
---|
85 | . S O=0
|
---|
86 | . F O=1:1:$L(M(N),U) S BMXFLDO(O-1,"IEN0")=$P(M(N),U,O)
|
---|
87 | . S BMXORD=BMXNUM
|
---|
88 | . D OA
|
---|
89 | Q
|
---|
90 | ;
|
---|
91 | REORG N R,IEN,J,CONT,TEST
|
---|
92 | F R=0:1:BMXFLDO-1 S IEN(R)=0
|
---|
93 | F J=1:1 D Q:'CONT
|
---|
94 | . S CONT=0
|
---|
95 | . F R=1:1:BMXFLDO D
|
---|
96 | . . S TEST=$O(A(+BMXFLDO(R-1),IEN(R-1)))
|
---|
97 | . . I +TEST S IEN(R-1)=TEST,CONT=1
|
---|
98 | . . S $P(M(J),U,R)=IEN(R-1)
|
---|
99 | . Q
|
---|
100 | I M(J)=M(J-1) K M(J)
|
---|
101 | Q
|
---|
102 | ;
|
---|
103 | ;
|
---|
104 | OA ;
|
---|
105 | I $D(A) F R=0:1:(BMXFLDO-1) S F=$P(BMXFLDO(R),U,2),BMXFN=$P(BMXFLDO(R),U),BMXINT=$P(BMXFLDO(R),U,3) D S:(R+1)<BMXFLDO ^BMXTEMP($J,I)=^BMXTEMP($J,I)_U
|
---|
106 | . ;S IEN0=BMXFLDO(R,"IEN0") F S IEN0=$O(A(BMXFN,IEN0)) Q:'+IEN0 Q:$D(A(BMXFN,IEN0,F,BMXINT))
|
---|
107 | . S IEN0=BMXFLDO(R,"IEN0")
|
---|
108 | . Q:'+IEN0
|
---|
109 | . S BMXORD=BMXORD+1
|
---|
110 | . I $D(^DD(BMXFN,F,0)),$P(^DD(BMXFN,F,0),U,2) D I 1 ;Multiple or WP
|
---|
111 | . . ;Get the subfile number into FL1
|
---|
112 | . . S FL1=+$P(^DD(BMXFN,F,0),U,2)
|
---|
113 | . . S FLD1=$O(^DD(FL1,0))
|
---|
114 | . . I $P(^DD(FL1,FLD1,0),U,2)["W" D ;WP
|
---|
115 | . . . S WPL=0,BMXLTMP=0
|
---|
116 | . . . F S WPL=$O(A(BMXFN,IEN0,F,WPL)) Q:'WPL S I=I+1 D
|
---|
117 | . . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,WPL)_" "
|
---|
118 | . . . . S BMXLTMP=BMXLTMP+$L(A(BMXFN,IEN0,F,WPL))+1
|
---|
119 | . . . . Q
|
---|
120 | . . . S:BMXLTMP>BMXLEN(BMXORD) BMXLEN(BMXORD)=BMXLTMP
|
---|
121 | . . . Q
|
---|
122 | . . D ;It's a multiple. Implement in next phase
|
---|
123 | . . . ;S BMXMCT=BMXMCT+1
|
---|
124 | . . . ;S BMXMCT(BMXMCT)=BMXFN_U_F
|
---|
125 | . . . Q ;Process A( for multiple field
|
---|
126 | . . Q
|
---|
127 | . E D ;Not a multiple
|
---|
128 | . . S I=I+1
|
---|
129 | . . I $G(BMXTK("DISTINCT"))="TRUE" D Q
|
---|
130 | . . . Q:A(BMXFN,IEN0,F,BMXINT)=""
|
---|
131 | . . . I $D(^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))) Q
|
---|
132 | . . . S ^BMXTMPD($J,A(BMXFN,IEN0,F,BMXINT))=""
|
---|
133 | . . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
|
---|
134 | . . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
|
---|
135 | . . . Q
|
---|
136 | . . S ^BMXTEMP($J,I)=A(BMXFN,IEN0,F,BMXINT)
|
---|
137 | . . S:$L(A(BMXFN,IEN0,F,BMXINT))>BMXLEN(BMXORD) BMXLEN(BMXORD)=$L(A(BMXFN,IEN0,F,BMXINT))
|
---|
138 | . Q
|
---|
139 | ;---> Set data in result global.
|
---|
140 | I $D(^BMXTEMP($J,I)) S ^BMXTEMP($J,I)=^BMXTEMP($J,I)_$C(30)
|
---|
141 | ZZZ Q
|
---|