ORY27 ;SLC/MKB-Postinit for OR*3*27 ;5/11/98 08:28
;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997
;
PRE ; -- preinstall
N DA,DR,DIE
S DA=$O(^ORD(101,"B","ORC VERIFY ORELSE MENU",0)) Q:DA'>0
S DIE="^ORD(101,",DR=".01///ORC VERIFY MENU" D ^DIE
Q
;
POST ; -- postinstall
D VER,COMP,ORDTAB ; << update protocol menus
D PARAM ; << copy user preferences to new parameter
I '$D(^OR(100,"AR")) D ; << build AR xref
. N ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK,MSG
. S ZTRTN="AR^ORY27",ZTIO="",ZTDTH=$H,ZTDESC="Build ^OR(100,AR) xref"
. D ^%ZTLOAD S MSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started."
. D MES^XPDUTL(MSG)
Q
;
VER ; -- Replace Verify action w/menu
;
N ORKEY,ORMENU,OROLD,ORNEW,DA,DR,DIE,X,Y
S OROLD=+$O(^ORD(101,"B","ORC VERIFY ORDERS",0)) Q:OROLD'>0
S ORNEW=+$O(^ORD(101,"B","ORC VERIFY MENU",0)) Q:ORNEW'>0
F ORKEY="ORELSE","OREMAS" D
. S ORMENU=+$O(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0)) Q:ORMENU<1
. S DA=$O(^ORD(101,"AD",OROLD,ORMENU,0)) Q:'DA ;already replaced
. S DA(1)=ORMENU,DR=".01///"_ORNEW,DIE="^ORD(101,"_DA(1)_",10,"
. D ^DIE
Q
;
COMP ; -- Add Complete action
;
N ORKEY,ORMENU,ORCOMP,DA,DIC,X,Y
S ORCOMP=+$O(^ORD(101,"B","ORC COMPLETE ORDERS",0)) Q:ORCOMP'>0
F ORKEY="ORES","OREMAS" D
. S ORMENU=+$O(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0)) Q:ORMENU<1
. Q:$O(^ORD(101,"AD",ORCOMP,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///53"
. S X="ORC COMPLETE ORDERS" D ^DIC
Q
;
ORDTAB ; -- Add RV, screens to Orders Tab menu
;
N ORMENU,ORITM,DA,DR,DIE
S ORMENU=+$O(^ORD(101,"B","ORCHART ORDERS MENU",0)) Q:ORMENU'>0
S ORITM=+$O(^ORD(101,"B","ORC NEXT SCREEN",0)) Q:ORITM'>0
S DA=+$O(^ORD(101,"AD",ORITM,ORMENU,0)) Q:DA'>0 ;already replaced
S ORITM=+$O(^ORD(101,"B","ORC NEW ORDERS",0)) Q:ORITM'>0
S DA(1)=ORMENU,DIE="^ORD(101,"_DA(1)_",10,",DR=".01///"_ORITM_";2///RV"
D ^DIE F ORITM="ORC PATIENT","ORCHART TABS" D
. S DA=+$O(^ORD(101,"B",ORITM,0)) Q:DA'>0
. S ^ORD(101,DA,24)="I '$G(DGPMT)" ;unavailable in DGPM MOVEMENT EVENTS
Q
;
PARAM ; -- Reset user parameter values for ORCH CONTEXT MEDS
;
N ORPARAM,ORI,ORP,ORENT,ORVAL,ORDA,DA,DIK
S ORPARAM=+$O(^XTV(8989.51,"B","ORCH CONTEXT MEDS",0)) Q:ORPARAM'>0
F ORI="IN","OUT" D
. S ORP=+$O(^XTV(8989.51,"B","ORCH CONTEXT "_ORI_"PT MEDS",0)) Q:ORP'>0
. S ORENT="" F S ORENT=$O(^XTV(8989.5,"AC",ORP,ORENT)) Q:ORENT="" S ORVAL=$G(^(ORENT,1)),ORDA=+$O(^(1,0)) D
. . I $P(ORENT,";",2)="VA(200,",$L(ORVAL) D EN^XPAR(ORENT,ORPARAM,1,ORVAL)
. . I ORDA S DA=ORDA,DIK="^XTV(8989.5," D ^DIK
. S DA=ORP,DIK="^XTV(8989.51," D ^DIK
S ORI=$O(^DIC(9.4,"C","OR",0)),ORDA=$O(^XTV(8989.5,"AC",ORPARAM,+ORI_";DIC(9.4,",1,0)) I ORDA S DA=ORDA,DIK="^XTV(8989.5," D ^DIK ;fix V1
Q
;
AR ; -- Build ^OR(100,"AR") xref
;
Q:$D(^OR(100,"AR")) N ORIFN,ORDA,ORVP,ORRDT
S ORIFN=0 F S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN'>0 S ORVP=$P($G(^(ORIFN,0)),U,2) I ORVP D
. S ORDA=0 F S ORDA=$O(^OR(100,ORIFN,8,ORDA)) Q:ORDA'>0 S ORRDT=$P($G(^(ORDA,0)),U,16) I ORRDT S ^OR(100,"AR",ORVP,9999999-ORRDT,ORIFN,ORDA)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY27 3211 printed Dec 13, 2024@02:40:25 Page 2
ORY27 ;SLC/MKB-Postinit for OR*3*27 ;5/11/98 08:28
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997
+2 ;
PRE ; -- preinstall
+1 NEW DA,DR,DIE
+2 SET DA=$ORDER(^ORD(101,"B","ORC VERIFY ORELSE MENU",0))
if DA'>0
QUIT
+3 SET DIE="^ORD(101,"
SET DR=".01///ORC VERIFY MENU"
DO ^DIE
+4 QUIT
+5 ;
POST ; -- postinstall
+1 ; << update protocol menus
DO VER
DO COMP
DO ORDTAB
+2 ; << copy user preferences to new parameter
DO PARAM
+3 ; << build AR xref
IF '$DATA(^OR(100,"AR"))
Begin DoDot:1
+4 NEW ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK,MSG
+5 SET ZTRTN="AR^ORY27"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="Build ^OR(100,AR) xref"
+6 DO ^%ZTLOAD
SET MSG="Task "_$SELECT($GET(ZTSK):"#"_ZTSK,1:"not")_" started."
+7 DO MES^XPDUTL(MSG)
End DoDot:1
+8 QUIT
+9 ;
VER ; -- Replace Verify action w/menu
+1 ;
+2 NEW ORKEY,ORMENU,OROLD,ORNEW,DA,DR,DIE,X,Y
+3 SET OROLD=+$ORDER(^ORD(101,"B","ORC VERIFY ORDERS",0))
if OROLD'>0
QUIT
+4 SET ORNEW=+$ORDER(^ORD(101,"B","ORC VERIFY MENU",0))
if ORNEW'>0
QUIT
+5 FOR ORKEY="ORELSE","OREMAS"
Begin DoDot:1
+6 SET ORMENU=+$ORDER(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0))
if ORMENU<1
QUIT
+7 ;already replaced
SET DA=$ORDER(^ORD(101,"AD",OROLD,ORMENU,0))
if 'DA
QUIT
+8 SET DA(1)=ORMENU
SET DR=".01///"_ORNEW
SET DIE="^ORD(101,"_DA(1)_",10,"
+9 DO ^DIE
End DoDot:1
+10 QUIT
+11 ;
COMP ; -- Add Complete action
+1 ;
+2 NEW ORKEY,ORMENU,ORCOMP,DA,DIC,X,Y
+3 SET ORCOMP=+$ORDER(^ORD(101,"B","ORC COMPLETE ORDERS",0))
if ORCOMP'>0
QUIT
+4 FOR ORKEY="ORES","OREMAS"
Begin DoDot:1
+5 SET ORMENU=+$ORDER(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0))
if ORMENU<1
QUIT
+6 ;already added
if $ORDER(^ORD(101,"AD",ORCOMP,ORMENU,0))
QUIT
+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")="3///53"
+9 SET X="ORC COMPLETE ORDERS"
DO ^DIC
End DoDot:1
+10 QUIT
+11 ;
ORDTAB ; -- Add RV, screens to Orders Tab menu
+1 ;
+2 NEW ORMENU,ORITM,DA,DR,DIE
+3 SET ORMENU=+$ORDER(^ORD(101,"B","ORCHART ORDERS MENU",0))
if ORMENU'>0
QUIT
+4 SET ORITM=+$ORDER(^ORD(101,"B","ORC NEXT SCREEN",0))
if ORITM'>0
QUIT
+5 ;already replaced
SET DA=+$ORDER(^ORD(101,"AD",ORITM,ORMENU,0))
if DA'>0
QUIT
+6 SET ORITM=+$ORDER(^ORD(101,"B","ORC NEW ORDERS",0))
if ORITM'>0
QUIT
+7 SET DA(1)=ORMENU
SET DIE="^ORD(101,"_DA(1)_",10,"
SET DR=".01///"_ORITM_";2///RV"
+8 DO ^DIE
FOR ORITM="ORC PATIENT","ORCHART TABS"
Begin DoDot:1
+9 SET DA=+$ORDER(^ORD(101,"B",ORITM,0))
if DA'>0
QUIT
+10 ;unavailable in DGPM MOVEMENT EVENTS
SET ^ORD(101,DA,24)="I '$G(DGPMT)"
End DoDot:1
+11 QUIT
+12 ;
PARAM ; -- Reset user parameter values for ORCH CONTEXT MEDS
+1 ;
+2 NEW ORPARAM,ORI,ORP,ORENT,ORVAL,ORDA,DA,DIK
+3 SET ORPARAM=+$ORDER(^XTV(8989.51,"B","ORCH CONTEXT MEDS",0))
if ORPARAM'>0
QUIT
+4 FOR ORI="IN","OUT"
Begin DoDot:1
+5 SET ORP=+$ORDER(^XTV(8989.51,"B","ORCH CONTEXT "_ORI_"PT MEDS",0))
if ORP'>0
QUIT
+6 SET ORENT=""
FOR
SET ORENT=$ORDER(^XTV(8989.5,"AC",ORP,ORENT))
if ORENT=""
QUIT
SET ORVAL=$GET(^(ORENT,1))
SET ORDA=+$ORDER(^(1,0))
Begin DoDot:2
+7 IF $PIECE(ORENT,";",2)="VA(200,"
IF $LENGTH(ORVAL)
DO EN^XPAR(ORENT,ORPARAM,1,ORVAL)
+8 IF ORDA
SET DA=ORDA
SET DIK="^XTV(8989.5,"
DO ^DIK
End DoDot:2
+9 SET DA=ORP
SET DIK="^XTV(8989.51,"
DO ^DIK
End DoDot:1
+10 ;fix V1
SET ORI=$ORDER(^DIC(9.4,"C","OR",0))
SET ORDA=$ORDER(^XTV(8989.5,"AC",ORPARAM,+ORI_";DIC(9.4,",1,0))
IF ORDA
SET DA=ORDA
SET DIK="^XTV(8989.5,"
DO ^DIK
+11 QUIT
+12 ;
AR ; -- Build ^OR(100,"AR") xref
+1 ;
+2 if $DATA(^OR(100,"AR"))
QUIT
NEW ORIFN,ORDA,ORVP,ORRDT
+3 SET ORIFN=0
FOR
SET ORIFN=$ORDER(^OR(100,ORIFN))
if ORIFN'>0
QUIT
SET ORVP=$PIECE($GET(^(ORIFN,0)),U,2)
IF ORVP
Begin DoDot:1
+4 SET ORDA=0
FOR
SET ORDA=$ORDER(^OR(100,ORIFN,8,ORDA))
if ORDA'>0
QUIT
SET ORRDT=$PIECE($GET(^(ORDA,0)),U,16)
IF ORRDT
SET ^OR(100,"AR",ORVP,9999999-ORRDT,ORIFN,ORDA)=""
End DoDot:1
+5 QUIT
