source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORKCHK2.m@ 1578

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1ORKCHK2 ; slc/CLA - Order Checking support routine to do OCX-related order checks ;8/8/96 [ 04/02/97 1:08 PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,123**;Dec 17, 1997
3 Q
4 ;
5MLM(ORKS,ORKDFN,ORKA,ENT,ORKMODE) ;perform expert system-based order checking
6 ;ORKS - return sort array of order checks
7 ;ORKDFN - patient id
8 ;ORKA - order information
9 ;ENT - entity for parameter calls
10 ;ORKMODE - ordering mode
11 N ORKRTN,OCN,DNGR,ORKMSG,ORKTENT,ORNUM
12 S ORKTENT=ENT
13 S ORNUM=$P(ORKA,"|",5)
14 D EN^OCXOEPS(.ORKRTN,ORKDFN,ORKA,ORKMODE)
15 N ORKJ S ORKJ=""
16 F S ORKJ=$O(ORKRTN(ORKJ)) Q:ORKJ="" D
17 .S OCN=$P(ORKRTN(ORKJ),U,2)
18 .Q:+$G(OCN)<1
19 .S ENT=ORKTENT
20 .I $$GET^XPAR(ENT,"ORK PROCESSING FLAG",OCN,"I")'="D" D
21 ..I ORKMODE="DISPLAY" S DNGR=""
22 ..E S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
23 ..I ($P($G(^ORD(100.8,OCN,0)),U)="ERROR MESSAGE"),(ORKMODE="DISPLAY") D
24 ...S ORKMSG="CPRS Expert System disabled. Some order checks cannot be performed."
25 ..I $P($G(^ORD(100.8,OCN,0)),U)'="ERROR MESSAGE" S ORKMSG=$P(ORKRTN(ORKJ),U,4)
26 ..Q:'$L($G(ORKMSG))
27 ..S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
28 Q
29 ;
30OISESS(OI) ;check for Lab OI match in order array (ORA)
31 N ORI,LRID,LRIDX,LRIDY,LROI,ORQ,X
32 S ORQ=""
33 ;get lab id from orderable item (OI):
34 S LRID=$G(^ORD(101.43,OI,0)) Q:'$L(LRID) ORQ
35 S LRID=$P(LRID,U,2),LRID=$P(LRID,";")
36 S X=0 F S X=$O(^TMP("ORKA",$J,X)) Q:X="" D
37 .S ORI=^TMP("ORKA",$J,X)
38 .I $P(ORI,"|",2)="LR" D ;lab order
39 ..S LRIDX=$P($P(ORI,"|",3),U,4) I LRIDX=LRID S ORQ=1 Q ;match
40 ..S LROI=$P(ORI,"|")
41 ..;get children lab ids and check against ordered array ORL
42 ..S LRIDY="" F S LRIDY=$O(^ORD(101.43,LROI,10,"AID",LRIDY)) Q:LRIDY="" D
43 ...S LRIDX=$P(LRIDY,";") I LRIDX=LRID S ORQ=1 Q ;match
44 Q ORQ
Note: See TracBrowser for help on using the repository browser.