- 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 Feb 19, 2025@00:00:52 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
