| 1 | OCXOCMP4 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Sort Code Segments) ;1/05/04 14:38
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
|
---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
| 4 | ;
|
---|
| 5 | EN() ;
|
---|
| 6 | ;
|
---|
| 7 | Q:$G(OCXWARN) OCXWARN
|
---|
| 8 | N OCXD0,OCXD1,OCXD2,OCXD3,OCXD4,OCXU
|
---|
| 9 | S OCXU="UPDATE"
|
---|
| 10 | Q:'$$LINE("LOG","-") 1
|
---|
| 11 | Q:'$$LINE("CDATA","-") 1
|
---|
| 12 | Q:'$$LINE(OCXU,"DFN","OCXSRC","OUTMSG") 1
|
---|
| 13 | Q:'$$LINE("SCAN") 1
|
---|
| 14 | Q:'$$LINE("TERM","OCXTERM","OCXLIST") 1
|
---|
| 15 | ;
|
---|
| 16 | D SWAP^OCXOCMPH
|
---|
| 17 | ;
|
---|
| 18 | D TERM^OCXOCMPU
|
---|
| 19 | ;
|
---|
| 20 | D IN("LOG"," Q "_(+OCXDLOG))
|
---|
| 21 | D IN("CDATA"," Q """_(+OCXTRACE)_U_(+OCXTLOG)_U_(+OCXDLOG)_"""")
|
---|
| 22 | ;
|
---|
| 23 | I OCXTLOG D
|
---|
| 24 | .D IN(OCXU," S OCXOTIME=$$TIMELOG(""O"",""UPDATE^OCXOZ01"")")
|
---|
| 25 | .D IN(OCXU," ;")
|
---|
| 26 | ;
|
---|
| 27 | D IN(OCXU," K ^TMP(""OCXCHK"",$J)")
|
---|
| 28 | D IN(OCXU," S ^TMP(""OCXCHK"",$J)=($P($H,"","",2)+($H*86400)+(2*60))_"" <- ^TMP ENTRY EXPIRATION DATE FOR ^OCXOPURG""")
|
---|
| 29 | I '(OCXTLOG) D IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI")
|
---|
| 30 | I (OCXTLOG) D IN(OCXU," N OCXOERR,OCXOCMSG,OCXNDX,OCXDF,OCXX,OCXTSPI,OCXBOOLV")
|
---|
| 31 | D IN(OCXU," S OCXTSPI="_+$G(OCXTSPI))
|
---|
| 32 | I $G(OCXTRACE) D
|
---|
| 33 | .D IN(OCXU," I $G(OCXTRACE),'$G(DFN) W !,""Patient not defined !""")
|
---|
| 34 | .D IN(OCXU," I $G(OCXTRACE),$G(DFN) W !,||LNTAG||,?30,""Data Field: Patient: ("",DFN,"") "",$P($G(^DPT(DFN,0)),""^"",1),"" !""")
|
---|
| 35 | I 'OCXTLOG D IN(OCXU," Q:'$G(DFN)")
|
---|
| 36 | I OCXTLOG D IN(OCXU," I '$G(DFN) S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"") Q")
|
---|
| 37 | D IN("SCAN"," ;")
|
---|
| 38 | D IN("SCAN"," N OCXD0,OCXRULE S OCXD0=0 F S OCXD0=$O(^TMP(""OCXCHK"",$J,DFN,OCXD0)) Q:'OCXD0 D")
|
---|
| 39 | D IN("SCAN"," .Q:'($G(^TMP(""OCXCHK"",$J,DFN,OCXD0))=1)")
|
---|
| 40 | D IN("SCAN"," .N OCXPGM S OCXPGM=$O(^OCXS(860.3,""APGM"",OCXD0,"""")) Q:'$L(OCXPGM) X ""I $L($T(""_OCXPGM_""))"" E Q")
|
---|
| 41 | D IN("SCAN"," .D @OCXPGM")
|
---|
| 42 | D IN("SCAN"," .S ^TMP(""OCXCHK"",$J,DFN,OCXD0)=$G(^TMP(""OCXCHK"",$J,DFN,OCXD0))+10")
|
---|
| 43 | D IN("SCAN"," K ^TMP(""OCXCHK"",$J)")
|
---|
| 44 | ;
|
---|
| 45 | S OCXCOD0=0 F S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0)) Q:'OCXCOD0 D Q:OCXWARN
|
---|
| 46 | .S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1)) Q:'OCXD1 S OCXCODE=$G(^(OCXD1)) I $L(OCXCODE) D
|
---|
| 47 | ..I '$G(OCXAUTO) W:($X>60) ! W "."
|
---|
| 48 | ..Q:(OCXCODE["OCXBOOLV")
|
---|
| 49 | ..S OCXD2=OCXD1 F S OCXD2=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2)) Q:'OCXD2 D
|
---|
| 50 | ...I (OCXCODE=$G(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2))) K ^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD2)
|
---|
| 51 | ;
|
---|
| 52 | I $G(OCXTRACE) D
|
---|
| 53 | .D IN(OCXU," ;")
|
---|
| 54 | .D IN(OCXU," I $G(OCXTRACE) D")
|
---|
| 55 | .D IN(OCXU," .W !,||LNTAG||,?30,""Data Source: "",$G(OCXOSRC)")
|
---|
| 56 | .;S CONTXT=$O(^OCXS(860.6,"B","DATABASE LOOKUP",0)) Q:'CONTXT 0
|
---|
| 57 | .S OCXD0="" F S OCXD0=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0)) Q:'$L(OCXD0) D
|
---|
| 58 | ..N OCXTRLN,OCXTRSR
|
---|
| 59 | ..S OCXTRLN="TRACE"_OCXD0,OCXTRSR=$$LINE(OCXTRLN) Q:'OCXTRSR
|
---|
| 60 | ..I ($P($G(^OCXS(860.6,+OCXD0,0)),U,1)="DATABASE LOOKUP") D IN(OCXU," .D ||LINE:"_OCXTRSR_"||") I 1
|
---|
| 61 | ..E D IN(OCXU," .I ($G(OCXOSRC)="""_$P($G(^OCXS(860.6,+OCXD0,0)),U,1)_""") D ||LINE:"_OCXTRSR_"||")
|
---|
| 62 | ..S OCXD1="" F S OCXD1=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1)) Q:'$L(OCXD1) D
|
---|
| 63 | ...S OCXD2="" F S OCXD2=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2)) Q:'$L(OCXD2) D
|
---|
| 64 | ....S OCXD3="" F S OCXD3=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3)) Q:'$L(OCXD3) D
|
---|
| 65 | .....S OCXD4="" F S OCXD4=$O(^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4)) Q:'$L(OCXD4) D
|
---|
| 66 | ......D IN(OCXTRLN," "_^TMP("OCXCMP",$J,"DATA FIELD TRACE",OCXD0,OCXD1,OCXD2,OCXD3,OCXD4))
|
---|
| 67 | .D IN(OCXU," ;")
|
---|
| 68 | ;
|
---|
| 69 | S OCXD0=$$LINE("GETDF")
|
---|
| 70 | S OCXD1=$$LINE("SWAPOUT")
|
---|
| 71 | D IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") D ||LINE:"_OCXD0_"||,||LINE:"_OCXD1_"||(""OCXODATA"",.OCXODATA)","Y")
|
---|
| 72 | ;
|
---|
| 73 | S OCXCOD0=0 F S OCXCOD0=$O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0)) Q:'OCXCOD0 D Q:OCXWARN
|
---|
| 74 | .N OCXCODE,OCXLIST
|
---|
| 75 | .S (OCXPAR,OCXD1)=0,OCXLLAB=OCXU
|
---|
| 76 | .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
|
---|
| 77 | ..I '$G(OCXAUTO) W:($X>60) ! W "."
|
---|
| 78 | ..S OCXD2=$$CODELKUP(OCXPAR,OCXCODE)
|
---|
| 79 | ..I 'OCXD2 D
|
---|
| 80 | ...S OCXD2=$O(^TMP("OCXCMP",$J,"B CODE",OCXPAR,99999),-1)+1
|
---|
| 81 | ...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,"B",$E(OCXCODE,1,50),OCXD2)=OCXCODE
|
---|
| 82 | ...S OCXNPAR=$O(^TMP("OCXCMP",$J,"B CODE",99999),-1)+1
|
---|
| 83 | ...I ($O(^TMP("OCXCMP",$J,"A CODE",OCXCOD0,OCXD1))) S OCXCODE=OCXCODE_" D ||LINE:"_$$LINE("CHK"_OCXNPAR)_"||" S:$L(OCXLIST) OCXLIST=OCXLIST_"D"
|
---|
| 84 | ...D IN(OCXLLAB," "_OCXCODE,OCXLIST,16000)
|
---|
| 85 | ...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"PAR")=OCXNPAR
|
---|
| 86 | ...S ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2)=OCXCODE
|
---|
| 87 | ...S:$L(OCXLIST) ^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"OPLIST")=OCXLIST
|
---|
| 88 | ..S OCXPAR=$G(^TMP("OCXCMP",$J,"B CODE",OCXPAR,OCXD2,"PAR"))
|
---|
| 89 | ..S OCXLLAB="CHK"_OCXPAR
|
---|
| 90 | ;
|
---|
| 91 | S OCXWARN=$$EN^OCXOCMPD
|
---|
| 92 | ;
|
---|
| 93 | D IN(OCXU," ;","Y",18000)
|
---|
| 94 | D IN(OCXU," D ||LINE:"_$$LINE("SCAN")_"||","Y",18000)
|
---|
| 95 | D IN(OCXU," ;","Y",18000)
|
---|
| 96 | D IN(OCXU," I $O(OCXOCMSG("""")) D","Y",18000)
|
---|
| 97 | D IN(OCXU," .N OCXNDX1,OCXNDX2","Y",18000)
|
---|
| 98 | D IN(OCXU," .S OCXNDX1=0 F S OCXNDX1=$O(OCXOCMSG(OCXNDX1)) Q:'OCXNDX1 D","Y",18000)
|
---|
| 99 | D IN(OCXU," ..S OCXNDX2=0 F S OCXNDX2=$O(OUTMSG(OCXNDX2)) Q:'OCXNDX2 Q:(OUTMSG(OCXNDX2)=OCXOCMSG(OCXNDX1))","Y",18000)
|
---|
| 100 | D IN(OCXU," ..Q:OCXNDX2 S OUTMSG($O(OUTMSG(999999),-1)+1)=OCXOCMSG(OCXNDX1)","Y",18000)
|
---|
| 101 | D IN(OCXU," K ^TMP(""OCXCHK"",$J)","Y",18000)
|
---|
| 102 | I OCXTLOG D IN(OCXU," S OCXOTIME=$$TIMELOG(""I"",""UPDATE^OCXOZ01"")","Y",18000)
|
---|
| 103 | ;
|
---|
| 104 | D IN(OCXU," ;","Y",18000)
|
---|
| 105 | S OCXD0=$$LINE("SWAPIN")
|
---|
| 106 | D IN(OCXU," I ($G(OCXOSRC)=""GENERIC HL7 MESSAGE ARRAY"") K OCXDF D ||LINE:"_OCXD0_"||(""OCXODATA"",.OCXODATA)","Y",18000)
|
---|
| 107 | ;
|
---|
| 108 | Q OCXWARN
|
---|
| 109 | ;
|
---|
| 110 | CODELKUP(OCXP,OCXC) ;
|
---|
| 111 | ;
|
---|
| 112 | N OCXD0
|
---|
| 113 | S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"B CODE",OCXP,"B",$E(OCXC,1,50),OCXD0)) Q:'OCXD0 Q:(OCXC=^(OCXD0))
|
---|
| 114 | Q +OCXD0
|
---|
| 115 | ;
|
---|
| 116 | IN(LINE,CODE,OPLIST,STRT) ;
|
---|
| 117 | ;
|
---|
| 118 | N INDEX,NEXTLN
|
---|
| 119 | S STRT=+$G(STRT,13000),INDEX=$$LINE(LINE)
|
---|
| 120 | F NEXTLN=STRT:1 Q:'$D(^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN))
|
---|
| 121 | S ^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN,0)=CODE
|
---|
| 122 | S:$L($G(OPLIST)) ^TMP("OCXCMP",$J,"C CODE",INDEX,NEXTLN,"OPLIST")=OPLIST
|
---|
| 123 | ;
|
---|
| 124 | Q
|
---|
| 125 | ;
|
---|
| 126 | LINE(X,ARG1,ARG2,ARG3,ARG4) ;
|
---|
| 127 | ;
|
---|
| 128 | N Y S Y=+$G(^TMP("OCXCMP",$J,"LINE","B",X)) Q:Y +Y
|
---|
| 129 | ;
|
---|
| 130 | Q +$$NEWLINE(X,$G(ARG1),$G(ARG2),$G(ARG3),$G(ARG4))
|
---|
| 131 | ;
|
---|
| 132 | NEWLINE(X,ARG1,ARG2,ARG3,ARG4) ;
|
---|
| 133 | ;
|
---|
| 134 | N Y,REC
|
---|
| 135 | S Y=0
|
---|
| 136 | I ($E(X,1,3)="LOG") S Y=1
|
---|
| 137 | E I ($E(X,1,5)="CDATA") S Y=2
|
---|
| 138 | E I ($E(X,1,6)="UPDATE") S Y=3
|
---|
| 139 | E I (X="SWAPIN") S Y=10
|
---|
| 140 | E I (X="SWAPOUT") S Y=10
|
---|
| 141 | E I ($E(X,1,5)="GETDF") S Y=10
|
---|
| 142 | E I ($E(X,1,4)="SCAN") S Y=20
|
---|
| 143 | E I ($E(X,1,5)="TRACE") S Y=30
|
---|
| 144 | E I ($E(X,1,8)="TERM") S Y=40
|
---|
| 145 | E D
|
---|
| 146 | .I ($E(X,1,3)="CHK") S Y=100000
|
---|
| 147 | .I ($E(X,1,2)="EL") S Y=200000
|
---|
| 148 | .I ($E(X,1)="R") S Y=300000
|
---|
| 149 | F Y=Y:1 Q:'$D(^TMP("OCXCMP",$J,"LINE",Y))
|
---|
| 150 | S ^TMP("OCXCMP",$J,"LINE",+Y)=X
|
---|
| 151 | S ^TMP("OCXCMP",$J,"LINE","B",X)=+Y
|
---|
| 152 | S REC(10000,0)=X_" ;"
|
---|
| 153 | I $L($G(ARG1)) S REC(10000,0)=X_"("_$S(ARG1="-":"",1:ARG1)_") ;"
|
---|
| 154 | I $L($G(ARG1)),$L($G(ARG2)) S REC(10000,0)=X_"("_ARG1_","_ARG2_") ;"
|
---|
| 155 | I $L($G(ARG1)),$L($G(ARG2)),$L($G(ARG3)) S REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_") ;"
|
---|
| 156 | I $L($G(ARG1)),$L($G(ARG2)),$L($G(ARG3)),$L($G(ARG4)) S REC(10000,0)=X_"("_ARG1_","_ARG2_","_ARG3_","_ARG4_") ;"
|
---|
| 157 | ;
|
---|
| 158 | S REC(10001,0)=" ;",REC(10002,0)=" ;"
|
---|
| 159 | I '(X["UPDATE"),'(X["LOG"),'(X["CDATA") S REC(10003,0)=" Q:$G(OCXOERR)"
|
---|
| 160 | ;
|
---|
| 161 | I $G(OCXTRACE) D
|
---|
| 162 | .S:(X["UPDATE") REC(10004,0)=" W:$G(OCXTRACE) !!,""**********************************************************"",!,||LNTAG||,?25,""Execution trace. """
|
---|
| 163 | .S:'(X["UPDATE") REC(10004,0)=" W:$G(OCXTRACE) !,||LNTAG||,?25,""Execution trace. "",$P($T("_X_"+1),"";"",2)"
|
---|
| 164 | ;
|
---|
| 165 | I OCXTLOG,'(X["UPDATE"),'(X["LOG") S REC(10005,0)=" S OCXERR=$$TIMELOG(""M"",""Line: "_X_U_"""_$P($T(+1),"" "",1))"
|
---|
| 166 | ;
|
---|
| 167 | I '(X["LOG"),'(X["CDATA") S REC(11000,0)=" ;",REC(19998,0)=" Q"
|
---|
| 168 | S REC(19999,0)=" ;"
|
---|
| 169 | M ^TMP("OCXCMP",$J,"C CODE",+Y)=REC
|
---|
| 170 | Q (+Y)
|
---|
| 171 | K ARG1,ARG2
|
---|
| 172 | ;
|
---|