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

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.5 KB
Line 
1OCXOCMP4 ;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 ;
5EN() ;
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 ;
110CODELKUP(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 ;
116IN(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 ;
126LINE(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 ;
132NEWLINE(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 ;
Note: See TracBrowser for help on using the repository browser.