| 1 | ORKCHK2 ; 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 | ;
|
|---|
| 5 | MLM(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 | ;
|
|---|
| 30 | OISESS(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
|
|---|
