[613] | 1 | OCXOSCR2 ;SLC/RJS,CLA - Post selection action for the Order Check Element File;10/29/98 12:37
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,74**;Dec 17,1997
|
---|
| 3 | ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
|
---|
| 4 | ;
|
---|
| 5 | I $G(OCXSCR) K OCXSCR Q
|
---|
| 6 | ;
|
---|
| 7 | Q
|
---|
| 8 | ;
|
---|
| 9 | S N OCXD0,OCXD1,OCXREC,OCXDISP,OCXNAM,OCXABBR,OCXELE,OCXHDR
|
---|
| 10 | ;
|
---|
| 11 | W ! D WAIT^DICD W ! S OCXHDR="This Element is used by: "
|
---|
| 12 | I $D(^OCXS(860.3,+Y)) M OCXELE=^OCXS(860.3,+Y)
|
---|
| 13 | E Q
|
---|
| 14 | ;
|
---|
| 15 | W ! S OCXD0=0 F S OCXD0=$O(^OCXS(860.2,OCXD0)) Q:'OCXD0 D
|
---|
| 16 | .K OCXREC M OCXREC=^OCXS(860.2,OCXD0)
|
---|
| 17 | .K OCXDISP S OCXDISP(1)="** Rule: "_$P(OCXREC(0),U,1)
|
---|
| 18 | .S OCXD1=0 F S OCXD1=$O(OCXREC("C",OCXD1)) Q:'OCXD1 D
|
---|
| 19 | ..S OCXDISP(2)=" Condition: "_$P(OCXREC("C",OCXD1,0),U,1)
|
---|
| 20 | ..I ($P(OCXREC("C",OCXD1,0),U,2)=+Y) D DISPLAY
|
---|
| 21 | W !
|
---|
| 22 | ;
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | SELECT ;
|
---|
| 26 | ;
|
---|
| 27 | N DIC,X,Y
|
---|
| 28 | ;
|
---|
| 29 | F S DIC=860.3,DIC(0)="AEMQN" D ^DIC Q:(Y<1) I (Y>0) D S
|
---|
| 30 | ;
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | DISPLAY ;
|
---|
| 34 | ;
|
---|
| 35 | N OCXX
|
---|
| 36 | W !
|
---|
| 37 | I $L(OCXHDR) W !,OCXHDR,! S OCXHDR=""
|
---|
| 38 | S OCXX=0 F S OCXX=$O(OCXDISP(OCXX)) Q:'OCXX W OCXDISP(OCXX)
|
---|
| 39 | Q
|
---|
| 40 | ;
|
---|