Routine: ORTSKLPS

ORTSKLPS ;SLC/JMH-nightly task to lapse old unsigned orders ; 4/9/08 10:00am

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242

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

 .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("ALL","OR LAPSE ORDERS",ORDISP)

 ...;get default lapse parameter if one for display group not set

 ...I '$G(ORPARAM) S ORPARAM=$$GET^XPAR("ALL","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,1)<ORPARAM Q

 ...;if old then lapse

 ...D LAPSE^ORCSAVE2(ORN_";"_ORACT)

 ;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)

ORTSKLPS  ;SLC/JMH-nightly task to lapse old unsigned orders ; 4/9/08 10:00am

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242

 +2       ;

TASK      ;

 +1       ;only run between Midnight and 1:59:59 AM

 +2        IF $EXTRACT($PIECE($$NOW^XLFDT,".",2),1,2)>1

               QUIT

 +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               SET ORINVDT=0

FOR

                       SET ORINVDT=$ORDER(^OR(100,"AS",ORVP,ORINVDT))

                       IF 'ORINVDT

                           QUIT

                       Begin DoDot:2

 +12                       SET ORDT=9999999-ORINVDT

 +13                       SET ORN=0

FOR

                               SET ORN=$ORDER(^OR(100,"AS",ORVP,ORINVDT,ORN))

                               IF 'ORN

                                   QUIT

                               Begin DoDot:3

 +14      ;don't lapse if order does not have a status of unreleased (11)

 +15                               IF $PIECE($GET(^OR(100,ORN,3)),U,3)'=11

                                       QUIT

 +16      ;get order action

 +17                               SET ORACT=$ORDER(^OR(100,"AS",ORVP,ORINVDT,ORN,""))

 +18      ;get order dialog

 +19                               SET ORDIAL=$PIECE($GET(^OR(100,ORN,0)),U,5)

 +20                               IF $PIECE(ORDIAL,";",2)='"ORD(101.41,"

                                       QUIT

 +21      ;using order dialog get display group

 +22                               SET ORDISP=$PIECE($GET(^ORD(101.41,+ORDIAL,0)),U,5)

 +23                               IF +ORDISP

                                       SET ORDISP=$PIECE($GET(^ORD(100.98,+ORDISP,0)),U)

 +24      ;get lapse parameter for display group

 +25                               IF $LENGTH(ORDISP)

                                       SET ORPARAM=$$GET^XPAR("ALL","OR LAPSE ORDERS",ORDISP)

 +26      ;get default lapse parameter if one for display group not set

 +27                               IF '$GET(ORPARAM)

                                       SET ORPARAM=$$GET^XPAR("ALL","OR LAPSE ORDERS DFLT")

 +28      ;quit if ORPARAM isn't even set

 +29                               IF '$LENGTH(ORPARAM)

                                       QUIT

 +30      ;quit if order is not older than T-(days for lapse)

 +31                               IF $$FMDIFF^XLFDT($$NOW^XLFDT,ORDT,1)<ORPARAM

                                       QUIT

 +32      ;if old then lapse

 +33                               DO LAPSE^ORCSAVE2(ORN_";"_ORACT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +34      ;loop through pending events

 +35       NEW ORPT,OREVT,ORPTR,Y

 +36       SET ORPT=""

FOR

               SET ORPT=$ORDER(^ORE(100.2,"AE",ORPT))

               IF 'ORPT

                   QUIT

               Begin DoDot:1

 +37               SET OREVT=""

FOR

                       SET OREVT=$ORDER(^ORE(100.2,"AE",ORPT,OREVT))

                       IF 'OREVT

                           QUIT

                       Begin DoDot:2

 +38                       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

 +39       QUIT

ORTSKLPS.m