source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCPOST.m@ 841

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

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1ORCPOST ; slc/dcm,MKB - CPRS post-init ;10/25/97 16:13
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3EN ;-- Post-init cleanup
4 D POSTORLP^ORLP3C1,POSTORB^ORB3C1 ; User Parameters, Notifications
5 D BMES^XPDUTL("Cleaning up unused data and fields ...")
6 K ^ORYX("ORERR") S ^ORYX("ORERR",0)="OE/RR ERRORS^100.4D^^"
7 D 22,19,101,P49,200,DGPM,ZIS
8 Q
9 ;
1022 ;Set print 0th node
11 S $P(^ORD(100.22,0),"^",3)=""
12 ;S $P(^ORD(100.23,0),"^",3)=""
13 D RECMPL^ORPR00
14 Q
1519 ;Clean-up old entry & exit actions in Option file
16 N IFN,ENT,EX
17 S IFN=0 F S IFN=$O(^DIC(19,IFN)) Q:IFN<1 S ENT=$G(^(IFN,20)),EX=$G(^(15)) D
18 . I ENT["D TIT^OR",$P(ENT,"D TIT^",2)="OR" S ^DIC(19,IFN,20)=""
19 . I ENT["D EN^OR",$P(ENT,"D EN^",2)="OR" S ^DIC(19,IFN,20)="D ^ORCHART"
20 . I EX="D EXIT^OR" S ^DIC(19,IFN,15)=""
21 Q
22101 ;Clean-up old entry actions in Protocol file
23 N IFN,ENT
24 S IFN=0 F S IFN=$O(^ORD(101,IFN)) Q:IFN<1 S ENT=$G(^(IFN,20)) D
25 . I ENT["^OR3" S ^ORD(101,IFN,20)="" Q
26 Q
27200 ;Clean-up unused data and fields in file 200
28 N DA,DIK,IFN
29 S IFN=0 F S IFN=$O(^VA(200,IFN)) Q:IFN<1 D
30 . I $D(^VA(200,IFN,100.1)) K ^(100.1)
31 . I $D(^VA(200,IFN,100.2)) K ^(100.2)
32 S DIK="^DD(200,",DA=100.21,DA(1)=200 D ^DIK ;Remove Summary Default
33 S DIK="^DD(200,",DA=100.22,DA(1)=200 D ^DIK ;Remove Patient List Order
34 S DIK="^DD(200,",DA=100.23,DA(1)=200 D ^DIK ;Remove Default Result Reporting
35 S DIK="^DD(200,",DA=100.24,DA(1)=200 D ^DIK ;Remove Primary Profile Menu
36 S DIK="^DD(200,",DA=100.25,DA(1)=200 D ^DIK ;Remove Provider List
37 S DIK="^DD(200,",DA=100.26,DA(1)=200 D ^DIK ;Remove Specialty List
38 S DIK="^DD(200,",DA=100.27,DA(1)=200 D ^DIK ;Remove New Orders Default
39 S DIK="^DD(200,",DA=100.11,DA(1)=200 D ^DIK ;Remove Primary OE/RR Menu
40 S DIK="^DD(200,",DA=100.12,DA(1)=200 D ^DIK ;Remove Primary Order Menu
41 S DIK="^DD(200,",DA=100.13,DA(1)=200 D ^DIK ;Remove Primary Order Display
42 S DIK="^DD(200,",DA=100.14,DA(1)=200 D ^DIK ;Remove Ward List
43 S DIK="^DD(200,",DA=100.15,DA(1)=200 D ^DIK ;Remove Patient List
44 S DIK="^DD(200,",DA=100.16,DA(1)=200 D ^DIK ;Remove Selectpat
45 S DIK="^DD(200,",DA=100.17,DA(1)=200 D ^DIK ;Remove Clinic List
46 S DIK="^DD(200,",DA=100.18,DA(1)=200 D ^DIK ;Remove Clinic Appointment Start
47 S DIK="^DD(200,",DA=100.19,DA(1)=200 D ^DIK ;Remove Clinic Appointment Stop
48 Q
49 ;
50DGPM ; -- Replace OR items on DGPM MOVEMENT EVENTS
51 N DGPM,DIK,DA,DIC,DLAYGO,X,Y,ORDITEM,ORTASK,ORNOTASK,ORD,DONE
52 S DGPM=+$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0)) Q:'DGPM
53 F X=""," NOTASK" S Y=+$O(^ORD(101,"B","OR GUA EVENT PROCESSOR"_X,0)) I Y,$O(^ORD(101,"AD",Y,DGPM,0)) S DONE=1 Q ; already added
54 Q:$G(DONE) S DA(1)=DGPM,DIK="^ORD(101,"_DGPM_",10,"
55 F ORDITEM="GENERIC ORDERS","GEN ORD ON TRANS" D
56 . S ORD=$O(^ORD(101,"B","OR GUA DC "_ORDITEM,0)) Q:'ORD
57 . S DA=$O(^ORD(101,"AD",ORD,DGPM,0)) I DA D ^DIK S ORTASK=1
58 . S ORD=$O(^ORD(101,"B","OR GUA DC "_ORDITEM_" NOTASK",0)) Q:'ORD
59 . S DA=$O(^ORD(101,"AD",ORD,DGPM,0)) I DA D ^DIK S ORNOTASK=1
60 S DIC=DIK,DIC(0)="L",DLAYGO=101,DIC("P")=$P(^DD(101,10,0),U,2),DIC("DR")="3///999",X=+$O(^ORD(101,"B","OR GUA EVENT PROCESSOR"_$S($G(ORNOTASK):" NOTASK",1:""),0)) K Y
61 D:X FILE^DICN I +$G(Y)'>0 D BMES^XPDUTL(">>> Unable to add OR GUA EVENT PROCESSOR protocol to DGPM MOVEMENT EVENTS")
62 Q
63 ;
64P49 ; -- Ck stuff in patch 49 (do, if clean install)
65 I $O(^ORD(101.43,0)) D OI^ORSETUP1 ; Ck quick order ptrs only
66 I '$O(^ORD(101.43,0)) D ORDITMS^ORSETUP ; or populate whole file
67 D BMES^XPDUTL("Populating Parameters file ..."),^ORXPAR
68 I '$P($G(^ORD(100.99,1,200)),U,2) D ; [re]convert patch 49 stuff
69 . D ^ORPFCNVT,PARM^RAO7MFN ; Update package parameters
70 . D DGROUPS^ORSETUP ; Add new fields to #100.98
71 . D URG^ORSETUP ; Add Consult urgencies
72 . K ^ORD(100.99,1,101),^(101.41),^(200) D DIALOGS^ORSETUP ; #101->101.41
73 S $P(^ORD(100.99,1,200),U,2)=1 ; Done.
74 Q
75 ;
76ZIS ; -- Add OR WORKSTATION and resource devices
77 N DA,DIC,DIE,DLAYGO,X,Y
78 S DIC(0)="LQMZ",(DIC,DLAYGO)=3.5,X="OR WORKSTATION" D ^DIC
79 I Y,$P(Y,"^",3) D ; if newly added
80 . S DA=+Y,DIE=DIC
81 . S DR=".02///^S X=""OR Workstation HFS Device"";1///^S X=""ORDEV.DAT"""
82 . S DR=DR_";1.95////0;2///^S X=""HFS"";4////0;5////0;5.1////0;5.2////0"
83 . S DR=DR_";3///^S X=""`""_"_$$SUBTYPE^ORCPOST()
84 . D ^DIE
85 ;
86 S X=$$RES^XUDHSET("ORW/PXAPI RESOURCE",,5,"CPRS to PCE transactions")
87 S X=$$RES^XUDHSET("ORB NOTIFICATION RESOURCE",,5,"OE/RR notifications")
88 S X=$$RES^XUDHSET("OR MOVEMENT RESOURCE",,5,"OR movement event process")
89 Q
90 ;
91SUBTYPE() ; get subtype for P-OTHER
92 N DIC,X
93 S DIC(0)="QMXZ",DIC="^%ZIS(2,",X="P-OTHER" D ^DIC
94 Q +Y
Note: See TracBrowser for help on using the repository browser.