source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPF.m@ 1504

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1OCXOCMPF ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Parse a Rule Relation Expression continued...) ;10/29/98 12:37
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 Q
6 ;
7SYNTXER(EXP,PTR,FLD1,FLD2) ;
8 N OCXWTXT,OCXDASH
9 S OCXDASH="",$P(OCXDASH,"_",250)="_"
10 S OCXWTXT(1)=" "_EXP
11 S OCXWTXT(2)="_"_$E(OCXDASH,1,$L($P(EXP," ",1,PTR-1)))_"/"
12 S OCXWTXT(3)=" "
13 I 'FLD1,FLD2 S OCXWTXT(4)=" Syntax Error: A Boolean expression cannot start with a '"_$$TKTXT(FLD2)_"'."
14 I 'FLD1,'FLD2 S OCXWTXT(4)=" Unknown Symbol: '"_$P(EXP," ",PTR)_"'."
15 I FLD1,FLD2 S OCXWTXT(4)=" Syntax Error: A '"_$$TKTXT(FLD2)_"' cannot follow a '"_$$TKTXT(FLD1)_"'."
16 I '$D(OCXWTXT(4)) S OCXWTXT(4)="Unknown error with: '"_$P(EXP," ",PTR)_"'."
17 D WARN^OCXOCMPV(.OCXWTXT,2,OCXD0,$P($T(+1)," ",1)) Q
18 Q
19 ;
20OPCODE(TXT) ;
21 ;
22 N OPNUM,SUB,OPFUNC,OPCNT,OCXX,OCXPFN
23 S OPNUM=0 F S OPNUM=$O(^OCXS(863.9,"B",TXT,OPNUM)) Q:'OPNUM Q:($P($G(^OCXS(863.9,OPNUM,0)),U,2)=OCXBOOL)
24 I 'OPNUM F S OPNUM=$O(^OCXS(863.9,"SYN",TXT,OPNUM)) Q:'OPNUM Q:($P($G(^OCXS(863.9,OPNUM,0)),U,2)=OCXBOOL)
25 Q:'OPNUM ""
26 S OPFUNC=$$GETPARM(39,OPNUM,"OCXO GENERATE CODE FUNCTION")
27 I OPFUNC S OCXPFN=+OPFUNC
28 E S OCXPFN=0 F S OCXPFN=$O(^OCXS(863.7,"B",$E(OPFUNC,1,30),OCXPFN)) Q:'OCXPFN Q:($P($G(^OCXS(863.7,+OCXPFN,0)),U,1)=OPFUNC)
29 S OCXX=0 F OPCNT=0:1 S OCXX=$O(^OCXS(863.7,+OCXPFN,"PAR",OCXX)) Q:'OCXX
30 ;
31 Q:(OPCNT=1) 0
32 ;
33 Q OPCNT_U_OPFUNC
34 ;
35GETPARM(FILE,INST,PARM) ;
36 Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
37 N OCXP,OCXP1,OCXI,OCXGL
38 S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
39 Q:'$D(@OCXGL@(+FILE,0)) ""
40 I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
41 E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
42 Q:'OCXP ""
43 I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
44 E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
45 Q:'OCXI ""
46 S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) S:'OCXP1 OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",PARM,0))
47 Q:'OCXP1 ""
48 Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
49 ;
50PARCNT(EXP) ;
51 N CNT,PTR
52 ;
53 S CNT=$L(EXP,"(")-$L(EXP,")") I CNT D Q ""
54 .N MSG
55 .S MSG(1)=" "_EXP,MSG(2)=" "
56 .S MSG(3)=" "_$S((CNT<0):(-CNT),1:CNT)_" Unmatched "_$S((CNT>0):"LEFT '('",1:"RIGHT ')'")_" parenthesis in expression"
57 .S MSG(4)=" PARCNT^OCXOCMPF "
58 .D WARN^OCXOCMPV(.MSG,2,OCXD0,$P($T(+1)," ",1)) Q
59 ;
60 F Q:'(EXP["(") S EXP=$P(EXP,"(",1)_" @ "_$P(EXP,"(",2,999)
61 S EXP=$TR(EXP,"@","(")
62 F Q:'(EXP[")") S EXP=$P(EXP,")",1)_" @ "_$P(EXP,")",2,999)
63 S EXP=$TR(EXP,"@",")")
64 ;
65 F Q:'(EXP[" ") S EXP=$P(EXP," ",1)_" "_$P(EXP," ",2,999)
66 ;
67 F PTR=1:1:$L(EXP) Q:'($E(EXP,PTR)=" ")
68 S EXP=$E(EXP,PTR,$L(EXP))
69 ;
70 F PTR=$L(EXP):-1:1 Q:'($E(EXP,PTR)=" ")
71 S EXP=$E(EXP,1,PTR)
72 ;
73 Q EXP
74 ;
75TKTXT(T) Q $S(T=1:"Data Field 1",T=2:"Data Field 2",T=3:"AND Operator",T=4:"OR Operator",T=5:"Left Parenthesis",T=6:"Right Parenthesis",1:"Token not found")
76 ;
77EXPAND(OPFUNC,OCXP) ;
78 ;
79 N OCXCOD1,OCXCODE,OCXD1
80 S OCXCODE="",OCXP=$G(^OCXS(863.7,+OPFUNC,"EX")),OCXCOD1="S OCXCODE=$$"_OCXP
81 S OCXD1=0 F S OCXD1=$O(^OCXS(863.7,+OPFUNC,"PAR",OCXD1)) Q:'OCXD1 D
82 .N OCXPOS,OCXVNAM
83 .S OCXPOS=+$G(^OCXS(863.7,+OPFUNC,"PAR",OCXD1,"IN")) Q:'OCXPOS Q:$D(OCXP(OCXPOS))
84 .S OCXVNAM=+$G(^OCXS(863.7,+OPFUNC,"PAR",OCXD1,0)) Q:'OCXVNAM
85 .S OCXVNAM=$P($G(^OCXS(863.8,+OCXVNAM,0)),U,2) Q:'$L(OCXVNAM)
86 .S OCXP(+OCXPOS)=OCXVNAM
87 I $O(OCXP(0)) D
88 .S OCXCOD1=OCXCOD1_"(",OCXD1=0 F S OCXD1=$O(OCXP(OCXD1)) Q:'OCXD1 D
89 ..I ($E(OCXP(OCXP(OCXD1)),1)="""") S OCXCOD1=OCXCOD1_""""""_OCXP(OCXP(OCXD1))_""""""
90 ..E S OCXCOD1=OCXCOD1_""""_OCXP(OCXP(OCXD1))_""""
91 ..I $O(OCXP(OCXD1)) S OCXCOD1=OCXCOD1_","
92 ..E S OCXCOD1=OCXCOD1_")"
93 .X OCXCOD1
94 ;
95 Q OCXCODE
96 ;
Note: See TracBrowser for help on using the repository browser.