Routine: ORY36

ORY36 ;SLC/MKB-Postinit for patch OR*3*36 ;10/9/98  15:10

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**36**;Dec 17, 1997

EN ; -- start here

 D LOC,EXP,NOTIF

LOC ; -- Add ORC NEW LOCATION to ORC HIDDEN ACTIONS

 N XQORM,ORBLANK,ORLOC,DA,DR,DIE,X,Y,ORSL

 S ORBLANK=+$O(^ORD(101,"B","ORB BLANK LINE4",0)) Q:ORBLANK'>0

 S ORLOC=+$O(^ORD(101,"B","ORC NEW LOCATION",0)) Q:ORLOC'>0

 S XQORM=+$O(^ORD(101,"B","ORC HIDDEN ACTIONS",0)) Q:XQORM'>0

 S DA=$O(^ORD(101,"AD",ORBLANK,XQORM,0)) Q:DA'>0  ;already replaced

 S DR=".01////"_ORLOC_";2///LOC;3///36;5///@;6///Change Ordering Info"

 S DA(1)=XQORM,DIE="^ORD(101,"_DA(1)_",10," D ^DIE

 S ORSL=+$O(^ORD(101,"B","ORC SEARCH LIST",0)) Q:ORSL'>0

 S DA=$O(^ORD(101,"AD",ORSL,XQORM,0)) Q:DA'>0

 S DA(1)=XQORM,DR="3///28" D ^DIE ;switch seq#

 S XQORM=XQORM_";ORD(101," D XREF^XQORM ;rebuild ^XUTL

EXP ; -- Add Edit action to Expiring Orders menu

 N ORMENU,X,Y,DIC,DA

 S ORMENU=+$O(^ORD(101,"B","ORCB EXPIRING MENU",0)) Q:ORMENU'>0

 S X=+$O(^ORD(101,"B","ORC CHANGE ORDERS",0)) Q:X'>0

 Q:$O(^ORD(101,"AD",X,ORMENU,0))  ;already added

 S DIC="^ORD(101,"_ORMENU_",10,",DIC(0)="LX",DA(1)=ORMENU

 S DIC("P")=$P(^DD(101,10,0),U,2),DIC("DR")="3///22"

 S X="ORC CHANGE ORDERS" D ^DIC

NOTIF ; -- Add Remove Alert action to follow-up menu

 N ORMENU,X,Y,DIC,DIE,DA,DR,ORI,ITM

 S ORMENU=+$O(^ORD(101,"B","ORCB NOTIFICATIONS",0)) Q:ORMENU'>0

 S X=+$O(^ORD(101,"B","ORCB DELETE ALERT",0)) Q:X'>0

 Q:$O(^ORD(101,"AD",X,ORMENU,0))  ;already done

 S DIE="^ORD(101,",DA=ORMENU,DR="41///40" D ^DIE K DA,DR,DIE

 S DIC="^ORD(101,"_ORMENU_",10,",DIC(0)="LX",DA(1)=ORMENU

 S DIC("P")=$P(^DD(101,10,0),U,2),DIC("DR")="2///RM;3///21"

 S X="ORCB DELETE ALERT" D ^DIC

 ; -- resequence menu items

 S DIE=DIC F ORI=1:1 S X=$T(ITEMS+ORI) Q:X["ZZZZZ"  D

 . S ITM=+$O(^ORD(101,"B",$P(X,";",3),0)),DA=+$O(^ORD(101,ORMENU,10,"B",ITM,0)) Q:DA'>0

 . S DR="3///"_$P(X,";",4) D ^DIE

ITEMS ;;NAME;SEQ#

 ;;ORC PREVIOUS SCREEN;12

 ;;ORB BLANK LINE1;13

 ;;VALM QUIT;22

 ;;ORB BLANK LINE2;23

 ;;ZZZZZ

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY36   2077     printed  Mar 13, 2025@21:46:29                                                                                                                                                                                                       Page 2

ORY36     ;SLC/MKB-Postinit for patch OR*3*36 ;10/9/98  15:10

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**36**;Dec 17, 1997

 +2       ;

EN        ; -- start here

 +1        DO LOC

           DO EXP

           DO NOTIF

 +2        QUIT

 +3       ;

LOC       ; -- Add ORC NEW LOCATION to ORC HIDDEN ACTIONS

 +1       ;

 +2        NEW XQORM,ORBLANK,ORLOC,DA,DR,DIE,X,Y,ORSL

 +3        SET ORBLANK=+$ORDER(^ORD(101,"B","ORB BLANK LINE4",0))

           if ORBLANK'>0

               QUIT

 +4        SET ORLOC=+$ORDER(^ORD(101,"B","ORC NEW LOCATION",0))

           if ORLOC'>0

               QUIT

 +5        SET XQORM=+$ORDER(^ORD(101,"B","ORC HIDDEN ACTIONS",0))

           if XQORM'>0

               QUIT

 +6       ;already replaced

           SET DA=$ORDER(^ORD(101,"AD",ORBLANK,XQORM,0))

           if DA'>0

               QUIT

 +7        SET DR=".01////"_ORLOC_";2///LOC;3///36;5///@;6///Change Ordering Info"

 +8        SET DA(1)=XQORM

           SET DIE="^ORD(101,"_DA(1)_",10,"

           DO ^DIE

 +9        SET ORSL=+$ORDER(^ORD(101,"B","ORC SEARCH LIST",0))

           if ORSL'>0

               QUIT

 +10       SET DA=$ORDER(^ORD(101,"AD",ORSL,XQORM,0))

           if DA'>0

               QUIT

 +11      ;switch seq#

           SET DA(1)=XQORM

           SET DR="3///28"

           DO ^DIE

 +12      ;rebuild ^XUTL

           SET XQORM=XQORM_";ORD(101,"

           DO XREF^XQORM

 +13       QUIT

 +14      ;

EXP       ; -- Add Edit action to Expiring Orders menu

 +1       ;

 +2        NEW ORMENU,X,Y,DIC,DA

 +3        SET ORMENU=+$ORDER(^ORD(101,"B","ORCB EXPIRING MENU",0))

           if ORMENU'>0

               QUIT

 +4        SET X=+$ORDER(^ORD(101,"B","ORC CHANGE ORDERS",0))

           if X'>0

               QUIT

 +5       ;already added

           if $ORDER(^ORD(101,"AD",X,ORMENU,0))

               QUIT

 +6        SET DIC="^ORD(101,"_ORMENU_",10,"

           SET DIC(0)="LX"

           SET DA(1)=ORMENU

 +7        SET DIC("P")=$PIECE(^DD(101,10,0),U,2)

           SET DIC("DR")="3///22"

 +8        SET X="ORC CHANGE ORDERS"

           DO ^DIC

 +9        QUIT

 +10      ;

NOTIF     ; -- Add Remove Alert action to follow-up menu

 +1       ;

 +2        NEW ORMENU,X,Y,DIC,DIE,DA,DR,ORI,ITM

 +3        SET ORMENU=+$ORDER(^ORD(101,"B","ORCB NOTIFICATIONS",0))

           if ORMENU'>0

               QUIT

 +4        SET X=+$ORDER(^ORD(101,"B","ORCB DELETE ALERT",0))

           if X'>0

               QUIT

 +5       ;already done

           if $ORDER(^ORD(101,"AD",X,ORMENU,0))

               QUIT

 +6        SET DIE="^ORD(101,"

           SET DA=ORMENU

           SET DR="41///40"

           DO ^DIE

           KILL DA,DR,DIE

 +7        SET DIC="^ORD(101,"_ORMENU_",10,"

           SET DIC(0)="LX"

           SET DA(1)=ORMENU

 +8        SET DIC("P")=$PIECE(^DD(101,10,0),U,2)

           SET DIC("DR")="2///RM;3///21"

 +9        SET X="ORCB DELETE ALERT"

           DO ^DIC

 +10      ; -- resequence menu items

 +11       SET DIE=DIC

           FOR ORI=1:1

               SET X=$TEXT(ITEMS+ORI)

               if X["ZZZZZ"

                   QUIT

               Begin DoDot:1

 +12               SET ITM=+$ORDER(^ORD(101,"B",$PIECE(X,";",3),0))

                   SET DA=+$ORDER(^ORD(101,ORMENU,10,"B",ITM,0))

                   if DA'>0

                       QUIT

 +13               SET DR="3///"_$PIECE(X,";",4)

                   DO ^DIE

               End DoDot:1

 +14       QUIT

 +15      ;

ITEMS     ;;NAME;SEQ#

 +1       ;;ORC PREVIOUS SCREEN;12

 +2       ;;ORB BLANK LINE1;13

 +3       ;;VALM QUIT;22

 +4       ;;ORB BLANK LINE2;23

 +5       ;;ZZZZZ

ORY36.m