source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP5.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1OCXOCMP5 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Optimize Order Check Sub-Routines) ;2/02/99 13:39
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN() ;
6 ;
7 Q:$G(OCXWARN) 1
8 N OCXPC,OCXD0,OCXD1,OCXD2,OCXD3
9 ;
10 S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0)) Q:'OCXD0 D
11 .I '$G(OCXAUTO) W:($X>60) ! W "."
12 .S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0,OCXD1)) Q:'OCXD1 D
13 ..S OCXLINE=$G(^TMP("OCXCMP",$J,"C CODE",OCXD0,OCXD1,0))
14 ..Q:'$L(OCXLINE) Q:'(OCXLINE["||LINE:")
15 ..F OCXPC=2:1:$L(OCXLINE,"||LINE:") S OCXD2=+$P(OCXLINE,"||LINE:",OCXPC) D
16 ...S:OCXD2 ^TMP("OCXCMP",$J,"CALLREF",OCXD2,OCXD0,OCXD1)=""
17 ;
18 S OCXD0=$G(^TMP("OCXCMP",$J,"LINE","B","SCAN")) I OCXD0 D
19 .S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"C CODE",OCXD0,OCXD1)) Q:'OCXD1 Q:(^(OCXD1,0)["D @OCXPGM")
20 .S OCXD3=199999 F S OCXD3=$O(^TMP("OCXCMP",$J,"LINE",OCXD3)) Q:(OCXD3>299999) D
21 ..S ^TMP("OCXCMP",$J,"CALLREF",OCXD3,OCXD0,OCXD1)=""
22 ..I '$G(OCXAUTO) W:($X>60) ! W "."
23 ;
24 F S OCXFLAG=0 D Q:'OCXFLAG
25 .S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"CALLREF",OCXD0)) Q:'OCXD0 D
26 ..I '$G(OCXAUTO) W:($X>60) ! W "."
27 ..N OCXNSUB,OCXLLAB,OCXCNT,OCXCHG,OCXCOD1,OCXCOD2
28 ..N OCXD1,OCXD2,OCXCALL,OCXOP1,OCXOP2,OCXOP3,OCXREC1,OCXREC2
29 ..S OCXCALL=" D ||LINE:"_OCXD0_"||"
30 ..Q:$D(^TMP("OCXCMP",$J,"C CODE",OCXD0,13000))
31 ..Q:$D(^TMP("OCXCMP",$J,"C CODE",OCXD0,16001))
32 ..S OCXCOD1=$G(^TMP("OCXCMP",$J,"C CODE",OCXD0,16000,0)) Q:'$L(OCXCOD1)
33 ..S OCXOP1=$G(^TMP("OCXCMP",$J,"C CODE",OCXD0,16000,"OPLIST"))
34 ..S (OCXCNT,OCXCHG)=0
35 ..S OCXD1=0 F S OCXD1=$O(^TMP("OCXCMP",$J,"CALLREF",OCXD0,OCXD1)) Q:'OCXD1 D
36 ...S OCXD2=0 F S OCXD2=$O(^TMP("OCXCMP",$J,"CALLREF",OCXD0,OCXD1,OCXD2)) Q:'OCXD2 D
37 ....S OCXCOD2=$G(^TMP("OCXCMP",$J,"C CODE",OCXD1,OCXD2,0)) Q:'(OCXCOD2[OCXCALL)
38 ....S OCXOP2=$G(^TMP("OCXCMP",$J,"C CODE",OCXD1,OCXD2,"OPLIST"))
39 ....S OCXOP3=$E(OCXOP2,1,$L(OCXOP2)-1)
40 ....S OCXCNT=OCXCNT+1
41 ....Q:(($L(OCXCOD1)+$L(OCXCOD2))>OCXCLL)
42 ....Q:(OCXOP2["Y")
43 ....I $L(OCXOP1),$L(OCXOP3),($E(OCXOP1,1)=$E(OCXOP3,$L(OCXOP3))),'($E(OCXOP1,1)="Z") D
44 .....S OCXCOD2=$P(OCXCOD2,OCXCALL,1)_","_$P(OCXCOD1," ",3,999)_$P(OCXCOD2,OCXCALL,2,9999)
45 .....S OCXOP2=OCXOP3_$E(OCXOP1,2,$L(OCXOP1))_$P(OCXOP2,"D",2,999)
46 ....E D
47 .....S OCXCOD2=$P(OCXCOD2,OCXCALL,1)_OCXCOD1_$P(OCXCOD2,OCXCALL,2,9999)
48 .....S OCXOP2=OCXOP3_OCXOP1_$P(OCXOP2,"D",2,999)
49 ....S ^TMP("OCXCMP",$J,"C CODE",OCXD1,OCXD2,0)=OCXCOD2
50 ....S ^TMP("OCXCMP",$J,"C CODE",OCXD1,OCXD2,"OPLIST")=OCXOP2
51 ....K ^TMP("OCXCMP",$J,"CALLREF",OCXD0,OCXD1,OCXD2)
52 ....F OCXPC=2:2:$L(OCXCOD2,"D ||LINE:") S OCXD3=+$P(OCXCOD2,"D ||LINE:",OCXPC) D
53 .....S ^TMP("OCXCMP",$J,"CALLREF",OCXD3,OCXD1,OCXD2)=""
54 ....S OCXCHG=OCXCHG+1,OCXFLAG=1
55 ..I (OCXCNT=OCXCHG) D
56 ...S OCXLLAB=$P(^TMP("OCXCMP",$J,"LINE",OCXD0),U,1)
57 ...Q:'($E(OCXLLAB,1,3)="CHK")
58 ...K ^TMP("OCXCMP",$J,"C CODE",OCXD0)
59 ...K ^TMP("OCXCMP",$J,"CALLREF",OCXD0)
60 ...K ^TMP("OCXCMP",$J,"LINE",OCXD0)
61 ...K ^TMP("OCXCMP",$J,"LINE","B",OCXLLAB)
62 ;
63 Q OCXWARN
64 ;
Note: See TracBrowser for help on using the repository browser.