- 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"))
- ;
- 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 ;
