| 1 | OCXOCMP3 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Rule Element Relation code) ;10/29/98 12:37
|
|---|
| 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) OCXWARN
|
|---|
| 8 | S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"RULE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
|
|---|
| 9 | .S OCXNAM=$P($G(^OCXS(860.2,OCXD0,0)),U,1) Q:'$L(OCXNAM)
|
|---|
| 10 | .I '$G(OCXAUTO) W:($X>60) ! W "."
|
|---|
| 11 | .N OCXD1,OCXCODE
|
|---|
| 12 | .;
|
|---|
| 13 | .Q:'$O(^OCXS(860.2,OCXD0,"C",0))
|
|---|
| 14 | .Q:'$O(^OCXS(860.2,OCXD0,"R",0))
|
|---|
| 15 | .;
|
|---|
| 16 | .S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"C",OCXD1)) Q:'OCXD1 D Q:OCXWARN
|
|---|
| 17 | ..N X,OCXLAB,DA
|
|---|
| 18 | ..S OCXLAB0=$G(^OCXS(860.2,OCXD0,"C",OCXD1,0))
|
|---|
| 19 | ..S OCXLABE=$G(^OCXS(860.2,OCXD0,"C",OCXD1,"EXP"))
|
|---|
| 20 | ..S X=$P(OCXLAB0,U,1) Q:'$L(X) S DA=OCXD1,DA(1)=OCXD0 D LABEL^OCXOCMPS I '$D(X) S OCXWARN=1 Q
|
|---|
| 21 | ..;
|
|---|
| 22 | ..I '$P(OCXLAB0,U,3) S OCXCODE(OCXD1)=(+$P(OCXLAB0,U,2)),OCXCODE(OCXD1,"LABEL")=X,OCXCODE("B",X)=OCXD1
|
|---|
| 23 | ..I $P(OCXLAB0,U,3) S OCXCODE(OCXD1)=OCXLABE,OCXCODE(OCXD1,"LABEL")=X,OCXCODE("B",X)=OCXD1
|
|---|
| 24 | .;
|
|---|
| 25 | .Q:'$D(OCXCODE)
|
|---|
| 26 | .;
|
|---|
| 27 | .S OCXWARN=$$GETCODE^OCXOCMPI(OCXD0,.OCXCODE) Q:OCXWARN
|
|---|
| 28 | .;
|
|---|
| 29 | .S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"R",OCXD1)) Q:'OCXD1 D Q:OCXWARN
|
|---|
| 30 | ..;
|
|---|
| 31 | ..N OCXEXP,OCXD2
|
|---|
| 32 | ..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"E")) Q:'$L(OCXEXP)
|
|---|
| 33 | ..S OCXWARN=$$PARSE^OCXOCMPB(OCXD0,OCXD1,OCXEXP,.OCXCODE) Q:OCXWARN
|
|---|
| 34 | ..I '$G(OCXAUTO) W:($X>60) ! W "."
|
|---|
| 35 | ;
|
|---|
| 36 | Q OCXWARN
|
|---|
| 37 | ;
|
|---|
| 38 | GETPARM(FILE,INST,PARM) ;
|
|---|
| 39 | Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
|
|---|
| 40 | N OCXP,OCXP1,OCXI,OCXGL
|
|---|
| 41 | S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
|
|---|
| 42 | Q:'$D(@OCXGL@(+FILE,0)) ""
|
|---|
| 43 | I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
|
|---|
| 44 | E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
|
|---|
| 45 | Q:'OCXP ""
|
|---|
| 46 | I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
|
|---|
| 47 | E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
|
|---|
| 48 | Q:'OCXI ""
|
|---|
| 49 | S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) S:'OCXP1 OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",PARM,0))
|
|---|
| 50 | Q:'$L(OCXP1) ""
|
|---|
| 51 | Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
|
|---|
| 52 | ;
|
|---|
