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) ;