OCXOSCR2.m

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 ---OCXOSCR2   1032     printed  Feb 18, 2025@23:52:18                                                                                                                                                                                                    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       ;