OCXOSCR1 ;SLC/RJS,CLA - Post selection action for the Order Check DataField File;6/19/01 16:35
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
I $G(OCXSCR) K OCXSCR Q
;
Q
;
S ;
;
N OCXD0,OCXD1,OCXREC,OCXDISP,OCXNAM,OCXABBR,OCXDF,OCXHDR
;
W ! D WAIT^DICD W ! S OCXHDR="This Datafield is used by: "
I $D(^OCXS(860.4,+Y)) M OCXDF=^OCXS(860.4,+Y)
E Q
;
S OCXD0=0 F S OCXD0=$O(^OCXS(860.3,OCXD0)) Q:'OCXD0 D
.K OCXREC M OCXREC=^OCXS(860.3,OCXD0)
.K OCXDISP S OCXDISP(1)="** Element: "_$P(OCXREC(0),U,1)
.S OCXD1=0 F S OCXD1=$O(OCXREC("COND",OCXD1)) Q:'OCXD1 D
..S OCXDISP(2)=" Expression Number: "_+OCXREC("COND",OCXD1,0)
..I ($G(OCXREC("COND",OCXD1,"DFLD1"))=+Y) S OCXDISP(2)=" Primary Data Field 2" D DISPLAY
..I ($G(OCXREC("COND",OCXD1,"DFLD2"))=+Y) S OCXDISP(2)=" Data Field 2" D DISPLAY
..I ($G(OCXREC("COND",OCXD1,"DFLD3"))=+Y) S OCXDISP(2)=" Data Field 3" D DISPLAY
;
S OCXNAME=$P($G(OCXDF(0)),U,1),OCXABBR=$P($G(OCXDF(1)),U,1)
;
W ! S OCXD0=0 F S OCXD0=$O(^OCXS(860.2,OCXD0)) Q:'OCXD0 D
.K OCXREC M OCXREC=^OCXS(860.2,OCXD0)
.K OCXDISP S OCXDISP(1)="** Rule: "_$P(OCXREC(0),U,1)
.S OCXD1=0 F S OCXD1=$O(OCXREC("C",OCXD1)) Q:'OCXD1 D
..S OCXDISP(2)=" Condition: "_$P(OCXREC("C",OCXD1,0),U,1)
..S OCXVAL=$G(OCXREC("C",OCXD1,"EXP"))
..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
.S OCXD1=0 F S OCXD1=$O(OCXREC("R",OCXD1)) Q:'OCXD1 D
..S OCXDISP(2)=" Relation Index: "_$P(OCXREC("R",OCXD1,0),U,1)
..;
..S OCXVAL=$G(OCXREC("R",OCXD1,"E"))
..S OCXDISP(2)=" Expression field"
..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
..;
..S OCXVAL=$G(OCXREC("R",OCXD1,"MSG"))
..S OCXDISP(2)=" Notification Message field"
..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
..;
..S OCXVAL=$G(OCXREC("R",OCXD1,"OCMSG"))
..S OCXDISP(2)=" Order Check Message field"
..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
..;
..S OCXVAL=$G(OCXREC("R",OCXD1,"MCODE"))
..S OCXDISP(2)=" Execute code field"
..I $L(OCXVAL),(OCXVAL[("|"_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("|"_OCXABBR_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXNAME_"|")) D DISPLAY
..I $L(OCXVAL),(OCXVAL[("."_OCXABBR_"|")) D DISPLAY
W !
;
SELECT ;
;
N DIC,X,Y
;
F S DIC=860.4,DIC(0)="AEMQN" D ^DIC Q:(Y<1) I (Y>0) D S
;
Q
;
DISPLAY ;
;
N OCXX
W !
I $L(OCXHDR) W !,OCXHDR,! S OCXHDR=""
S OCXX=0 F S OCXX=$O(OCXDISP(OCXX)) Q:'OCXX W OCXDISP(OCXX)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOSCR1 3206 printed Oct 16, 2024@18:26:20 Page 2
OCXOSCR1 ;SLC/RJS,CLA - Post selection action for the Order Check DataField File;6/19/01 16:35
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 IF $GET(OCXSCR)
KILL OCXSCR
QUIT
+5 ;
+6 QUIT
+7 ;
S ;
+1 ;
+2 NEW OCXD0,OCXD1,OCXREC,OCXDISP,OCXNAM,OCXABBR,OCXDF,OCXHDR
+3 ;
+4 WRITE !
DO WAIT^DICD
WRITE !
SET OCXHDR="This Datafield is used by: "
+5 IF $DATA(^OCXS(860.4,+Y))
MERGE OCXDF=^OCXS(860.4,+Y)
+6 IF '$TEST
QUIT
+7 ;
+8 SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXS(860.3,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+9 KILL OCXREC
MERGE OCXREC=^OCXS(860.3,OCXD0)
+10 KILL OCXDISP
SET OCXDISP(1)="** Element: "_$PIECE(OCXREC(0),U,1)
+11 SET OCXD1=0
FOR
SET OCXD1=$ORDER(OCXREC("COND",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+12 SET OCXDISP(2)=" Expression Number: "_+OCXREC("COND",OCXD1,0)
+13 IF ($GET(OCXREC("COND",OCXD1,"DFLD1"))=+Y)
SET OCXDISP(2)=" Primary Data Field 2"
DO DISPLAY
+14 IF ($GET(OCXREC("COND",OCXD1,"DFLD2"))=+Y)
SET OCXDISP(2)=" Data Field 2"
DO DISPLAY
+15 IF ($GET(OCXREC("COND",OCXD1,"DFLD3"))=+Y)
SET OCXDISP(2)=" Data Field 3"
DO DISPLAY
End DoDot:2
End DoDot:1
+16 ;
+17 SET OCXNAME=$PIECE($GET(OCXDF(0)),U,1)
SET OCXABBR=$PIECE($GET(OCXDF(1)),U,1)
+18 ;
+19 WRITE !
SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXS(860.2,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+20 KILL OCXREC
MERGE OCXREC=^OCXS(860.2,OCXD0)
+21 KILL OCXDISP
SET OCXDISP(1)="** Rule: "_$PIECE(OCXREC(0),U,1)
+22 SET OCXD1=0
FOR
SET OCXD1=$ORDER(OCXREC("C",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+23 SET OCXDISP(2)=" Condition: "_$PIECE(OCXREC("C",OCXD1,0),U,1)
+24 SET OCXVAL=$GET(OCXREC("C",OCXD1,"EXP"))
+25 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXNAME_"|"))
DO DISPLAY
+26 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXABBR_"|"))
DO DISPLAY
+27 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXNAME_"|"))
DO DISPLAY
+28 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXABBR_"|"))
DO DISPLAY
End DoDot:2
+29 SET OCXD1=0
FOR
SET OCXD1=$ORDER(OCXREC("R",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+30 SET OCXDISP(2)=" Relation Index: "_$PIECE(OCXREC("R",OCXD1,0),U,1)
+31 ;
+32 SET OCXVAL=$GET(OCXREC("R",OCXD1,"E"))
+33 SET OCXDISP(2)=" Expression field"
+34 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXNAME_"|"))
DO DISPLAY
+35 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXABBR_"|"))
DO DISPLAY
+36 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXNAME_"|"))
DO DISPLAY
+37 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXABBR_"|"))
DO DISPLAY
+38 ;
+39 SET OCXVAL=$GET(OCXREC("R",OCXD1,"MSG"))
+40 SET OCXDISP(2)=" Notification Message field"
+41 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXNAME_"|"))
DO DISPLAY
+42 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXABBR_"|"))
DO DISPLAY
+43 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXNAME_"|"))
DO DISPLAY
+44 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXABBR_"|"))
DO DISPLAY
+45 ;
+46 SET OCXVAL=$GET(OCXREC("R",OCXD1,"OCMSG"))
+47 SET OCXDISP(2)=" Order Check Message field"
+48 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXNAME_"|"))
DO DISPLAY
+49 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXABBR_"|"))
DO DISPLAY
+50 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXNAME_"|"))
DO DISPLAY
+51 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXABBR_"|"))
DO DISPLAY
+52 ;
+53 SET OCXVAL=$GET(OCXREC("R",OCXD1,"MCODE"))
+54 SET OCXDISP(2)=" Execute code field"
+55 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXNAME_"|"))
DO DISPLAY
+56 IF $LENGTH(OCXVAL)
IF (OCXVAL[("|"_OCXABBR_"|"))
DO DISPLAY
+57 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXNAME_"|"))
DO DISPLAY
+58 IF $LENGTH(OCXVAL)
IF (OCXVAL[("."_OCXABBR_"|"))
DO DISPLAY
End DoDot:2
End DoDot:1
+59 WRITE !
+60 ;
SELECT ;
+1 ;
+2 NEW DIC,X,Y
+3 ;
+4 FOR
SET DIC=860.4
SET DIC(0)="AEMQN"
DO ^DIC
if (Y<1)
QUIT
IF (Y>0)
DO S
+5 ;
+6 QUIT
+7 ;
DISPLAY ;
+1 ;
+2 NEW OCXX
+3 WRITE !
+4 IF $LENGTH(OCXHDR)
WRITE !,OCXHDR,!
SET OCXHDR=""
+5 SET OCXX=0
FOR
SET OCXX=$ORDER(OCXDISP(OCXX))
if 'OCXX
QUIT
WRITE OCXDISP(OCXX)
+6 QUIT
+7 ;
