| 1 | ORY24 ;SLC/MKB-Postinit for OR*3*24 ;4/16/98  16:18
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**24**;Dec 17, 1997
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | EN ; -- start here
 | 
|---|
| 5 |  N X S X=$$GET^XPAR("ALL","ORPF DC OF GENERIC ORDERS")
 | 
|---|
| 6 |  D:'$L(X) EN^XPAR("SYS","ORPF DC OF GENERIC ORDERS",1,2)
 | 
|---|
| 7 |  S X=$$GET^XPAR("ALL","OR DC GEN ORD ON ADMISSION")
 | 
|---|
| 8 |  D:'$L(X) EN^XPAR("SYS","OR DC GEN ORD ON ADMISSION",1,0)
 | 
|---|
| 9 |  Q
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 | TASK ; -- start here to task status update
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
 | 
|---|
| 14 |  S ZTDESC="Expire text orders more than 90 days old",ZTDTH=$H,ZTIO=""
 | 
|---|
| 15 |  S ZTRTN="EXP^ORY24" D ^%ZTLOAD
 | 
|---|
| 16 |  W !,"Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" queued."
 | 
|---|
| 17 |  Q
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | EXP ; -- expire text orders more than 90 days old
 | 
|---|
| 20 |  N ORPKG,ORALG,ORNOW,OROLD,ORIFN,OR0,OR3,ORSTRT,ORSTOP,ORLAST
 | 
|---|
| 21 |  S ORPKG=+$O(^DIC(9.4,"C","OR",0)),ORALG=+$O(^DIC(9.4,"C","GMRA",0))
 | 
|---|
| 22 |  S ORNOW=$$NOW^XLFDT,OROLD=$$FMADD^XLFDT(ORNOW,-90),ORIFN=0
 | 
|---|
| 23 |  F  S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN'>0  S OR0=$G(^(ORIFN,0)),OR3=$G(^(3)) I "^1^2^7^12^13^14^15^"'[(U_$P(OR3,U,3)_U) D  ;still active
 | 
|---|
| 24 |  . S ORSTRT=$P(OR0,U,8),ORSTOP=$P(OR0,U,9),ORLAST=$P(OR3,U)
 | 
|---|
| 25 |  . I $P(OR0,U,14)=ORALG,ORSTRT,ORSTRT<OROLD D RESET(2,ORLAST) Q
 | 
|---|
| 26 |  . Q:$P(OR0,U,14)'=ORPKG  ; ** generic orders only:
 | 
|---|
| 27 |  . I ORSTOP D:ORSTOP'>ORNOW RESET(7) S:ORSTOP>ORNOW ^OR(100,"AE",ORSTOP,ORIFN)="" Q
 | 
|---|
| 28 |  . I ORSTRT,ORSTRT<OROLD D RESET(7,ORLAST) Q
 | 
|---|
| 29 |  Q
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 | RESET(NEWSTS,STOP) ; -- reset terminal fields for ORIFN
 | 
|---|
| 32 |  S:$G(NEWSTS) $P(^OR(100,ORIFN,3),U,3)=NEWSTS
 | 
|---|
| 33 |  S:$G(STOP) $P(^OR(100,ORIFN,0),U,9)=STOP
 | 
|---|
| 34 |  D SETALL^ORDD100(ORIFN)
 | 
|---|
| 35 |  Q
 | 
|---|