OCXOCMP4 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments) ;1/05/04 14:38
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
;
Q:$G(OCXWARN) OCXWARN
N OCXD0,OCXD1,OCXD2,OCXD3,OCXD4,OCXU
S OCXU="UPDATE"
Q:'$$LINE("LOG","-") 1
Q:'$$LINE("CDATA","-") 1
Q:'$$LINE(OCXU,"DFN","OCXSRC","OUTMSG") 1
Q:'$$LINE("SCAN") 1
Q:'$$LINE("TERM","OCXTERM","OCXLIST") 1
;
D SWAP^OCXOCMPH
;
D TERM^OCXOCMPU
;
D IN("LOG"," Q "_(+OCXDLOG))
D IN("CDATA"," Q """_(+OCXTRACE)_U_(+OCXTLOG)_U_(+OCXDLOG)_"""")
;
I OCXTLOG D
.D IN(OCXU," S OCXOTIME=$$TIMELOG(""O"",""UPDATE^OCXOZ01"")")
.D IN(OCXU," ;")
;
D IN(OCXU," K ^TMP(""OCXCHK"",$J)")
D IN(OCXU," S ^TMP(""OCXCHK"",$J)=($P($H,"","",2)+($H*86400)+(2*60))_"" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG""")
I '(OCXTLOG) D IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI")
I (OCXTLOG) D IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI,OCXBOOLV")
D IN(OCXU," S OCXTSPI="_+$G(OCXTSPI))
I $G(OCXTRACE) D
.D IN(OCXU," I $G(OCXTRACE),'$G(DFN) W !,""Patient not defined !""")
.D IN(OCXU," I $G(OCXTRACE),$G(DFN) W !,||LNTAG||,?30,""Data Field: Patient: ("",DFN,"") "",$P($G(^DPT(DFN,0)),""^"",1),"" !""")
I 'OCXTLOG D IN(OCXU," Q:'$G(DFN)")
I OCXTLOG D IN(OCXU," I '$G(DFN) S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"") Q")
D IN("SCAN"," ;")
D IN("SCAN"," N OCXD0,OCXRULE S OCXD0=0 F S OCXD0=$O(^TMP(""OCXCHK"",$J,DFN,OCXD0)) Q:'OCXD0 D")
D IN("SCAN"," .Q:'($G(^TMP(""OCXCHK"",$J,DFN,OCXD0))=1)")
D IN("SCAN"," .N OCXPGM S OCXPGM=$O(^OCXS(860.3,""APGM"",OCXD0,"""")) Q:'$L(OCXPGM) X ""I $L($T(""_OCXPGM_""))"" E Q")
D IN("SCAN"," .D @OCXPGM")
D IN("SCAN"," .S ^TMP(""OCXCHK"",$J,DFN,OCXD0)=$G(^TMP(""OCXCHK"",$J,DFN,OCXD0))+10")
D IN("SCAN"," K ^TMP(""OCXCHK"",$J)")
;
S OCXCOD0=0 F S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0)) Q:'OCXCOD0 D Q:OCXWARN
.S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1)) Q:'OCXD1 S OCXCODE=$G(^(OCXD1)) I $L(OCXCODE) D
..I '$G(OCXAUTO) W:($X>60) ! W "."
..Q:(OCXCODE["OCXBOOLV")
..S OCXD2=OCXD1 F S OCXD2=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2)) Q:'OCXD2 D
...I (OCXCODE=$G(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2))) K ^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2)
;
I $G(OCXTRACE) D
.D IN(OCXU," ;")
.D IN(OCXU," I $G(OCXTRACE) D")
.D IN(OCXU," .W !,||LNTAG||,?30,""Data Source: "",$G(OCXOSRC)")
.;S CONTXT=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0)) Q:'CONTXT 0
.S OCXD0="" F S OCXD0=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0)) Q:'$L(OCXD0) D
..N OCXTRLN,OCXTRSR
..S OCXTRLN="TRACE"_OCXD0,OCXTRSR=$$LINE(OCXTRLN) Q:'OCXTRSR
..I ($P($G(^OCXS(860.6,+OCXD0,0)),U,1)="DATABASE LOOKUP") D IN(OCXU," .D ||LINE:"_OCXTRSR_"||") I 1
..E D IN(OCXU," .I ($G(OCXOSRC)="""_$P($G(^OCXS(860.6,+OCXD0,0)),U,1)_""") D ||LINE:"_OCXTRSR_"||")
..S OCXD1="" F S OCXD1=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1)) Q:'$L(OCXD1) D
...S OCXD2="" F S OCXD2=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2)) Q:'$L(OCXD2) D
....S OCXD3="" F S OCXD3=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3)) Q:'$L(OCXD3) D
.....S OCXD4="" F S OCXD4=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4)) Q:'$L(OCXD4) D
......D IN(OCXTRLN," "_^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4))
.D IN(OCXU," ;")
;
S OCXD0=$$LINE("GETDF")
S OCXD1=$$LINE("SWAPOUT")
D IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") D ||LINE:"_OCXD0_"||,||LINE:"_OCXD1_"||(""OCXODATA"",.OCXODATA)","Y")
;
S OCXCOD0=0 F S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0)) Q:'OCXCOD0 D Q:OCXWARN
.N OCXCODE,OCXLIST
.S (OCXPAR,OCXD1)=0,OCXLLAB=OCXU
.F S OCXD1=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1)) Q:'OCXD1 S OCXCODE=$G(^(OCXD1)),OCXLIST=$G(^(OCXD1,"OPLIST")) I $L(OCXCODE) D
..I '$G(OCXAUTO) W:($X>60) ! W "."
..S OCXD2=$$CODELKUP(OCXPAR,OCXCODE)
..I 'OCXD2 D
...S OCXD2=$O(^TMP("OCXCMP",$J,"B CODE",OCXPAR,99999),-1)+1
...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,"B",$E(OCXCODE,1,50),OCXD2)=OCXCODE
...S OCXNPAR=$O(^TMP("OCXCMP",$J,"B CODE",99999),-1)+1
...I ($O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1))) S OCXCODE=OCXCODE_" D ||LINE:"_$$LINE("CHK"_OCXNPAR)_"||" S:$L(OCXLIST) OCXLIST=OCXLIST_"D"
...D IN(OCXLLAB," "_OCXCODE,OCXLIST,16000)
...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"PAR")=OCXNPAR
...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2)=OCXCODE
...S:$L(OCXLIST) ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"OPLIST")=OCXLIST
..S OCXPAR=$G(^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"PAR"))
..S OCXLLAB="CHK"_OCXPAR
;
S OCXWARN=$$EN^OCXOCMPD
;
D IN(OCXU," ;","Y",18000)
D IN(OCXU," D ||LINE:"_$$LINE("SCAN")_"||","Y",18000)
D IN(OCXU," ;","Y",18000)
D IN(OCXU," I $O(OCXOCMSG("""")) D","Y",18000)
D IN(OCXU," .N OCXNDX1,OCXNDX2","Y",18000)
D IN(OCXU," .S OCXNDX1=0 F S OCXNDX1=$O(OCXOCMSG(OCXNDX1)) Q:'OCXNDX1 D","Y",18000)
D IN(OCXU," ..S OCXNDX2=0 F S OCXNDX2=$O(OUTMSG(OCXNDX2)) Q:'OCXNDX2 Q:(OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))","Y",18000)
D IN(OCXU," ..Q:OCXNDX2 S OUTMSG($O(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)","Y",18000)
D IN(OCXU," K ^TMP(""OCXCHK"",$J)","Y",18000)
I OCXTLOG D IN(OCXU," S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"")","Y",18000)
;
D IN(OCXU," ;","Y",18000)
S OCXD0=$$LINE("SWAPIN")
D IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") K OCXDF D ||LINE:"_OCXD0_"||(""OCXODATA"",.OCXODATA)","Y",18000)
;
Q OCXWARN
;
CODELKUP(OCXP,OCXC) ;
;
N OCXD0
S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"B CODE",OCXP,"B",$E(OCXC,1,50),OCXD0)) Q:'OCXD0 Q:(OCXC=^(OCXD0))
Q +OCXD0
;
IN(LINE,CODE,OPLIST,STRT) ;
;
N INDEX,NEXTLN
S STRT=+$G(STRT,13000),INDEX=$$LINE(LINE)
F NEXTLN=STRT:1 Q:'$D(^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN))
S ^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN,0)=CODE
S:$L($G(OPLIST)) ^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN,"OPLIST")=OPLIST
;
Q
;
LINE(X,ARG1,ARG2,ARG3,ARG4) ;
;
N Y S Y=+$G(^TMP("OCXCMP",$J,"LINE","B",X)) Q:Y +Y
;
Q +$$NEWLINE(X,$G(ARG1),$G(ARG2),$G(ARG3),$G(ARG4))
;
NEWLINE(X,ARG1,ARG2,ARG3,ARG4) ;
;
N Y,REC
S Y=0
I ($E(X,1,3)="LOG") S Y=1
E I ($E(X,1,5)="CDATA") S Y=2
E I ($E(X,1,6)="UPDATE") S Y=3
E I (X="SWAPIN") S Y=10
E I (X="SWAPOUT") S Y=10
E I ($E(X,1,5)="GETDF") S Y=10
E I ($E(X,1,4)="SCAN") S Y=20
E I ($E(X,1,5)="TRACE") S Y=30
E I ($E(X,1,8)="TERM") S Y=40
E D
.I ($E(X,1,3)="CHK") S Y=100000
.I ($E(X,1,2)="EL") S Y=200000
.I ($E(X,1)="R") S Y=300000
F Y=Y:1 Q:'$D(^TMP("OCXCMP",$J,"LINE",Y))
S ^TMP("OCXCMP",$J,"LINE",+Y)=X
S ^TMP("OCXCMP",$J,"LINE","B",X)=+Y
S REC(10000,0)=X_" ;"
I $L($G(ARG1)) S REC(10000,0)=X_"("_$S(ARG1="-":"",1:ARG1)_") ;"
I $L($G(ARG1)),$L($G(ARG2)) S REC(10000,0)=X_"("_ARG1_","_ARG2_") ;"
I $L($G(ARG1)),$L($G(ARG2)),$L($G(ARG3)) S REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_") ;"
I $L($G(ARG1)),$L($G(ARG2)),$L($G(ARG3)),$L($G(ARG4)) S REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_","_ARG4_") ;"
;
S REC(10001,0)=" ;",REC(10002,0)=" ;"
I '(X["UPDATE"),'(X["LOG"),'(X["CDATA") S REC(10003,0)=" Q:$G(OCXOERR)"
;
I $G(OCXTRACE) D
.S:(X["UPDATE") REC(10004,0)=" W:$G(OCXTRACE) !!,""**********************************************************"",!,||LNTAG||,?25,""Execution trace. """
.S:'(X["UPDATE") REC(10004,0)=" W:$G(OCXTRACE) !,||LNTAG||,?25,""Execution trace. "",$P($T("_X_"+1),"";"",2)"
;
I OCXTLOG,'(X["UPDATE"),'(X["LOG") S REC(10005,0)=" S OCXERR=$$TIMELOG(""M"",""Line: "_X_U_"""_$P($T(+1),"" "",1))"
;
I '(X["LOG"),'(X["CDATA") S REC(11000,0)=" ;",REC(19998,0)=" Q"
S REC(19999,0)=" ;"
M ^TMP("OCXCMP",$J,"C CODE",+Y)=REC
Q (+Y)
K ARG1,ARG2
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMP4 7807 printed Dec 13, 2024@02:24:41 Page 2
OCXOCMP4 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments) ;1/05/04 14:38
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ;
+2 if $GET(OCXWARN)
QUIT OCXWARN
+3 NEW OCXD0,OCXD1,OCXD2,OCXD3,OCXD4,OCXU
+4 SET OCXU="UPDATE"
+5 if '$$LINE("LOG","-")
QUIT 1
+6 if '$$LINE("CDATA","-")
QUIT 1
+7 if '$$LINE(OCXU,"DFN","OCXSRC","OUTMSG")
QUIT 1
+8 if '$$LINE("SCAN")
QUIT 1
+9 if '$$LINE("TERM","OCXTERM","OCXLIST")
QUIT 1
+10 ;
+11 DO SWAP^OCXOCMPH
+12 ;
+13 DO TERM^OCXOCMPU
+14 ;
+15 DO IN("LOG"," Q "_(+OCXDLOG))
+16 DO IN("CDATA"," Q """_(+OCXTRACE)_U_(+OCXTLOG)_U_(+OCXDLOG)_"""")
+17 ;
+18 IF OCXTLOG
Begin DoDot:1
+19 DO IN(OCXU," S OCXOTIME=$$TIMELOG(""O"",""UPDATE^OCXOZ01"")")
+20 DO IN(OCXU," ;")
End DoDot:1
+21 ;
+22 DO IN(OCXU," K ^TMP(""OCXCHK"",$J)")
+23 DO IN(OCXU," S ^TMP(""OCXCHK"",$J)=($P($H,"","",2)+($H*86400)+(2*60))_"" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG""")
+24 IF '(OCXTLOG)
DO IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI")
+25 IF (OCXTLOG)
DO IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI,OCXBOOLV")
+26 DO IN(OCXU," S OCXTSPI="_+$GET(OCXTSPI))
+27 IF $GET(OCXTRACE)
Begin DoDot:1
+28 DO IN(OCXU," I $G(OCXTRACE),'$G(DFN) W !,""Patient not defined !""")
+29 DO IN(OCXU," I $G(OCXTRACE),$G(DFN) W !,||LNTAG||,?30,""Data Field: Patient: ("",DFN,"") "",$P($G(^DPT(DFN,0)),""^"",1),"" !""")
End DoDot:1
+30 IF 'OCXTLOG
DO IN(OCXU," Q:'$G(DFN)")
+31 IF OCXTLOG
DO IN(OCXU," I '$G(DFN) S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"") Q")
+32 DO IN("SCAN"," ;")
+33 DO IN("SCAN"," N OCXD0,OCXRULE S OCXD0=0 F S OCXD0=$O(^TMP(""OCXCHK"",$J,DFN,OCXD0)) Q:'OCXD0 D")
+34 DO IN("SCAN"," .Q:'($G(^TMP(""OCXCHK"",$J,DFN,OCXD0))=1)")
+35 DO IN("SCAN"," .N OCXPGM S OCXPGM=$O(^OCXS(860.3,""APGM"",OCXD0,"""")) Q:'$L(OCXPGM) X ""I $L($T(""_OCXPGM_""))"" E Q")
+36 DO IN("SCAN"," .D @OCXPGM")
+37 DO IN("SCAN"," .S ^TMP(""OCXCHK"",$J,DFN,OCXD0)=$G(^TMP(""OCXCHK"",$J,DFN,OCXD0))+10")
+38 DO IN("SCAN"," K ^TMP(""OCXCHK"",$J)")
+39 ;
+40 SET OCXCOD0=0
FOR
SET OCXCOD0=$ORDER(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0))
if 'OCXCOD0
QUIT
Begin DoDot:1
+41 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0,OCXD1))
if 'OCXD1
QUIT
SET OCXCODE=$GET(^(OCXD1))
IF $LENGTH(OCXCODE)
Begin DoDot:2
+42 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+43 if (OCXCODE["OCXBOOLV")
QUIT
+44 SET OCXD2=OCXD1
FOR
SET OCXD2=$ORDER(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0,OCXD2))
if 'OCXD2
QUIT
Begin DoDot:3
+45 IF (OCXCODE=$GET(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0,OCXD2)))
KILL ^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0,OCXD2)
End DoDot:3
End DoDot:2
End DoDot:1
if OCXWARN
QUIT
+46 ;
+47 IF $GET(OCXTRACE)
Begin DoDot:1
+48 DO IN(OCXU," ;")
+49 DO IN(OCXU," I $G(OCXTRACE) D")
+50 DO IN(OCXU," .W !,||LNTAG||,?30,""Data Source: "",$G(OCXOSRC)")
+51 ;S CONTXT=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0)) Q:'CONTXT 0
+52 SET OCXD0=""
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXD0))
if '$LENGTH(OCXD0)
QUIT
Begin DoDot:2
+53 NEW OCXTRLN,OCXTRSR
+54 SET OCXTRLN="TRACE"_OCXD0
SET OCXTRSR=$$LINE(OCXTRLN)
if 'OCXTRSR
QUIT
+55 IF ($PIECE($GET(^OCXS(860.6,+OCXD0,0)),U,1)="DATABASE LOOKUP")
DO IN(OCXU," .D ||LINE:"_OCXTRSR_"||")
IF 1
+56 IF '$TEST
DO IN(OCXU," .I ($G(OCXOSRC)="""_$PIECE($GET(^OCXS(860.6,+OCXD0,0)),U,1)_""") D ||LINE:"_OCXTRSR_"||")
+57 SET OCXD1=""
FOR
SET OCXD1=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXD0,OCXD1))
if '$LENGTH(OCXD1)
QUIT
Begin DoDot:3
+58 SET OCXD2=""
FOR
SET OCXD2=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2))
if '$LENGTH(OCXD2)
QUIT
Begin DoDot:4
+59 SET OCXD3=""
FOR
SET OCXD3=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3))
if '$LENGTH(OCXD3)
QUIT
Begin DoDot:5
+60 SET OCXD4=""
FOR
SET OCXD4=$ORDER(^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4))
if '$LENGTH(OCXD4)
QUIT
Begin DoDot:6
+61 DO IN(OCXTRLN," "_^TMP("OCXCMP",$JOB,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4))
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+62 DO IN(OCXU," ;")
End DoDot:1
+63 ;
+64 SET OCXD0=$$LINE("GETDF")
+65 SET OCXD1=$$LINE("SWAPOUT")
+66 DO IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") D ||LINE:"_OCXD0_"||,||LINE:"_OCXD1_"||(""OCXODATA"",.OCXODATA)","Y")
+67 ;
+68 SET OCXCOD0=0
FOR
SET OCXCOD0=$ORDER(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0))
if 'OCXCOD0
QUIT
Begin DoDot:1
+69 NEW OCXCODE,OCXLIST
+70 SET (OCXPAR,OCXD1)=0
SET OCXLLAB=OCXU
+71 FOR
SET OCXD1=$ORDER(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0,OCXD1))
if 'OCXD1
QUIT
SET OCXCODE=$GET(^(OCXD1))
SET OCXLIST=$GET(^(OCXD1,"OPLIST"))
IF $LENGTH(OCXCODE)
Begin DoDot:2
+72 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+73 SET OCXD2=$$CODELKUP(OCXPAR,OCXCODE)
+74 IF 'OCXD2
Begin DoDot:3
+75 SET OCXD2=$ORDER(^TMP("OCXCMP",$JOB,"B CODE",OCXPAR,99999),-1)+1
+76 SET ^TMP("OCXCMP",$JOB,"B CODE",OCXPAR,"B",$EXTRACT(OCXCODE,1,50),OCXD2)=OCXCODE
+77 SET OCXNPAR=$ORDER(^TMP("OCXCMP",$JOB,"B CODE",99999),-1)+1
+78 IF ($ORDER(^TMP("OCXCMP",$JOB,"A CODE",OCXCOD0,OCXD1)))
SET OCXCODE=OCXCODE_" D ||LINE:"_$$LINE("CHK"_OCXNPAR)_"||"
if $LENGTH(OCXLIST)
SET OCXLIST=OCXLIST_"D"
+79 DO IN(OCXLLAB," "_OCXCODE,OCXLIST,16000)
+80 SET ^TMP("OCXCMP",$JOB,"B CODE",OCXPAR,OCXD2,"PAR")=OCXNPAR
+81 SET ^TMP("OCXCMP",$JOB,"B CODE",OCXPAR,OCXD2)=OCXCODE
+82 if $LENGTH(OCXLIST)
SET ^TMP("OCXCMP",$JOB,"B CODE",OCXPAR,OCXD2,"OPLIST")=OCXLIST
End DoDot:3
+83 SET OCXPAR=$GET(^TMP("OCXCMP",$JOB,"B CODE",OCXPAR,OCXD2,"PAR"))
+84 SET OCXLLAB="CHK"_OCXPAR
End DoDot:2
End DoDot:1
if OCXWARN
QUIT
+85 ;
+86 SET OCXWARN=$$EN^OCXOCMPD
+87 ;
+88 DO IN(OCXU," ;","Y",18000)
+89 DO IN(OCXU," D ||LINE:"_$$LINE("SCAN")_"||","Y",18000)
+90 DO IN(OCXU," ;","Y",18000)
+91 DO IN(OCXU," I $O(OCXOCMSG("""")) D","Y",18000)
+92 DO IN(OCXU," .N OCXNDX1,OCXNDX2","Y",18000)
+93 DO IN(OCXU," .S OCXNDX1=0 F S OCXNDX1=$O(OCXOCMSG(OCXNDX1)) Q:'OCXNDX1 D","Y",18000)
+94 DO IN(OCXU," ..S OCXNDX2=0 F S OCXNDX2=$O(OUTMSG(OCXNDX2)) Q:'OCXNDX2 Q:(OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))","Y",18000)
+95 DO IN(OCXU," ..Q:OCXNDX2 S OUTMSG($O(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)","Y",18000)
+96 DO IN(OCXU," K ^TMP(""OCXCHK"",$J)","Y",18000)
+97 IF OCXTLOG
DO IN(OCXU," S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"")","Y",18000)
+98 ;
+99 DO IN(OCXU," ;","Y",18000)
+100 SET OCXD0=$$LINE("SWAPIN")
+101 DO IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") K OCXDF D ||LINE:"_OCXD0_"||(""OCXODATA"",.OCXODATA)","Y",18000)
+102 ;
+103 QUIT OCXWARN
+104 ;
CODELKUP(OCXP,OCXC) ;
+1 ;
+2 NEW OCXD0
+3 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"B CODE",OCXP,"B",$EXTRACT(OCXC,1,50),OCXD0))
if 'OCXD0
QUIT
if (OCXC=^(OCXD0))
QUIT
+4 QUIT +OCXD0
+5 ;
IN(LINE,CODE,OPLIST,STRT) ;
+1 ;
+2 NEW INDEX,NEXTLN
+3 SET STRT=+$GET(STRT,13000)
SET INDEX=$$LINE(LINE)
+4 FOR NEXTLN=STRT:1
if '$DATA(^TMP("OCXCMP",$JOB,"C CODE",INDEX,NEXTLN))
QUIT
+5 SET ^TMP("OCXCMP",$JOB,"C CODE",INDEX,NEXTLN,0)=CODE
+6 if $LENGTH($GET(OPLIST))
SET ^TMP("OCXCMP",$JOB,"C CODE",INDEX,NEXTLN,"OPLIST")=OPLIST
+7 ;
+8 QUIT
+9 ;
LINE(X,ARG1,ARG2,ARG3,ARG4) ;
+1 ;
+2 NEW Y
SET Y=+$GET(^TMP("OCXCMP",$JOB,"LINE","B",X))
if Y
QUIT +Y
+3 ;
+4 QUIT +$$NEWLINE(X,$GET(ARG1),$GET(ARG2),$GET(ARG3),$GET(ARG4))
+5 ;
NEWLINE(X,ARG1,ARG2,ARG3,ARG4) ;
+1 ;
+2 NEW Y,REC
+3 SET Y=0
+4 IF ($EXTRACT(X,1,3)="LOG")
SET Y=1
+5 IF '$TEST
IF ($EXTRACT(X,1,5)="CDATA")
SET Y=2
+6 IF '$TEST
IF ($EXTRACT(X,1,6)="UPDATE")
SET Y=3
+7 IF '$TEST
IF (X="SWAPIN")
SET Y=10
+8 IF '$TEST
IF (X="SWAPOUT")
SET Y=10
+9 IF '$TEST
IF ($EXTRACT(X,1,5)="GETDF")
SET Y=10
+10 IF '$TEST
IF ($EXTRACT(X,1,4)="SCAN")
SET Y=20
+11 IF '$TEST
IF ($EXTRACT(X,1,5)="TRACE")
SET Y=30
+12 IF '$TEST
IF ($EXTRACT(X,1,8)="TERM")
SET Y=40
+13 IF '$TEST
Begin DoDot:1
+14 IF ($EXTRACT(X,1,3)="CHK")
SET Y=100000
+15 IF ($EXTRACT(X,1,2)="EL")
SET Y=200000
+16 IF ($EXTRACT(X,1)="R")
SET Y=300000
End DoDot:1
+17 FOR Y=Y:1
if '$DATA(^TMP("OCXCMP",$JOB,"LINE",Y))
QUIT
+18 SET ^TMP("OCXCMP",$JOB,"LINE",+Y)=X
+19 SET ^TMP("OCXCMP",$JOB,"LINE","B",X)=+Y
+20 SET REC(10000,0)=X_" ;"
+21 IF $LENGTH($GET(ARG1))
SET REC(10000,0)=X_"("_$SELECT(ARG1="-":"",1:ARG1)_") ;"
+22 IF $LENGTH($GET(ARG1))
IF $LENGTH($GET(ARG2))
SET REC(10000,0)=X_"("_ARG1_","_ARG2_") ;"
+23 IF $LENGTH($GET(ARG1))
IF $LENGTH($GET(ARG2))
IF $LENGTH($GET(ARG3))
SET REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_") ;"
+24 IF $LENGTH($GET(ARG1))
IF $LENGTH($GET(ARG2))
IF $LENGTH($GET(ARG3))
IF $LENGTH($GET(ARG4))
SET REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_","_ARG4_") ;"
+25 ;
+26 SET REC(10001,0)=" ;"
SET REC(10002,0)=" ;"
+27 IF '(X["UPDATE")
IF '(X["LOG")
IF '(X["CDATA")
SET REC(10003,0)=" Q:$G(OCXOERR)"
+28 ;
+29 IF $GET(OCXTRACE)
Begin DoDot:1
+30 if (X["UPDATE")
SET REC(10004,0)=" W:$G(OCXTRACE) !!,""**********************************************************"",!,||LNTAG||,?25,""Execution trace. """
+31 if '(X["UPDATE")
SET REC(10004,0)=" W:$G(OCXTRACE) !,||LNTAG||,?25,""Execution trace. "",$P($T("_X_"+1),"";"",2)"
End DoDot:1
+32 ;
+33 IF OCXTLOG
IF '(X["UPDATE")
IF '(X["LOG")
SET REC(10005,0)=" S OCXERR=$$TIMELOG(""M"",""Line: "_X_U_"""_$P($T(+1),"" "",1))"
+34 ;
+35 IF '(X["LOG")
IF '(X["CDATA")
SET REC(11000,0)=" ;"
SET REC(19998,0)=" Q"
+36 SET REC(19999,0)=" ;"
+37 MERGE ^TMP("OCXCMP",$JOB,"C CODE",+Y)=REC
+38 QUIT (+Y)
+39 KILL ARG1,ARG2
+40 ;
