OCXOCMP3 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Rule Element Relation code) ;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN() ;
;
Q:$G(OCXWARN) OCXWARN
S OCXD0=0 F S OCXD0=$O(^TMP("OCXCMP",$J,"RULE",OCXD0)) Q:'OCXD0 D Q:OCXWARN
.S OCXNAM=$P($G(^OCXS(860.2,OCXD0,0)),U,1) Q:'$L(OCXNAM)
.I '$G(OCXAUTO) W:($X>60) ! W "."
.N OCXD1,OCXCODE
.;
.Q:'$O(^OCXS(860.2,OCXD0,"C",0))
.Q:'$O(^OCXS(860.2,OCXD0,"R",0))
.;
.S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"C",OCXD1)) Q:'OCXD1 D Q:OCXWARN
..N X,OCXLAB,DA
..S OCXLAB0=$G(^OCXS(860.2,OCXD0,"C",OCXD1,0))
..S OCXLABE=$G(^OCXS(860.2,OCXD0,"C",OCXD1,"EXP"))
..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
..;
..I '$P(OCXLAB0,U,3) S OCXCODE(OCXD1)=(+$P(OCXLAB0,U,2)),OCXCODE(OCXD1,"LABEL")=X,OCXCODE("B",X)=OCXD1
..I $P(OCXLAB0,U,3) S OCXCODE(OCXD1)=OCXLABE,OCXCODE(OCXD1,"LABEL")=X,OCXCODE("B",X)=OCXD1
.;
.Q:'$D(OCXCODE)
.;
.S OCXWARN=$$GETCODE^OCXOCMPI(OCXD0,.OCXCODE) Q:OCXWARN
.;
.S OCXD1=0 F S OCXD1=$O(^OCXS(860.2,OCXD0,"R",OCXD1)) Q:'OCXD1 D Q:OCXWARN
..;
..N OCXEXP,OCXD2
..S OCXEXP=$G(^OCXS(860.2,OCXD0,"R",OCXD1,"E")) Q:'$L(OCXEXP)
..S OCXWARN=$$PARSE^OCXOCMPB(OCXD0,OCXD1,OCXEXP,.OCXCODE) Q:OCXWARN
..I '$G(OCXAUTO) W:($X>60) ! W "."
;
Q OCXWARN
;
GETPARM(FILE,INST,PARM) ;
Q:'$L(FILE) "" Q:'$L(INST) "" Q:'$L(PARM) ""
N OCXP,OCXP1,OCXI,OCXGL
S OCXGL="^OCXS" S:(FILE=1) OCXGL="^OCXD" S:(FILE=7) OCXGL="^OCXD" S:(FILE=10) OCXGL="^OCXD" S FILE=FILE/10+860
Q:'$D(@OCXGL@(+FILE,0)) ""
I (PARM=+PARM),$D(^OCXS(863.8,PARM,0)) S OCXP=PARM
E S OCXP=$O(^OCXS(863.8,"B",PARM,0))
Q:'OCXP ""
I (INST=+INST),$D(@OCXGL@(FILE,INST,0)) S OCXI=INST
E S OCXI=$O(@OCXGL@(FILE,"B",INST,0))
Q:'OCXI ""
S OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0)) S:'OCXP1 OCXP1=$O(@OCXGL@(FILE,OCXI,"PAR","B",PARM,0))
Q:'$L(OCXP1) ""
Q $G(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOCMP3 2054 printed Nov 22, 2024@17:34:39 Page 2
OCXOCMP3 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Compile Rule Element Relation code) ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN() ;
+1 ;
+2 if $GET(OCXWARN)
QUIT OCXWARN
+3 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^TMP("OCXCMP",$JOB,"RULE",OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+4 SET OCXNAM=$PIECE($GET(^OCXS(860.2,OCXD0,0)),U,1)
if '$LENGTH(OCXNAM)
QUIT
+5 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
+6 NEW OCXD1,OCXCODE
+7 ;
+8 if '$ORDER(^OCXS(860.2,OCXD0,"C",0))
QUIT
+9 if '$ORDER(^OCXS(860.2,OCXD0,"R",0))
QUIT
+10 ;
+11 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^OCXS(860.2,OCXD0,"C",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+12 NEW X,OCXLAB,DA
+13 SET OCXLAB0=$GET(^OCXS(860.2,OCXD0,"C",OCXD1,0))
+14 SET OCXLABE=$GET(^OCXS(860.2,OCXD0,"C",OCXD1,"EXP"))
+15 SET X=$PIECE(OCXLAB0,U,1)
if '$LENGTH(X)
QUIT
SET DA=OCXD1
SET DA(1)=OCXD0
DO LABEL^OCXOCMPS
IF '$DATA(X)
SET OCXWARN=1
QUIT
+16 ;
+17 IF '$PIECE(OCXLAB0,U,3)
SET OCXCODE(OCXD1)=(+$PIECE(OCXLAB0,U,2))
SET OCXCODE(OCXD1,"LABEL")=X
SET OCXCODE("B",X)=OCXD1
+18 IF $PIECE(OCXLAB0,U,3)
SET OCXCODE(OCXD1)=OCXLABE
SET OCXCODE(OCXD1,"LABEL")=X
SET OCXCODE("B",X)=OCXD1
End DoDot:2
if OCXWARN
QUIT
+19 ;
+20 if '$DATA(OCXCODE)
QUIT
+21 ;
+22 SET OCXWARN=$$GETCODE^OCXOCMPI(OCXD0,.OCXCODE)
if OCXWARN
QUIT
+23 ;
+24 SET OCXD1=0
FOR
SET OCXD1=$ORDER(^OCXS(860.2,OCXD0,"R",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+25 ;
+26 NEW OCXEXP,OCXD2
+27 SET OCXEXP=$GET(^OCXS(860.2,OCXD0,"R",OCXD1,"E"))
if '$LENGTH(OCXEXP)
QUIT
+28 SET OCXWARN=$$PARSE^OCXOCMPB(OCXD0,OCXD1,OCXEXP,.OCXCODE)
if OCXWARN
QUIT
+29 IF '$GET(OCXAUTO)
if ($X>60)
WRITE !
WRITE "."
End DoDot:2
if OCXWARN
QUIT
End DoDot:1
if OCXWARN
QUIT
+30 ;
+31 QUIT OCXWARN
+32 ;
GETPARM(FILE,INST,PARM) ;
+1 if '$LENGTH(FILE)
QUIT ""
if '$LENGTH(INST)
QUIT ""
if '$LENGTH(PARM)
QUIT ""
+2 NEW OCXP,OCXP1,OCXI,OCXGL
+3 SET OCXGL="^OCXS"
if (FILE=1)
SET OCXGL="^OCXD"
if (FILE=7)
SET OCXGL="^OCXD"
if (FILE=10)
SET OCXGL="^OCXD"
SET FILE=FILE/10+860
+4 if '$DATA(@OCXGL@(+FILE,0))
QUIT ""
+5 IF (PARM=+PARM)
IF $DATA(^OCXS(863.8,PARM,0))
SET OCXP=PARM
+6 IF '$TEST
SET OCXP=$ORDER(^OCXS(863.8,"B",PARM,0))
+7 if 'OCXP
QUIT ""
+8 IF (INST=+INST)
IF $DATA(@OCXGL@(FILE,INST,0))
SET OCXI=INST
+9 IF '$TEST
SET OCXI=$ORDER(@OCXGL@(FILE,"B",INST,0))
+10 if 'OCXI
QUIT ""
+11 SET OCXP1=$ORDER(@OCXGL@(FILE,OCXI,"PAR","B",OCXP,0))
if 'OCXP1
SET OCXP1=$ORDER(@OCXGL@(FILE,OCXI,"PAR","B",PARM,0))
+12 if '$LENGTH(OCXP1)
QUIT ""
+13 QUIT $GET(@OCXGL@(FILE,OCXI,"PAR",OCXP1,"VAL"))
+14 ;
