source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP6.m@ 1361

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

revised back to 6/30/08 version

File size: 6.1 KB
Line 
1OCXOCMP6 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines) ;1/05/04 14:33
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) 1
8 N OCXD0,OCXD1,OCXRN,OCXSCNT,OCXOFF
9 ;
10 S OCXLCNT=0
11 ;
12 W:'$G(OCXAUTO) !,?5,"Generate Extrinsic Function and Variables documentation..."
13 S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D DOC^OCXOCMPT(OCXD0)
14 ;
15 K ^OCXS(860.3,"APGM")
16 S OCXD0=0 F S OCXD0=$O(^OCXS(860.3,OCXD0)) Q:'OCXD0 D
17 .K ^OCXS(860.3,OCXD0,"RTN") I '$G(OCXAUTO) W:($X>60) ! W "."
18 ;
19 K ^TMP("OCXCMP",$J,"D CODE")
20 ;
21 W:'$G(OCXAUTO) !,?5,"Assign Subroutines to Routines..."
22 S OCXRN=1,OCXD0=0
23 D GETHDR(1)
24 F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
25 .N OCXLLAB,OCXSKIP,OCXEXF,OCXSUB,OCXSIZE,OCXFILE,OCXCCODE,OCXDCODE,OCXLAST
26 .I '$G(OCXAUTO) W:($X>60) ! W "."
27 .S OCXLLAB=^TMP("OCXCMP",$J,"LINE",OCXD0)
28 .S OCXSKIP=((OCXLLAB="UPDATE")!(OCXLLAB="LOG"))
29 .S OCXSIZE=$$SIZE^OCXOCMP8(OCXRN,OCXD0)
30 .S OCXLAST='$O(^TMP("OCXCMP",$J,"C CODE",OCXD0))
31 .S OCXFILE=(OCXSIZE>OCXCRS)!(OCXLAST) S:OCXSKIP OCXFILE=0
32 .I OCXFILE D
33 ..K OCXEXF S OCXEXF=""
34 ..I $D(^TMP("OCXCMP",$J,"D CODE",OCXRN,"CALLS")) M OCXEXF=^("CALLS")
35 ..S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) I 'OCXEXF(OCXSUB) D
36 ...S OCXEXF(OCXSUB)=1,OCXEXF=OCXSUB
37 ...S OCXSUB="" F S OCXSUB=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXEXF,"CALLS",OCXSUB)) Q:'$L(OCXSUB) D
38 ....S OCXEXF(OCXSUB)=$G(OCXEXF(OCXSUB))
39 ..S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) D
40 ...D APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
41 ..D APPEND^OCXOCMP8(OCXRN,"$")
42 ..S OCXRN=OCXRN+1 D GETHDR(OCXRN)
43 ..;
44 .D APPEND^OCXOCMP8(OCXRN,OCXD0,"C",OCXLLAB)
45 .I ($E(OCXLLAB,1,2)="EL") D
46 ..S ^OCXS(860.3,"APGM",(+$E(OCXLLAB,3,$L(OCXLLAB))),(OCXLLAB_U_$$RNAM(OCXRN)))=""
47 .S $P(^TMP("OCXCMP",$J,"LINE",OCXD0),U,2)=$$RNAM(OCXRN)
48 .Q:'OCXLAST
49 .K OCXEXF S OCXEXF=""
50 .I $D(^TMP("OCXCMP",$J,"D CODE",OCXRN,"CALLS")) M OCXEXF=^("CALLS")
51 .S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) I 'OCXEXF(OCXSUB) D
52 ..S OCXEXF(OCXSUB)=1,OCXEXF=OCXSUB
53 ..S OCXSUB="" F S OCXSUB=$O(^TMP("OCXCMP",$J,"INCLUDE",OCXEXF,"CALLS",OCXSUB)) Q:'$L(OCXSUB) D
54 ...S OCXEXF(OCXSUB)=$G(OCXEXF(OCXSUB))
55 .S OCXSUB="" F S OCXSUB=$O(OCXEXF(OCXSUB)) Q:'$L(OCXSUB) D
56 ..D APPEND^OCXOCMP8(OCXRN,OCXSUB,"F")
57 .D APPEND^OCXOCMP8(OCXRN,"$")
58 ;
59 W:'$G(OCXAUTO) !,?5,"Resolve Routine Line Tags..."
60 S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
61 .I '$G(OCXAUTO) W:($X>60) ! W "."
62 .N TEXT,RTN,TEMP,ALT,LABL,OBJ,PIEC
63 .S RTN=$$RNAM(OCXD0)
64 .K TEMP M TEMP=^TMP("OCXCMP",$J,"D CODE",OCXD0)
65 .S OCXD1=0 F OCXOFF=0:1 S OCXD1=$O(TEMP(OCXD1)) Q:'OCXD1 D Q:OCXWARN
66 ..N TEXT,PIEC
67 ..S TEXT=TEMP(OCXD1,0) Q:'(TEXT["||")
68 ..;
69 ..F PIEC=2:2:$L(TEXT,"||") D Q:OCXWARN
70 ...S LABL=$P(TEXT,"||",PIEC)
71 ...I ($E(LABL,1,5)="LINE:") D I 1
72 ....S LABL=$G(^TMP("OCXCMP",$J,"LINE",+$P(LABL,":",2)))
73 ....I '$L(LABL) D WARN^OCXOCMPV("Line Label not found: "_$P(TEXT,"|",2),$P($T(+1)," ",1)) Q
74 ....S:($P(LABL,"^",2)=RTN) LABL=$P(LABL,"^",1)
75 ...;
76 ...E I ($E(LABL,1,5)="LNTAG") D I 1
77 ....N D0,CNT
78 ....S D0=OCXD1 F CNT=1:1 S D0=$O(TEMP(D0),-1) Q:$L($P(TEMP(D0,0)," ",1))
79 ....S LABL=$P(TEMP(D0,0)," ",1) S:(LABL["(") LABL=$P(LABL,"(",1)
80 ....S LABL="(+$P($H,"","",2))_""<"_LABL_"+"_CNT_U_RTN_">"""
81 ...;
82 ...E D WARN^OCXOCMPV("Unknown Compiler directive: "_LABL,$P($T(+1)," ",1)) Q
83 ...;
84 ...S $P(TEXT,"||",PIEC)=LABL
85 ..;
86 ..F Q:'(TEXT["||") S TEXT=$P(TEXT,"||",1)_$P(TEXT,"||",2,999)
87 ..S TEMP(OCXD1,0)=TEXT
88 .;
89 .K ^TMP("OCXCMP",$J,"D CODE",OCXD0)
90 .M ^TMP("OCXCMP",$J,"D CODE",OCXD0)=TEMP
91 ;
92 Q:OCXWARN 1
93 W:'$G(OCXAUTO) !,?5,"Generate Subroutine and Call documentation..."
94 S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D CALL^OCXOCMPT(OCXD0)
95 ;
96 W:'$G(OCXAUTO) !!,?5,"Delete Old OCXOZ* Routines..."
97 S OCXRTEST=^%ZOSF("TEST"),OCXSAVE=^%ZOSF("SAVE"),OCXDEL=^%ZOSF("DEL")
98 F OCXRN=1:1:1290 D
99 .I '$G(OCXAUTO) W:($X>60) ! W:'(OCXRN#100) "."
100 .S X=$$RNAM(OCXRN) X OCXRTEST I X OCXDEL W:'$G(OCXAUTO) "!"
101 ;
102 W:'$G(OCXAUTO) !,?5,"File New OCXOZ* routines..."
103 S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",0)) Q:'OCXD0 1
104 F S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
105 .I '$G(OCXAUTO) W:($X>60) ! W "."
106 .D FILE^OCXOCMP8(OCXD0)
107 S OCXD0=$O(^TMP("OCXCMP",$J,"D CODE",0)) Q:'OCXD0 1 D FILE^OCXOCMP8(OCXD0)
108 ;
109 Q OCXWARN
110 ;
111GETHDR(RNUM) ;
112 ;
113 N OCXREC,D0,EFC,OCXEFF,PIEC,TEXT
114 S OCXREC(1,0)=$$RNAM(RNUM)_" ;SLC/RJS,CLA - Order Check Scan ;"_$$NOW
115 S OCXREC(2,0)=$T(+2)
116 S OCXREC(3,0)=$T(+3)
117 S OCXREC(4,0)=" ;"
118 S OCXREC(5,0)=" ; ***************************************************************"
119 S OCXREC(6,0)=" ; ** Warning: This routine is automatically generated by the **"
120 S OCXREC(7,0)=" ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **"
121 S OCXREC(8,0)=" ; ** will be lost the next time the rule compiler executes. **"
122 S OCXREC(9,0)=" ; ***************************************************************"
123 S OCXREC(10,0)=" ;"
124 I (RNUM=1) D
125 .S OCXREC(11,0)=" ; compiled code line length: "_OCXCLL
126 .S OCXREC(12,0)=" ; compiled routine size: "_OCXCRS
127 .S OCXREC(13,0)=" ; triggered rule ignore period: "_OCXTSPI
128 .S OCXREC(14,0)=" ;"
129 .S OCXREC(15,0)=" ; Program Execution Trace Mode: "_$S($G(OCXTRACE):" ON",1:"OFF")
130 .S OCXREC(16,0)=" ;" ; " ; Elapsed time logging: "_$S($G(OCXTLOG):" ON",1:"OFF")
131 .S OCXREC(17,0)=" ; Raw Data Logging: "_$S($G(OCXDLOG):(" ON Keep data for "_OCXDLOG_" day"_$S(OCXDLOG=1:"",1:"s")_" then purge."),1:"OFF")
132 .S OCXREC(18,0)=" ; Compiler mode: "_$S(($G(OCXAUTO)>1):"Queued",$G(OCXAUTO):" ON",1:"OFF")
133 .S OCXREC(19,0)=" ; Compiled by: "_$P($G(^VA(200,+$G(DUZ),0)),U,1)_" (DUZ="_(+$G(DUZ))_")"
134 .S OCXREC(20,0)=" Q"
135 .S OCXREC(21,0)=" ;"
136 ;
137 E D
138 .S OCXREC(11,0)=" Q"
139 .S OCXREC(12,0)=" ;"
140 ;
141 M ^TMP("OCXCMP",$J,"D CODE",RNUM)=OCXREC
142 Q
143 ;
144RNAM(X) ;
145 N CHAR
146 S CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
147 Q "OCXOZ"_$E(CHAR,(X\36+1))_$E(CHAR,(X#36+1))
148 ;
149TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT X ^DD("DD") Q Y
150 ;
151NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2,99) Q Y
152 ;
Note: See TracBrowser for help on using the repository browser.