ORY24.m

ORY24 ;SLC/MKB-Postinit for OR*3*24 ;4/16/98  16:18

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**24**;Dec 17, 1997

 ;

EN ; -- start here

 N X S X=$$GET^XPAR("ALL","ORPF DC OF GENERIC ORDERS")

 D:'$L(X) EN^XPAR("SYS","ORPF DC OF GENERIC ORDERS",1,2)

 S X=$$GET^XPAR("ALL","OR DC GEN ORD ON ADMISSION")

 D:'$L(X) EN^XPAR("SYS","OR DC GEN ORD ON ADMISSION",1,0)

 Q

 ;

TASK ; -- start here to task status update

 ;

 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK

 S ZTDESC="Expire text orders more than 90 days old",ZTDTH=$H,ZTIO=""

 S ZTRTN="EXP^ORY24" D ^%ZTLOAD

 W !,"Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" queued."

 Q

 ;

EXP ; -- expire text orders more than 90 days old

 N ORPKG,ORALG,ORNOW,OROLD,ORIFN,OR0,OR3,ORSTRT,ORSTOP,ORLAST

 S ORPKG=+$O(^DIC(9.4,"C","OR",0)),ORALG=+$O(^DIC(9.4,"C","GMRA",0))

 S ORNOW=$$NOW^XLFDT,OROLD=$$FMADD^XLFDT(ORNOW,-90),ORIFN=0

 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

 . S ORSTRT=$P(OR0,U,8),ORSTOP=$P(OR0,U,9),ORLAST=$P(OR3,U)

 . I $P(OR0,U,14)=ORALG,ORSTRT,ORSTRT<OROLD D RESET(2,ORLAST) Q

 . Q:$P(OR0,U,14)'=ORPKG  ; ** generic orders only:

 . I ORSTOP D:ORSTOP'>ORNOW RESET(7) S:ORSTOP>ORNOW ^OR(100,"AE",ORSTOP,ORIFN)="" Q

 . I ORSTRT,ORSTRT<OROLD D RESET(7,ORLAST) Q

 Q

 ;

RESET(NEWSTS,STOP) ; -- reset terminal fields for ORIFN

 S:$G(NEWSTS) $P(^OR(100,ORIFN,3),U,3)=NEWSTS

 S:$G(STOP) $P(^OR(100,ORIFN,0),U,9)=STOP

 D SETALL^ORDD100(ORIFN)

 Q

ORY24     ;SLC/MKB-Postinit for OR*3*24 ;4/16/98  16:18

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**24**;Dec 17, 1997

 +2       ;

EN        ; -- start here

 +1        NEW X

           SET X=$$GET^XPAR("ALL","ORPF DC OF GENERIC ORDERS")

 +2        IF '$LENGTH(X)

               DO EN^XPAR("SYS","ORPF DC OF GENERIC ORDERS",1,2)

 +3        SET X=$$GET^XPAR("ALL","OR DC GEN ORD ON ADMISSION")

 +4        IF '$LENGTH(X)

               DO EN^XPAR("SYS","OR DC GEN ORD ON ADMISSION",1,0)

 +5        QUIT 

 +6       ;

TASK      ; -- start here to task status update

 +1       ;

 +2        NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK

 +3        SET ZTDESC="Expire text orders more than 90 days old"

           SET ZTDTH=$HOROLOG

           SET ZTIO=""

 +4        SET ZTRTN="EXP^ORY24"

           DO ^%ZTLOAD

 +5        WRITE !,"Task "_$SELECT($GET(ZTSK):"#"_ZTSK,1:"not")_" queued."

 +6        QUIT 

 +7       ;

EXP       ; -- expire text orders more than 90 days old

 +1        NEW ORPKG,ORALG,ORNOW,OROLD,ORIFN,OR0,OR3,ORSTRT,ORSTOP,ORLAST

 +2        SET ORPKG=+$ORDER(^DIC(9.4,"C","OR",0))

           SET ORALG=+$ORDER(^DIC(9.4,"C","GMRA",0))

 +3        SET ORNOW=$$NOW^XLFDT

           SET OROLD=$$FMADD^XLFDT(ORNOW,-90)

           SET ORIFN=0

 +4       ;still active

           FOR 

               SET ORIFN=$ORDER(^OR(100,ORIFN))

               IF ORIFN'>0

                   QUIT 

               SET OR0=$GET(^(ORIFN,0))

               SET OR3=$GET(^(3))

               IF "^1^2^7^12^13^14^15^"'[(U_$PIECE(OR3,U,3)_U)

                   Begin DoDot:1

 +5                    SET ORSTRT=$PIECE(OR0,U,8)

                       SET ORSTOP=$PIECE(OR0,U,9)

                       SET ORLAST=$PIECE(OR3,U)

 +6                    IF $PIECE(OR0,U,14)=ORALG

                           IF ORSTRT

                               IF ORSTRT<OROLD

                                   DO RESET(2,ORLAST)

                                   QUIT 

 +7       ; ** generic orders only:

                       IF $PIECE(OR0,U,14)'=ORPKG

                           QUIT 

 +8                    IF ORSTOP

                           IF ORSTOP'>ORNOW

                               DO RESET(7)

                           IF ORSTOP>ORNOW

                               SET ^OR(100,"AE",ORSTOP,ORIFN)=""

                           QUIT 

 +9                    IF ORSTRT

                           IF ORSTRT<OROLD

                               DO RESET(7,ORLAST)

                               QUIT 

                   End DoDot:1

 +10       QUIT 

 +11      ;

RESET(NEWSTS,STOP) ; -- reset terminal fields for ORIFN

 +1        IF $GET(NEWSTS)

               SET $PIECE(^OR(100,ORIFN,3),U,3)=NEWSTS

 +2        IF $GET(STOP)

               SET $PIECE(^OR(100,ORIFN,0),U,9)=STOP

 +3        DO SETALL^ORDD100(ORIFN)

 +4        QUIT