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
;
OCXOCMPD ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments cont...) ;3/22/01 09:38
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ;
+2 NEW OCXELE,OCXD0,OCXD1,OCXD2
+3 ;
+4 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"RULE",OCXD0))
IF 'OCXD0
QUIT
Begin DoDot:1
+5 NEW OCXR
MERGE OCXR=^OCXS(860.2,OCXD0)
+6 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^TMP("OCXCMP",$JOB,"RULE",OCXD0,OCXD1))
IF 'OCXD1
QUIT
SET OCXCODE=$GET(^(OCXD1))
IF $LENGTH(OCXCODE)
Begin DoDot:2
+7 NEW OCXNMSG,OCXCMSG,OCXNTF,OCXNOD0,OCXL,OCXD2,OCXCNT,OCXVAR,OCXCODE,OCXMCOD
+8 SET OCXLA="R"_OCXD0_"R"_OCXD1_"A"
SET OCXLB="R"_OCXD0_"R"_OCXD1_"B"
+9 SET OCXCODE=" D ||LINE:"_$$LINE^OCXOCMP4(OCXLA)_"||"
+10 ;
+11 SET OCXD2=0
FOR OCXCNT=0:1
SET OCXD2=$ORDER(^TMP("OCXCMP",$JOB,"RULE",OCXD0,OCXD1,OCXD2))
IF 'OCXD2
QUIT
Begin DoDot:3
+12 IF '$DATA(OCXELE(OCXD2))
Begin DoDot:4
+13 IF $GET(OCXTRACE)
DO IN^OCXOCMP4("EL"_OCXD2," W:$G(OCXTRACE) !,||LNTAG||,?27,""Element Check for: ("_OCXD2_") '"_$PIECE(^OCXS(860.3,OCXD2,0),U,1)_"'""")
+14 IF $GET(OCXTRACE)
DO IN^OCXOCMP4("EL"_OCXD2," ;")
+15 SET OCXELE(OCXD2)=""
End DoDot:4
+16 DO IN^OCXOCMP4("EL"_OCXD2,OCXCODE_" ; Check Relation #"_(+OCXD1)_" in Rule #"_(+OCXD0)_" '"_$PIECE(OCXR(0),U,1)_"'")
End DoDot:3
+17 ;
+18 DO IN^OCXOCMP4(OCXLA," Q:$G(^OCXS(860.2,"_OCXD0_",""INACT""))")
+19 DO IN^OCXOCMP4(OCXLA," ;")
+20 SET OCXD2=0
FOR
SET OCXD2=$ORDER(^TMP("OCXCMP",$JOB,"RULE",OCXD0,OCXD1,"CODE",OCXD2))
IF 'OCXD2
QUIT
SET OCXCODE=$GET(^(OCXD2))
Begin DoDot:3
+21 FOR
IF '(OCXCODE["@@@@")
QUIT
SET OCXCODE=$PIECE(OCXCODE,"@@@@",1)_"||LINE:"_$$LINE^OCXOCMP4(OCXLB)_"||"_$PIECE(OCXCODE,"@@@@",2,999)
+22 DO IN^OCXOCMP4(OCXLA," "_OCXCODE)
End DoDot:3
+23 ;
+24 SET OCXNOD0=$GET(OCXR("R",OCXD1,0))
+25 SET OCXNMSG=$GET(OCXR("R",OCXD1,"MSG"))
IF '$PIECE(OCXNOD0,U,3)
SET OCXNMSG=""
+26 SET OCXCMSG=$GET(OCXR("R",OCXD1,"OCMSG"))
IF '$PIECE(OCXNOD0,U,2)
SET OCXCMSG=""
+27 SET OCXMCOD=$GET(OCXR("R",OCXD1,"MCODE"))
+28 ;
+29 IF $GET(OCXTRACE)
DO IN^OCXOCMP4(OCXLB," I $G(OCXTRACE),$D(OCXRULE("""_OCXLB_""")) W !,||LNTAG||,?27,""Rule '"_$PIECE($GET(OCXR(0)),U,1)_"' already triggered !!""")
+30 DO IN^OCXOCMP4(OCXLB," Q:$D(OCXRULE("""_OCXLB_"""))")
+31 DO IN^OCXOCMP4(OCXLB," ;")
+32 ;
+33 IF '$GET(OCXAUTO)
IF ($X>60)
WRITE !
WRITE "."
+34 ;
+35 IF '($LENGTH(OCXCMSG)+$LENGTH(OCXNMSG))
IF '$LENGTH($GET(OCXR("R",OCXD1,"RULE")))
IF '$LENGTH(OCXMCOD)
Begin DoDot:3
+36 DO IN^OCXOCMP4(OCXLB," ; Notification and order checking disabled for this")
+37 DO IN^OCXOCMP4(OCXLB," ; rule due to no Order Check or Notification message,")
+38 DO IN^OCXOCMP4(OCXLB," ; or execute code found in the Order Check Rule File (860.2)")
End DoDot:3
QUIT
+39 ;
+40 IF $LENGTH($GET(OCXR("R",OCXD1,"RULE")))
Begin DoDot:3
+41 NEW OCXSCH,OCXTIME
+42 SET OCXSCH=$PIECE(OCXR("R",OCXD1,"RULE"),U,1)
+43 SET OCXTIME=$PIECE(OCXR("R",OCXD1,"RULE"),U,2)
+44 ;
+45 DO IN^OCXOCMP4(OCXLB," ;")
+46 IF ((OCXSCH="START")!(OCXSCH="CONTINUE"))
Begin DoDot:4
+47 IF '$LENGTH(OCXTIME)
Begin DoDot:5
+48 DO IN^OCXOCMP4(OCXLB," ; No code generated for '"_OCXSCH_"' rule schedule.")
+49 DO IN^OCXOCMP4(OCXLB," ; Time period not defined.")
+50 DO IN^OCXOCMP4(OCXLB," ;")
End DoDot:5
QUIT
+51 IF '$LENGTH($$TIME^OCXOCMPQ(OCXTIME,OCXD0,OCXD1))
Begin DoDot:5
+52 DO IN^OCXOCMP4(OCXLB," ; No code generated for '"_OCXSCH_"' rule schedule.")
+53 DO IN^OCXOCMP4(OCXLB," ; Invalid time period definition. -> "_OCXTIME)
+54 DO IN^OCXOCMP4(OCXLB," ;")
End DoDot:5
QUIT
+55 SET OCXTIME=$$TIME^OCXOCMPQ(OCXTIME,OCXD0,OCXD1)
+56 DO IN^OCXOCMP4(OCXLB," ; Add '"_$PIECE($GET(^OCXS(860.2,OCXD0,0)),U,1)_"' rule to")
+57 DO IN^OCXOCMP4(OCXLB," ; Time Based Order Check Schedule for patient defined by 'DFN'.")
+58 DO IN^OCXOCMP4(OCXLB," ;")
+59 DO IN^OCXOCMP4(OCXLB," N OCXSDATE")
+60 DO IN^OCXOCMP4(OCXLB," S OCXSDATE=$$ADD2DATE("_OCXTIME_")")
+61 DO IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,0)=DFN")
+62 DO IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,0)=""^860.12D^""_OCXSDATE")
+63 DO IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,OCXSDATE,1,0)=""^860.121P^"_OCXD0_"""")
+64 DO IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_",0)="_OCXD0)
+65 DO IN^OCXOCMP4(OCXLB," S ^OCXD(860.1,""TIME"","_OCXD0_",DFN,OCXSDATE,"_OCXD0_")=""""")
End DoDot:4
QUIT
+66 ;
+67 IF (OCXSCH="STOP")
Begin DoDot:4
+68 DO IN^OCXOCMP4(OCXLB," ; Delete all entries for rule '"_$PIECE($GET(^OCXS(860.2,OCXD0,0)),U,1)_"' from")
+69 DO IN^OCXOCMP4(OCXLB," ; Time Based Order Check Schedule for patient defined by 'DFN'.")
+70 DO IN^OCXOCMP4(OCXLB," ; ")
+71 DO IN^OCXOCMP4(OCXLB," N OCXSDATE S OCXSDATE=0 F S OCXSDATE=$O(^OCXD(860.1,DFN,2,OCXSDATE)) Q:'OCXSDATE D")
+72 DO IN^OCXOCMP4(OCXLB," .Q:'$D(^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_"))")
+73 DO IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,DFN,2,OCXSDATE,1,"_OCXD0_")")
+74 DO IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,DFN,2,OCXSDATE,1,""B"","_OCXD0_","_OCXD0_")")
+75 DO IN^OCXOCMP4(OCXLB," .K ^OCXD(860.1,""TIME"","_OCXD0_",DFN,OCXSDATE,"_OCXD0_")")
End DoDot:4
End DoDot:3
+76 ;
+77 IF '($LENGTH(OCXCMSG)+$LENGTH(OCXNMSG)+$LENGTH(OCXMCOD))
QUIT
+78 ;
+79 DO IN^OCXOCMP4(OCXLB," N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD")
+80 ;
+81 IF $LENGTH(OCXCMSG)
Begin DoDot:3
+82 SET OCXCMSG=$TRANSLATE(OCXCMSG,"""","""""")
+83 SET OCXCMSG=$$XLATE^OCXOCMPQ(OCXCMSG,OCXD0,OCXD1)
+84 DO IN^OCXOCMP4(OCXLB," I ($G(OCXOSRC)=""CPRS ORDER PRESCAN"") S OCXCMSG=(+OCXPSD)_""^"_(+$PIECE(OCXNOD0,U,2))_"^^"_$SELECT(($EXTRACT(OCXCMSG,1)=""""):$EXTRACT(OCXCMSG,2,$LENGTH(OCXCMSG)),1:"""_"_OCXCMSG)_" I 1")
+85 DO IN^OCXOCMP4(OCXLB," E S OCXCMSG="_OCXCMSG)
End DoDot:3
IF 1
+86 IF '$TEST
DO IN^OCXOCMP4(OCXLB," S OCXCMSG=""""")
+87 ;
+88 SET OCXNMSG=$$XLATE^OCXOCMPQ(OCXNMSG,OCXD0,OCXD1)
+89 SET OCXMCOD=$$XLATE^OCXOCMPQ(OCXMCOD,OCXD0,OCXD1,1)
+90 DO IN^OCXOCMP4(OCXLB," S OCXNMSG="_OCXNMSG)
+91 ;
+92 SET OCXWARN=$$EN^OCXOCMPG(OCXLB,OCXCNT)
+93 ;
+94 MERGE OCXVAR("CODE")=^TMP("OCXCMP",$JOB,"C CODE",$$LINE^OCXOCMP4(OCXLA))
+95 SET OCXD2=0
FOR
SET OCXD2=$ORDER(OCXVAR("CODE",OCXD2))
IF 'OCXD2
QUIT
Begin DoDot:3
+96 NEW OCXD3
+97 FOR OCXD3=1:1:$LENGTH(OCXVAR("CODE",OCXD2,0),"OCXLD")
IF +$PIECE(OCXVAR("CODE",OCXD2,0),"OCXLD",OCXD3+1)
SET OCXVAR("VAR","OCXLD"_(+$PIECE(OCXVAR("CODE",OCXD2),"OCXLD",OCXD3+1)))=""
+98 FOR OCXD3=1:1:$LENGTH(OCXVAR("CODE",OCXD2,0),"OCXLV")
IF +$PIECE(OCXVAR("CODE",OCXD2,0),"OCXLV",OCXD3+1)
SET OCXVAR("VAR","OCXLV"_(+$PIECE(OCXVAR("CODE",OCXD2),"OCXLV",OCXD3+1)))=""
+99 FOR OCXD3=1:1:$LENGTH(OCXVAR("CODE",OCXD2,0),"OCXLC")
IF +$PIECE(OCXVAR("CODE",OCXD2,0),"OCXLC",OCXD3+1)
SET OCXVAR("VAR","OCXLC"_(+$PIECE(OCXVAR("CODE",OCXD2),"OCXLC",OCXD3+1)))=""
End DoDot:3
+100 SET (OCXD2,OCXCODE)=""
FOR
SET OCXD2=$ORDER(OCXVAR("VAR",OCXD2))
IF '$LENGTH(OCXD2)
QUIT
IF $LENGTH(OCXCODE)
SET OCXCODE=OCXCODE_","
SET OCXCODE=OCXCODE_OCXD2
+101 IF $LENGTH(OCXCODE)
DO IN^OCXOCMP4(OCXLA," N "_OCXCODE,"",11000)
DO IN^OCXOCMP4(OCXLA," ;","",11000)
+102 KILL OCXVAR("CODE")
MERGE OCXVAR("CODE")=^TMP("OCXCMP",$JOB,"C CODE",$$LINE^OCXOCMP4(OCXLA),0)
End DoDot:2
End DoDot:1
IF OCXWARN
QUIT
+103 ;
+104 QUIT OCXWARN
+105 ;