Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OCXOCMP2

OCXOCMP2.m

Go to the documentation of this file.
  1. OCXOCMP2 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Rule Element Evaluation Code) ;3/20/01 16:12
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
  1. ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1. ;
  1. EN() ;
  1. ;
  1. Q:$G(OCXWARN) OCXWARN
  1. S OCXDLK=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0))
  1. S OCXEL=0 F S OCXEL=$O(^TMP("OCXCMP",$J,"ELEMENT",OCXEL)) Q:'OCXEL D Q:OCXWARN
  1. .N OCXD0,OCXD1,OCXREC,OCXDFC,OCXCF,OCXCNT1,OCXCNT2,OCXFCODE,OCXDFL,OCXSCAN,OCXSORT
  1. .S (OCXFCODE,OCXDFL)=""
  1. .K OCXREC M OCXREC=^OCXS(860.3,OCXEL) Q:'$D(OCXREC(0))
  1. .S OCXNAM=$P(OCXREC(0),U,1) Q:'$L(OCXNAM)
  1. .S OCXCON=$P(OCXREC(0),U,2) I '(OCXCON) D WARN^OCXOCMPV("Context not defined for Element...",3,OCXEL,$P($T(+1)," ",1)) Q
  1. .Q:(OCXCON=OCXDLK)
  1. .S OCXCONN=$P($G(^OCXS(860.6,+OCXCON,0)),U,1) I '$L(OCXCONN) D WARN^OCXOCMPV("Data context a '"_OCXCON_"' not defined in Data Context file...",4,OCXDF,$P($T(+1)," ",1)) Q
  1. .S OCXCONA=$P($G(^OCXS(860.6,+OCXCON,0)),U,2) I '$L(OCXCONA) D WARN^OCXOCMPV("Data context abbreviation for '"_OCXCONN_"' not defined in Data Context file...",4,OCXDF,$P($T(+1)," ",1)) Q
  1. .;
  1. .I (OCXCONN="TIMED ORDER CHECK") D I 1
  1. ..D FILECODE("I ($G(OCXOSRC)="""_OCXCONN_"""),($D(OCXOSRC(""ELEMENT"","_OCXEL_")))","Y")
  1. .E D FILECODE("I ($G(OCXOSRC)="""_OCXCONN_""")","Y")
  1. .;
  1. .I '$G(OCXAUTO) W:($X>60) ! W "."
  1. .K OCXSORT
  1. .S OCXD1=0 F S OCXD1=$O(OCXREC("COND",OCXD1)) Q:'OCXD1 D Q:OCXWARN
  1. ..N OCXSUB
  1. ..F OCXSUB=1,2,3 D Q:OCXWARN
  1. ...N OCXDF,OCXFREC,OCXCNT
  1. ...S OCXDF=+$G(OCXREC("COND",OCXD1,"DFLD"_OCXSUB)) Q:'OCXDF
  1. ...K OCXFREC M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)
  1. ...S OCXCNT=+$G(OCXFREC)
  1. ...I '$D(OCXFREC(OCXCON)) S OCXCNT=OCXCNT+99999 I '$D(OCXFREC(OCXDLK)) D Q
  1. ....D WARN^OCXOCMPV("Cannot resolve Navigation code for Data Field "_OCXCONN_" context...",4,OCXDF,$P($T(+1)," ",1)) Q
  1. ...S OCXSORT(OCXD1)=$G(OCXSORT(OCXD1))+OCXCNT
  1. ...S OCXSORT(OCXD1,OCXCNT,OCXDF)=""
  1. .;
  1. .S OCXD1=0 F S OCXD1=$O(OCXSORT(OCXD1)) Q:'OCXD1 S OCXSORT("A",OCXSORT(OCXD1),OCXD1)=""
  1. .;
  1. .Q:OCXWARN
  1. .;
  1. .; GET PRIMARY DATA FIELD'S 'GET CODE'
  1. .;
  1. .S OCXCNT1=0 F S OCXCNT1=$O(OCXSORT("A",OCXCNT1)) Q:'OCXCNT1 D
  1. ..S OCXD1=0 F S OCXD1=$O(OCXSORT("A",OCXCNT1,OCXD1)) Q:'OCXD1 D Q:OCXWARN
  1. ...N OCXDF,OCXD2,OCXFREC K OCXFREC
  1. ...S OCXCNT2=0 F S OCXCNT2=$O(OCXSORT(OCXD1,OCXCNT2)) Q:'OCXCNT2 D Q:OCXWARN
  1. ....S OCXDF=0 F S OCXDF=$O(OCXSORT(OCXD1,OCXCNT2,OCXDF)) Q:'OCXDF D Q:OCXWARN
  1. .....I $D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXCON)) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXCON)
  1. .....E S OCXD2=0 F S OCXD2=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXD2)) Q:'OCXD2 I $G(^(OCXD2,"DA MODE")) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXD2) Q
  1. .....S OCXD2=0 F S OCXD2=$O(OCXFREC(OCXD2)) Q:'OCXD2 D FILECODE($G(OCXFREC(OCXD2)))
  1. ...;
  1. ...; GET EXPRESSION CONDITIONAL EVALUATION CODE
  1. ...;
  1. ...Q:'$D(OCXFREC)
  1. ...N OCXCOD1,OCXCOD2,OCXCVAL,OCXFLDG,OCXFLDN,OCXFLDP,OCXFLDS,OCXDFLD
  1. ...N OCXNAM,OCXOPER,OCXOPC,OCXD2,OCXD3,OCXP,OCXP1,OCXP2,OCXP3
  1. ...S OCXOPER=$G(OCXREC("COND",OCXD1,"OPER"))
  1. ...I '(OCXOPER) D WARN^OCXOCMPV("Operator/Function not defined...",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ...S OCXOPN=$P($G(^OCXS(863.9,OCXOPER,0)),U,1),OCXOPDT=$P($G(^OCXS(863.9,OCXOPER,0)),U,2)
  1. ...I '(OCXOPDT) D WARN^OCXOCMPV("Data Type not defined for '"_OCXOPN_"' Operator",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ...I '$L($G(^OCXS(864.1,+OCXOPDT,0))) D WARN^OCXOCMPV("Data Type '"_OCXOPDT_"' not defined for '"_OCXOPN_"' Operator",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ...S OCXOPC=$$GETPARM^OCXOCMPE(39,OCXOPER,"OCXO GENERATE CODE FUNCTION")
  1. ...I '$L(OCXOPC) D WARN^OCXOCMPV("'"_OCXOPN_"' Operator 'OCXO GENERATE CODE FUNCTION' parameter not defined",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ...S:'(OCXOPC=+OCXOPC) OCXOPC=$$GETIEN("^OCXS(863.7)",OCXOPC)
  1. ...I '$D(^OCXS(863.7,+OCXOPC,0)) D WARN^OCXOCMPV("'"_OCXOPN_"' Operator 'OCXO GENERATE CODE FUNCTION' Public Function not defined",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ...S OCXP=$G(^OCXS(863.7,+OCXOPC,"EX")) I '$L(OCXP) D WARN^OCXOCMPV("Operator ("_(+OCXOPC)_") '"_$P($G(^OCXS(863.9,+OCXOPC,0)),U,1)_"' executable not defined",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ...S OCXD2=0 F S OCXD2=$O(^OCXS(863.7,+OCXOPC,"PAR",OCXD2)) Q:'OCXD2 D
  1. ....N OCXPOS,OCXVNAM
  1. ....S OCXPOS=+$G(^OCXS(863.7,+OCXOPC,"PAR",OCXD2,"IN")) Q:'OCXPOS Q:$D(OCXP(OCXPOS))
  1. ....S OCXVNAM=+$G(^OCXS(863.7,+OCXOPC,"PAR",OCXD2,0)) Q:'OCXVNAM
  1. ....S OCXVNAM=$P($G(^OCXS(863.8,+OCXVNAM,0)),U,2) Q:'$L(OCXVNAM)
  1. ....S OCXP(+OCXPOS)=OCXVNAM,OCXP(OCXVNAM)=""
  1. ....;
  1. ...D GETC^OCXOCMPE(OCXEL,OCXD1,.OCXP)
  1. .;
  1. .; GATHER OUTPUT DATA FOR THIS ELEMENT-EVENT
  1. .;
  1. .S OCXDF=0 F S OCXDF=$O(^TMP("OCXCMP",$J,"ELEMENT",OCXEL,"DATA",OCXDF)) Q:'OCXDF D
  1. ..N OCXCON,OCXFREC S OCXCON=$P($G(^OCXS(860.3,OCXEL,0)),U,2)
  1. ..I 'OCXCON D WARN^OCXOCMPV("CMP2 Data context not defined for '"_$P($G(^OCXS(860.3,+OCXEL,0)),U,1)_"' ( "_(+OCXDF)_" )",2,OCXEL,$P($T(+1)," ",1)) Q
  1. ..I $D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXCON)) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXCON)
  1. ..E M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXDLK)
  1. ..I '$L($G(OCXFREC("G"))) D WARN^OCXOCMPV("CMP2 Get data code not defined for '"_$P($G(^OCXS(860.4,+OCXDF,0)),U,1)_"' ( "_(+OCXDF)_" )",2,OCXEL,$P($T(+1)," ",1)) Q
  1. ..S OCXDFL(OCXDF)=+$G(^TMP("OCXCMP",$J,"ELEMENT",OCXEL,"DATA",OCXDF))
  1. ..S OCXD2=0 F S OCXD2=$O(OCXFREC(OCXD2)) Q:'OCXD2 I $L($G(OCXFREC(OCXD2))) D
  1. ...D FILECODE(OCXFREC(OCXD2),$G(OCXFREC(OCXD2,"OPLIST")))
  1. ..;
  1. .;
  1. .; FILE ELEMENT-EVENT IN ACTIVE PATIENT DATA FILE
  1. .;
  1. .S OCXDFL="",OCXDF=0 F S OCXDF=$O(OCXDFL(OCXDF)) Q:'OCXDF S:$L(OCXDFL) OCXDFL=OCXDFL_"," S OCXDFL=OCXDFL_OCXDF_$S(OCXDFL(OCXDF):"X",1:"")
  1. .;
  1. .I OCXTLOG D
  1. ..N OCXX,OPCODE
  1. ..S OCXX="S OCXOERR=$$TIMELOG(""O"",""FILE"")"
  1. ..S OCXX=OCXX_",OCXOERR=$$FILE(DFN,"_OCXEL_","""_OCXDFL_""")"
  1. ..S OCXX=OCXX_",OCXOERR=$$TIMELOG(""I"",""FILE"")"
  1. ..D FILECODE(OCXX,"SHS")
  1. .I 'OCXTLOG D FILECODE("S OCXOERR=$$FILE(DFN,"_OCXEL_","""_OCXDFL_""") Q:OCXOERR ","SQ")
  1. .;
  1. .; RESOLVE EXTRINSIC FUNCTON RUNTIME PARAMETERS
  1. .;
  1. .S OCXSCAN=0 F D Q:'OCXSCAN Q:OCXWARN
  1. ..S OCXSCAN=0 S OCXD2=0 F S OCXD2=$O(OCXFCODE(OCXD2)) Q:'OCXD2 I $L(OCXFCODE(OCXD2)),(OCXFCODE(OCXD2)["|") D
  1. ...N OCXPIEC,DFNAM,DFNUM,DFCODE
  1. ...S DFCODE=OCXFCODE(OCXD2)
  1. ...F OCXPIEC=2:2:$L(DFCODE,"|") S DFNAM=$P($P(DFCODE,"|",OCXPIEC),"|",1) I $L(DFNAM),'(DFNAM["""") S DFNAM(DFNAM)=""
  1. ...S DFNAM="" F S DFNAM=$O(DFNAM(DFNAM)) Q:'$L(DFNAM) D
  1. ....N DFBNAM,DFNUM,OCXFREC,OCXD3
  1. ....S DFBNAM="|"_DFNAM_"|",OCXSCAN=1
  1. ....S DFNUM=+$O(^OCXS(860.4,"B",DFNAM,0))
  1. ....I 'DFNUM S DFNUM=+$O(^OCXS(860.4,"C",DFNAM,0))
  1. ....I 'DFNUM D WARN^OCXOCMPV("Data field argument '"_DFNAM_"' not defined in Data Field file...",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ....I $D(^TMP("OCXCMP",$J,"DATA FIELD",DFNUM,OCXCON)) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",DFNUM,OCXCON)
  1. ....E I $D(^TMP("OCXCMP",$J,"DATA FIELD",DFNUM,OCXDLK)) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",DFNUM,OCXDLK)
  1. ....E S OCXD3=0 F S OCXD3=$O(^TMP("OCXCMP",$J,"DATA FIELD",DFNUM,OCXD3)) Q:'OCXD3 I $G(^(OCXD3,"DA MODE")) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",DFNUM,OCXD3) Q
  1. ....I '$D(OCXFREC) D WARN^OCXOCMPV("Data field '"_DFNAM_"' get code not defined for '"_OCXCONN_" context...",3,OCXEL,$P($T(+1)," ",1)) Q
  1. ....S OCXFREC($O(OCXFREC(99999),-1)+1)="I $L(OCXDF("_(+DFNUM)_"))"
  1. ....S OCXD3=0 F S OCXD3=$O(OCXFREC(OCXD3)) Q:'OCXD3 D FILECODE($G(OCXFREC(OCXD3)),$G(OCXFREC(OCXD3,"OPLIST")),OCXD2)
  1. ....F Q:'(DFCODE[DFBNAM) S DFCODE=$P(DFCODE,DFBNAM,1)_"OCXDF("_(+DFNUM)_")"_$P(DFCODE,DFBNAM,2,999)
  1. ...S OCXFCODE(OCXD2)=DFCODE
  1. ..;
  1. ..; PURGE REDUNDANT CODE
  1. ..;
  1. ..D PURGE(.OCXFCODE)
  1. .;
  1. .I (OCXTLOG) S OCXD2=0 F S OCXD2=$O(OCXFCODE(OCXD2)) Q:'OCXD2 I (OCXFCODE(OCXD2)["$$"),'(OCXFCODE(OCXD2)["$$TIMELOG") D
  1. ..N OCXX,OPCODE
  1. ..S OPCODE=$E(OCXFCODE(OCXD2),1)
  1. ..S OCXX="S OCXOERR=$$TIMELOG(""O"","""_$P($P(OCXFCODE(OCXD2),"$$",2)_"(","(",1)_""")"
  1. ..S OCXX=OCXX_" "_OCXFCODE(OCXD2)
  1. ..S OCXX=OCXX_" S OCXOERR=$$TIMELOG(""I"","""_$P($P(OCXFCODE(OCXD2),"$$",2)_"(","(",1)_""")"
  1. ..S OCXFCODE(OCXD2)=OCXX
  1. ..S OCXFCODE(OCXD2,"OPLIST")="SH"_OPCODE_"S"
  1. .;
  1. .;
  1. .; PURGE AND REINDEX CODE
  1. .;
  1. .D PURGE(.OCXFCODE)
  1. .;
  1. .; SAVE CODE IN ^TMP GLOBAL
  1. .;
  1. .S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",99999),-1)+1
  1. .;
  1. .M ^TMP("OCXCMP",$J,"A CODE",OCXCOD0)=OCXFCODE
  1. .S ^TMP("OCXCMP",$J,"A CODE",OCXCOD0)=OCXEL
  1. .S ^TMP("OCXCMP",$J,"A CODE","B",OCXEL,OCXCOD0)=""
  1. ;
  1. Q OCXWARN
  1. ;
  1. PURGE(CODE) ;
  1. ;
  1. N D0,D1
  1. ;
  1. S D0=0 F S D0=$O(CODE(D0)) Q:'D0 D
  1. .I (CODE(D0)="||NOOP||") K CODE(D0) Q
  1. .S:'$D(CODE(D0,"OPLIST")) CODE(D0,"OPLIST")=$E(CODE(D0),1)
  1. .S D1=D0 F S D1=$O(CODE(D1)) Q:'D1 D
  1. ..Q:(CODE(D0)["OCXBOOLV")
  1. ..I (CODE(D0)=CODE(D1)) K CODE(D1)
  1. D REINDEX(.CODE)
  1. Q
  1. ;
  1. GETIEN(FILE,KEY) ;
  1. ;
  1. N IEN1,IEN2,LEN,SHORT
  1. F LEN=$L(KEY):-1:0 I LEN Q:$D(@FILE@("B",$E(KEY,1,LEN)))
  1. Q:'LEN 0 S SHORT=$E(KEY,1,LEN)
  1. S IEN1=0 F S IEN1=$O(@FILE@("B",SHORT,IEN1)) Q:'IEN1 Q:($P($G(@FILE@(IEN1,0)),U,1)=KEY)
  1. S IEN2=IEN1 F S IEN2=$O(@FILE@("B",SHORT,IEN2)) Q:'IEN2 Q:($P($G(@FILE@(IEN2,0)),U,1)=KEY)
  1. I IEN1,IEN2 Q -1
  1. Q IEN1
  1. ;
  1. REINDEX(ARRAY) ;
  1. ;
  1. N TEMP,NDX1,NDX2 M TEMP=ARRAY K ARRAY
  1. S (NDX1,NDX2)="" F S NDX1=$O(TEMP(NDX1)) Q:'$L(NDX1) I $L(TEMP(NDX1)) S NDX2=NDX2+1 M ARRAY(NDX2)=TEMP(NDX1)
  1. Q
  1. ;
  1. FILECODE(CODE,OPLIST,INDEX) ;
  1. ;
  1. N OCXNDX
  1. I $G(INDEX) D
  1. .N PREV,HALF
  1. .S PREV=$O(OCXFCODE(INDEX),-1),HALF=INDEX-PREV/2
  1. .S OCXNDX=INDEX-HALF
  1. E S OCXNDX=$O(OCXFCODE(""),-1)+1
  1. S OCXFCODE(OCXNDX)=CODE
  1. S:$L($G(OPLIST)) OCXFCODE(OCXNDX,"OPLIST")=OPLIST
  1. Q
  1. ;