ORRCOR ;SLC/MKB - OR data for CM ; 25 Jul 2003 9:31 AM
;;1.0;CARE MANAGEMENT;**3**;Jul 15, 2003
;
PTUNS(ORY,ORUSR) ; -- Return list of patients with unsigned orders by ORUSR
; in @ORY@(PAT) = #unsigned orders
; @ORY@(PAT,"ORU:ien;act")=""
; [from ORRCDPT]
N IDX,PAT,IFN,ACT,NUM,X
S ORY=$NA(^TMP($J,"ORRCORU")),IDX="^OR(100,""AS"")" K @ORY
F S IDX=$Q(@IDX) Q:IDX'?1"^OR(100,""AS"",".E D
. S PAT=+$P($P(IDX,",",3),"""",2),IFN=+$P(IDX,",",5),ACT=+$P(IDX,",",6)
. Q:+$P($G(^OR(100,IFN,8,ACT,0)),U,3)'=ORUSR
. S X=+$G(ORY(PAT)),ORY(PAT)=X+1,ORY(PAT,"ORU:"_IFN_";"_ACT)=""
Q
;
IDS(ORY,ORPAT,ORTYPE,ORBEG,OREND) ; -- Return order IDs for ORPAT where
; ORTYPE = ORN: Active Nursing Orders (2)
; ORV: Orders Unverified by Nursing (9)
; in @ORY@(PAT) = #orders
; @ORY@(PAT,ID)= ! if completed (for ORN), else null
; [from ORRCDPT1]
N ORN,ORWARD,ORFLG,ORID,ORDG,ORPKG,ORLIST,ORI,ORIFN,STS,PKG,X
S ORY=$NA(^TMP($J,"ORRCORU")) K @ORY
S ORPAT=+$G(ORPAT)_";DPT(",ORTYPE=$G(ORTYPE,"ORD")
S ORWARD=$G(^DPT(+ORPAT,.1)) S:$L(ORWARD) ORWARD=+$O(^DIC(42,"B",ORWARD,0))
S ORFLG=$S(ORTYPE="ORU":11,ORTYPE="ORV":9,1:2),ORID=ORTYPE_":"
S ORDG=$S(ORTYPE="ORN":"NURS",1:"ALL"),ORDG=+$O(^ORD(100.98,"B",ORDG,0))
S ORPKG=+$O(^DIC(9.4,"C","OR",0))
;S (ORBEG,OREND)="" I ORFLG=9 S OREND=$$NOW^XLFDT,ORBEG=OREND-1
D EN^ORQ1(ORPAT,ORDG,ORFLG,,$G(ORBEG),$G(OREND)) S (ORI,CNT)=0
F S ORI=+$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
. S STS=$P($G(^OR(100,+ORIFN,3)),U,3),PKG=+$P($G(^(0)),U,14),X=""
. ;I ORTYPE="ORV",STS=1,+$G(^(6))=10 Q ;changed ??
. I ORTYPE="ORN","^1^2^7^11^12^13^14^"[(U_STS_U)!(PKG'=ORPKG) S X="!" ;can't complete
. S CNT=CNT+1,@ORY@(+ORPAT,ORID_ORIFN)=X
S:CNT @ORY@(+ORPAT)=CNT K ^TMP("ORR",$J,ORLIST)
;if ORTYPE=ORN also get all other GEN TEXT ORDERS not in NURSING display group
Q:ORTYPE'="ORN"
S ORDG="CLINIC ORDERS",ORDG=+$O(^ORD(100.98,"B",ORDG,0))
D EN^ORQ1(ORPAT,ORDG,ORFLG,,$G(ORBEG),$G(OREND))
S ORI=0 F S ORI=+$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 D
. S ORIFN=$G(^TMP("ORR",$J,ORLIST,ORI))
. S STS=$P($G(^OR(100,+ORIFN,3)),U,3),PKG=+$P($G(^(0)),U,14),X=""
. I ORTYPE="ORN","^1^2^7^11^12^13^14^"[(U_STS_U)!(PKG'=ORPKG) S X="!" ;can't complete
. Q:(PKG'=ORPKG)
. S CNT=CNT+1,@ORY@(+ORPAT,ORID_ORIFN)=X
S:CNT @ORY@(+ORPAT)=CNT K ^TMP("ORR",$J,ORLIST)
Q
;
LISTUNS(ORY,ORUSR,ORPAT,ORDET) ; -- Return unsigned orders by ORUSR for ORPAT
; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format
; = Order=line of order text, and also if ORDET
; = Text=line of report text
; [from LIST^ORRCSIG]
N ORN,ORDT,ORIFN,ORACT,ORID,ORRCTX,I
S ORY=$NA(^TMP($J,"ORRCORD")) K @ORY
S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)_";DPT(",ORN=0
S ORDT=0 F S ORDT=+$O(^OR(100,"AS",ORPAT,ORDT)) Q:ORDT<1 D
. S ORIFN=0 F S ORIFN=+$O(^OR(100,"AS",ORPAT,ORDT,ORIFN)) Q:ORIFN<1 D
.. S ORACT=0 F S ORACT=+$O(^OR(100,"AS",ORPAT,ORDT,ORIFN,ORACT)) Q:ORACT<1 D
... Q:+$P($G(^OR(100,ORIFN,8,ORACT,0)),U,3)'=ORUSR S ORID=ORIFN_";"_ORACT
... D TEXT^ORQ12(.ORRCTX,ORID,200)
... S ORN=ORN+1,@ORY@(ORN)="Item=ORU:"_ORID_U_$$TXT1_U_$$FMTHL7^XLFDT(ORDT)_U_$$STS(ORIFN)
... S I=0 F S I=$O(ORRCTX(I)) Q:I<1 S ORN=ORN+1,@ORY@(ORN)="Order="_ORRCTX(I)
... I $G(ORDET) D ORD ;add Detailed Display to @ORY@(#)
;S ORY(0)=CNT
Q
;
LIST(ORY,ORPAT,ORTYPE,ORUSR,ORDET,ORBEG,OREND) ; -- Return orders for ORPAT where
; ORTYPE = ORN: Active Nursing Orders (2)
; ORV: Orders Unverified by Nursing (9)
; ORU: Unsigned Orders by ORUSR (11)
; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format^Status
; = Order=line of order text, & if ORDET
; = Text=line of report text
; where ID = ORTYPE_":"_order#;action#
; RPC = ORRC ORDERS BY PATIENT
N ORN,ORWARD,ORIGVIEW,ORFLG,ORID,ORDG,ORLIST,ORI,ORIFN,ORACT,OR0,ORA0,ORDT,ORRCTX,I
S ORY=$NA(^TMP($J,"ORRCORD")) K @ORY
S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)_";DPT(",ORTYPE=$G(ORTYPE,"ORD")
S ORWARD=$G(^DPT(+ORPAT,.1)),ORIGVIEW=1
S:$L(ORWARD) ORWARD=+$O(^DIC(42,"B",ORWARD,0))
S ORFLG=$S(ORTYPE="ORU":11,ORTYPE="ORV":9,1:2),ORID=ORTYPE_":"
S ORDG=$S(ORTYPE="ORN":"NURS",1:"ALL"),ORDG=+$O(^ORD(100.98,"B",ORDG,0))
S:$G(ORBEG) ORBEG=$$HL7TFM^XLFDT(ORBEG) S:$G(OREND) OREND=$$HL7TFM^XLFDT(OREND)
D EN^ORQ1(ORPAT,ORDG,ORFLG,,$G(ORBEG),$G(OREND)) S (ORI,ORN)=0
F S ORI=+$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1 S ORIFN=^(ORI) D
. S ORACT=+$P(ORIFN,";",2) S:ORACT<1 ORACT=+$P($G(^OR(100,+ORIFN,3)),U,7)
. S OR0=$G(^OR(100,+ORIFN,0)),ORA0=$G(^(8,ORACT,0))
. I ORFLG=11,+$P(ORA0,U,3)'=ORUSR Q
. S ORDT=$S('$P(OR0,U,8):$P(ORA0,U),"^DC^HD^"[(U_$P(ORA0,U,2)_U):$P(ORA0,U),1:$P(OR0,U,8))
. D TEXT^ORQ12(.ORRCTX,ORIFN,200)
. S ORN=ORN+1,@ORY@(ORN)="Item="_ORID_ORIFN_U_$$TXT1_U_$$FMTHL7^XLFDT(ORDT)_U_$$STS(ORIFN)
. S I=0 F S I=$O(ORRCTX(I)) Q:I<1 S ORN=ORN+1,@ORY@(ORN)="Order="_ORRCTX(I)
. I $G(ORDET) D ORD ;add Detailed Display to @ORY@(#)
Q
;
DETAIL(ORY,ORDER) ; -- Return details of ORDERs
; where ORDER(#) = ID
; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format^Status
; = Order=line of order text
; = Text=line of report text
; RPC = ORRC ORDERS BY ID [and from DETAIL^ORRCSIG]
N ORN,ORI,ORID,ORIFN,ORACT,ORDT,ORRCTX,I
S ORN=0,ORY=$NA(^TMP($J,"ORRCORD")) K @ORY
S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" S ORID=ORDER(ORI) D
. S ORIFN=$P(ORID,":",2),ORACT=+$P(ORIFN,";",2)
. S:ORACT<1 ORACT=+$P($G(^OR(100,+ORIFN,3)),U,7) S:ORACT<1 ORACT=1
. S ORDT=+$G(^OR(100,+ORIFN,8,ORACT,0))
. D TEXT^ORQ12(.ORRCTX,ORIFN,200)
. S ORN=ORN+1,@ORY@(ORN)="Item="_ORID_U_$$TXT1_U_$P($$FMTHL7^XLFDT(ORDT),"-")_U_$$STS(ORIFN)
. S I=0 F S I=$O(ORRCTX(I)) Q:I<1 S ORN=ORN+1,@ORY@(ORN)="Order="_ORRCTX(I)
. D ORD
Q
;
TXT(IFN) ; -- Return [first line of] order IFN's text
N ORRCTX,Y D TEXT^ORQ12(.ORRCTX,$G(IFN),200)
S Y=$G(ORRCTX(1))_$S($O(ORRCTX(1)):"...",1:"")
Q Y
;
TXT1() ; -- Return [first line of] order text from ORRCTX()
N Y
S Y=$G(ORRCTX(1))_$S($O(ORRCTX(1)):"...",1:"")
Q Y
;
STS(IFN) ; --Return name of order IFN's status
N STS,X,Y
S STS=+$P($G(^OR(100,+$G(IFN),3)),U,3)
S X=$P($G(^ORD(100.01,STS,0)),U),Y=$$LOW^XLFSTR(X)
Q Y
;
ORD ; -- Add details of ORIFN to @ORY@(ORN)
Q:'+$G(ORIFN) N ORRCZ,ORI,ORVP
S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2)
S ORRCZ="^TMP($J,""ORRCTXT"")" D DETAIL^ORQ2(.ORRCZ,ORIFN)
S ORI=0 F S ORI=$O(@ORRCZ@(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)="Text="_@ORRCZ@(ORI)
K @ORRCZ
Q
;
VERIFY(ORY,ORUSR,ORDER) ; -- Mark ORDERs as verified by ORUSR
;where ORDER(#) = ID = ORV:order#;action#
;returns ORY(#) = ID^1 if successful, else ID^0^error
;RPC = ORRC ORDERS VERIFY
Q:'$G(ORUSR) N ORVER,ORI,ORID,ORIFN,ORACT,ORA0,ORLK,ORES,ORERR,ORVP,ORWARD
K ORY S ORVER="N"
S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" D
. S ORID=ORDER(ORI),ORIFN=$P(ORID,":",2),ORACT=+$P(ORIFN,";",2)
. I ORACT<1 S ORACT=+$P($G(^OR(100,+ORIFN,3)),U,7),ORIFN=+ORIFN_";"_ORACT
. S ORA0=$G(^OR(100,+ORIFN,8,ORACT,0)) I $P(ORA0,U,9) D Q ;verified
.. N WHO,WHEN,X S WHO=$P(ORA0,U,8),WHEN=$P(ORA0,U,9),X=""
.. S:WHO X=X_" by "_$$UP^XLFSTR($$NAME^XUSER(WHO,"F"))
.. S:WHEN X=X_" on "_$$FMTE^XLFDT(WHEN,"2P")
.. S ORY(ORI)=ORID_"^0^This order has been verified"_X_"!" Q
. S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK S ORY(ORI)=ORID_U_ORLK Q
. S ORES(ORIFN)=ORID,ORES("B",ORIFN)=ORI
. D REPLCD^ORCACT1 ;incl unverified replaced orders
Q:'$O(ORES(0)) S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN<1 D
. S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2),ORVP(ORVP)=""
. D EN^ORCSEND(ORIFN,"VR","","",,,.ORERR),UNLK1^ORX2(+ORIFN)
. S ORID=$G(ORES(ORIFN)),ORI=+$G(ORES("B",ORIFN))
. I ORI S ORY(ORI)=ORID_U_$S($G(ORERR):"0^"_$P(ORERR,U,2),1:1)
S ORVP="" F S ORVP=$O(ORVP(ORVP)) Q:ORVP="" D
. S ORWARD=$S($G(^DPT(+ORVP,.105)):1,1:0) ;inpt
. D CKALERT^ORCACT1 ;delete unver orders alerts
Q
;
COMP(ORY,ORUSR,ORDER) ; -- Mark ORDERs as completed by ORUSR
;where ORDER(#) = ID = ORN:order#;action#
;returns ORY(#) = ID^1 if successful, else ID^0^error
;RPC = ORRC ORDERS COMPLETE
Q:'$G(ORUSR) N ORNOW,ORI,ORID,ORIFN,ORLK
K ORY S ORNOW=+$E($$NOW^XLFDT,1,12)
S ORI="" F S ORI=$O(ORDER(ORI)) Q:ORI="" D
. S ORID=ORDER(ORI),ORIFN=+$P(ORID,":",2)
. S ORLK=$$LOCK1^ORX2(ORIFN) I 'ORLK S ORY(ORI)=ORID_U_ORLK Q
. D COMP^ORCSAVE2(ORIFN,ORUSR,ORNOW),UNLK1^ORX2(ORIFN)
. S ORY(ORI)=ORID_U_$S($P($G(^OR(100,ORIFN,6)),U,6):1,1:0)
Q
ORRCOR ;SLC/MKB - OR data for CM ; 25 Jul 2003 9:31 AM
+1 ;;1.0;CARE MANAGEMENT;**3**;Jul 15, 2003
+2 ;
PTUNS(ORY,ORUSR) ; -- Return list of patients with unsigned orders by ORUSR
+1 ; in @ORY@(PAT) = #unsigned orders
+2 ; @ORY@(PAT,"ORU:ien;act")=""
+3 ; [from ORRCDPT]
+4 NEW IDX,PAT,IFN,ACT,NUM,X
+5 SET ORY=$NAME(^TMP($JOB,"ORRCORU"))
SET IDX="^OR(100,""AS"")"
KILL @ORY
+6 FOR
SET IDX=$QUERY(@IDX)
IF IDX'?1"^OR(100,""AS"",".E
QUIT
Begin DoDot:1
+7 SET PAT=+$PIECE($PIECE(IDX,",",3),"""",2)
SET IFN=+$PIECE(IDX,",",5)
SET ACT=+$PIECE(IDX,",",6)
+8 IF +$PIECE($GET(^OR(100,IFN,8,ACT,0)),U,3)'=ORUSR
QUIT
+9 SET X=+$GET(ORY(PAT))
SET ORY(PAT)=X+1
SET ORY(PAT,"ORU:"_IFN_";"_ACT)=""
End DoDot:1
+10 QUIT
+11 ;
IDS(ORY,ORPAT,ORTYPE,ORBEG,OREND) ; -- Return order IDs for ORPAT where
+1 ; ORTYPE = ORN: Active Nursing Orders (2)
+2 ; ORV: Orders Unverified by Nursing (9)
+3 ; in @ORY@(PAT) = #orders
+4 ; @ORY@(PAT,ID)= ! if completed (for ORN), else null
+5 ; [from ORRCDPT1]
+6 NEW ORN,ORWARD,ORFLG,ORID,ORDG,ORPKG,ORLIST,ORI,ORIFN,STS,PKG,X
+7 SET ORY=$NAME(^TMP($JOB,"ORRCORU"))
KILL @ORY
+8 SET ORPAT=+$GET(ORPAT)_";DPT("
SET ORTYPE=$GET(ORTYPE,"ORD")
+9 SET ORWARD=$GET(^DPT(+ORPAT,.1))
IF $LENGTH(ORWARD)
SET ORWARD=+$ORDER(^DIC(42,"B",ORWARD,0))
+10 SET ORFLG=$SELECT(ORTYPE="ORU":11,ORTYPE="ORV":9,1:2)
SET ORID=ORTYPE_":"
+11 SET ORDG=$SELECT(ORTYPE="ORN":"NURS",1:"ALL")
SET ORDG=+$ORDER(^ORD(100.98,"B",ORDG,0))
+12 SET ORPKG=+$ORDER(^DIC(9.4,"C","OR",0))
+13 ;S (ORBEG,OREND)="" I ORFLG=9 S OREND=$$NOW^XLFDT,ORBEG=OREND-1
+14 DO EN^ORQ1(ORPAT,ORDG,ORFLG,,$GET(ORBEG),$GET(OREND))
SET (ORI,CNT)=0
+15 FOR
SET ORI=+$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
IF ORI<1
QUIT
SET ORIFN=^(ORI)
Begin DoDot:1
+16 SET STS=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
SET PKG=+$PIECE($GET(^(0)),U,14)
SET X=""
+17 ;I ORTYPE="ORV",STS=1,+$G(^(6))=10 Q ;changed ??
+18 ;can't complete
IF ORTYPE="ORN"
IF "^1^2^7^11^12^13^14^"[(U_STS_U)!(PKG'=ORPKG)
SET X="!"
+19 SET CNT=CNT+1
SET @ORY@(+ORPAT,ORID_ORIFN)=X
End DoDot:1
+20 IF CNT
SET @ORY@(+ORPAT)=CNT
KILL ^TMP("ORR",$JOB,ORLIST)
+21 ;if ORTYPE=ORN also get all other GEN TEXT ORDERS not in NURSING display group
+22 IF ORTYPE'="ORN"
QUIT
+23 SET ORDG="CLINIC ORDERS"
SET ORDG=+$ORDER(^ORD(100.98,"B",ORDG,0))
+24 DO EN^ORQ1(ORPAT,ORDG,ORFLG,,$GET(ORBEG),$GET(OREND))
+25 SET ORI=0
FOR
SET ORI=+$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
IF ORI<1
QUIT
Begin DoDot:1
+26 SET ORIFN=$GET(^TMP("ORR",$JOB,ORLIST,ORI))
+27 SET STS=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
SET PKG=+$PIECE($GET(^(0)),U,14)
SET X=""
+28 ;can't complete
IF ORTYPE="ORN"
IF "^1^2^7^11^12^13^14^"[(U_STS_U)!(PKG'=ORPKG)
SET X="!"
+29 IF (PKG'=ORPKG)
QUIT
+30 SET CNT=CNT+1
SET @ORY@(+ORPAT,ORID_ORIFN)=X
End DoDot:1
+31 IF CNT
SET @ORY@(+ORPAT)=CNT
KILL ^TMP("ORR",$JOB,ORLIST)
+32 QUIT
+33 ;
LISTUNS(ORY,ORUSR,ORPAT,ORDET) ; -- Return unsigned orders by ORUSR for ORPAT
+1 ; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format
+2 ; = Order=line of order text, and also if ORDET
+3 ; = Text=line of report text
+4 ; [from LIST^ORRCSIG]
+5 NEW ORN,ORDT,ORIFN,ORACT,ORID,ORRCTX,I
+6 SET ORY=$NAME(^TMP($JOB,"ORRCORD"))
KILL @ORY
+7 SET ORUSR=+$GET(ORUSR)
SET ORPAT=+$GET(ORPAT)_";DPT("
SET ORN=0
+8 SET ORDT=0
FOR
SET ORDT=+$ORDER(^OR(100,"AS",ORPAT,ORDT))
IF ORDT<1
QUIT
Begin DoDot:1
+9 SET ORIFN=0
FOR
SET ORIFN=+$ORDER(^OR(100,"AS",ORPAT,ORDT,ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:2
+10 SET ORACT=0
FOR
SET ORACT=+$ORDER(^OR(100,"AS",ORPAT,ORDT,ORIFN,ORACT))
IF ORACT<1
QUIT
Begin DoDot:3
+11 IF +$PIECE($GET(^OR(100,ORIFN,8,ORACT,0)),U,3)'=ORUSR
QUIT
SET ORID=ORIFN_";"_ORACT
+12 DO TEXT^ORQ12(.ORRCTX,ORID,200)
+13 SET ORN=ORN+1
SET @ORY@(ORN)="Item=ORU:"_ORID_U_$$TXT1_U_$$FMTHL7^XLFDT(ORDT)_U_$$STS(ORIFN)
+14 SET I=0
FOR
SET I=$ORDER(ORRCTX(I))
IF I<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)="Order="_ORRCTX(I)
+15 ;add Detailed Display to @ORY@(#)
IF $GET(ORDET)
DO ORD
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;S ORY(0)=CNT
+17 QUIT
+18 ;
LIST(ORY,ORPAT,ORTYPE,ORUSR,ORDET,ORBEG,OREND) ; -- Return orders for ORPAT where
+1 ; ORTYPE = ORN: Active Nursing Orders (2)
+2 ; ORV: Orders Unverified by Nursing (9)
+3 ; ORU: Unsigned Orders by ORUSR (11)
+4 ; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format^Status
+5 ; = Order=line of order text, & if ORDET
+6 ; = Text=line of report text
+7 ; where ID = ORTYPE_":"_order#;action#
+8 ; RPC = ORRC ORDERS BY PATIENT
+9 NEW ORN,ORWARD,ORIGVIEW,ORFLG,ORID,ORDG,ORLIST,ORI,ORIFN,ORACT,OR0,ORA0,ORDT,ORRCTX,I
+10 SET ORY=$NAME(^TMP($JOB,"ORRCORD"))
KILL @ORY
+11 SET ORUSR=+$GET(ORUSR)
SET ORPAT=+$GET(ORPAT)_";DPT("
SET ORTYPE=$GET(ORTYPE,"ORD")
+12 SET ORWARD=$GET(^DPT(+ORPAT,.1))
SET ORIGVIEW=1
+13 IF $LENGTH(ORWARD)
SET ORWARD=+$ORDER(^DIC(42,"B",ORWARD,0))
+14 SET ORFLG=$SELECT(ORTYPE="ORU":11,ORTYPE="ORV":9,1:2)
SET ORID=ORTYPE_":"
+15 SET ORDG=$SELECT(ORTYPE="ORN":"NURS",1:"ALL")
SET ORDG=+$ORDER(^ORD(100.98,"B",ORDG,0))
+16 IF $GET(ORBEG)
SET ORBEG=$$HL7TFM^XLFDT(ORBEG)
IF $GET(OREND)
SET OREND=$$HL7TFM^XLFDT(OREND)
+17 DO EN^ORQ1(ORPAT,ORDG,ORFLG,,$GET(ORBEG),$GET(OREND))
SET (ORI,ORN)=0
+18 FOR
SET ORI=+$ORDER(^TMP("ORR",$JOB,ORLIST,ORI))
IF ORI<1
QUIT
SET ORIFN=^(ORI)
Begin DoDot:1
+19 SET ORACT=+$PIECE(ORIFN,";",2)
IF ORACT<1
SET ORACT=+$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
+20 SET OR0=$GET(^OR(100,+ORIFN,0))
SET ORA0=$GET(^(8,ORACT,0))
+21 IF ORFLG=11
IF +$PIECE(ORA0,U,3)'=ORUSR
QUIT
+22 SET ORDT=$SELECT('$PIECE(OR0,U,8):$PIECE(ORA0,U),"^DC^HD^"[(U_$PIECE(ORA0,U,2)_U):$PIECE(ORA0,U),1:$PIECE(OR0,U,8))
+23 DO TEXT^ORQ12(.ORRCTX,ORIFN,200)
+24 SET ORN=ORN+1
SET @ORY@(ORN)="Item="_ORID_ORIFN_U_$$TXT1_U_$$FMTHL7^XLFDT(ORDT)_U_$$STS(ORIFN)
+25 SET I=0
FOR
SET I=$ORDER(ORRCTX(I))
IF I<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)="Order="_ORRCTX(I)
+26 ;add Detailed Display to @ORY@(#)
IF $GET(ORDET)
DO ORD
End DoDot:1
+27 QUIT
+28 ;
DETAIL(ORY,ORDER) ; -- Return details of ORDERs
+1 ; where ORDER(#) = ID
+2 ; in @ORY@(#) = Item=ID^Text^OrderDate in HL7 format^Status
+3 ; = Order=line of order text
+4 ; = Text=line of report text
+5 ; RPC = ORRC ORDERS BY ID [and from DETAIL^ORRCSIG]
+6 NEW ORN,ORI,ORID,ORIFN,ORACT,ORDT,ORRCTX,I
+7 SET ORN=0
SET ORY=$NAME(^TMP($JOB,"ORRCORD"))
KILL @ORY
+8 SET ORI=""
FOR
SET ORI=$ORDER(ORDER(ORI))
IF ORI=""
QUIT
SET ORID=ORDER(ORI)
Begin DoDot:1
+9 SET ORIFN=$PIECE(ORID,":",2)
SET ORACT=+$PIECE(ORIFN,";",2)
+10 IF ORACT<1
SET ORACT=+$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
IF ORACT<1
SET ORACT=1
+11 SET ORDT=+$GET(^OR(100,+ORIFN,8,ORACT,0))
+12 DO TEXT^ORQ12(.ORRCTX,ORIFN,200)
+13 SET ORN=ORN+1
SET @ORY@(ORN)="Item="_ORID_U_$$TXT1_U_$P($$FMTHL7^XLFDT(ORDT),"-")_U_$$STS(ORIFN)
+14 SET I=0
FOR
SET I=$ORDER(ORRCTX(I))
IF I<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)="Order="_ORRCTX(I)
+15 DO ORD
End DoDot:1
+16 QUIT
+17 ;
TXT(IFN) ; -- Return [first line of] order IFN's text
+1 NEW ORRCTX,Y
DO TEXT^ORQ12(.ORRCTX,$GET(IFN),200)
+2 SET Y=$GET(ORRCTX(1))_$SELECT($ORDER(ORRCTX(1)):"...",1:"")
+3 QUIT Y
+4 ;
TXT1() ; -- Return [first line of] order text from ORRCTX()
+1 NEW Y
+2 SET Y=$GET(ORRCTX(1))_$SELECT($ORDER(ORRCTX(1)):"...",1:"")
+3 QUIT Y
+4 ;
STS(IFN) ; --Return name of order IFN's status
+1 NEW STS,X,Y
+2 SET STS=+$PIECE($GET(^OR(100,+$GET(IFN),3)),U,3)
+3 SET X=$PIECE($GET(^ORD(100.01,STS,0)),U)
SET Y=$$LOW^XLFSTR(X)
+4 QUIT Y
+5 ;
ORD ; -- Add details of ORIFN to @ORY@(ORN)
+1 IF '+$GET(ORIFN)
QUIT
NEW ORRCZ,ORI,ORVP
+2 SET ORVP=$PIECE($GET(^OR(100,+ORIFN,0)),U,2)
+3 SET ORRCZ="^TMP($J,""ORRCTXT"")"
DO DETAIL^ORQ2(.ORRCZ,ORIFN)
+4 SET ORI=0
FOR
SET ORI=$ORDER(@ORRCZ@(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)="Text="_@ORRCZ@(ORI)
+5 KILL @ORRCZ
+6 QUIT
+7 ;
VERIFY(ORY,ORUSR,ORDER) ; -- Mark ORDERs as verified by ORUSR
+1 ;where ORDER(#) = ID = ORV:order#;action#
+2 ;returns ORY(#) = ID^1 if successful, else ID^0^error
+3 ;RPC = ORRC ORDERS VERIFY
+4 IF '$GET(ORUSR)
QUIT
NEW ORVER,ORI,ORID,ORIFN,ORACT,ORA0,ORLK,ORES,ORERR,ORVP,ORWARD
+5 KILL ORY
SET ORVER="N"
+6 SET ORI=""
FOR
SET ORI=$ORDER(ORDER(ORI))
IF ORI=""
QUIT
Begin DoDot:1
+7 SET ORID=ORDER(ORI)
SET ORIFN=$PIECE(ORID,":",2)
SET ORACT=+$PIECE(ORIFN,";",2)
+8 IF ORACT<1
SET ORACT=+$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
SET ORIFN=+ORIFN_";"_ORACT
+9 ;verified
SET ORA0=$GET(^OR(100,+ORIFN,8,ORACT,0))
IF $PIECE(ORA0,U,9)
Begin DoDot:2
+10 NEW WHO,WHEN,X
SET WHO=$PIECE(ORA0,U,8)
SET WHEN=$PIECE(ORA0,U,9)
SET X=""
+11 IF WHO
SET X=X_" by "_$$UP^XLFSTR($$NAME^XUSER(WHO,"F"))
+12 IF WHEN
SET X=X_" on "_$$FMTE^XLFDT(WHEN,"2P")
+13 SET ORY(ORI)=ORID_"^0^This order has been verified"_X_"!"
QUIT
End DoDot:2
QUIT
+14 SET ORLK=$$LOCK1^ORX2(+ORIFN)
IF 'ORLK
SET ORY(ORI)=ORID_U_ORLK
QUIT
+15 SET ORES(ORIFN)=ORID
SET ORES("B",ORIFN)=ORI
+16 ;incl unverified replaced orders
DO REPLCD^ORCACT1
End DoDot:1
+17 IF '$ORDER(ORES(0))
QUIT
SET ORIFN=0
FOR
SET ORIFN=$ORDER(ORES(ORIFN))
IF ORIFN<1
QUIT
Begin DoDot:1
+18 SET ORVP=$PIECE($GET(^OR(100,+ORIFN,0)),U,2)
SET ORVP(ORVP)=""
+19 DO EN^ORCSEND(ORIFN,"VR","","",,,.ORERR)
DO UNLK1^ORX2(+ORIFN)
+20 SET ORID=$GET(ORES(ORIFN))
SET ORI=+$GET(ORES("B",ORIFN))
+21 IF ORI
SET ORY(ORI)=ORID_U_$SELECT($GET(ORERR):"0^"_$PIECE(ORERR,U,2),1:1)
End DoDot:1
+22 SET ORVP=""
FOR
SET ORVP=$ORDER(ORVP(ORVP))
IF ORVP=""
QUIT
Begin DoDot:1
+23 ;inpt
SET ORWARD=$SELECT($GET(^DPT(+ORVP,.105)):1,1:0)
+24 ;delete unver orders alerts
DO CKALERT^ORCACT1
End DoDot:1
+25 QUIT
+26 ;
COMP(ORY,ORUSR,ORDER) ; -- Mark ORDERs as completed by ORUSR
+1 ;where ORDER(#) = ID = ORN:order#;action#
+2 ;returns ORY(#) = ID^1 if successful, else ID^0^error
+3 ;RPC = ORRC ORDERS COMPLETE
+4 IF '$GET(ORUSR)
QUIT
NEW ORNOW,ORI,ORID,ORIFN,ORLK
+5 KILL ORY
SET ORNOW=+$EXTRACT($$NOW^XLFDT,1,12)
+6 SET ORI=""
FOR
SET ORI=$ORDER(ORDER(ORI))
IF ORI=""
QUIT
Begin DoDot:1
+7 SET ORID=ORDER(ORI)
SET ORIFN=+$PIECE(ORID,":",2)
+8 SET ORLK=$$LOCK1^ORX2(ORIFN)
IF 'ORLK
SET ORY(ORI)=ORID_U_ORLK
QUIT
+9 DO COMP^ORCSAVE2(ORIFN,ORUSR,ORNOW)
DO UNLK1^ORX2(ORIFN)
+10 SET ORY(ORI)=ORID_U_$SELECT($PIECE($GET(^OR(100,ORIFN,6)),U,6):1,1:0)
End DoDot:1
+11 QUIT
