- 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
