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

OCXOCMPI ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build LIST Function Code) ;10/29/98  12:37
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 ;
 Q
 ;
GETCODE(OCXD0,OCXLIST) ;
 ;
 Q:$G(OCXWARN) 1
 ;
 N OCXNDX
 ;
 S OCXNDX=0 F  S OCXNDX=$O(OCXLIST(OCXNDX)) Q:'OCXNDX  D  Q:OCXWARN
 .I OCXLIST(OCXNDX) D  Q:OCXWARN
 ..N OCXPAR,OCXELE,OCXPC,OCXCODE,OCXVAR
 ..S OCXPAR=$P(OCXLIST(OCXNDX)," ",3,999),OCXELE=+OCXLIST(OCXNDX)
 ..;
 ..F OCXPC=2:2:$L(OCXPAR,"|") D  Q:OCXWARN
 ...N OCXDF S OCXDF=+$$DATAFLD($P($P(OCXPAR,"|",OCXPC),"|",1),OCXELE)
 ...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
 ...S $P(OCXPAR,"|",OCXPC)=OCXDF
 ..;
 ..S OCXVAR="OCXLX"_(+OCXNDX)
 ..S OCXLIST(OCXNDX,"CODE",1)="I $$MCE"_(+OCXELE)_" D @@@@"
 .;
 .I 'OCXLIST(OCXNDX) D
 ..;
 ..N OCXEXP,OCXDTYP,OCXCD
 ..S OCXEXP=OCXLIST(OCXNDX),OCXDTYP=""
 ..;
 ..F OCXPC=2:2:$L(OCXEXP,"|") D  Q:OCXWARN
 ...N OCXELE,OCXDF,OCXDFN,OCXSTR,OCXENDX,OCXNVAL,OCXCON
 ...S OCXSTR=$P($P(OCXEXP,"|",OCXPC),"|",1),OCXELE=$P(OCXSTR,".",1)
 ...S OCXDF=$P(OCXSTR,".",2),OCXENDX=+$G(OCXLIST("B",OCXELE))
 ...S:$L(OCXELE) OCXELE=+$G(OCXLIST(OCXENDX))
 ...S OCXCON=+$P($G(^OCXS(860.3,+OCXELE,0)),U,2)
 ...I 'OCXELE D WARN^OCXOCMPV("Label '"_$P(OCXSTR,".",1)_"' not defined.",2,OCXD0,$P($T(+1)," ",1)) Q
 ...S OCXDFN=+$$DATAFLD(OCXDF,OCXELE)
 ...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
 ...S OCXNVAL="$G(^TMP(""""OCXCHK"""",$J,DFN,"_(+OCXELE)_","_(+OCXDFN)_"))"
 ...S $P(OCXEXP,"|",OCXPC)=OCXNVAL
 ...I $L(OCXDTYP),'(OCXDTYP=$$GETDTYP(+OCXDFN,+OCXCON)) D  Q
 ....D WARN^OCXOCMPV("Invalid Expression, Cannot compare '"_OCXDTYP_"' data with '"_$$GETDTYP(+OCXDFN,+OCXCON)_"' data. ",2,OCXD0,$P($T(+1)," ",1)) Q
 ...I '$L(OCXDTYP) S OCXDTYP=$$GETDTYP(+OCXDFN,OCXCON)
 ..I '$L(OCXDTYP) D WARN^OCXOCMPV("Data Type for '"_OCXLIST(OCXNDX,"LABEL")_"' not defined. ",2,OCXD0,$P($T(+1)," ",1)) Q
 ..;
 ..; GET EXPRESSION CONDITIONAL EVALUATION CODE
 ..;
 ..S OCXCD="",OCXWARN=$$GETC^OCXOCMPL(OCXD0,OCXEXP,OCXDTYP,.OCXCD)
 ..S OCXLIST(OCXNDX,"CODE",1)=OCXCD
 .;
 .S OCXWARN='$D(OCXLIST(OCXNDX,"CODE"))
 ;
 Q OCXWARN
 ;
DATAFLD(OCXFNAM,OCXEL) ;
 ;
 N OCXDFN,OCXCON,OCXLINK
 S OCXCON=+$P($G(^OCXS(860.3,+OCXEL,0)),U,2),OCXDFN=$O(^OCXS(860.4,"B",OCXFNAM,0))
 Q:'$L($G(OCXFNAM)) 0 Q:'OCXCON 0
 S OCXLINK=0 F  S OCXLINK=$O(^OCXS(860.4,OCXDFN,"LINK",OCXLINK)) Q:'OCXLINK  Q:(OCXLINK=OCXCON)
 Q:OCXLINK +OCXDFN Q 0
 ;
GETDTYP(OCXDF,OCXCON) ;
 ;
 N OCXLINK,OCXATT
 S OCXDF=+$G(OCXDF),OCXCON=+$G(OCXCON)
 Q:'OCXDF "" Q:'OCXCON ""
 S OCXLINK=$G(^OCXS(860.4,+OCXDF,"LINK",OCXCON,"DATAPATH"))
 Q:'$L(OCXLINK) ""
 S OCXLINK=$O(^OCXS(863.3,"B",OCXLINK,0)) Q:'OCXLINK ""
 S OCXATT=$P($G(^OCXS(863.3,OCXLINK,0)),U,5) Q:'OCXATT ""
 Q $$GETPARM(34,OCXATT,"DATA TYPE")
 ;
GETPARM(FILE,INST,PARM) ;
 Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
 N OCXP,OCXP1,OCXI,OCXGL
 S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
 Q:'$D(@OCXGL@(+FILE,0)) ""
 I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
 E  S OCXP=$O(^OCXS(863.8,"B",PARM,0))
 Q:'OCXP ""
 I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
 E  S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
 Q:'OCXI "" S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) Q:'OCXP1 ""
 Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
 ;
LAST(ROOT,ELEM,INDEX,PARAM,CD) Q $$LAST^OCXOCMPJ(ROOT,ELEM,INDEX,PARAM,.CD)
FIRST(ROOT,ELEM,INDEX,PARAM,CD) Q $$FIRST^OCXOCMPJ(ROOT,ELEM,INDEX,PARAM,.CD)
RANGE(ROOT,ELEM,INDEX,PARAM,CD) Q $$RANGE^OCXOCMPK(ROOT,ELEM,INDEX,PARAM,.CD)
ANY(ROOT,ELEM,INDEX,PARAM,CD) Q $$ANY^OCXOCMPK(ROOT,ELEM,INDEX,PARAM,.CD)
 ;