ORKCHK2 ; slc/CLA - Order Checking support routine to do OCX-related order checks ;8/8/96 [ 04/02/97 1:08 PM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,123**;Dec 17, 1997
Q
;
MLM(ORKS,ORKDFN,ORKA,ENT,ORKMODE) ;perform expert system-based order checking
;ORKS - return sort array of order checks
;ORKDFN - patient id
;ORKA - order information
;ENT - entity for parameter calls
;ORKMODE - ordering mode
N ORKRTN,OCN,DNGR,ORKMSG,ORKTENT,ORNUM
S ORKTENT=ENT
S ORNUM=$P(ORKA,"|",5)
D EN^OCXOEPS(.ORKRTN,ORKDFN,ORKA,ORKMODE)
N ORKJ S ORKJ=""
F S ORKJ=$O(ORKRTN(ORKJ)) Q:ORKJ="" D
.S OCN=$P(ORKRTN(ORKJ),U,2)
.Q:+$G(OCN)<1
.S ENT=ORKTENT
.I $$GET^XPAR(ENT,"ORK PROCESSING FLAG",OCN,"I")'="D" D
..I ORKMODE="DISPLAY" S DNGR=""
..E S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
..I ($P($G(^ORD(100.8,OCN,0)),U)="ERROR MESSAGE"),(ORKMODE="DISPLAY") D
...S ORKMSG="CPRS Expert System disabled. Some order checks cannot be performed."
..I $P($G(^ORD(100.8,OCN,0)),U)'="ERROR MESSAGE" S ORKMSG=$P(ORKRTN(ORKJ),U,4)
..Q:'$L($G(ORKMSG))
..S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
Q
;
OISESS(OI) ;check for Lab OI match in order array (ORA)
N ORI,LRID,LRIDX,LRIDY,LROI,ORQ,X
S ORQ=""
;get lab id from orderable item (OI):
S LRID=$G(^ORD(101.43,OI,0)) Q:'$L(LRID) ORQ
S LRID=$P(LRID,U,2),LRID=$P(LRID,";")
S X=0 F S X=$O(^TMP("ORKA",$J,X)) Q:X="" D
.S ORI=^TMP("ORKA",$J,X)
.I $P(ORI,"|",2)="LR" D ;lab order
..S LRIDX=$P($P(ORI,"|",3),U,4) I LRIDX=LRID S ORQ=1 Q ;match
..S LROI=$P(ORI,"|")
..;get children lab ids and check against ordered array ORL
..S LRIDY="" F S LRIDY=$O(^ORD(101.43,LROI,10,"AID",LRIDY)) Q:LRIDY="" D
...S LRIDX=$P(LRIDY,";") I LRIDX=LRID S ORQ=1 Q ;match
Q ORQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKCHK2 1835 printed Apr 09, 2024@21:31:33 Page 2
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
+2 QUIT
+3 ;
MLM(ORKS,ORKDFN,ORKA,ENT,ORKMODE) ;perform expert system-based order checking
+1 ;ORKS - return sort array of order checks
+2 ;ORKDFN - patient id
+3 ;ORKA - order information
+4 ;ENT - entity for parameter calls
+5 ;ORKMODE - ordering mode
+6 NEW ORKRTN,OCN,DNGR,ORKMSG,ORKTENT,ORNUM
+7 SET ORKTENT=ENT
+8 SET ORNUM=$PIECE(ORKA,"|",5)
+9 DO EN^OCXOEPS(.ORKRTN,ORKDFN,ORKA,ORKMODE)
+10 NEW ORKJ
SET ORKJ=""
+11 FOR
SET ORKJ=$ORDER(ORKRTN(ORKJ))
if ORKJ=""
QUIT
Begin DoDot:1
+12 SET OCN=$PIECE(ORKRTN(ORKJ),U,2)
+13 if +$GET(OCN)<1
QUIT
+14 SET ENT=ORKTENT
+15 IF $$GET^XPAR(ENT,"ORK PROCESSING FLAG",OCN,"I")'="D"
Begin DoDot:2
+16 IF ORKMODE="DISPLAY"
SET DNGR=""
+17 IF '$TEST
SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
+18 IF ($PIECE($GET(^ORD(100.8,OCN,0)),U)="ERROR MESSAGE")
IF (ORKMODE="DISPLAY")
Begin DoDot:3
+19 SET ORKMSG="CPRS Expert System disabled. Some order checks cannot be performed."
End DoDot:3
+20 IF $PIECE($GET(^ORD(100.8,OCN,0)),U)'="ERROR MESSAGE"
SET ORKMSG=$PIECE(ORKRTN(ORKJ),U,4)
+21 if '$LENGTH($GET(ORKMSG))
QUIT
+22 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
OISESS(OI) ;check for Lab OI match in order array (ORA)
+1 NEW ORI,LRID,LRIDX,LRIDY,LROI,ORQ,X
+2 SET ORQ=""
+3 ;get lab id from orderable item (OI):
+4 SET LRID=$GET(^ORD(101.43,OI,0))
if '$LENGTH(LRID)
QUIT ORQ
+5 SET LRID=$PIECE(LRID,U,2)
SET LRID=$PIECE(LRID,";")
+6 SET X=0
FOR
SET X=$ORDER(^TMP("ORKA",$JOB,X))
if X=""
QUIT
Begin DoDot:1
+7 SET ORI=^TMP("ORKA",$JOB,X)
+8 ;lab order
IF $PIECE(ORI,"|",2)="LR"
Begin DoDot:2
+9 ;match
SET LRIDX=$PIECE($PIECE(ORI,"|",3),U,4)
IF LRIDX=LRID
SET ORQ=1
QUIT
+10 SET LROI=$PIECE(ORI,"|")
+11 ;get children lab ids and check against ordered array ORL
+12 SET LRIDY=""
FOR
SET LRIDY=$ORDER(^ORD(101.43,LROI,10,"AID",LRIDY))
if LRIDY=""
QUIT
Begin DoDot:3
+13 ;match
SET LRIDX=$PIECE(LRIDY,";")
IF LRIDX=LRID
SET ORQ=1
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT ORQ
