source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPD.m@ 1607

OCXOCMPD ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;3/22/01  09:38
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 ;
EN() ;
 ;
 N OCXELE,OCXD0,OCXD1,OCXD2
 ;
 S OCXD0=0 F  S OCXD0=$O(^TMP("OCXCMP",$J,"RULE",OCXD0)) Q:'OCXD0  D  Q:OCXWARN
 .N OCXR M OCXR=^OCXS(860.2,OCXD0)
 .S OCXD1=0 F  S OCXD1=$O(^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1)) Q:'OCXD1  S OCXCODE=$G(^(OCXD1)) I $L(OCXCODE) D
 ..N OCXNMSG,OCXCMSG,OCXNTF,OCXNOD0,OCXL,OCXD2,OCXCNT,OCXVAR,OCXCODE,OCXMCOD
 ..S OCXLA="R"_OCXD0_"R"_OCXD1_"A",OCXLB="R"_OCXD0_"R"_OCXD1_"B"
 ..S OCXCODE=" D ||LINE:"_$$LINE^OCXOCMP4(OCXLA)_"||"
 ..;
 ..S OCXD2=0 F OCXCNT=0:1 S OCXD2=$O(^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1,OCXD2)) Q:'OCXD2  D
 ...I '$D(OCXELE(OCXD2)) D
 ....I $G(OCXTRACE) D IN^OCXOCMP4("EL"_OCXD2," W:$G(OCXTRACE) !,||LNTAG||,?27,""Element Check for: ("_OCXD2_") '"_$P(^OCXS(860.3,OCXD2,0),U,1)_"'""")
 ....I $G(OCXTRACE) D IN^OCXOCMP4("EL"_OCXD2," ;")
 ....S OCXELE(OCXD2)=""
 ...D IN^OCXOCMP4("EL"_OCXD2,OCXCODE_"   ; Check Relation #"_(+OCXD1)_" in Rule #"_(+OCXD0)_" '"_$P(OCXR(0),U,1)_"'")
 ..;
 ..D IN^OCXOCMP4(OCXLA," Q:$G(^OCXS(860.2,"_OCXD0_",""INACT""))")
 ..D IN^OCXOCMP4(OCXLA," ;")
 ..S OCXD2=0 F  S OCXD2=$O(^TMP("OCXCMP",$J,"RULE",OCXD0,OCXD1,"CODE",OCXD2)) Q:'OCXD2  S OCXCODE=$G(^(OCXD2)) D
 ...F  Q:'(OCXCODE["@@@@")  S OCXCODE=$P(OCXCODE,"@@@@",1)_"||LINE:"_$$LINE^OCXOCMP4(OCXLB)_"||"_$P(OCXCODE,"@@@@",2,999)
 ...D IN^OCXOCMP4(OCXLA," "_OCXCODE)
 ..;
 ..S OCXNOD0=$G(OCXR("R",OCXD1,0))
 ..S OCXNMSG=$G(OCXR("R",OCXD1,"MSG")) S:'$P(OCXNOD0,U,3) OCXNMSG=""
 ..S OCXCMSG=$G(OCXR("R",OCXD1,"OCMSG")) S:'$P(OCXNOD0,U,2) OCXCMSG=""
 ..S OCXMCOD=$G(OCXR("R",OCXD1,"MCODE"))
 ..;
 ..I $G(OCXTRACE) D IN^OCXOCMP4(OCXLB," I $G(OCXTRACE),$D(OCXRULE("""_OCXLB_""")) W !,||LNTAG||,?27,""Rule '"_$P($G(OCXR(0)),U,1)_"' already triggered !!""")
 ..D IN^OCXOCMP4(OCXLB," Q:$D(OCXRULE("""_OCXLB_"""))")
 ..D IN^OCXOCMP4(OCXLB," ;")
 ..;
 ..I '$G(OCXAUTO) W:($X>60) ! W "."
 ..;
 ..I '($L(OCXCMSG)+$L(OCXNMSG)),'$L($G(OCXR("R",OCXD1,"RULE"))),'$L(OCXMCOD) D  Q
 ...D IN^OCXOCMP4(OCXLB," ; Notification and order checking disabled for this")
 ...D IN^OCXOCMP4(OCXLB," ; rule due to no Order Check or Notification message,")
 ...D IN^OCXOCMP4(OCXLB," ; or execute code found in the Order Check Rule File (860.2)")
 ..;
 ..I $L($G(OCXR("R",OCXD1,"RULE"))) D
 ...N OCXSCH,OCXTIME
 ...S OCXSCH=$P(OCXR("R",OCXD1,"RULE"),U,1)
 ...S OCXTIME=$P(OCXR("R",OCXD1,"RULE"),U,2)
 ...;
 ...D IN^OCXOCMP4(OCXLB," ;")
 ...I ((OCXSCH="START")!(OCXSCH="CONTINUE")) D  Q
 ....I '$L(OCXTIME) D  Q
 .....D IN^OCXOCMP4(OCXLB," ; No code generated for '"_OCXSCH_"' rule schedule.")
 .....D IN^OCXOCMP4(OCXLB," ; Time period not defined.")
 .....D IN^OCXOCMP4(OCXLB," ;")
 ....I '$L($$TIME^OCXOCMPQ(OCXTIME,OCXD0,OCXD1)) D  Q
 .....D IN^OCXOCMP4(OCXLB," ; No code generated for '"_OCXSCH_"' rule schedule.")
 .....D IN^OCXOCMP4(OCXLB," ; Invalid time period definition. -> "_OCXTIME)
 .....D IN^OCXOCMP4(OCXLB," ;")
 ....S OCXTIME=$$TIME^OCXOCMPQ(OCXTIME,OCXD0,OCXD1)
 ....D IN^OCXOCMP4(OCXLB," ;  Add '"_$P($G(^OCXS(860.2,OCXD0,0)),U,1)_"' rule to")
 ....D IN^OCXOCMP4(OCXLB," ;  Time Based Order Check Schedule for patient defined by 'DFN'.")
 ....D IN^OCXOCMP4(OCXLB," ;")
 ....D IN^OCXOCMP4(OCXLB," N OCXSDATE")
 ....D IN^OCXOCMP4(OCXLB," S OCXSDATE=$$ADD2DATE("_OCXTIME_")")
 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,0)=DFN")
 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,0)=""^860.12D^""_OCXSDATE")
 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,OCXSDATE,1,0)=""^860.121P^"_OCXD0_"""")
 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_",0)="_OCXD0)
 ....D IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,""TIME"","_OCXD0_",DFN,OCXSDATE,"_OCXD0_")=""""")
 ...;
 ...I (OCXSCH="STOP") D
 ....D IN^OCXOCMP4(OCXLB," ;  Delete all entries for rule '"_$P($G(^OCXS(860.2,OCXD0,0)),U,1)_"' from")
 ....D IN^OCXOCMP4(OCXLB," ;  Time Based Order Check Schedule for patient defined by 'DFN'.")
 ....D IN^OCXOCMP4(OCXLB," ; ")
 ....D IN^OCXOCMP4(OCXLB," N OCXSDATE S OCXSDATE=0 F  S OCXSDATE=$O(^OCXD(860.1,DFN,2,OCXSDATE)) Q:'OCXSDATE  D")
 ....D IN^OCXOCMP4(OCXLB," .Q:'$D(^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_"))")
 ....D IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_")")
 ....D IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,DFN,2,OCXSDATE,1,""B"","_OCXD0_","_OCXD0_")")
 ....D IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,""TIME"","_OCXD0_",DFN,OCXSDATE,"_OCXD0_")")
 ..;
 ..I '($L(OCXCMSG)+$L(OCXNMSG)+$L(OCXMCOD)) Q
 ..;
 ..D IN^OCXOCMP4(OCXLB," N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD")
 ..;
 ..I $L(OCXCMSG) D  I 1
 ...S OCXCMSG=$TR(OCXCMSG,"""","""""")
 ...S OCXCMSG=$$XLATE^OCXOCMPQ(OCXCMSG,OCXD0,OCXD1)
 ...D IN^OCXOCMP4(OCXLB," I ($G(OCXOSRC)=""CPRS ORDER PRESCAN"") S OCXCMSG=(+OCXPSD)_""^"_(+$P(OCXNOD0,U,2))_"^^"_$S(($E(OCXCMSG,1)=""""):$E(OCXCMSG,2,$L(OCXCMSG)),1:"""_"_OCXCMSG)_" I 1")
 ...D IN^OCXOCMP4(OCXLB," E  S OCXCMSG="_OCXCMSG)
 ..E  D IN^OCXOCMP4(OCXLB," S OCXCMSG=""""")
 ..;
 ..S OCXNMSG=$$XLATE^OCXOCMPQ(OCXNMSG,OCXD0,OCXD1)
 ..S OCXMCOD=$$XLATE^OCXOCMPQ(OCXMCOD,OCXD0,OCXD1,1)
 ..D IN^OCXOCMP4(OCXLB," S OCXNMSG="_OCXNMSG)
 ..;
 ..S OCXWARN=$$EN^OCXOCMPG(OCXLB,OCXCNT)
 ..;
 ..M OCXVAR("CODE")=^TMP("OCXCMP",$J,"C CODE",$$LINE^OCXOCMP4(OCXLA))
 ..S OCXD2=0 F  S OCXD2=$O(OCXVAR("CODE",OCXD2)) Q:'OCXD2  D
 ...N OCXD3
 ...F OCXD3=1:1:$L(OCXVAR("CODE",OCXD2,0),"OCXLD") I +$P(OCXVAR("CODE",OCXD2,0),"OCXLD",OCXD3+1) S OCXVAR("VAR","OCXLD"_(+$P(OCXVAR("CODE",OCXD2),"OCXLD",OCXD3+1)))=""
 ...F OCXD3=1:1:$L(OCXVAR("CODE",OCXD2,0),"OCXLV") I +$P(OCXVAR("CODE",OCXD2,0),"OCXLV",OCXD3+1) S OCXVAR("VAR","OCXLV"_(+$P(OCXVAR("CODE",OCXD2),"OCXLV",OCXD3+1)))=""
 ...F OCXD3=1:1:$L(OCXVAR("CODE",OCXD2,0),"OCXLC") I +$P(OCXVAR("CODE",OCXD2,0),"OCXLC",OCXD3+1) S OCXVAR("VAR","OCXLC"_(+$P(OCXVAR("CODE",OCXD2),"OCXLC",OCXD3+1)))=""
 ..S (OCXD2,OCXCODE)="" F  S OCXD2=$O(OCXVAR("VAR",OCXD2)) Q:'$L(OCXD2)  S:$L(OCXCODE) OCXCODE=OCXCODE_"," S OCXCODE=OCXCODE_OCXD2
 ..I $L(OCXCODE) D IN^OCXOCMP4(OCXLA," N "_OCXCODE,"",11000),IN^OCXOCMP4(OCXLA," ;","",11000)
 ..K OCXVAR("CODE") M OCXVAR("CODE")=^TMP("OCXCMP",$J,"C CODE",$$LINE^OCXOCMP4(OCXLA),0)
 ;
 Q OCXWARN
 ;