ORWOR.m

ORWOR ; SLC/KCM - Orders Calls;10:54 PM  08/15/2006

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,141,163,187,190,215,243**;Dec 17, 1997;Build 242

 ;

CURRENT(LST,DFN) ; Get Current Orders for a Patient

 ; Returns two lists in ^TMP("ORW",$J), fields and text

 N TM,IEN,X,X0,X3,CTR,IDX,I

 K ^TMP("ORW",$J)

 S IDX=0,DFN=DFN_";DPT("

 S TM=0 F  S TM=$O(^OR(100,"AC",DFN,TM)) Q:TM<1  D

 . S IEN=0 F  S IEN=$O(^OR(100,"AC",DFN,TM,IEN)) Q:IEN<1  D

 . . S X0=^OR(100,IEN,0),X3=^(3)

 . . S X=IEN_U_$P(X0,U,7)_U_$P(X0,U,11)_U_$P(X3,U,6)_U_$P(X3,U,3)

 . . S ^TMP("ORW",$J,IDX+1)=X

 . . S (CTR,I)=0,X=""

 . . F  S I=$O(^OR(100,IEN,1,I)) Q:I<1  D  Q:CTR>244

 . . . S X=X_$E(^OR(100,IEN,1,I,0),1,(245-CTR)),CTR=$L(X)

 . . S ^TMP("ORW",$J,IDX+2)=X,IDX=IDX+2

 ; S LST=$NA(^TMP("ORW",$J))

 M LST=^TMP("ORW",$J)

 Q

DETAIL(LST,ORID,DFN)    ; Return details of ORID (shell to kill VIDEO subs)

 Q:'+ORID

 I $G(DFN) N ORVP S ORVP=DFN_";DPT("

 S LST="^TMP(""ORTXT"",$J)"

 D DETAIL^ORQ2(.LST,ORID)

 K @LST@("VIDEO")

 S LST=$NA(^TMP("ORTXT",$J)),@LST=""

 Q

RESULT(REF,DFN,ORID,ID)      ; Return results of order identified by ID

 K ^TMP("ORXPND",$J)

 N ORESULTS,ORVP,LCNT S ORESULTS=1,LCNT=0,ORVP=DFN_";DPT("

 D ORDERS^ORCXPND1

 K ^TMP("ORXPND",$J,"VIDEO")

 S REF=$NA(^TMP("ORXPND",$J))

 Q

RESHIST(REF,DFN,ORID,ID)      ; Return result history of associated tests identified by ID

 K ^TMP("ORXPND",$J)

 N ORESULTS,ORVP,LCNT

 S ORESULTS=1,LCNT=0,ORVP=DFN_";DPT("

 D ORDHIST^ORWOR2

 K ^TMP("ORXPND",$J,"VIDEO")

 S REF=$NA(^TMP("ORXPND",$J))

 Q

TSALL(LST)      ; Return list of treating specialties

 N Y S Y=0

 F  S Y=$O(^DIC(45.7,Y)) Q:'Y  I $$ACTIVE^DGACT(45.7,Y) S LST(Y)=Y_U_$P(^DIC(45.7,Y,0),U)

 Q

DT(X) ; -- Returns FM date for X (SEE ORCHTAB1)

 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT

 Q +Y

VWSET(ORERR,VIEW)       ; Set the preferred view for orders

 ; VIEW:  semi-colon delimited record

 ;        1 - Relative From Date/Time or ""

 ;        2 - Relative Thru Date/Time or ""

 ;        3 - Filter

 ;        4 - Display Group Pointer

 ;        5 - Format (preserve for list manager)

 ;        6 - chronological display (R or F)

 ;        7 - sort by display group

 N FMT

 ; use short name for display group instead of pointer

 I $E($P(VIEW,";",2))="T" S $P(VIEW,";",2)=$P($P(VIEW,";",2),"@") ;allows all orders for Today

 S $P(VIEW,";",4)=$P($G(^ORD(100.98,+$P(VIEW,";",4),0)),U,3)

 ; use last saved format, since this is used only by LM

 S FMT=$P($$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I"),";",5)

 S:'$L(FMT) FMT="L" S $P(VIEW,";",5)=FMT

 ; and save the parameter

 D EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT ORDERS",1,VIEW,.ORERR)

 Q

VWGET(REC)      ; Get the preferred view for orders

 N FROM,THRU,FILTER,DGRP,FRMT,CHRN,BYGRP,S,VNAME,FL

 S REC=$$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I"),S=";"

 S FROM=$$DT($P(REC,S)),THRU=$$DT($P(REC,S,2)),FILTER=$P(REC,S,3)

 S DGRP=$P(REC,S,4),FRMT=$P(REC,S,5),CHRN=$P(REC,S,6),BYGRP=$P(REC,S,7)

 S:'$L(DGRP) DGRP="ALL" S DGRP=+$O(^ORD(100.98,"B",DGRP,0))

 I FILTER="" S FILTER=2  ; active orders

 I CHRN="" S CHRN="R"    ; reverse chronological

 I BYGRP="" S BYGRP=1    ; sort by display group

 ; set up view name

 D REVSTS^ORWORDG(.FL)

 S I=0 F  S I=$O(FL(I)) Q:'I  Q:+FL(I)=FILTER

 S VNAME=$P($G(FL(+I)),U,2)

 I '("^6^8^9^10^19^20^"[(U_FILTER_U)) S VNAME=VNAME_" Orders"

 I FILTER=2 S VNAME="Active Orders (includes Pending & Recent Activity)"

 I FILTER=23 S VNAME="Current Orders (Active & Pending Status Only)"

 S VNAME=VNAME_" - "_$P($G(^ORD(100.98,DGRP,0)),U)

 I (FROM>0)!(THRU>0) D

 . S VNAME=VNAME_" ("_$$FMTE^XLFDT(FROM,"2D")_" thru "

 . S VNAME=VNAME_$S(THRU>0:$$FMTE^XLFDT(THRU,"2D"),1:"")_")"

 S REC=FROM_S_THRU_S_FILTER_S_DGRP_S_FRMT_S_CHRN_S_BYGRP_S_VNAME

 Q

SHEETS(LST,ORVP) ; Return Order Sheets for a patient

 N ELST,ETYP,ORIFN,TS,I

 S ORVP=ORVP_";DPT("

 S ETYP="" F  S ETYP=$O(^OR(100,"AEVNT",ORVP,ETYP)) Q:ETYP=""  D

 . S ORIFN=0 F  S ORIFN=$O(^OR(100,"AEVNT",ORVP,ETYP,ORIFN)) Q:'ORIFN  D

 . . I (ETYP="A")!(ETYP="T") S ELST(ETYP,$P($G(^OR(100,+ORIFN,0)),U,13))=""

 S LST(1)="C;O^Current View",I=1

 S TS="" F  S TS=$O(ELST("A",TS)) Q:TS=""  D

 . S I=I+1,LST(I)="A;"_TS_U_"Admit to "_$P($G(^DIC(45.7,TS,0)),U)

 S I=I+1,LST(I)="A;-1^Admit..."

 S TS="" F  S TS=$O(ELST("T",TS)) Q:TS=""  D

 . S I=I+1,LST(I)="T;"_TS_U_"Transfer to "_$P($G(^DIC(45.7,TS,0)),U)

 I $L($G(^DPT(+ORVP,.1))) D

 . S I=I+1,LST(I)="T;-1^Transfer..."

 . S I=I+1,LST(I)="D;0^Discharge"

 Q

EVENTS(LST,EVT) ; Return general delayed events categories for a patient

 N EVTI

 S EVTI=0

 S EVTI=EVTI+1,LST(EVTI)="A;-1^Admit..."

 S EVTI=EVTI+1,LST(EVTI)="T;-1^Transfer..."

 S EVTI=EVTI+1,LST(EVTI)="D;0^Discharge"

 Q

UNSIGN(LST,ORVP,HAVE)   ; Return Unsigned Orders that are not on client

 N IFN,ACT,X8,ENT,LVL,TM,ILST S ILST=0

 Q:'$D(^XUSEC("ORES",DUZ))

 S ORVP=ORVP_";DPT("

 S ENT="ALL"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"")

 S LVL=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT")

 Q:'LVL

 S TM=0 F  S TM=$O(^OR(100,"AS",ORVP,TM)) Q:TM<1  D

 . S IFN=0 F  S IFN=$O(^OR(100,"AS",ORVP,TM,IFN)) Q:IFN<1  D

 . . S ACT=0 F  S ACT=$O(^OR(100,"AS",ORVP,TM,IFN,ACT)) Q:ACT<1  D

 . . . Q:$D(HAVE(IFN_";"_ACT))                        ;in Changes

 . . . S X8=$G(^OR(100,IFN,8,ACT,0))

 . . . I '$S(LVL=1&($P(X8,U,3)=DUZ):1,LVL=2:1,1:0) Q  ;chk user

 . . . S ILST=ILST+1,LST(ILST)=IFN_";"_ACT_U_$P(X8,U,3)

 Q

PKIUSE(RETURN) ; RPC determines user can use PKI Digital Signature

 S RETURN=0

 I $$GET^XPAR("ALL^USR.`"_DUZ,"ORWOR PKI USE",1,"Q") S RETURN=1

 Q

PKISITE(RETURN) ; RPC determines if PKI is turned on at the site

 S RETURN=0

 Q:'$L($T(STORESIG^XUSSPKI))  ;Check for Kernel piece

 Q:'$L($T(DOSE^PSSOPKI1))  ;Check for Pharmacy piece

 I $$GET^XPAR("ALL","ORWOR PKI SITE",1,"Q") S RETURN=1

 Q

ACTXT(ORY,ORIFN) ;Return detail action information

 N ORI,CNT,OR0,OR3,OR6

 K ^TMP("ORACTXT",$J)

 S ORY="^TMP(""ORACTXT"",$J)",ORI=$P(ORIFN,";",2)

 S CNT=0,ORIFN=+ORIFN,OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6))

 F  S ORI=$O(^OR(100,+ORIFN,8,ORI)) Q:ORI'>0  S ACTION=$G(^(ORI,0)) D ACT^ORQ20

 S ORY=$NA(^TMP("ORACTXT",$J)),@ORY=""

 Q

EXPIRED(ORY) ;return FM date/time to begin search for expired orders

 N HRS

 S HRS=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I")

 S ORY=$$FMADD^XLFDT($$NOW^XLFDT,"","-"_HRS,"","")

 Q

ORWOR     ; SLC/KCM - Orders Calls;10:54 PM  08/15/2006

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,141,163,187,190,215,243**;Dec 17, 1997;Build 242

 +2       ;

CURRENT(LST,DFN) ; Get Current Orders for a Patient

 +1       ; Returns two lists in ^TMP("ORW",$J), fields and text

 +2        NEW TM,IEN,X,X0,X3,CTR,IDX,I

 +3        KILL ^TMP("ORW",$JOB)

 +4        SET IDX=0

           SET DFN=DFN_";DPT("

 +5        SET TM=0

           FOR 

               SET TM=$ORDER(^OR(100,"AC",DFN,TM))

               IF TM<1

                   QUIT 

               Begin DoDot:1

 +6                SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^OR(100,"AC",DFN,TM,IEN))

                       IF IEN<1

                           QUIT 

                       Begin DoDot:2

 +7                        SET X0=^OR(100,IEN,0)

                           SET X3=^(3)

 +8                        SET X=IEN_U_$PIECE(X0,U,7)_U_$PIECE(X0,U,11)_U_$PIECE(X3,U,6)_U_$PIECE(X3,U,3)

 +9                        SET ^TMP("ORW",$JOB,IDX+1)=X

 +10                       SET (CTR,I)=0

                           SET X=""

 +11                       FOR 

                               SET I=$ORDER(^OR(100,IEN,1,I))

                               IF I<1

                                   QUIT 

                               Begin DoDot:3

 +12                               SET X=X_$EXTRACT(^OR(100,IEN,1,I,0),1,(245-CTR))

                                   SET CTR=$LENGTH(X)

                               End DoDot:3

                               IF CTR>244

                                   QUIT 

 +13                       SET ^TMP("ORW",$JOB,IDX+2)=X

                           SET IDX=IDX+2

                       End DoDot:2

               End DoDot:1

 +14      ; S LST=$NA(^TMP("ORW",$J))

 +15       MERGE LST=^TMP("ORW",$JOB)

 +16       QUIT 

DETAIL(LST,ORID,DFN) ; Return details of ORID (shell to kill VIDEO subs)

 +1        IF '+ORID

               QUIT 

 +2        IF $GET(DFN)

               NEW ORVP

               SET ORVP=DFN_";DPT("

 +3        SET LST="^TMP(""ORTXT"",$J)"

 +4        DO DETAIL^ORQ2(.LST,ORID)

 +5        KILL @LST@("VIDEO")

 +6        SET LST=$NAME(^TMP("ORTXT",$JOB))

           SET @LST=""

 +7        QUIT 

RESULT(REF,DFN,ORID,ID) ; Return results of order identified by ID

 +1        KILL ^TMP("ORXPND",$JOB)

 +2        NEW ORESULTS,ORVP,LCNT

           SET ORESULTS=1

           SET LCNT=0

           SET ORVP=DFN_";DPT("

 +3        DO ORDERS^ORCXPND1

 +4        KILL ^TMP("ORXPND",$JOB,"VIDEO")

 +5        SET REF=$NAME(^TMP("ORXPND",$JOB))

 +6        QUIT 

RESHIST(REF,DFN,ORID,ID) ; Return result history of associated tests identified by ID

 +1        KILL ^TMP("ORXPND",$JOB)

 +2        NEW ORESULTS,ORVP,LCNT

 +3        SET ORESULTS=1

           SET LCNT=0

           SET ORVP=DFN_";DPT("

 +4        DO ORDHIST^ORWOR2

 +5        KILL ^TMP("ORXPND",$JOB,"VIDEO")

 +6        SET REF=$NAME(^TMP("ORXPND",$JOB))

 +7        QUIT 

TSALL(LST) ; Return list of treating specialties

 +1        NEW Y

           SET Y=0

 +2        FOR 

               SET Y=$ORDER(^DIC(45.7,Y))

               IF 'Y

                   QUIT 

               IF $$ACTIVE^DGACT(45.7,Y)

                   SET LST(Y)=Y_U_$PIECE(^DIC(45.7,Y,0),U)

 +3        QUIT 

DT(X)     ; -- Returns FM date for X (SEE ORCHTAB1)

 +1        NEW Y,%DT

           SET %DT="T"

           SET Y=""

           IF X'=""

               DO ^%DT

 +2        QUIT +Y

VWSET(ORERR,VIEW) ; Set the preferred view for orders

 +1       ; VIEW:  semi-colon delimited record

 +2       ;        1 - Relative From Date/Time or ""

 +3       ;        2 - Relative Thru Date/Time or ""

 +4       ;        3 - Filter

 +5       ;        4 - Display Group Pointer

 +6       ;        5 - Format (preserve for list manager)

 +7       ;        6 - chronological display (R or F)

 +8       ;        7 - sort by display group

 +9        NEW FMT

 +10      ; use short name for display group instead of pointer

 +11      ;allows all orders for Today

           IF $EXTRACT($PIECE(VIEW,";",2))="T"

               SET $PIECE(VIEW,";",2)=$PIECE($PIECE(VIEW,";",2),"@")

 +12       SET $PIECE(VIEW,";",4)=$PIECE($GET(^ORD(100.98,+$PIECE(VIEW,";",4),0)),U,3)

 +13      ; use last saved format, since this is used only by LM

 +14       SET FMT=$PIECE($$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I"),";",5)

 +15       IF '$LENGTH(FMT)

               SET FMT="L"

           SET $PIECE(VIEW,";",5)=FMT

 +16      ; and save the parameter

 +17       DO EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT ORDERS",1,VIEW,.ORERR)

 +18       QUIT 

VWGET(REC) ; Get the preferred view for orders

 +1        NEW FROM,THRU,FILTER,DGRP,FRMT,CHRN,BYGRP,S,VNAME,FL

 +2        SET REC=$$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I")

           SET S=";"

 +3        SET FROM=$$DT($PIECE(REC,S))

           SET THRU=$$DT($PIECE(REC,S,2))

           SET FILTER=$PIECE(REC,S,3)

 +4        SET DGRP=$PIECE(REC,S,4)

           SET FRMT=$PIECE(REC,S,5)

           SET CHRN=$PIECE(REC,S,6)

           SET BYGRP=$PIECE(REC,S,7)

 +5        IF '$LENGTH(DGRP)

               SET DGRP="ALL"

           SET DGRP=+$ORDER(^ORD(100.98,"B",DGRP,0))

 +6       ; active orders

           IF FILTER=""

               SET FILTER=2

 +7       ; reverse chronological

           IF CHRN=""

               SET CHRN="R"

 +8       ; sort by display group

           IF BYGRP=""

               SET BYGRP=1

 +9       ; set up view name

 +10       DO REVSTS^ORWORDG(.FL)

 +11       SET I=0

           FOR 

               SET I=$ORDER(FL(I))

               IF 'I

                   QUIT 

               IF +FL(I)=FILTER

                   QUIT 

 +12       SET VNAME=$PIECE($GET(FL(+I)),U,2)

 +13       IF '("^6^8^9^10^19^20^"[(U_FILTER_U))

               SET VNAME=VNAME_" Orders"

 +14       IF FILTER=2

               SET VNAME="Active Orders (includes Pending & Recent Activity)"

 +15       IF FILTER=23

               SET VNAME="Current Orders (Active & Pending Status Only)"

 +16       SET VNAME=VNAME_" - "_$PIECE($GET(^ORD(100.98,DGRP,0)),U)

 +17       IF (FROM>0)!(THRU>0)

               Begin DoDot:1

 +18               SET VNAME=VNAME_" ("_$$FMTE^XLFDT(FROM,"2D")_" thru "

 +19               SET VNAME=VNAME_$SELECT(THRU>0:$$FMTE^XLFDT(THRU,"2D"),1:"")_")"

               End DoDot:1

 +20       SET REC=FROM_S_THRU_S_FILTER_S_DGRP_S_FRMT_S_CHRN_S_BYGRP_S_VNAME

 +21       QUIT 

SHEETS(LST,ORVP) ; Return Order Sheets for a patient

 +1        NEW ELST,ETYP,ORIFN,TS,I

 +2        SET ORVP=ORVP_";DPT("

 +3        SET ETYP=""

           FOR 

               SET ETYP=$ORDER(^OR(100,"AEVNT",ORVP,ETYP))

               IF ETYP=""

                   QUIT 

               Begin DoDot:1

 +4                SET ORIFN=0

                   FOR 

                       SET ORIFN=$ORDER(^OR(100,"AEVNT",ORVP,ETYP,ORIFN))

                       IF 'ORIFN

                           QUIT 

                       Begin DoDot:2

 +5                        IF (ETYP="A")!(ETYP="T")

                               SET ELST(ETYP,$PIECE($GET(^OR(100,+ORIFN,0)),U,13))=""

                       End DoDot:2

               End DoDot:1

 +6        SET LST(1)="C;O^Current View"

           SET I=1

 +7        SET TS=""

           FOR 

               SET TS=$ORDER(ELST("A",TS))

               IF TS=""

                   QUIT 

               Begin DoDot:1

 +8                SET I=I+1

                   SET LST(I)="A;"_TS_U_"Admit to "_$PIECE($GET(^DIC(45.7,TS,0)),U)

               End DoDot:1

 +9        SET I=I+1

           SET LST(I)="A;-1^Admit..."

 +10       SET TS=""

           FOR 

               SET TS=$ORDER(ELST("T",TS))

               IF TS=""

                   QUIT 

               Begin DoDot:1

 +11               SET I=I+1

                   SET LST(I)="T;"_TS_U_"Transfer to "_$PIECE($GET(^DIC(45.7,TS,0)),U)

               End DoDot:1

 +12       IF $LENGTH($GET(^DPT(+ORVP,.1)))

               Begin DoDot:1

 +13               SET I=I+1

                   SET LST(I)="T;-1^Transfer..."

 +14               SET I=I+1

                   SET LST(I)="D;0^Discharge"

               End DoDot:1

 +15       QUIT 

EVENTS(LST,EVT) ; Return general delayed events categories for a patient

 +1        NEW EVTI

 +2        SET EVTI=0

 +3        SET EVTI=EVTI+1

           SET LST(EVTI)="A;-1^Admit..."

 +4        SET EVTI=EVTI+1

           SET LST(EVTI)="T;-1^Transfer..."

 +5        SET EVTI=EVTI+1

           SET LST(EVTI)="D;0^Discharge"

 +6        QUIT 

UNSIGN(LST,ORVP,HAVE) ; Return Unsigned Orders that are not on client

 +1        NEW IFN,ACT,X8,ENT,LVL,TM,ILST

           SET ILST=0

 +2        IF '$DATA(^XUSEC("ORES",DUZ))

               QUIT 

 +3        SET ORVP=ORVP_";DPT("

 +4        SET ENT="ALL"_$SELECT($GET(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"")

 +5        SET LVL=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT")

 +6        IF 'LVL

               QUIT 

 +7        SET TM=0

           FOR 

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

               IF TM<1

                   QUIT 

               Begin DoDot:1

 +8                SET IFN=0

                   FOR 

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

                       IF IFN<1

                           QUIT 

                       Begin DoDot:2

 +9                        SET ACT=0

                           FOR 

                               SET ACT=$ORDER(^OR(100,"AS",ORVP,TM,IFN,ACT))

                               IF ACT<1

                                   QUIT 

                               Begin DoDot:3

 +10      ;in Changes

                                   IF $DATA(HAVE(IFN_";"_ACT))

                                       QUIT 

 +11                               SET X8=$GET(^OR(100,IFN,8,ACT,0))

 +12      ;chk user

                                   IF '$SELECT(LVL=1&($PIECE(X8,U,3)=DUZ):1,LVL=2:1,1:0)

                                       QUIT 

 +13                               SET ILST=ILST+1

                                   SET LST(ILST)=IFN_";"_ACT_U_$PIECE(X8,U,3)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

PKIUSE(RETURN) ; RPC determines user can use PKI Digital Signature

 +1        SET RETURN=0

 +2        IF $$GET^XPAR("ALL^USR.`"_DUZ,"ORWOR PKI USE",1,"Q")

               SET RETURN=1

 +3        QUIT 

PKISITE(RETURN) ; RPC determines if PKI is turned on at the site

 +1        SET RETURN=0

 +2       ;Check for Kernel piece

           IF '$LENGTH($TEXT(STORESIG^XUSSPKI))

               QUIT 

 +3       ;Check for Pharmacy piece

           IF '$LENGTH($TEXT(DOSE^PSSOPKI1))

               QUIT 

 +4        IF $$GET^XPAR("ALL","ORWOR PKI SITE",1,"Q")

               SET RETURN=1

 +5        QUIT 

ACTXT(ORY,ORIFN) ;Return detail action information

 +1        NEW ORI,CNT,OR0,OR3,OR6

 +2        KILL ^TMP("ORACTXT",$JOB)

 +3        SET ORY="^TMP(""ORACTXT"",$J)"

           SET ORI=$PIECE(ORIFN,";",2)

 +4        SET CNT=0

           SET ORIFN=+ORIFN

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

           SET OR3=$GET(^(3))

           SET OR6=$GET(^(6))

 +5        FOR 

               SET ORI=$ORDER(^OR(100,+ORIFN,8,ORI))

               IF ORI'>0

                   QUIT 

               SET ACTION=$GET(^(ORI,0))

               DO ACT^ORQ20

 +6        SET ORY=$NAME(^TMP("ORACTXT",$JOB))

           SET @ORY=""

 +7        QUIT 

EXPIRED(ORY) ;return FM date/time to begin search for expired orders

 +1        NEW HRS

 +2        SET HRS=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I")

 +3        SET ORY=$$FMADD^XLFDT($$NOW^XLFDT,"","-"_HRS,"","")

 +4        QUIT