source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY24.m@ 1384

Last change on this file since 1384 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1ORY24 ;SLC/MKB-Postinit for OR*3*24 ;4/16/98 16:18
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**24**;Dec 17, 1997
3 ;
4EN ; -- 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 ;
11TASK ; -- 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 ;
19EXP ; -- 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 ;
31RESET(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
Note: See TracBrowser for help on using the repository browser.