source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPI.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1OCXOCMPI ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build LIST Function Code) ;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 ;
7GETCODE(OCXD0,OCXLIST) ;
8 ;
9 Q:$G(OCXWARN) 1
10 ;
11 N OCXNDX
12 ;
13 S OCXNDX=0 F S OCXNDX=$O(OCXLIST(OCXNDX)) Q:'OCXNDX D Q:OCXWARN
14 .I OCXLIST(OCXNDX) D Q:OCXWARN
15 ..N OCXPAR,OCXELE,OCXPC,OCXCODE,OCXVAR
16 ..S OCXPAR=$P(OCXLIST(OCXNDX)," ",3,999),OCXELE=+OCXLIST(OCXNDX)
17 ..;
18 ..F OCXPC=2:2:$L(OCXPAR,"|") D Q:OCXWARN
19 ...N OCXDF S OCXDF=+$$DATAFLD($P($P(OCXPAR,"|",OCXPC),"|",1),OCXELE)
20 ...I 'OCXDF D WARN^OCXOCMPV("1 Data Field '"_$P($P(OCXPAR,"|",OCXPC),"|",1)_"' not defined for '("_OCXCON_") "_$P($G(^OCXS(860.6,OCXCON,0)),U,1)_"' data context.",2,OCXD0,$P($T(+1)," ",1)) Q
21 ...S $P(OCXPAR,"|",OCXPC)=OCXDF
22 ..;
23 ..S OCXVAR="OCXLX"_(+OCXNDX)
24 ..S OCXLIST(OCXNDX,"CODE",1)="I $$MCE"_(+OCXELE)_" D @@@@"
25 .;
26 .I 'OCXLIST(OCXNDX) D
27 ..;
28 ..N OCXEXP,OCXDTYP,OCXCD
29 ..S OCXEXP=OCXLIST(OCXNDX),OCXDTYP=""
30 ..;
31 ..F OCXPC=2:2:$L(OCXEXP,"|") D Q:OCXWARN
32 ...N OCXELE,OCXDF,OCXDFN,OCXSTR,OCXENDX,OCXNVAL,OCXCON
33 ...S OCXSTR=$P($P(OCXEXP,"|",OCXPC),"|",1),OCXELE=$P(OCXSTR,".",1)
34 ...S OCXDF=$P(OCXSTR,".",2),OCXENDX=+$G(OCXLIST("B",OCXELE))
35 ...S:$L(OCXELE) OCXELE=+$G(OCXLIST(OCXENDX))
36 ...S OCXCON=+$P($G(^OCXS(860.3,+OCXELE,0)),U,2)
37 ...I 'OCXELE D WARN^OCXOCMPV("Label '"_$P(OCXSTR,".",1)_"' not defined.",2,OCXD0,$P($T(+1)," ",1)) Q
38 ...S OCXDFN=+$$DATAFLD(OCXDF,OCXELE)
39 ...I 'OCXDFN D WARN^OCXOCMPV("2 Data Field '"_OCXSTR_"' not defined for '"_$P($G(^OCXS(860.6,+OCXCON,0)),U,1)_"' data context.",2,OCXD0,$P($T(+1)," ",1)) Q
40 ...S OCXNVAL="$G(^TMP(""""OCXCHK"""",$J,DFN,"_(+OCXELE)_","_(+OCXDFN)_"))"
41 ...S $P(OCXEXP,"|",OCXPC)=OCXNVAL
42 ...I $L(OCXDTYP),'(OCXDTYP=$$GETDTYP(+OCXDFN,+OCXCON)) D Q
43 ....D WARN^OCXOCMPV("Invalid Expression, Cannot compare '"_OCXDTYP_"' data with '"_$$GETDTYP(+OCXDFN,+OCXCON)_"' data. ",2,OCXD0,$P($T(+1)," ",1)) Q
44 ...I '$L(OCXDTYP) S OCXDTYP=$$GETDTYP(+OCXDFN,OCXCON)
45 ..I '$L(OCXDTYP) D WARN^OCXOCMPV("Data Type for '"_OCXLIST(OCXNDX,"LABEL")_"' not defined. ",2,OCXD0,$P($T(+1)," ",1)) Q
46 ..;
47 ..; GET EXPRESSION CONDITIONAL EVALUATION CODE
48 ..;
49 ..S OCXCD="",OCXWARN=$$GETC^OCXOCMPL(OCXD0,OCXEXP,OCXDTYP,.OCXCD)
50 ..S OCXLIST(OCXNDX,"CODE",1)=OCXCD
51 .;
52 .S OCXWARN='$D(OCXLIST(OCXNDX,"CODE"))
53 ;
54 Q OCXWARN
55 ;
56DATAFLD(OCXFNAM,OCXEL) ;
57 ;
58 N OCXDFN,OCXCON,OCXLINK
59 S OCXCON=+$P($G(^OCXS(860.3,+OCXEL,0)),U,2),OCXDFN=$O(^OCXS(860.4,"B",OCXFNAM,0))
60 Q:'$L($G(OCXFNAM)) 0 Q:'OCXCON 0
61 S OCXLINK=0 F S OCXLINK=$O(^OCXS(860.4,OCXDFN,"LINK",OCXLINK)) Q:'OCXLINK Q:(OCXLINK=OCXCON)
62 Q:OCXLINK +OCXDFN Q 0
63 ;
64GETDTYP(OCXDF,OCXCON) ;
65 ;
66 N OCXLINK,OCXATT
67 S OCXDF=+$G(OCXDF),OCXCON=+$G(OCXCON)
68 Q:'OCXDF "" Q:'OCXCON ""
69 S OCXLINK=$G(^OCXS(860.4,+OCXDF,"LINK",OCXCON,"DATAPATH"))
70 Q:'$L(OCXLINK) ""
71 S OCXLINK=$O(^OCXS(863.3,"B",OCXLINK,0)) Q:'OCXLINK ""
72 S OCXATT=$P($G(^OCXS(863.3,OCXLINK,0)),U,5) Q:'OCXATT ""
73 Q $$GETPARM(34,OCXATT,"DATA TYPE")
74 ;
75GETPARM(FILE,INST,PARM) ;
76 Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
77 N OCXP,OCXP1,OCXI,OCXGL
78 S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
79 Q:'$D(@OCXGL@(+FILE,0)) ""
80 I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
81 E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
82 Q:'OCXP ""
83 I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
84 E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
85 Q:'OCXI "" S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) Q:'OCXP1 ""
86 Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
87 ;
88LAST(ROOT,ELEM,INDEX,PARAM,CD) Q $$LAST^OCXOCMPJ(ROOT,ELEM,INDEX,PARAM,.CD)
89FIRST(ROOT,ELEM,INDEX,PARAM,CD) Q $$FIRST^OCXOCMPJ(ROOT,ELEM,INDEX,PARAM,.CD)
90RANGE(ROOT,ELEM,INDEX,PARAM,CD) Q $$RANGE^OCXOCMPK(ROOT,ELEM,INDEX,PARAM,.CD)
91ANY(ROOT,ELEM,INDEX,PARAM,CD) Q $$ANY^OCXOCMPK(ROOT,ELEM,INDEX,PARAM,.CD)
92 ;
Note: See TracBrowser for help on using the repository browser.