| 1 | ORY27 ;SLC/MKB-Postinit for OR*3*27 ;5/11/98 08:28
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997
|
---|
| 3 | ;
|
---|
| 4 | PRE ; -- preinstall
|
---|
| 5 | N DA,DR,DIE
|
---|
| 6 | S DA=$O(^ORD(101,"B","ORC VERIFY ORELSE MENU",0)) Q:DA'>0
|
---|
| 7 | S DIE="^ORD(101,",DR=".01///ORC VERIFY MENU" D ^DIE
|
---|
| 8 | Q
|
---|
| 9 | ;
|
---|
| 10 | POST ; -- postinstall
|
---|
| 11 | D VER,COMP,ORDTAB ; << update protocol menus
|
---|
| 12 | D PARAM ; << copy user preferences to new parameter
|
---|
| 13 | I '$D(^OR(100,"AR")) D ; << build AR xref
|
---|
| 14 | . N ZTRTN,ZTIO,ZTDTH,ZTDESC,ZTSK,MSG
|
---|
| 15 | . S ZTRTN="AR^ORY27",ZTIO="",ZTDTH=$H,ZTDESC="Build ^OR(100,AR) xref"
|
---|
| 16 | . D ^%ZTLOAD S MSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started."
|
---|
| 17 | . D MES^XPDUTL(MSG)
|
---|
| 18 | Q
|
---|
| 19 | ;
|
---|
| 20 | VER ; -- Replace Verify action w/menu
|
---|
| 21 | ;
|
---|
| 22 | N ORKEY,ORMENU,OROLD,ORNEW,DA,DR,DIE,X,Y
|
---|
| 23 | S OROLD=+$O(^ORD(101,"B","ORC VERIFY ORDERS",0)) Q:OROLD'>0
|
---|
| 24 | S ORNEW=+$O(^ORD(101,"B","ORC VERIFY MENU",0)) Q:ORNEW'>0
|
---|
| 25 | F ORKEY="ORELSE","OREMAS" D
|
---|
| 26 | . S ORMENU=+$O(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0)) Q:ORMENU<1
|
---|
| 27 | . S DA=$O(^ORD(101,"AD",OROLD,ORMENU,0)) Q:'DA ;already replaced
|
---|
| 28 | . S DA(1)=ORMENU,DR=".01///"_ORNEW,DIE="^ORD(101,"_DA(1)_",10,"
|
---|
| 29 | . D ^DIE
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | COMP ; -- Add Complete action
|
---|
| 33 | ;
|
---|
| 34 | N ORKEY,ORMENU,ORCOMP,DA,DIC,X,Y
|
---|
| 35 | S ORCOMP=+$O(^ORD(101,"B","ORC COMPLETE ORDERS",0)) Q:ORCOMP'>0
|
---|
| 36 | F ORKEY="ORES","OREMAS" D
|
---|
| 37 | . S ORMENU=+$O(^ORD(101,"B","ORC "_ORKEY_" ORDER ACTIONS",0)) Q:ORMENU<1
|
---|
| 38 | . Q:$O(^ORD(101,"AD",ORCOMP,ORMENU,0)) ;already added
|
---|
| 39 | . S DIC="^ORD(101,"_ORMENU_",10,",DIC(0)="LX",DA(1)=ORMENU
|
---|
| 40 | . S DIC("P")=$P(^DD(101,10,0),U,2),DIC("DR")="3///53"
|
---|
| 41 | . S X="ORC COMPLETE ORDERS" D ^DIC
|
---|
| 42 | Q
|
---|
| 43 | ;
|
---|
| 44 | ORDTAB ; -- Add RV, screens to Orders Tab menu
|
---|
| 45 | ;
|
---|
| 46 | N ORMENU,ORITM,DA,DR,DIE
|
---|
| 47 | S ORMENU=+$O(^ORD(101,"B","ORCHART ORDERS MENU",0)) Q:ORMENU'>0
|
---|
| 48 | S ORITM=+$O(^ORD(101,"B","ORC NEXT SCREEN",0)) Q:ORITM'>0
|
---|
| 49 | S DA=+$O(^ORD(101,"AD",ORITM,ORMENU,0)) Q:DA'>0 ;already replaced
|
---|
| 50 | S ORITM=+$O(^ORD(101,"B","ORC NEW ORDERS",0)) Q:ORITM'>0
|
---|
| 51 | S DA(1)=ORMENU,DIE="^ORD(101,"_DA(1)_",10,",DR=".01///"_ORITM_";2///RV"
|
---|
| 52 | D ^DIE F ORITM="ORC PATIENT","ORCHART TABS" D
|
---|
| 53 | . S DA=+$O(^ORD(101,"B",ORITM,0)) Q:DA'>0
|
---|
| 54 | . S ^ORD(101,DA,24)="I '$G(DGPMT)" ;unavailable in DGPM MOVEMENT EVENTS
|
---|
| 55 | Q
|
---|
| 56 | ;
|
---|
| 57 | PARAM ; -- Reset user parameter values for ORCH CONTEXT MEDS
|
---|
| 58 | ;
|
---|
| 59 | N ORPARAM,ORI,ORP,ORENT,ORVAL,ORDA,DA,DIK
|
---|
| 60 | S ORPARAM=+$O(^XTV(8989.51,"B","ORCH CONTEXT MEDS",0)) Q:ORPARAM'>0
|
---|
| 61 | F ORI="IN","OUT" D
|
---|
| 62 | . S ORP=+$O(^XTV(8989.51,"B","ORCH CONTEXT "_ORI_"PT MEDS",0)) Q:ORP'>0
|
---|
| 63 | . S ORENT="" F S ORENT=$O(^XTV(8989.5,"AC",ORP,ORENT)) Q:ORENT="" S ORVAL=$G(^(ORENT,1)),ORDA=+$O(^(1,0)) D
|
---|
| 64 | . . I $P(ORENT,";",2)="VA(200,",$L(ORVAL) D EN^XPAR(ORENT,ORPARAM,1,ORVAL)
|
---|
| 65 | . . I ORDA S DA=ORDA,DIK="^XTV(8989.5," D ^DIK
|
---|
| 66 | . S DA=ORP,DIK="^XTV(8989.51," D ^DIK
|
---|
| 67 | 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
|
---|
| 68 | Q
|
---|
| 69 | ;
|
---|
| 70 | AR ; -- Build ^OR(100,"AR") xref
|
---|
| 71 | ;
|
---|
| 72 | Q:$D(^OR(100,"AR")) N ORIFN,ORDA,ORVP,ORRDT
|
---|
| 73 | S ORIFN=0 F S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN'>0 S ORVP=$P($G(^(ORIFN,0)),U,2) I ORVP D
|
---|
| 74 | . 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)=""
|
---|
| 75 | Q
|
---|