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

ORKLR2.m

Go to the documentation of this file. 
  1. ORKLR2 ; slc/CLA - Order checking support proc for lab orders, part 2 ;May 17, 2019 17:00
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**510**;Dec 17, 1997;Build 11
  1.  ;
  1.  ;IA #2387 - ^LAB(60 fields retrieved by routine LR7OR3
  1.  ;
  1.  Q
  1. ORFREQ(ORKLR,OI,ORDFN,NEWORDT,SPECIMEN) ;lab order freq restrictions order check
  1.  N LRID,LFREQS,MAX,DAILY,MAXDT,EARLYDT,ORM,ORD,X1,X2,X,ORDIFF
  1.  S EARLYDT=NEWORDT
  1.  ;get lab id from orderable item (OI):
  1.  S LRID=$P(^ORD(101.43,OI,0),U,2) I $L($G(LRID)) D
  1.  .S LFREQS=$$FREQS(+LRID,SPECIMEN),MAX=$P(LFREQS,U),DAILY=$P(LFREQS,U,2)
  1.  .;if max order freq exists, don't process for daily order max:
  1.  .I '$L($G(MAX)) S:$L($G(DAILY)) ORD(LRID_";"_SPECIMEN)=DAILY_"^0"
  1.  .I $L($G(MAX)) D
  1.  ..;decrease by 1 since order frequency occurs for calendar days
  1.  ..;example: every two days = equals today and tomorrow - not including
  1.  ..;         the day after tomorrow
  1.  ..S MAX=MAX-1
  1.  ..S X1=NEWORDT,X2="-"_MAX D C^%DTC Q:X<1  S MAXDT=X
  1.  ..I MAXDT<EARLYDT S EARLYDT=MAXDT ;find and keep earliest MAXDT
  1.  ..;
  1.  ..;The earliest max d/t is used because if the lab order has children,
  1.  ..;they  may have different (or no) maximum order freq values. By taking
  1.  ..;the earliest, we cover all values yet narrow the search range for the
  1.  ..;call into ORQ1.  In MAXFREQ2 the specific max d/ts stored in ORL are
  1.  ..;checked against the d/ts of orders returned by ORQ1. ORQ1 orders' d/t
  1.  ..;are checked to see if they fall between the max d/t of an equivalent
  1.  ..;parent or child lab test order stored in ORL and the d/t of the order
  1.  ..;being checked. 
  1.  ..;
  1.  ..S ORM(LRID_";"_SPECIMEN)=MAXDT
  1.  ;
  1.  ;expand into child-level lab identifiers if children exist for this OI:
  1.  S LRID="" F  S LRID=$O(^ORD(101.43,OI,10,"AID",LRID)) Q:LRID=""  D
  1.  .S MAX="",DAILY="",LFREQS=""
  1.  .S LFREQS=$$FREQS(+LRID,SPECIMEN),MAX=$P(LFREQS,U),DAILY=$P(LFREQS,U,2)
  1.  .;if max order freq exists, don't process for daily order max:
  1.  .I '$L($G(MAX)),($L($G(DAILY))) S ORD(LRID_";"_SPECIMEN)=DAILY
  1.  .I $L($G(MAX)) D
  1.  ..;decrease by 1 since order frequency occurs for calendar days
  1.  ..;example: every two days = equals today and tomorrow - not including
  1.  ..;         the day after tomorrow
  1.  ..S MAX=MAX-1
  1.  ..S X1=NEWORDT,X2="-"_MAX D C^%DTC Q:X<1  S MAXDT=X
  1.  ..I MAXDT<EARLYDT S EARLYDT=MAXDT ;find and keep earliest MAXDT
  1.  ..S ORM(LRID_";"_SPECIMEN)=MAXDT
  1.  I $D(ORM) D
  1.  . ;expand the search range to include orders with a collection date
  1.  . ;after this order's collection date
  1.  . S ORDIFF=$$FMDIFF^XLFDT(NEWORDT,EARLYDT,"")
  1.  . S NEWORDT=$$FMADD^XLFDT(NEWORDT,ORDIFF)
  1.  . ;start EARLYDT at midnight of previous date
  1.  . S EARLYDT=$$FMADD^XLFDT(EARLYDT,"","","",-60)
  1.  . D MAXFREQ(.ORM,EARLYDT)
  1.  I $D(ORD) D DAILY(.ORD)
  1.  Q
  1. MAXFREQ(ORM,EARLYDT) ;check for maximum order frequency violation
  1.  N DGIEN,HOR,SEQ,X,ORIFN,ODT,ORIFNC
  1.  S HOR=0,SEQ=0
  1.  ;get all lab orders since earliest max order freq d/t:
  1.  S DGIEN=0,DGIEN=$O(^ORD(100.98,"B","LAB",DGIEN))
  1.  K ^TMP("ORR",$J)
  1.  D EN^ORQ1(ORDFN,DGIEN,1,"",EARLYDT,NEWORDT+.2359,1,0,"AW")
  1.  S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1
  1.  F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D
  1.  .S X=^TMP("ORR",$J,HOR,SEQ),ORIFN=+$P(X,U),ODT=$P(X,U,4)
  1.  .;break into child orders if they exist:
  1.  .I $D(^OR(100,ORIFN,2,0)) D  ;child orders exist
  1.  ..S ORIFNC=0 F  S ORIFNC=$O(^OR(100,ORIFN,2,ORIFNC)) Q:ORIFNC=""  D
  1.  ...D MAXFREQ2(ORIFNC,ODT,.ORM)
  1.  .I '$D(^OR(100,ORIFN,2,0)) D MAXFREQ2(ORIFN,ODT,.ORM)
  1.  K ^TMP("ORR",$J)
  1.  Q
  1. MAXFREQ2(ORIFN,ODT,ORL) ;second part of max order freq order check
  1.  N ORS,ORSI,ORSP,OROI,LRID,LRIDX,LRIDXC,EXDT,INVDT,MAXDT,ORKMSG
  1.  S ORS=$$STATUS^ORQOR2(ORIFN),ORSI=$P(ORS,U)
  1.  ;quit if order status is canceled/discontinued/expired/lapsed/changed/delayed:
  1.  I (ORSI=13)!(ORSI=1)!(ORSI=7)!(ORSI=14)!(ORSI=12)!(ORSI=10) Q
  1.  ;
  1.  ;get specimen for this order:
  1.  S ORSP=$$VALUE^ORCSAVE2(ORIFN,"SPECIMEN")
  1.  Q:'$L($G(ORSP))  ;quit if no specimen found
  1.  ;get orderable item for this order:
  1.  S OROI=$$OI^ORQOR2(ORIFN)
  1.  Q:'$L($G(OROI))  ;quit if no orderable item found
  1.  ;get lab id and check against ordered array ORD
  1.  S:$L($G(^ORD(101.43,OROI,0))) LRIDX=$P(^ORD(101.43,OROI,0),U,2)_";"_ORSP I $L($G(LRIDX)) D
  1.  .S LRID="" F  S LRID=$O(ORL(LRID)) Q:LRID=""  I LRID=LRIDX D
  1.  ..S MAXDT=ORL(LRID)
  1.  ..;if order's dt > or equal to max dt and (order's dt < or equal to new order's dt or 
  1.  ..;   order's date = new order's date), max order freq violated:
  1.  ..;   (The $P(ODT,".")=$P(NEWORDT,".") might not be necessary, but keeping it
  1.  ..;   in case a scenario depends on it.)
  1.  ..I ODT'<MAXDT,((ODT'>NEWORDT)!($P(ODT,".")=$P(NEWORDT,"."))) D
  1.  ...S ORKMSG="Max lab test order freq exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
  1.  ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
  1.  ;get children lab ids and check against ordered array  ORD
  1.  S LRIDX="" F  S LRIDX=$O(^ORD(101.43,OROI,10,"AID",LRIDX)) Q:LRIDX=""  D
  1.  .S LRIDXC=LRIDX_";"_ORSP
  1.  .S LRID="" F  S LRID=$O(ORL(LRID)) Q:LRID=""  I LRID=LRIDXC D
  1.  ..S MAXDT=ORL(LRID)
  1.  ..;if order's dt > or equal to max dt and (order's dt < or equal to new order's dt or 
  1.  ..;   order's date = new order's date), max order freq violated:
  1.  ..;   (The $P(ODT,".")=$P(NEWORDT,".") might not be necessary, but keeping it
  1.  ..;   in case a scenario depends on it.)
  1.  ..I ODT'<MAXDT,((ODT'>NEWORDT)!($P(ODT,".")=$P(NEWORDT,"."))) D
  1.  ...S ORKMSG="Max lab test order freq exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
  1.  ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
  1.  Q
  1. DAILY(ORD) ;check for daily order maximum violation
  1.  N DGIEN,HOR,SEQ,X,ORIFN,ODT,ORIFNC,NEWORDAY,CNT
  1.  S HOR=0,SEQ=0,CNT=0
  1.  ;get all lab orders occurring on new order's date:
  1.  S NEWORDAY=$P(NEWORDT,".")
  1.  S DGIEN=0,DGIEN=$O(^ORD(100.98,"B","LAB",DGIEN))
  1.  K ^TMP("ORR",$J)
  1.  D EN^ORQ1(ORDFN,DGIEN,1,"",$$FMADD^XLFDT(NEWORDAY,"","","",-60),NEWORDAY+.2359,1,0,"AW")
  1.  S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1
  1.  S SEQ=0 F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D
  1.  .S X=^TMP("ORR",$J,HOR,SEQ),ORIFN=+$P(X,U),ODT=$P(X,U,4)
  1.  .;break into child orders if they exist:
  1.  .I $D(^OR(100,ORIFN,2,0)) D  ;child orders exist
  1.  ..S ORIFNC=0 F  S ORIFNC=$O(^OR(100,ORIFN,2,ORIFNC)) Q:ORIFNC=""  D
  1.  ...D DAILY2(ORIFNC,ODT,CNT,.ORD)
  1.  .I '$D(^OR(100,ORIFN,2,0)) D DAILY2(ORIFN,ODT,CNT,.ORD)
  1.  K ^TMP("ORR",$J)
  1.  Q
  1. DAILY2(ORIFN,ODT,CNT,ORL) ;second part of daily order max order check
  1.  N ORS,ORSI,ORSP,OROI,LRID,LRIDX,LRIDXC,EXDT,INVDT,DAILY
  1.  S ORS=$$STATUS^ORQOR2(ORIFN),ORSI=$P(ORS,U)
  1.  ;quit if order status is canceled/discontinued/expired/lapsed/changed/delayed:
  1.  I (ORSI=13)!(ORSI=1)!(ORSI=7)!(ORSI=14)!(ORSI=12)!(ORSI=10) Q
  1.  ;
  1.  ;get specimen for this order:
  1.  S ORSP=$$VALUE^ORCSAVE2(ORIFN,"SPECIMEN")
  1.  Q:'$L($G(ORSP))  ;quit if no specimen found
  1.  ;get orderable item for this order:
  1.  S OROI=$$OI^ORQOR2(ORIFN)
  1.  Q:'$L($G(OROI))  ;quit if no orderable item found
  1.  ;get lab id and check against ordered array ORD
  1.  S:$L($G(^ORD(101.43,OROI,0))) LRIDX=$P(^ORD(101.43,OROI,0),U,2)_";"_ORSP I $L($G(LRIDX)) D
  1.  .;use 2nd piece of the lab id array as a counter to keep counter specific to the lab test_specimen: 
  1.  .S LRID="" F  S LRID=$O(ORL(LRID)) Q:LRID=""  I LRID=LRIDX D
  1.  ..S $P(ORL(LRID),U,2)=$P(ORL(LRID),U,2)+1,DAILY=$P(ORL(LRID),U)
  1.  ..;if count for this lab test_specimen exceeds daily order max, send oc message:
  1.  ..I $P(ORL(LRID),U,2)=DAILY D
  1.  ...S ORKMSG="Lab test daily order max exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
  1.  ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
  1.  ;get children lab ids and check against ordered array  ORD
  1.  S LRIDX="" F  S LRIDX=$O(^ORD(101.43,OROI,10,"AID",LRIDX)) Q:LRIDX=""  D
  1.  .S LRIDXC=LRIDX_";"_ORSP
  1.  .;use 2nd piece of the lab id array as a counter to keep counter specific to the lab test_specimen: 
  1.  .S LRID="" F  S LRID=$O(ORL(LRID)) Q:LRID=""  I LRID=LRIDXC D
  1.  ..S $P(ORL(LRID),U,2)=$P(ORL(LRID),U,2)+1,DAILY=$P(ORL(LRID),U)
  1.  ..;if count for this lab test_specimen exceeds daily order max, send oc message:
  1.  ..I $P(ORL(LRID),U,2)=DAILY D
  1.  ...S ORKMSG="Lab test daily order max exceeded for: "_$E($P(^LAB(60,+LRID,0),U),1,30)
  1.  ...S ORKLR(ORKMSG)=ORIFN_U_ORKMSG
  1.  Q
  1. FREQS(LRIEN,ORSPEC) ;extrinsic funct returns max order freq and daily order max for a lab test
  1.  N LRY,LRI,SPEC,MAXFREQ,X,DAILYMAX,Y,LRCNODE
  1.  S MAXFREQ="",DAILYMAX=""
  1.  D TEST^LR7OR3(LRIEN,.LRY)
  1.  I $D(LRY) D
  1.  .S LRI="" F  S LRI=$O(LRY("CollSamp",LRI)) Q:LRI=""  D
  1.  ..S LRCNODE=LRY("CollSamp",LRI),SPEC=$P(LRCNODE,U,3),X=+$P(LRCNODE,U,5),Y=+$P(LRCNODE,U,6)
  1.  ..;if specimens match:
  1.  ..I SPEC=ORSPEC D
  1.  ...;get maxfreq, if more than one max freq exists for this
  1.  ...;  collection sample/specimen use the largest max freq:
  1.  ...I X>MAXFREQ S MAXFREQ=X
  1.  ...;if dailymax > 0:
  1.  ...I $G(Y)>0 D
  1.  ....I $L($G(DAILYMAX)),(Y<DAILYMAX) S DAILYMAX=Y ;use smallest daily mx
  1.  ....I '$L($G(DAILYMAX)) S DAILYMAX=Y ;get first occurrence of dailymax
  1.  Q MAXFREQ_U_DAILYMAX