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