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

OCXOCMPM.m

Go to the documentation of this file. 
  1. OCXOCMPM ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Rule Element MetaCode) ;10/29/98  12:37
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1. EN() ;
  1.  ;
  1.  Q:$G(OCXWARN) 1
  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 OCXD1,OCXREC,OCXDFC,OCXCNT,OCXFCODE,OCXDFL,OCXSCAN
  1.  .S (OCXFCODE,OCXDFL)=""
  1.  .;
  1.  .I '$G(OCXAUTO) W:($X>60) ! W "."
  1.  .;
  1.  .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.  .I '(OCXCON) D WARN^OCXOCMPV("Context not defined for Element...",3,OCXEL,$P($T(+1)," ",1)) Q
  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 (OCXTRACE) D FILECODE("W:$G(OCXTRACE) !,||LNTAG||,?27,""Metacode Function MCE"_OCXEL_"()  Execution trace. ""","Y")
  1.  .D FILECODE("N OCXRES","Y")
  1.  .D FILECODE("Q:'(|PATIENT IEN|) 0 I $D(^TMP(""OCXCHK"",$J,|PATIENT IEN|,"_(+OCXEL)_")) Q $G(^TMP(""OCXCHK"",$J,|PATIENT IEN|,"_(+OCXEL)_"))","Y")
  1.  .;
  1.  .I '(OCXCON=OCXDLK) D FILECODE("Q 0","Y")
  1.  .;
  1.  .I (OCXCON=OCXDLK) D
  1.  ..;
  1.  ..D FILECODE("S OCXRES("_(+OCXEL)_")=0","S")
  1.  ..;
  1.  ..; SORT PRIMARY DATA FIELDS
  1.  ..;
  1.  ..S OCXD1=0 F  S OCXD1=$O(OCXREC("COND",OCXD1)) Q:'OCXD1  D
  1.  ...N OCXDF,OCXSUB
  1.  ...F OCXSUB=1,2,3 D
  1.  ....N OCXFREC S OCXDF=+$G(OCXREC("COND",OCXD1,"DFLD"_OCXSUB)) Q:'OCXDF
  1.  ....M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF)
  1.  ....I '$D(OCXFREC(OCXCON)) S OCXFREC=OCXFREC-99999
  1.  ....I OCXDF,OCXFREC S OCXDFC(OCXFREC,OCXD1)=OCXDF,OCXDFL(OCXDF)=""
  1.  ..;
  1.  ..;
  1.  ..; GET PRIMARY DATA FIELD'S 'GET CODE'
  1.  ..;
  1.  ..S OCXCNT="" F  S OCXCNT=$O(OCXDFC(OCXCNT),-1) Q:'OCXCNT  D
  1.  ...S OCXD1=0 F  S OCXD1=$O(OCXDFC(OCXCNT,OCXD1)) Q:'OCXD1  D  Q:OCXWARN
  1.  ....N OCXDF,OCXD2,OCXFREC
  1.  ....S OCXDF=+$G(OCXDFC(OCXCNT,OCXD1)) Q:'OCXDF
  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.  ....I $D(OCXFREC) D
  1.  .....N OCXCOD1,OCXCOD2,OCXCVAL,OCXFLDG,OCXFLDN,OCXFLDP,OCXFLDS,OCXDFLD
  1.  .....N OCXNAM,OCXOPER,OCXOPC,OCXD2,OCXD3,OCXP,OCXP1,OCXP2,OCXP3
  1.  .....;
  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.  .....;
  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.  ..D FILECODE("E  Q 0","Y")
  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 $D(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXDLK)) M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXDLK)
  1.  ...E  D
  1.  ....I '$G(OCXAUTO) D
  1.  .....W !
  1.  .....W !,"Database Lookup Method not defined for:"
  1.  .....W !,"       '"_$P($G(^OCXS(860.3,+OCXEL,0)),U,1)_"'"
  1.  .....W !,"           ( "_(+OCXDF)_" ) "_$P($G(^OCXS(860.4,+OCXDF,0)),U,1)
  1.  ....M OCXFREC=^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXCON)
  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.  ..;    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.  ..D FILECODE("S OCXRES("_(+OCXEL)_")=11","S")
  1.  ..D FILECODE("M ^TMP(""OCXCHK"",$J,|PATIENT IEN|,"_(+OCXEL)_")=OCXRES("_(+OCXEL)_")","M")
  1.  ..D FILECODE("Q +OCXRES("_(+OCXEL)_")","Y")
  1.  .;
  1.  .; RESOLVE EXTRINSIC FUNCTON RUNTIME PARAMETERS
  1.  .;
  1.  .F  D  Q:'OCXSCAN  Q:OCXWARN
  1.  ..S (OCXSCAN,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.  ..S OCXD2=0 F  S OCXD2=$O(OCXFCODE(OCXD2)) Q:'OCXD2  D
  1.  ...I (OCXFCODE(OCXD2)="||NOOP||") K OCXFCODE(OCXD2) Q
  1.  ...I '$D(OCXFCODE(OCXD2,"OPLIST")) D
  1.  ....I '(OCXFCODE(OCXD2)["OCXTRACE") S OCXFCODE(OCXD2,"OPLIST")=$E(OCXFCODE(OCXD2),1)
  1.  ....E  S OCXFCODE(OCXD2,"OPLIST")="Y"
  1.  ...S OCXD3=OCXD2 F  S OCXD3=$O(OCXFCODE(OCXD3)) Q:'OCXD3  D
  1.  ....Q:(OCXFCODE(OCXD2)["OCXBOOLV")
  1.  ....I (OCXFCODE(OCXD2)=OCXFCODE(OCXD3)) K OCXFCODE(OCXD3)
  1.  ..D REINDEX(.OCXFCODE,0)
  1.  .;
  1.  .; SAVE CODE IN ^TMP GLOBAL
  1.  .;
  1.  .D MC^OCXOCMPN(.OCXFCODE,OCXEL)
  1.  .;
  1.  .D REINDEX(.OCXFCODE,2)
  1.  .S OCXCOD0="MCE"_OCXEL
  1.  .S OCXD2=0 F  S OCXD2=$O(OCXFCODE(OCXD2)) Q:'OCXD2  D
  1.  ..K OCXFCODE(OCXD2,"OPLIST")
  1.  ..S OCXFCODE(OCXD2)=" "_OCXFCODE(OCXD2)
  1.  .S OCXFCODE(1)=OCXCOD0_"() ; Verify Event/Element: "_$P($G(^OCXS(860.3,+OCXEL,0)),U,1)
  1.  .S OCXFCODE(2)=" ;"
  1.  .S OCXFCODE($O(OCXFCODE(" "),-1)+1)=" ;"
  1.  .S OCXD2=0 F  S OCXD2=$O(OCXFCODE(OCXD2)) Q:'OCXD2  D
  1.  ..N TEMP
  1.  ..S TEMP=OCXFCODE(OCXD2)
  1.  ..K OCXFCODE(OCXD2)
  1.  ..S OCXFCODE(OCXD2,0)=TEMP
  1.  .M ^TMP("OCXCMP",$J,"INCLUDE",OCXCOD0)=OCXFCODE
  1.  ;
  1.  Q OCXWARN
  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.  ;
  1.  I IEN1,IEN2 Q -1
  1.  Q IEN1
  1.  ;
  1. REINDEX(ARRAY,NDX2) ;
  1.  ;
  1.  N TEMP,NDX1 M TEMP=ARRAY K ARRAY
  1.  S NDX1="" F  S NDX1=$O(TEMP(NDX1)) Q:'$L(NDX1)  D
  1.  .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.  ;