- 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 Jan 18, 2025@03:32:10 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