source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3C1.m@ 1476

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

initial load of WorldVistAEHR
File size: 7.3 KB
Line 
1ORB3C1 ; slc/CLA - Routine to pre-convert OE/RR 2.5 to OE/RR 3 notifications ;7/3/96 15:16 [ 04/03/97 1:41 PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
3 Q
4PREORB ;initiate pre-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
5 ;called by ORCPRE (OE/RR 3 pre-init)
6 N ORBC,ORBERR,ORBNOW
7 I $L($T(GET^XPAR))>1,($D(^XTV(8989.51,"B","ORBC CONVERSION"))>0) D
8 .S ORBC=$$GET^XPAR("SYS","ORBC CONVERSION",1,"Q")
9 I +$G(ORBC)>0 D BMES^XPDUTL("Notifications already PRE-converted.") Q
10 D BMES^XPDUTL("PRE-conversion of notifications...")
11 S ORBNOW=$$NOW^XLFDT
12 S ^XTMP("ORBC",0)=$$FMADD^XLFDT(ORBNOW,30,"","","")_U_ORBNOW
13 D PRESTUB,PREPKG,PRECONV,PRECLEAN,PRERU,PRERG,PREPF,PREEX
14 I $L($T(EN^XPAR))>1,($D(^XTV(8989.51,"B","ORBC CONVERSION"))>0) D
15 .D EN^XPAR("SYS","ORBC CONVERSION",1,"1",.ORBERR) ;1:pre-convert done
16 D BMES^XPDUTL("PRE-conversion of notifications completed.")
17 Q
18POSTORB ;initiate post-inits for converting OE/RR 2.5 notification fields to OE/RR 3.0 notification parameters
19 D POSTORB^ORB3C2
20 Q
21PRESTUB ;initiate stubbing of notifications 30-57 and renaming of some existing notifictions
22 D BMES^XPDUTL("Stubbing notifications 30-49,51-58.")
23 N ORBI,ORBA,ORBIEN,ORBERR
24 S ORBA(100.9,"+30,",.01)="CONSULT/REQUEST CANCEL/HOLD",ORBIEN(30)=30
25 S ORBA(100.9,"+31,",.01)="NPO DIET MORE THAN 72 HRS",ORBIEN(31)=31
26 S ORBA(100.9,"+32,",.01)="SITE-FLAGGED RESULTS",ORBIEN(32)=32
27 S ORBA(100.9,"+33,",.01)="ORDERER-FLAGGED RESULTS",ORBIEN(33)=33
28 S ORBA(100.9,"+35,",.01)="DISCHARGE",ORBIEN(35)=35
29 S ORBA(100.9,"+36,",.01)="TRANSFER FROM PSYCHIATRY",ORBIEN(36)=36
30 S ORBA(100.9,"+37,",.01)="ORDER REQUIRES CO-SIGNATURE",ORBIEN(37)=37
31 S ORBA(100.9,"+41,",.01)="SITE-FLAGGED ORDER",ORBIEN(41)=41
32 S ORBA(100.9,"+42,",.01)="LAB ORDER CANCELED",ORBIEN(42)=42
33 S ORBA(100.9,"+43,",.01)="STAT ORDER",ORBIEN(43)=43
34 S ORBA(100.9,"+44,",.01)="STAT RESULTS",ORBIEN(44)=44
35 S ORBA(100.9,"+45,",.01)="DNR EXPIRING",ORBIEN(45)=45
36 S ORBA(100.9,"+46,",.01)="FREE TEXT",ORBIEN(46)=46
37 S ORBA(100.9,"+47,",.01)="MEDICATIONS EXPIRING",ORBIEN(47)=47
38 S ORBA(100.9,"+48,",.01)="UNVERIFIED MEDICATION ORDER",ORBIEN(48)=48
39 S ORBA(100.9,"+51,",.01)="STAT IMAGING REQUEST",ORBIEN(51)=51
40 S ORBA(100.9,"+52,",.01)="URGENT IMAGING REQUEST",ORBIEN(52)=52
41 S ORBA(100.9,"+53,",.01)="IMAGING RESULTS AMENDED",ORBIEN(53)=53
42 S ORBA(100.9,"+54,",.01)="ORDER CHECK",ORBIEN(54)=54
43 S ORBA(100.9,"+55,",.01)="FOOD/DRUG INTERACTION",ORBIEN(55)=55
44 S ORBA(100.9,"+56,",.01)="ERROR MESSAGE",ORBIEN(56)=56
45 S ORBA(100.9,"+57,",.01)="CRITICAL LAB RESULTS (ACTION)",ORBIEN(57)=57
46 S ORBA(100.9,"+58,",.01)="ABNORMAL LAB RESULT (INFO)",ORBIEN(58)=58
47 D CLEAN^DILF
48 D UPDATE^DIE("","ORBA","ORBIEN","ORBERR")
49 D BMES^XPDUTL("Notification stubbing completed.")
50 D BMES^XPDUTL("Renaming notifications 14,21,22,24,25,26,50.")
51 S $P(^ORD(100.9,14,0),U)="ABNORMAL LAB RESULTS (ACTION)"
52 S $P(^ORD(100.9,21,0),U)="IMAGING PATIENT EXAMINED"
53 S $P(^ORD(100.9,22,0),U)="IMAGING RESULTS"
54 S $P(^ORD(100.9,24,0),U)="CRITICAL LAB RESULT (INFO)"
55 S $P(^ORD(100.9,25,0),U)="ABNORMAL IMAGING RESULTS"
56 S $P(^ORD(100.9,26,0),U)="IMAGING REQUEST CANCEL/HELD"
57 S $P(^ORD(100.9,50,0),U)="NEW ORDER"
58 ;kill then rebuild "B" x-ref:
59 K ^ORD(100.9,"B")
60 S DIK="^ORD(100.9,",DIK(1)=".01^B" D ENALL^DIK
61 K DIK
62 D BMES^XPDUTL("Notification renaming completed.")
63 Q
64PREPKG ;pre-init to kill bad entries in the package file
65 S DA=0,DIK="^DIC(9.4,",DA=$O(^DIC(9.4,"C","ORA",DA)) I $L($G(DA)) D ^DIK
66 S DA=0,DIK="^DIC(9.4,",DA=$O(^DIC(9.4,"C","ORB",DA)) I $L($G(DA)) D ^DIK
67 K DA,DIK
68 Q
69PRECONV ;convert OE/RR 2.5 alerts that are deleted in the CPRS conversion into
70 ;informational alerts and send them to the appropriate user
71 N ORBUSR,ORBDT,ORBNOW,ORBNODE,ORBMSG,ORBN,ORBCNT,ORBAID
72 S ORBNOW=$$NOW^XLFDT
73 S ORBUSR=0,ORBCNT=0
74 D BMES^XPDUTL("Converting existing alerts...")
75 F S ORBUSR=$O(^XTV(8992,ORBUSR)) Q:+$G(ORBUSR)<.5 D
76 .S ORBDT=0 F S ORBDT=$O(^XTV(8992,ORBUSR,"XQA",ORBDT)) Q:ORBDT="" D
77 ..S ORBNODE=^XTV(8992,ORBUSR,"XQA",ORBDT,0)
78 ..S ORBAID=$P($P(ORBNODE,U,2),";")
79 ..Q:$P(ORBAID,",")'="OR" ;quit if not an OE/RR alert
80 ..S ORBN=$P(ORBAID,",",3) ;get notification ien
81 ..;if notification is an alert to be deleted during conversion:
82 ..I (ORBN=3)!(ORBN=6)!(ORBN=12)!(ORBN=14)!(ORBN=24)!(ORBN=50) D
83 ...S ORBCNT=ORBCNT+1
84 ...S ORBMSG=$P(ORBNODE,U,3)
85 ...S XQAMSG="[CONV] "_ORBMSG
86 ...S XQAID="OR3CONV"_","_ORBCNT_","_ORBNOW
87 ...S XQA(ORBUSR)=""
88 ...S XQAFLG="I"
89 ...D SETUP^XQALERT
90 ...K XQAMSG,XQAID,XQA,XQAFLG
91 Q
92PRECLEAN ;clean up old alerts and unused entries in Notification file
93 ; 3 - Lab Results
94 ; 6 - Flagged Orders
95 ;10 - Unsigned Progress Notes
96 ;12 - Orders Requiring Electronic Signature
97 ;13 - Co-signature on Progress Notes
98 ;14 - Abnormal Labs
99 ;15 - Cytology Results
100 ;16 - Anatomical Pathology Results
101 ;17 - Autopsy Report
102 ;24 - Critical Lab Results
103 ;50 - Lab critical/abnormal/new rslt
104 ;97 - Test Notification
105 ;
106 ;clean up old alerts with fup actions unprocessable or unused by CPRS:
107 N ORBI,ORX S ORBI=""
108 D BMES^XPDUTL("Cleaning up old alerts...")
109 F ORBI=3,6,10,12,13,14,15,16,17,24,50,97 D
110 .Q:'$D(^ORD(100.9,ORBI))
111 .D NOTIPURG^XQALBUTL(ORBI)
112 .S ORX=" "_$P(^ORD(100.9,ORBI,0),U)_" cleaned up."
113 .D BMES^XPDUTL(ORX)
114 ;
115 K XPDIDTOT
116 ;clean up unused entries in the notification file:
117 S ORBI=""
118 F ORBI=10,13,15,16,17,97 D
119 .Q:'$D(^ORD(100.9,ORBI))
120 .S DA=ORBI,DIK="^ORD(100.9," D ^DIK
121 .K DA,DIK
122KILLC ;kill then rebuild "C" x-ref
123 K ^ORD(100.9,"C")
124 S DIK="^ORD(100.9,",DIK(1)=".02^C" D ENALL^DIK ;rebuild the "C" x-ref
125 K DA,DIK
126 Q
127PRERU ;pre-init conversion of OE/RR 2.5 RECIPIENT USERS
128 N ORBN,ORBU,ORI,I
129 S ORBN=0,ORI="",I=1
130 F S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1 D
131 .I $G(^ORD(100.9,ORBN,200,0))="" Q
132 .S ORI=0 F S ORI=$O(^ORD(100.9,ORBN,200,ORI)) Q:'ORI D
133 ..S ORBU=$G(^ORD(100.9,ORBN,200,ORI,0)) Q:ORBU=""
134 ..Q:'$L($G(^VA(200,ORBU,0)))
135 ..S ^XTMP("ORBC","USER PROCESSING FLAG",I)=ORBU_U_ORBN
136 ..S ^XTMP("ORBC","USER PROCESSING FLAG",0)=I,I=I+1
137 Q
138PRERG ;pre-init conversion of OE/RR 2.5 RECIPIENT GROUPS
139 N ORBN,ORBT,ORI,I
140 S ORBN=0,ORI="",I=1
141 F S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1 D
142 .I $G(^ORD(100.9,ORBN,2,0))="" Q
143 .S ORI=0 F S ORI=$O(^ORD(100.9,ORBN,2,ORI)) Q:'ORI D
144 ..S ORBT=$G(^ORD(100.9,ORBN,2,ORI,0)) Q:ORBT=""
145 ..Q:'$L($G(^OR(100.21,ORBT,0)))
146 ..S ^XTMP("ORBC","DEFAULT RECIPIENTS",I)=ORBT_U_ORBN
147 ..S ^XTMP("ORBC","DEFAULT RECIPIENTS",0)=I,I=I+1
148 Q
149PREPF ;pre-init conversion of OE/RR 2.5 PROCESSING FLAG
150 N ORBN,ORBF,I
151 S ORBN=0,I=1
152 F S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1 D
153 .S ORBF=$G(^ORD(100.9,ORBN,3)) Q:ORBF=""
154 .S ORBF=$S(ORBF["^":$P(ORBF,U),1:ORBF) Q:ORBF=""
155 .S ORBF=$S(ORBF="M":"Mandatory",ORBF="E":"Disabled",ORBF="N":"Disabled",ORBF="D":"Disabled",1:"Disabled")
156 .S ^XTMP("ORBC","SITE PROCESSING FLAG",I)=ORBF_U_ORBN
157 .S ^XTMP("ORBC","SITE PROCESSING FLAG",0)=I,I=I+1
158 Q
159PREEX ;pre-init conversion of OE/RR 2.5 EXCLUDE ATTENDING & EXCLUDE PRIMARY
160 N ORBN,ORBXA,ORBXP,ORBNTOP,I
161 S ORBN=0,I=1
162 ;
163 ;check Order Param file for value of Notification to Physician field:
164 S ORBNTOP=$P($G(^ORD(100.99,1,2)),U,11)
165 ;
166 F S ORBN=$O(^ORD(100.9,ORBN)) Q:+ORBN<1 D
167 .Q:$G(^ORD(100.9,ORBN,0))=""
168 .Q:$G(^ORD(100.9,ORBN,3))="" ;quit if a stubbed notif
169 .S ORBXA=$P(^ORD(100.9,ORBN,0),U,9),ORBXP=$P(^ORD(100.9,ORBN,0),U,10)
170 .I '$L(ORBNTOP),(+$G(ORBXA)<1),(+$G(ORBXP)<1) Q
171 .I ($L(ORBXA))!($L(ORBXP)) D
172 ..S ^XTMP("ORBC","PROVIDER RECIPIENTS",I)=ORBXA_U_ORBXP_U_ORBNTOP_U_ORBN
173 ..S ^XTMP("ORBC","PROVIDER RECIPIENTS",0)=I,I=I+1
174 Q
Note: See TracBrowser for help on using the repository browser.