| [613] | 1 | OCXOCMP5 ;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 | ;
|
|---|
| 5 | EN() ;
|
|---|
| 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 | ;
|
|---|
