Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORKCHK2

ORKCHK2.m

Go to the documentation of this file.
  1. ORKCHK2 ; slc/CLA - Order Checking support routine to do OCX-related order checks ;8/8/96 [ 04/02/97 1:08 PM ]
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,123**;Dec 17, 1997
  1. Q
  1. ;
  1. MLM(ORKS,ORKDFN,ORKA,ENT,ORKMODE) ;perform expert system-based order checking
  1. ;ORKS - return sort array of order checks
  1. ;ORKDFN - patient id
  1. ;ORKA - order information
  1. ;ENT - entity for parameter calls
  1. ;ORKMODE - ordering mode
  1. N ORKRTN,OCN,DNGR,ORKMSG,ORKTENT,ORNUM
  1. S ORKTENT=ENT
  1. S ORNUM=$P(ORKA,"|",5)
  1. D EN^OCXOEPS(.ORKRTN,ORKDFN,ORKA,ORKMODE)
  1. N ORKJ S ORKJ=""
  1. F S ORKJ=$O(ORKRTN(ORKJ)) Q:ORKJ="" D
  1. .S OCN=$P(ORKRTN(ORKJ),U,2)
  1. .Q:+$G(OCN)<1
  1. .S ENT=ORKTENT
  1. .I $$GET^XPAR(ENT,"ORK PROCESSING FLAG",OCN,"I")'="D" D
  1. ..I ORKMODE="DISPLAY" S DNGR=""
  1. ..E S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
  1. ..I ($P($G(^ORD(100.8,OCN,0)),U)="ERROR MESSAGE"),(ORKMODE="DISPLAY") D
  1. ...S ORKMSG="CPRS Expert System disabled. Some order checks cannot be performed."
  1. ..I $P($G(^ORD(100.8,OCN,0)),U)'="ERROR MESSAGE" S ORKMSG=$P(ORKRTN(ORKJ),U,4)
  1. ..Q:'$L($G(ORKMSG))
  1. ..S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
  1. Q
  1. ;
  1. OISESS(OI) ;check for Lab OI match in order array (ORA)
  1. N ORI,LRID,LRIDX,LRIDY,LROI,ORQ,X
  1. S ORQ=""
  1. ;get lab id from orderable item (OI):
  1. S LRID=$G(^ORD(101.43,OI,0)) Q:'$L(LRID) ORQ
  1. S LRID=$P(LRID,U,2),LRID=$P(LRID,";")
  1. S X=0 F S X=$O(^TMP("ORKA",$J,X)) Q:X="" D
  1. .S ORI=^TMP("ORKA",$J,X)
  1. .I $P(ORI,"|",2)="LR" D ;lab order
  1. ..S LRIDX=$P($P(ORI,"|",3),U,4) I LRIDX=LRID S ORQ=1 Q ;match
  1. ..S LROI=$P(ORI,"|")
  1. ..;get children lab ids and check against ordered array ORL
  1. ..S LRIDY="" F S LRIDY=$O(^ORD(101.43,LROI,10,"AID",LRIDY)) Q:LRIDY="" D
  1. ...S LRIDX=$P(LRIDY,";") I LRIDX=LRID S ORQ=1 Q ;match
  1. Q ORQ