source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPT.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1OCXOCMPT ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build Sub-Routine Variable and Function Call Documentation) ;3/22/01 16:55
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 Q
6DOC(OCXSUB) ;
7 ;
8 N OCXLINE,OCXLIST,OCXDF,OCXNEW,OCXDELM,OCXPIEC,OCXTXT,OCXREST,OCXPTR,OCXRSUB,OCXD0,OCXOFF,OCXSRTN
9 ;
10 I '$G(OCXAUTO) W:($X>60) ! W "."
11 ;
12 ;
13 S OCXSRTN=$P($G(^TMP("OCXCMP",$J,"C CODE",OCXSUB,10000,0))," ",1)
14 S OCXLINE=0 F OCXOFF=0:1 S OCXLINE=$O(^TMP("OCXCMP",$J,"C CODE",OCXSUB,OCXLINE)) Q:'OCXLINE D
15 .S OCXTXT=$G(^TMP("OCXCMP",$J,"C CODE",OCXSUB,OCXLINE,0)) Q:'$L(OCXTXT)
16 .;
17 .F OCXPIEC=2:1:$L(OCXTXT,"OCXDF(") S OCXDF=+$P(OCXTXT,"OCXDF(",OCXPIEC) I OCXDF S OCXLIST("V",OCXDF)=0
18 .;
19 .F OCXDELM="S OCXDF(",",OCXDF(" D
20 ..F OCXPIEC=1:1:$L(OCXTXT,OCXDELM) I $P(OCXTXT,OCXDELM,OCXPIEC+1) D
21 ...S OCXREST=$P(OCXTXT,OCXDELM,OCXPIEC+1),OCXDF=+OCXREST
22 ...F OCXPTR=1:1:$L(OCXREST) Q:'($E(OCXREST,OCXPTR)=+$E(OCXREST,OCXPTR))
23 ...S OCXLIST("V",OCXDF)=$G(OCXLIST("V",OCXDF),0)
24 ...I ($E(OCXREST,OCXPTR)="=") S OCXLIST("V",OCXDF)=1
25 .;
26 .F OCXPIEC=2:1:$L(OCXTXT,"$$") D
27 ..S OCXREST=$P(OCXTXT,"$$",OCXPIEC)
28 ..S OCXDF=$P(OCXREST,")",1)
29 ..I (OCXREST[")"),($P(OCXREST,"(",1)[" ") S OCXDF=$P(OCXREST," ",1)
30 ..I '(OCXREST[")"),(OCXREST[" ") S OCXDF=$P(OCXREST," ",1)
31 ..;
32 ..I $L(OCXDF),($P(OCXDF,"(",1)="FILE") S OCXLIST("F",$P(OCXDF,"(",1)_"("_$P($P(OCXDF,"(",2),",",1,2)_",")=0 Q
33 ..I $L(OCXDF) S OCXLIST("F",$P(OCXDF,"(",1)_"(")=0 Q
34 ;
35 S OCXNEW="" I $O(OCXLIST("V",0)) D
36 .D FILE(" ;")
37 .D FILE(" ; Local "_$P($G(^TMP("OCXCMP",$J,"LINE",OCXSUB)),U,1)_" Variables")
38 .S OCXDF=0 F S OCXDF=$O(OCXLIST("V",OCXDF)) Q:'OCXDF D
39 ..N OCXTXT
40 ..S OCXTXT=" ; OCXDF("_(OCXDF)_") "_$E("----------",$L(OCXDF)+7,10)
41 ..S OCXTXT=OCXTXT_"-> Data Field: "_$P($G(^OCXS(860.4,OCXDF,0)),U,1)_" ("_$$DATATYP(OCXDF)_")"
42 ..D FILE(OCXTXT)
43 ;
44 I $L($O(OCXLIST("F",0))) D
45 .N OCXFCALL,OCXFNAM,OCXF,OCXTXT,OCXELE
46 .D FILE(" ;")
47 .D FILE(" ; Local Extrinsic Functions")
48 .S OCXFCALL="" F S OCXFCALL=$O(OCXLIST("F",OCXFCALL)) Q:'$L(OCXFCALL) D
49 ..S OCXFNAM=$P(OCXFCALL,"(",1) S:(OCXFNAM[" ") OCXFNAM=$P(OCXFNAM," ",1) Q:(OCXFNAM[U)
50 ..S OCXTXT=" ; "_OCXFCALL
51 ..S OCXF=$O(^OCXS(860.8,"C",OCXFNAM,0))
52 ..I OCXF S OCXTXT=OCXTXT_" "_$E("---------------",$L(OCXFCALL),15)_"-> "_$P($G(^OCXS(860.8,OCXF,0)),U,1)
53 ..I OCXF,(OCXFNAM="FILE") S OCXELE=$P($G(^OCXS(860.3,+$P($P(OCXFCALL,"(",2),",",2),0)),U,1),OCXTXT=OCXTXT_" (Event/Element: "_OCXELE_")"
54 ..I 'OCXF,($E(OCXFCALL,1,3)="MCE") D
55 ...S OCXTXT=OCXTXT_" "_$E("---------------",$L(OCXFCALL),15)_"-> "
56 ...S OCXTXT=OCXTXT_" Verify Event/Element: '"_$P($G(^OCXS(860.3,+$P(OCXFCALL,"MCE",2),0)),U,1)_"'"
57 ..D FILE(OCXTXT)
58 ;
59 I $L(OCXNEW) D FILE(" ;"),FILE(" N "_OCXNEW)
60 ;
61 Q
62 ;
63CALL(OCXSUB) ;
64 ;
65 N OCXD0,OCXD1,OCXFROM,OCXLINE,OCXCALL,OCXDOC,OCXRTN,OCXOFF
66 ;
67 I '$G(OCXAUTO) W:($X>60) ! W "."
68 ;
69 S OCXLINE=$G(^TMP("OCXCMP",$J,"LINE",OCXSUB))
70 S OCXRTN=$P(OCXLINE,U,2),OCXLINE=$P(OCXLINE,U,1) Q:'$L(OCXLINE)
71 ;
72 S (OCXDOC,OCXCALL)="",(OCXOFF,OCXD0)=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"CALLREF",OCXSUB,OCXD0)) Q:'OCXD0 D
73 .S OCXFROM=$G(^TMP("OCXCMP",$J,"LINE",OCXD0)) Q:'$L(OCXFROM)
74 .S OCXD1=$O(^TMP("OCXCMP",$J,"CALLREF",OCXSUB,OCXD0,0))
75 .I OCXD1 F OCXOFF=0:1 S OCXD1=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0,OCXD1),-1) Q:'OCXD1
76 .I OCXOFF S $P(OCXFROM,U,1)=$P(OCXFROM,U,1)_"+"_OCXOFF
77 .I (OCXRTN=$P(OCXFROM,U,2)) S OCXFROM=$P(OCXFROM,U,1)
78 .S:$L(OCXCALL) OCXCALL=OCXCALL_", and " S OCXCALL=OCXCALL_OCXFROM
79 I $L(OCXCALL) S OCXCALL=" Called from "_OCXCALL_"."
80 E S OCXCALL=" External Call."
81 ;
82 ;
83 I (OCXLINE="LOG") S OCXDOC=" Returns the number of days to keep the Raw Data Log or 0 if logging is disabled."
84 I (OCXLINE="CDATA") S OCXDOC=" Returns compiler flags, Execution TRACE ON/OFF, Time Logging ON/OFF, and Raw Data Logging ON/OFF"
85 I (OCXLINE="UPDATE") S OCXDOC=" Main Entry point for evaluating Rules."
86 I (OCXLINE="SCAN") S OCXDOC=" Tests all Rules for Event/Elements that were found to be valid in the UPDATE subroutine."
87 I ($E(OCXLINE,1,5)="SWAPIN") S OCXDOC="This subroutine moves an array from ^TMP to a local variable."
88 I ($E(OCXLINE,1,5)="SWAPOUT") S OCXDOC="This subroutine moves an array from a local variable to ^TMP."
89 I ($E(OCXLINE,1,5)="GETDF") S OCXDOC="This subroutine loads the OCXDF data field array from variables in the environment."
90 I ($E(OCXLINE,1,5)="TRACE") S OCXDOC="During program execution trace mode, display all data fields for '"_$P($G(^OCXS(860.6,+$P(OCXLINE,"TRACE",2),0)),U,1)_"' data source."
91 I ($E(OCXLINE,1,3)="CHK") S OCXDOC=" Look through the current environment for valid Event/Elements for this patient."
92 I ($E(OCXLINE,1,2)="EL") S OCXDOC=" Examine every rule that involves Element #"_(+$P(OCXLINE,"EL",2))_" ["_$P($G(^OCXS(860.3,+$P(OCXLINE,"EL",2),0)),U,1)_"]"
93 I ($E(OCXLINE,1,4)="TERM") S OCXDOC=" Local Term Lookup",OCXCALL=" Internal Call."
94 I ($E(OCXLINE,1)="R") D
95 .N OCXR0,OCXR1,OCXR2
96 .S OCXR0=+$P(OCXLINE,"R",2) Q:'OCXR0
97 .S OCXR1=+$P(OCXLINE,"R",3) Q:'OCXR1
98 .S OCXR2=$E(OCXLINE,$L(OCXLINE))
99 .I (OCXR2="A") S OCXDOC=" Verify all Event/Elements of"
100 .E I (OCXR2="B") S OCXDOC=" Send Order Check, Notication messages and/or Execute code for"
101 .E Q
102 .S OCXDOC=OCXDOC_" Rule #"_(+$P(OCXLINE,"R",2))_" '"_$E($P($G(^OCXS(860.2,+OCXR0,0)),U,1),1,40)
103 .I ($L($P($G(^OCXS(860.2,+OCXR0,0)),U,1))>40) S OCXDOC=OCXDOC_"..."
104 .S OCXDOC=OCXDOC_"'"
105 .S OCXDOC=OCXDOC_" Relation #"_(+$P(OCXLINE,"R",3))_" '"_$E($G(^OCXS(860.2,OCXR0,"R",OCXR1,"E")),1,50)
106 .I ($L(^OCXS(860.2,OCXR0,"R",OCXR1,"E"))>50) S OCXDOC=OCXDOC_"..."
107 .S OCXDOC=OCXDOC_"'"
108 ;
109 S OCXD0=$G(^TMP("OCXCMP",$J,"D CODE","LINE",OCXLINE))
110 S OCXD1=+$P(OCXD0,",",2),OCXD0=+OCXD0 Q:'OCXD0 Q:'OCXD1
111 Q:'$D(^TMP("OCXCMP",$J,"D CODE",OCXD0,OCXD1,0))
112 S ^TMP("OCXCMP",$J,"D CODE",OCXD0,OCXD1,0)=^TMP("OCXCMP",$J,"D CODE",OCXD0,OCXD1,0)_OCXDOC
113 S ^TMP("OCXCMP",$J,"D CODE",OCXD0,OCXD1+1,0)=^TMP("OCXCMP",$J,"D CODE",OCXD0,OCXD1+1,0)_OCXCALL
114 Q
115 ;
116FILE(TXT) ;
117 ;
118 N OCXLINE
119 S OCXLINE=$O(^TMP("OCXCMP",$J,"C CODE",OCXSUB,10999),-1)+1
120 S ^TMP("OCXCMP",$J,"C CODE",OCXSUB,OCXLINE,0)=TXT
121 Q
122 ;
123DATATYP(OCXDF) ;
124 ;
125 N OCXCON
126 S OCXCON=$O(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,0)) Q:'OCXCON ""
127 Q $G(^TMP("OCXCMP",$J,"DATA FIELD",OCXDF,OCXCON,"DTYP","DATA TYPE NAME"))
128 ;
Note: See TracBrowser for help on using the repository browser.