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