Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORY27

ORY27.m

Go to the documentation of this file. 
  1. ORY27 ;SLC/MKB-Postinit for OR*3*27 ;5/11/98  08:28
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997
  1.  ;
  1. PRE ; -- preinstall
  1.  N DA,DR,DIE
  1.  S DA=$O(^ORD(101,"B","ORC VERIFY ORELSE MENU",0)) Q:DA'>0
  1.  S DIE="^ORD(101,",DR=".01///ORC VERIFY MENU" D ^DIE
  1.  Q
  1.  ;
  1. POST ; -- postinstall
  1.  D VER,COMP,ORDTAB ;       << update protocol menus
  1.  D PARAM ;                 << copy user preferences to new parameter
  1.  I '$D(^OR(100,"AR")) D  ; << build AR xref
  1.  . N ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK,MSG
  1.  . S ZTRTN="AR^ORY27",ZTIO="",ZTDTH=$H,ZTDESC="Build ^OR(100,AR) xref"
  1.  . D ^%ZTLOAD S MSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started."
  1.  . D MES^XPDUTL(MSG)
  1.  Q
  1.  ;
  1. VER ; -- Replace Verify action w/menu
  1.  ;
  1.  N ORKEY,ORMENU,OROLD,ORNEW,DA,DR,DIE,X,Y
  1.  S OROLD=+$O(^ORD(101,"B","ORC VERIFY ORDERS",0)) Q:OROLD'>0
  1.  S ORNEW=+$O(^ORD(101,"B","ORC VERIFY MENU",0)) Q:ORNEW'>0
  1.  F ORKEY="ORELSE","OREMAS" D
  1.  . S ORMENU=+$O(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0)) Q:ORMENU<1
  1.  . S DA=$O(^ORD(101,"AD",OROLD,ORMENU,0)) Q:'DA  ;already replaced
  1.  . S DA(1)=ORMENU,DR=".01///"_ORNEW,DIE="^ORD(101,"_DA(1)_",10,"
  1.  . D ^DIE
  1.  Q
  1.  ;
  1. COMP ; -- Add Complete action
  1.  ;
  1.  N ORKEY,ORMENU,ORCOMP,DA,DIC,X,Y
  1.  S ORCOMP=+$O(^ORD(101,"B","ORC COMPLETE ORDERS",0)) Q:ORCOMP'>0
  1.  F ORKEY="ORES","OREMAS" D
  1.  . S ORMENU=+$O(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0)) Q:ORMENU<1
  1.  . Q:$O(^ORD(101,"AD",ORCOMP,ORMENU,0))  ;already added
  1.  . S DIC="^ORD(101,"_ORMENU_",10,",DIC(0)="LX",DA(1)=ORMENU
  1.  . S DIC("P")=$P(^DD(101,10,0),U,2),DIC("DR")="3///53"
  1.  . S X="ORC COMPLETE ORDERS" D ^DIC
  1.  Q
  1.  ;
  1. ORDTAB ; -- Add RV, screens to Orders Tab menu
  1.  ;
  1.  N ORMENU,ORITM,DA,DR,DIE
  1.  S ORMENU=+$O(^ORD(101,"B","ORCHART ORDERS MENU",0)) Q:ORMENU'>0
  1.  S ORITM=+$O(^ORD(101,"B","ORC NEXT SCREEN",0)) Q:ORITM'>0
  1.  S DA=+$O(^ORD(101,"AD",ORITM,ORMENU,0)) Q:DA'>0  ;already replaced
  1.  S ORITM=+$O(^ORD(101,"B","ORC NEW ORDERS",0)) Q:ORITM'>0
  1.  S DA(1)=ORMENU,DIE="^ORD(101,"_DA(1)_",10,",DR=".01///"_ORITM_";2///RV"
  1.  D ^DIE F ORITM="ORC PATIENT","ORCHART TABS" D
  1.  . S DA=+$O(^ORD(101,"B",ORITM,0)) Q:DA'>0
  1.  . S ^ORD(101,DA,24)="I '$G(DGPMT)" ;unavailable in DGPM MOVEMENT EVENTS
  1.  Q
  1.  ;
  1. PARAM ; -- Reset user parameter values for ORCH CONTEXT MEDS
  1.  ;
  1.  N ORPARAM,ORI,ORP,ORENT,ORVAL,ORDA,DA,DIK
  1.  S ORPARAM=+$O(^XTV(8989.51,"B","ORCH CONTEXT MEDS",0)) Q:ORPARAM'>0
  1.  F ORI="IN","OUT" D
  1.  . S ORP=+$O(^XTV(8989.51,"B","ORCH CONTEXT "_ORI_"PT MEDS",0)) Q:ORP'>0
  1.  . S ORENT="" F  S ORENT=$O(^XTV(8989.5,"AC",ORP,ORENT)) Q:ORENT=""  S ORVAL=$G(^(ORENT,1)),ORDA=+$O(^(1,0)) D
  1.  . . I $P(ORENT,";",2)="VA(200,",$L(ORVAL) D EN^XPAR(ORENT,ORPARAM,1,ORVAL)
  1.  . . I ORDA S DA=ORDA,DIK="^XTV(8989.5," D ^DIK
  1.  . S DA=ORP,DIK="^XTV(8989.51," D ^DIK
  1.  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
  1.  Q
  1.  ;
  1. AR ; -- Build ^OR(100,"AR") xref
  1.  ;
  1.  Q:$D(^OR(100,"AR"))  N ORIFN,ORDA,ORVP,ORRDT
  1.  S ORIFN=0 F  S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN'>0  S ORVP=$P($G(^(ORIFN,0)),U,2) I ORVP D
  1.  . 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)=""
  1.  Q