ORWOR ; SLC/KCM - Orders Calls ;Oct 24,2022@10:47
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,141,163,187,190,215,243,307,330,280,347,306,588**;Dec 17, 1997;Build 29
;
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
;*347 Allow times to be saved.
;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,I
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 DC,DEL,DG,IFN,ACT,X0,X3,X8,ENT,LVL,TM,ILST,ORELSE,CS,PKG,ORCSPKG,OI
N DGIEN
S ILST=0
Q:'$D(^XUSEC("ORES",DUZ))&('$D(^XUSEC("ORELSE",DUZ))&'$D(^ORAM(103,+ORVP)))
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")
; Nurses only see their own unsigned orders, independent of OR UNSIGNED ORDERS ON EXIT
S ORELSE=$D(^XUSEC("ORELSE",DUZ))
I ORELSE S LVL=1
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 X0=$G(^OR(100,IFN,0)),X3=$G(^OR(100,IFN,3))
. . . S X8=$G(^OR(100,IFN,8,ACT,0))
. . . ;determine Display Group
. . . S DGIEN=$P(X0,U,11)
. . . S DG=$P($G(^ORD(100.98,DGIEN,0)),U,2)
. . . ;determine if DC
. . . S DC=$S($P(X8,U,2)="DC":1,1:0)
. . . ;determine if Delay
. . . S DEL=$$CHKORD^OREVNTX1(IFN)
. . . ;determine if controlled substance
. . . S PKG=$P(X0,"^",14)
. . . S ORCSPKG=""
. . . I PKG=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) S ORCSPKG="O"
. . . I PKG=$O(^DIC(9.4,"B","UNIT DOSE MEDICATIONS",0)) S ORCSPKG="I"
. . . I PKG=$O(^DIC(9.4,"B","INPATIENT MEDICATIONS",0)) S ORCSPKG="I"
. . . I PKG=$O(^DIC(9.4,"B","IV MEDICATIONS",0)) S ORCSPKG="I"
. . . I ORCSPKG="" S CS="0^0"
. . . I ORCSPKG'="" D
. . . . S OI=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0)),OI=+$G(^OR(100,IFN,4.5,OI,1))
. . . . D CSCHECK^ORDEA(.CS,OI,ORCSPKG)
. . . I '$S(LVL=1&($P(X8,U,3)=DUZ):1,ORELSE&($P(X8,U,13)=DUZ):1,LVL=2:1,1:0) Q ;chk user
. . . ;if Nurse, and order is already released or held for signature, don't include in list
. . . I ORELSE,$S((+$P(X8,U,16)>0):1,$D(^OR(100,IFN,5)):1,1:0) Q
. . . S ILST=ILST+1,LST(ILST)=IFN_";"_ACT_U_$P(X8,U,3)_U_DG_U_DC_U_DEL_U_CS_U_DGIEN
Q
PKIUSE(RETURN) ; RPC determines user can use PKI Digital Signature
N ORPKIU
S RETURN=0
S ORPKIU=0 I $D(^ORD(100.7,"C",DUZ)) S ORPKIU=1
I ORPKIU S RETURN=1
Q
PKISITE(RETURN) ; RPC determines if PKI is turned on at the site
N ORPKIS,ORSITE,IEN
S RETURN=0
Q:'$L($T(STORESIG^XUSSPKI)) ;Check for Kernel piece
Q:'$L($T(OIDEA^PSSOPKI)) ;Check for Pharmacy piece
S ORPKIS=0,ORSITE=+$$SITE^VASITE() I $D(^ORD(100.7,"B",ORSITE)) D
. S IEN=$O(^ORD(100.7,"B",ORSITE,"")),ORPKIS=$P(^ORD(100.7,IEN,0),"^",2)
I ORPKIS S RETURN=1
Q
ACTXT(ORY,ORIFN) ;Return detail action information
N ORI,CNT,OR0,OR3,OR6,ACTION
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWOR 7860 printed Dec 13, 2024@02:36:49 Page 2
ORWOR ; SLC/KCM - Orders Calls ;Oct 24,2022@10:47
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,141,163,187,190,215,243,307,330,280,347,306,588**;Dec 17, 1997;Build 29
+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 ;*347 Allow times to be saved.
+12 ;I $E($P(VIEW,";",2))="T" S $P(VIEW,";",2)=$P($P(VIEW,";",2),"@") ;allows all orders for Today
+13 SET $PIECE(VIEW,";",4)=$PIECE($GET(^ORD(100.98,+$PIECE(VIEW,";",4),0)),U,3)
+14 ; use last saved format, since this is used only by LM
+15 SET FMT=$PIECE($$GET^XPAR("ALL","ORCH CONTEXT ORDERS",1,"I"),";",5)
+16 if '$LENGTH(FMT)
SET FMT="L"
SET $PIECE(VIEW,";",5)=FMT
+17 ; and save the parameter
+18 DO EN^XPAR(DUZ_";VA(200,","ORCH CONTEXT ORDERS",1,VIEW,.ORERR)
+19 QUIT
VWGET(REC) ; Get the preferred view for orders
+1 NEW FROM,THRU,FILTER,DGRP,FRMT,CHRN,BYGRP,S,VNAME,FL,I
+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 DC,DEL,DG,IFN,ACT,X0,X3,X8,ENT,LVL,TM,ILST,ORELSE,CS,PKG,ORCSPKG,OI
+2 NEW DGIEN
+3 SET ILST=0
+4 if '$DATA(^XUSEC("ORES",DUZ))&('$DATA(^XUSEC("ORELSE",DUZ))&'$DATA(^ORAM(103,+ORVP)))
QUIT
+5 SET ORVP=ORVP_";DPT("
+6 SET ENT="ALL"_$SELECT($GET(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"")
+7 SET LVL=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT")
+8 ; Nurses only see their own unsigned orders, independent of OR UNSIGNED ORDERS ON EXIT
+9 SET ORELSE=$DATA(^XUSEC("ORELSE",DUZ))
+10 IF ORELSE
SET LVL=1
+11 if 'LVL
QUIT
+12 SET TM=0
FOR
SET TM=$ORDER(^OR(100,"AS",ORVP,TM))
if TM<1
QUIT
Begin DoDot:1
+13 SET IFN=0
FOR
SET IFN=$ORDER(^OR(100,"AS",ORVP,TM,IFN))
if IFN<1
QUIT
Begin DoDot:2
+14 SET ACT=0
FOR
SET ACT=$ORDER(^OR(100,"AS",ORVP,TM,IFN,ACT))
if ACT<1
QUIT
Begin DoDot:3
+15 ;in Changes
if $DATA(HAVE(IFN_";"_ACT))
QUIT
+16 SET X0=$GET(^OR(100,IFN,0))
SET X3=$GET(^OR(100,IFN,3))
+17 SET X8=$GET(^OR(100,IFN,8,ACT,0))
+18 ;determine Display Group
+19 SET DGIEN=$PIECE(X0,U,11)
+20 SET DG=$PIECE($GET(^ORD(100.98,DGIEN,0)),U,2)
+21 ;determine if DC
+22 SET DC=$SELECT($PIECE(X8,U,2)="DC":1,1:0)
+23 ;determine if Delay
+24 SET DEL=$$CHKORD^OREVNTX1(IFN)
+25 ;determine if controlled substance
+26 SET PKG=$PIECE(X0,"^",14)
+27 SET ORCSPKG=""
+28 IF PKG=$ORDER(^DIC(9.4,"B","OUTPATIENT PHARMACY",0))
SET ORCSPKG="O"
+29 IF PKG=$ORDER(^DIC(9.4,"B","UNIT DOSE MEDICATIONS",0))
SET ORCSPKG="I"
+30 IF PKG=$ORDER(^DIC(9.4,"B","INPATIENT MEDICATIONS",0))
SET ORCSPKG="I"
+31 IF PKG=$ORDER(^DIC(9.4,"B","IV MEDICATIONS",0))
SET ORCSPKG="I"
+32 IF ORCSPKG=""
SET CS="0^0"
+33 IF ORCSPKG'=""
Begin DoDot:4
+34 SET OI=+$ORDER(^OR(100,IFN,4.5,"ID","ORDERABLE",0))
SET OI=+$GET(^OR(100,IFN,4.5,OI,1))
+35 DO CSCHECK^ORDEA(.CS,OI,ORCSPKG)
End DoDot:4
+36 ;chk user
IF '$SELECT(LVL=1&($PIECE(X8,U,3)=DUZ):1,ORELSE&($PIECE(X8,U,13)=DUZ):1,LVL=2:1,1:0)
QUIT
+37 ;if Nurse, and order is already released or held for signature, don't include in list
+38 IF ORELSE
IF $SELECT((+$PIECE(X8,U,16)>0):1,$DATA(^OR(100,IFN,5)):1,1:0)
QUIT
+39 SET ILST=ILST+1
SET LST(ILST)=IFN_";"_ACT_U_$PIECE(X8,U,3)_U_DG_U_DC_U_DEL_U_CS_U_DGIEN
End DoDot:3
End DoDot:2
End DoDot:1
+40 QUIT
PKIUSE(RETURN) ; RPC determines user can use PKI Digital Signature
+1 NEW ORPKIU
+2 SET RETURN=0
+3 SET ORPKIU=0
IF $DATA(^ORD(100.7,"C",DUZ))
SET ORPKIU=1
+4 IF ORPKIU
SET RETURN=1
+5 QUIT
PKISITE(RETURN) ; RPC determines if PKI is turned on at the site
+1 NEW ORPKIS,ORSITE,IEN
+2 SET RETURN=0
+3 ;Check for Kernel piece
if '$LENGTH($TEXT(STORESIG^XUSSPKI))
QUIT
+4 ;Check for Pharmacy piece
if '$LENGTH($TEXT(OIDEA^PSSOPKI))
QUIT
+5 SET ORPKIS=0
SET ORSITE=+$$SITE^VASITE()
IF $DATA(^ORD(100.7,"B",ORSITE))
Begin DoDot:1
+6 SET IEN=$ORDER(^ORD(100.7,"B",ORSITE,""))
SET ORPKIS=$PIECE(^ORD(100.7,IEN,0),"^",2)
End DoDot:1
+7 IF ORPKIS
SET RETURN=1
+8 QUIT
ACTXT(ORY,ORIFN) ;Return detail action information
+1 NEW ORI,CNT,OR0,OR3,OR6,ACTION
+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
