source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXSQL91.m@ 645

Last change on this file since 645 was 645, checked in by Sam Habiel, 14 years ago

Initial Import of BMX.net code

File size: 4.4 KB
Line 
1BMXSQL91 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4 ;Below is dead code, but keep for later
5SETX2 ;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
37MAKEC1 ;
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 ;
47MCNT(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 ;
54MCNT2 ;
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 ;
72ITER ;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 ;
91REORG 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 ;
104OA ;
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)
141ZZZ Q
Note: See TracBrowser for help on using the repository browser.