| 1 | ORTASK01 ; SLC/RJS - Look for orders to purge; [1/2/01 11:44am]
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**98**;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; QUIT added below by PKS (SLC) on 11/27/2000 to prevent potential
|
|---|
| 5 | ; for any sites using unfinished ORTASK PURGE as scheduled option:
|
|---|
| 6 | ;
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | S ;
|
|---|
| 10 | N ORCNT,ORT0,ORT3,ORTERR,ORTGRC,ORTNOW,ORTORD,ORTPDT,ORTRUN,X,%DT
|
|---|
| 11 | ;
|
|---|
| 12 | I '$G(ZTSK) D HELP S ORTRUN=$$READ("Y","Want to run the purge now ","NO") Q:(ORTRUN[U) Q:('ORTRUN)
|
|---|
| 13 | ;
|
|---|
| 14 | S ORTORD=$$GET^XPAR("ALL","ORPF LAST ORDER PURGED") S:(ORTORD<1) ORTORD=0
|
|---|
| 15 | S ORTGRC=$$GET^XPAR("ALL","ORPF GRACE DAYS BEFORE PURGE") S:(ORTGRC<1) ORTGRC=90
|
|---|
| 16 | S %DT="",X="T-"_ORTGRC D ^%DT S ORTPDT=+Y
|
|---|
| 17 | S %DT="",X="T" D ^%DT S ORTNOW=+Y
|
|---|
| 18 | ;
|
|---|
| 19 | S ORTERR=0 D F ORCNT=0:1 S ORTORD=$O(^OR(100,ORTORD)) Q:'ORTORD D Q:ORTERR
|
|---|
| 20 | .Q:'ORTORD Q:ORTERR
|
|---|
| 21 | .;
|
|---|
| 22 | .D EN^XPAR("SYS","ORPF LAST ORDER PURGED",1,"`"_ORTORD,.ORTERR) Q:ORTERR
|
|---|
| 23 | .;
|
|---|
| 24 | .S ORT0=$G(^OR(100,ORTORD,0))
|
|---|
| 25 | .S ORT3=$G(^OR(100,ORTORD,3))
|
|---|
| 26 | .;
|
|---|
| 27 | .Q:(ORTPDT<ORT3) ; DATE OF LAST ACTIVITY IS AFTER PURGE DATE
|
|---|
| 28 | .;
|
|---|
| 29 | .Q:(ORTNOW<$P(ORT0,U,8)) ; ORDER START DATE IS IN THE FUTURE
|
|---|
| 30 | .;
|
|---|
| 31 | .Q:'("^0^1^2^7^12^13^14^"[("^"_(+$P(ORT3,U,3))_"^")) ; LAST ACTIVITY STATUS IS NOT TERMINAL
|
|---|
| 32 | .;
|
|---|
| 33 | .Q:$P(ORT3,U,9) ; CHILD ORDER
|
|---|
| 34 | .;
|
|---|
| 35 | .D PURGE^ORMEVNT(ORTORD)
|
|---|
| 36 | .;
|
|---|
| 37 | ;
|
|---|
| 38 | D EN^XPAR("SYS","ORPF LAST ORDER PURGED",1,"",.ORTERR) Q:ORTERR
|
|---|
| 39 | D PUT^XPAR("SYS","ORPF LAST PURGE DATE",1,DT,.ORTERR) Q:ORTERR
|
|---|
| 40 | ;
|
|---|
| 41 | D:$G(ZTSK) KILL^%ZTLOAD
|
|---|
| 42 | ;
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | HELP ;
|
|---|
| 46 | N LINE,TEXT
|
|---|
| 47 | W !!
|
|---|
| 48 | F LINE=1:1:999 S TEXT=$P($T(HELPTEXT+LINE),";",2,999) Q:TEXT W !,$P(TEXT,";",2,999)
|
|---|
| 49 | W !!
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | HELPTEXT ;;
|
|---|
| 53 | ;; Option: ORTASK PURGE (Old Orders Batch Purge)
|
|---|
| 54 | ;;
|
|---|
| 55 | ;; This is a purge of all orders that have a 'Last Activity Date' of more
|
|---|
| 56 | ;; than the number of 'Grace days' ago. It also checks to make sure the
|
|---|
| 57 | ;; orders that are purged are 'Child' orders, have an order start date in
|
|---|
| 58 | ;; the past, and have a 'Terminal' status.
|
|---|
| 59 | ;;
|
|---|
| 60 | ;; As this option scans the entire Orders file, it should be sheduled to
|
|---|
| 61 | ;; run after hours.
|
|---|
| 62 | ;1;
|
|---|
| 63 | ;
|
|---|
| 64 | READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
|
|---|
| 65 | N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 66 | Q:'$L($G(OCXZ0)) U
|
|---|
| 67 | S DIR(0)=OCXZ0
|
|---|
| 68 | S:$L($G(OCXZA)) DIR("A")=OCXZA
|
|---|
| 69 | S:$L($G(OCXZB)) DIR("B")=OCXZB
|
|---|
| 70 | F OCXLINE=1:1:($G(OCXZL)-1) W !
|
|---|
| 71 | D ^DIR
|
|---|
| 72 | I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
|
|---|
| 73 | Q Y
|
|---|
| 74 | ;
|
|---|
