ORTSKLPS ;SLC/JMH - NIGHTLY TASK TO LAPSE OLD UNSIGNED ORDERS;03/27/2015 11:45
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,280,350**;Dec 17, 1997;Build 77
;
TASK ;
;only run between Midnight and 1:59:59 AM
;I $E($P($$NOW^XLFDT,".",2),1,2)>1 Q
;don't run if run recently (within 4 hours)
;I $$FMDIFF^XLFDT($$NOW^XLFDT,$G(^XTMP("OR LAPSE ORDERS","LAST TIME")),2)<14400 Q
;set timestamp of last run
S ^XTMP("OR LAPSE ORDERS",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
S ^XTMP("OR LAPSE ORDERS","LAST TIME")=$$NOW^XLFDT
;loop through unsigned orders
N ORVP,ORDT,ORN,ORACT,ORINVDT,ORPARAM,ORDIAL,ORDISP
S ORVP="" F S ORVP=$O(^OR(100,"AS",ORVP)) Q:'$L(ORVP) D
.N ORDATA,ORDERERS
.S ORINVDT=0 F S ORINVDT=$O(^OR(100,"AS",ORVP,ORINVDT)) Q:'ORINVDT D
..S ORDT=9999999-ORINVDT
..S ORN=0 F S ORN=$O(^OR(100,"AS",ORVP,ORINVDT,ORN)) Q:'ORN D
...;don't lapse if order does not have a status of unreleased (11)
...Q:$P($G(^OR(100,ORN,3)),U,3)'=11
...;get order action
...S ORACT=$O(^OR(100,"AS",ORVP,ORINVDT,ORN,""))
...;get order dialog
...S ORDIAL=$P($G(^OR(100,ORN,0)),U,5)
...I $P(ORDIAL,";",2)='"ORD(101.41," Q
...;using order dialog get display group
...S ORDISP=$P($G(^ORD(101.41,+ORDIAL,0)),U,5)
...I +ORDISP S ORDISP=$P($G(^ORD(100.98,+ORDISP,0)),U)
...;get lapse parameter for display group
...I $L(ORDISP) S ORPARAM=$$GET^XPAR($$ENT(ORN),"OR LAPSE ORDERS",ORDISP)
...;get default lapse parameter if one for display group not set
...I '$G(ORPARAM) S ORPARAM=$$GET^XPAR($$ENT(ORN),"OR LAPSE ORDERS DFLT")
...;quit if ORPARAM isn't even set
...Q:'$L(ORPARAM)
...;quit if order is not older than T-(days for lapse)
...I $$FMDIFF^XLFDT($$NOW^XLFDT,ORDT,2)<(ORPARAM*24*60*60) Q
...;if old then lapse
...D LAPSE^ORCSAVE2(ORN_";"_ORACT)
...S ORDATA=$S($G(ORDATA)'="":ORDATA_U,1:"")_ORN
...;Since one alert covers many orders (not passing order number to EN^ORB3), collect the orderer
...S ORDERERS($$ORDERER^ORQOR2(ORN))=""
.;send notification, one per patient
.D:$D(ORDATA) EN^ORB3(78,+ORVP,"",.ORDERERS,"Lapsed Unsigned Order(s)","NEW;"_ORDATA)
;loop through pending events
N ORPT,OREVT,ORPTR,Y
S ORPT="" F S ORPT=$O(^ORE(100.2,"AE",ORPT)) Q:'ORPT D
.S OREVT="" F S OREVT=$O(^ORE(100.2,"AE",ORPT,OREVT)) Q:'OREVT D
..S ORPTR="" F S ORPTR=$O(^ORE(100.2,"AE",ORPT,OREVT,ORPTR)) Q:'ORPTR S Y=$$LAPSED^OREVNTX(ORPTR)
Q
ENT(ORN) ;get the proper entity for an order
N ORRET,ORHS,ORDIV
S ORRET="ALL"
S ORHS=$P(^OR(100,ORN,0),U,10)
I $G(ORHS)>0 S ORDIV=$P(^SC(+ORHS,0),U,4)
I $G(ORDIV)>0 S ORRET=ORDIV_";DIC(4,^SYS^PKG"
Q ORRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORTSKLPS 2633 printed Apr 09, 2024@21:44:15 Page 2
ORTSKLPS ;SLC/JMH - NIGHTLY TASK TO LAPSE OLD UNSIGNED ORDERS;03/27/2015 11:45
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,280,350**;Dec 17, 1997;Build 77
+2 ;
TASK ;
+1 ;only run between Midnight and 1:59:59 AM
+2 ;I $E($P($$NOW^XLFDT,".",2),1,2)>1 Q
+3 ;don't run if run recently (within 4 hours)
+4 ;I $$FMDIFF^XLFDT($$NOW^XLFDT,$G(^XTMP("OR LAPSE ORDERS","LAST TIME")),2)<14400 Q
+5 ;set timestamp of last run
+6 SET ^XTMP("OR LAPSE ORDERS",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
+7 SET ^XTMP("OR LAPSE ORDERS","LAST TIME")=$$NOW^XLFDT
+8 ;loop through unsigned orders
+9 NEW ORVP,ORDT,ORN,ORACT,ORINVDT,ORPARAM,ORDIAL,ORDISP
+10 SET ORVP=""
FOR
SET ORVP=$ORDER(^OR(100,"AS",ORVP))
if '$LENGTH(ORVP)
QUIT
Begin DoDot:1
+11 NEW ORDATA,ORDERERS
+12 SET ORINVDT=0
FOR
SET ORINVDT=$ORDER(^OR(100,"AS",ORVP,ORINVDT))
if 'ORINVDT
QUIT
Begin DoDot:2
+13 SET ORDT=9999999-ORINVDT
+14 SET ORN=0
FOR
SET ORN=$ORDER(^OR(100,"AS",ORVP,ORINVDT,ORN))
if 'ORN
QUIT
Begin DoDot:3
+15 ;don't lapse if order does not have a status of unreleased (11)
+16 if $PIECE($GET(^OR(100,ORN,3)),U,3)'=11
QUIT
+17 ;get order action
+18 SET ORACT=$ORDER(^OR(100,"AS",ORVP,ORINVDT,ORN,""))
+19 ;get order dialog
+20 SET ORDIAL=$PIECE($GET(^OR(100,ORN,0)),U,5)
+21 IF $PIECE(ORDIAL,";",2)='"ORD(101.41,"
QUIT
+22 ;using order dialog get display group
+23 SET ORDISP=$PIECE($GET(^ORD(101.41,+ORDIAL,0)),U,5)
+24 IF +ORDISP
SET ORDISP=$PIECE($GET(^ORD(100.98,+ORDISP,0)),U)
+25 ;get lapse parameter for display group
+26 IF $LENGTH(ORDISP)
SET ORPARAM=$$GET^XPAR($$ENT(ORN),"OR LAPSE ORDERS",ORDISP)
+27 ;get default lapse parameter if one for display group not set
+28 IF '$GET(ORPARAM)
SET ORPARAM=$$GET^XPAR($$ENT(ORN),"OR LAPSE ORDERS DFLT")
+29 ;quit if ORPARAM isn't even set
+30 if '$LENGTH(ORPARAM)
QUIT
+31 ;quit if order is not older than T-(days for lapse)
+32 IF $$FMDIFF^XLFDT($$NOW^XLFDT,ORDT,2)<(ORPARAM*24*60*60)
QUIT
+33 ;if old then lapse
+34 DO LAPSE^ORCSAVE2(ORN_";"_ORACT)
+35 SET ORDATA=$SELECT($GET(ORDATA)'="":ORDATA_U,1:"")_ORN
+36 ;Since one alert covers many orders (not passing order number to EN^ORB3), collect the orderer
+37 SET ORDERERS($$ORDERER^ORQOR2(ORN))=""
End DoDot:3
End DoDot:2
+38 ;send notification, one per patient
+39 if $DATA(ORDATA)
DO EN^ORB3(78,+ORVP,"",.ORDERERS,"Lapsed Unsigned Order(s)","NEW;"_ORDATA)
End DoDot:1
+40 ;loop through pending events
+41 NEW ORPT,OREVT,ORPTR,Y
+42 SET ORPT=""
FOR
SET ORPT=$ORDER(^ORE(100.2,"AE",ORPT))
if 'ORPT
QUIT
Begin DoDot:1
+43 SET OREVT=""
FOR
SET OREVT=$ORDER(^ORE(100.2,"AE",ORPT,OREVT))
if 'OREVT
QUIT
Begin DoDot:2
+44 SET ORPTR=""
FOR
SET ORPTR=$ORDER(^ORE(100.2,"AE",ORPT,OREVT,ORPTR))
if 'ORPTR
QUIT
SET Y=$$LAPSED^OREVNTX(ORPTR)
End DoDot:2
End DoDot:1
+45 QUIT
ENT(ORN) ;get the proper entity for an order
+1 NEW ORRET,ORHS,ORDIV
+2 SET ORRET="ALL"
+3 SET ORHS=$PIECE(^OR(100,ORN,0),U,10)
+4 IF $GET(ORHS)>0
SET ORDIV=$PIECE(^SC(+ORHS,0),U,4)
+5 IF $GET(ORDIV)>0
SET ORRET=ORDIV_";DIC(4,^SYS^PKG"
+6 QUIT ORRET
