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
Q
;
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
Q
;
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
Q
;
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
Q
;
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 Dec 13, 2024@02:41:31 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
