source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY27.m@ 814

Last change on this file since 814 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1ORY27 ;SLC/MKB-Postinit for OR*3*27 ;5/11/98 08:28
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27**;Dec 17, 1997
3 ;
4PRE ; -- 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 ;
10POST ; -- 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 ;
20VER ; -- 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 ;
32COMP ; -- 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 ;
44ORDTAB ; -- 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 ;
57PARAM ; -- 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 ;
70AR ; -- 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
Note: See TracBrowser for help on using the repository browser.