OCXOSCR2 ;SLC/RJS,CLA - Post selection action for the Order Check Element File;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74**;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,OCXELE,OCXHDR
;
W ! D WAIT^DICD W ! S OCXHDR="This Element is used by: "
I $D(^OCXS(860.3,+Y)) M OCXELE=^OCXS(860.3,+Y)
E Q
;
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)
..I ($P(OCXREC("C",OCXD1,0),U,2)=+Y) D DISPLAY
W !
;
Q
;
SELECT ;
;
N DIC,X,Y
;
F S DIC=860.3,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[HOCXOSCR2 1032 printed Oct 16, 2024@18:26:21 Page 2
OCXOSCR2 ;SLC/RJS,CLA - Post selection action for the Order Check Element File;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74**;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 NEW OCXD0,OCXD1,OCXREC,OCXDISP,OCXNAM,OCXABBR,OCXELE,OCXHDR
+1 ;
+2 WRITE !
DO WAIT^DICD
WRITE !
SET OCXHDR="This Element is used by: "
+3 IF $DATA(^OCXS(860.3,+Y))
MERGE OCXELE=^OCXS(860.3,+Y)
+4 IF '$TEST
QUIT
+5 ;
+6 WRITE !
SET OCXD0=0
FOR
SET OCXD0=$ORDER(^OCXS(860.2,OCXD0))
if 'OCXD0
QUIT
Begin DoDot:1
+7 KILL OCXREC
MERGE OCXREC=^OCXS(860.2,OCXD0)
+8 KILL OCXDISP
SET OCXDISP(1)="** Rule: "_$PIECE(OCXREC(0),U,1)
+9 SET OCXD1=0
FOR
SET OCXD1=$ORDER(OCXREC("C",OCXD1))
if 'OCXD1
QUIT
Begin DoDot:2
+10 SET OCXDISP(2)=" Condition: "_$PIECE(OCXREC("C",OCXD1,0),U,1)
+11 IF ($PIECE(OCXREC("C",OCXD1,0),U,2)=+Y)
DO DISPLAY
End DoDot:2
End DoDot:1
+12 WRITE !
+13 ;
+14 QUIT
+15 ;
SELECT ;
+1 ;
+2 NEW DIC,X,Y
+3 ;
+4 FOR
SET DIC=860.3
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 ;
