source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP4.m@ 635

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
 ;