ORQ20 ; SLC/MKB - Detailed Order Report cont ;Dec 02, 2020@15:20:07
;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,27,92,94,116,141,177,186,190,215,243,434,493,539**;Dec 17, 1997;Build 41
;
;Reference to file #123 supported by ICR #2586
ACT ; -- add Activity [from ^ORQ2]
N ORACT,ORPACK,ORUCID S ORACT=$P(ACTION,U,2)
I ORACT'="NW",$P(ACTION,U,4)=5,$P(ACTION,U,15)=13 Q ;skip canc actions
N NVA,USER S:$P(^ORD(100.98,$P(^OR(100,+ORIFN,0),U,11),0),U)="NON-VA MEDICATIONS" NVA=1
S CNT=CNT+1,@ORY@(CNT)=$$DATE($P(ACTION,U))_" "_$$ACTION(ORACT)
I $P(ACTION,U,13) S @ORY@(CNT)=@ORY@(CNT)_" entered by "_$$USER(+$P(ACTION,U,13))
I ORACT="NW" D ;Show original order text
. N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,ORIFN_";1",80)
. S ORPACK=$G(^OR(100,+ORIFN,4)) I $P(ORPACK,";",2)="GMRC" D ;493
. . S ORPACK=+ORPACK,ORUCID=$$GET1^DIQ(123,ORPACK,80)
. . I ORUCID]"" S CNT=CNT+1,@ORY@(CNT)=" UCID: "_ORUCID
. S CNT=CNT+1,@ORY@(CNT)=" Order Text: "_$G(ORZ(1))
. S I=1 F S I=$O(ORZ(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
I ORACT="XX" D ;Changed - show new text
. N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,ORIFN_";"_ORI,80)
. S CNT=CNT+1,@ORY@(CNT)=" Changed to: "_$G(ORZ(1))
. S I=1 F S I=$O(ORZ(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
A1 I $P(ACTION,U,12) D ;Nature of Order/Release
. N ORZ S ORZ=$G(^ORD(100.02,+$P(ACTION,U,12),0))
. S CNT=CNT+1,@ORY@(CNT)=" Nature of Order: "_$P(ORZ,U)
. I $P(OR0,U,17),(ORACT="NW") Q ;see event
. I "^V^P^"[(U_$P(ORZ,U,2)_U),$P(ACTION,U,16) S CNT=CNT+1,@ORY@(CNT)=" Released by: "_$$USER(+$P(ACTION,U,17))_" on "_$$DATE($P(ACTION,U,16))
I $P(OR0,U,17)&(ORACT="NW") D ;Delayed Release Event
. N EVT,X,ORV,I S EVT=+$P(OR0,U,17),X=$$NAME^OREVNTX(EVT)
. S:$E(X,1,8)="Delayed " X=$E(X,9,99)
. I $G(^ORE(100.2,EVT,1)),'$P(ACTION,U,16) S X=X_" on "_$$DATE(+^(1))
. S CNT=CNT+1,@ORY@(CNT)=" Delayed Until: "_X Q:'$P(ACTION,U,16)
. D EVENT(.ORV) S CNT=CNT+1,@ORY@(CNT)=" Released by: "_ORV(1)
. S I=1 F S I=$O(ORV(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORV(I))
A2 I $P(ACTION,U,5) S CNT=CNT+1,@ORY@(CNT)=$S($P(ACTION,U,4)=7:" Dig",1:" Elec")_" Signature: "_$$USER(+$P(ACTION,U,5))_" on "_$$DATE($P(ACTION,U,6))
I '$P(ACTION,U,5)!($P(ACTION,U,3)'=$P(ACTION,U,5)),'$$SERVCORR S CNT=CNT+1,@ORY@(CNT)=" "_$S($D(NVA):"Documented by:",1:"Ordered by: ")_" "_$$USER(+$P(ACTION,U,3))
I '$P(ACTION,U,5),$L($P(ACTION,U,4)) D
.I $P(ACTION,U,4)=0 D
..S USER=$$USER(+$P(ACTION,U,7))
..S CNT=CNT+1
..I USER'="" S @ORY@(CNT)=" Released by: "_USER_" on "_$$DATE($P(ACTION,U,16))
..I USER="" S @ORY@(CNT)=" Released: "_$$DATE($P(ACTION,U,16))
.S CNT=CNT+1,@ORY@(CNT)=" Signature: "_$$SIG($P(ACTION,U,4)) ;186
;I '$P(ACTION,U,5),$L($P(ACTION,U,4)) S:$P(ACTION,U,4)=0 CNT=CNT+1,@ORY@(CNT)=" Released by: "_$$USER(+$P(ACTION,U,7))_" on "_$$DATE($P(ACTION,U,16)) S CNT=CNT+1,@ORY@(CNT)=" Signature: "_$$SIG($P(ACTION,U,4)) ;186
I $P(ACTION,U,9) S CNT=CNT+1,@ORY@(CNT)=" Nurse Verified: "_$S($P(ACTION,U,8):$$USER(+$P(ACTION,U,8))_" on ",1:"")_$$DATE($P(ACTION,U,9))
I $P(ACTION,U,11) S CNT=CNT+1,@ORY@(CNT)=" Clerk Verified: "_$S($P(ACTION,U,10):$$USER(+$P(ACTION,U,10))_" on ",1:"")_$$DATE($P(ACTION,U,11))
I $P(ACTION,U,19) S CNT=CNT+1,@ORY@(CNT)=" Chart Reviewed: "_$S($P(ACTION,U,18):$$USER(+$P(ACTION,U,18))_" on ",1:"")_$$DATE($P(ACTION,U,19))
A3 I $P(ACTION,U,2)="DC",$L(OR6) S X=$S($L($P(OR6,U,5)):$P(OR6,U,5),$P(OR6,U,4):$P($G(^ORD(100.03,+$P(OR6,U,4),0)),U),$P(OR6,U):$P($G(^ORD(100.02,+$P(OR6,U),0)),U),1:"") S:$L(X) CNT=CNT+1,@ORY@(CNT)=" Reason for DC: "_X
I $L($G(^OR(100,ORIFN,8,ORI,1))) S X=^(1) D ;add backdoor comments
. N LBL,I S LBL=""
. I $P(ACTION,U,15)="",$P(ACTION,U,2)'="DC" S LBL=" Comments: " ;DC shown above
. I $P(ACTION,U,15)=13,$P(ACTION,U,2)'="NW" S LBL=" Cancelled: " ;NW shown in ORQ2
. Q:'$L(LBL) I $L(X)'>56 S CNT=CNT+1,@ORY@(CNT)=LBL_X Q
. S DIWL=1,DIWR=56,DIWF="C56" K ^UTILITY($J,"W") D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=LBL_^(I,0),LBL=" "
I $D(^OR(100,ORIFN,8,ORI,5)) D ;Ward comments
. N X,ORJ K ^UTILITY($J,"W")
. S ORJ=0 F S ORJ=$O(^OR(100,ORIFN,8,ORI,5,ORJ)) Q:ORJ'>0 S X=^(ORJ,0) D ^DIWP
. S ORJ=0 F S ORJ=$O(^UTILITY($J,"W",DIWL,ORJ)) Q:ORJ'>0 S CNT=CNT+1,@ORY@(CNT)=$S(ORJ=1:" Ward/Clinic Cmmts: ",1:" ")_^(ORJ,0)
. K ^UTILITY($J,"W")
A4 I $P(ACTION,U,2)="HD",$G(^OR(100,ORIFN,8,ORI,2)) S X2=^(2),CNT=CNT+1,@ORY@(CNT)=" Hold Released: "_$$FMTE^XLFDT($P(X2,U),"2P")_" by "_$$USER($P(X2,U,2))
N X3,F,Y
I $D(^OR(100,ORIFN,8,ORI,3)) D ;Un-/Flagged
. ;N X S X=$G(^OR(100,ORIFN,8,ORI,3))
. S X3=$G(^OR(100,ORIFN,8,ORI,3))
. S CNT=CNT+1,@ORY@(CNT)=" Flagged by: "_$$USER(+$P(X3,U,4))_" on "_$$DATE($P(X3,U,3))
. S CNT=CNT+1,@ORY@(CNT)=" "_$P(X3,U,5)
. I $P(X3,U,10)'="" S CNT=CNT+1,@ORY@(CNT)=" No Action Alert: "_$$DATE($P(X3,U,10))
;flagged recipients ;p539
S ORJ=0,F=0 F S ORJ=$O(^OR(100,ORIFN,8,ORI,6,ORJ)) Q:'ORJ S Y=^(ORJ,0) D
. S CNT=CNT+1,@ORY@(CNT)=$S('F:" Recipients: ",1:" ")_$$USER(+Y)_" added on "_$$DATE($P(Y,U,2)),F=1
;flagged comments ;p539
N DIWL,DIWR,DIWF,X,I,ORK
S ORJ=0,F=0 F S ORJ=$O(^OR(100,ORIFN,8,ORI,9,ORJ)) Q:'ORJ S Y=^(ORJ,0) D
. S CNT=CNT+1,@ORY@(CNT)=$S('F:" Comments by: ",1:" ")_$$USER($P(Y,U,2))_" on "_$$DATE(+Y),F=1
. S DIWL=24,DIWR=110,DIWF="I24" K ^UTILITY($J,"W")
. S ORK=0 F S ORK=$O(^OR(100,ORIFN,8,ORI,9,ORJ,"COM",ORK)) Q:'ORK S X=^(ORK,0) D ^DIWP
. S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I S CNT=CNT+1,@ORY@(CNT)=^(I,0)
K ^UTILITY($J,"W")
I $P($G(X3),U)=0 D
. S CNT=CNT+1,@ORY@(CNT)=" Unflagged by: "_$$USER(+$P(X3,U,7))_" on "_$$DATE($P(X3,U,6))
. S CNT=CNT+1,@ORY@(CNT)=" "_$P(X3,U,8)
;flagged history ;p539
K ORFHY
I $D(^OR(100,ORIFN,8,ORI,"FHIS")) D GETHST^ORWDXA1(.ORFHY,ORIFN_";"_ORI)
I $D(ORFHY) D
. S CNT=CNT+1,@ORY@(CNT)=" ***Order Flag History***"
. S ORJ=0,F=0 F S ORJ=$O(ORFHY(ORJ)) Q:'ORJ S Y=ORFHY(ORJ),CNT=CNT+1,@ORY@(CNT)=" "_Y
. K ORFHY
A5 ;disposition/RTC Orders
I $D(^OR(100,ORIFN,8,ORI,4)) D
.N S S X=$G(^OR(100,ORIFN,8,ORI,4))
.I +$P(X,U)>0 S CNT=CNT+1,@ORY@(CNT)=" Disposition by: "_$$USER(+$P(X,U))_" on "_$$DATE($P(X,U,2))
Q
;
DC ; -- Add Reason for DC
S CNT=CNT+1,@ORY@(CNT)=$$DATE($P(OR6,U,3))_$S($P(OR6,U,8):" Auto-",1:" ")_"Discontinued"
I $P(OR6,U,8) D Q
. N EVT,PKG,ORV,I
. S EVT=$P(OR6,U,8),PKG=$P($G(^ORE(100.2,+EVT,3,ORIFN,0)),U,2)
. S @ORY@(CNT)=@ORY@(CNT)_" by "_$S(PKG="FH":"DIETETICS",PKG="LR":"LABORATORY",PKG="PS":"PHARMACY",1:"CPRS")
. D EVENT(.ORV,1) S CNT=CNT+1,@ORY@(CNT)=" Patient Movement: "_ORV(1)
. S I=1 F S I=$O(ORV(I)) Q:I'>0 S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORV(I))
I $P(OR6,U,2),$P($G(^ORD(100.02,+$P(OR6,U),0)),U,2)'="A" S @ORY@(CNT)=@ORY@(CNT)_" by "_$$USER($P(OR6,U,2)) ;don't show user name if auto-dc
N X S X=$S($L($P(OR6,U,5)):$P(OR6,U,5),$P(OR6,U,4):$P($G(^ORD(100.03,+$P(OR6,U,4),0)),U),$P(OR6,U):$P($G(^ORD(100.02,+$P(OR6,U),0)),U),1:"") S:$L(X) CNT=CNT+1,@ORY@(CNT)=" Reason for DC: "_X
Q
;
ACTION(CODE) ; -- Return name of action CODE
N NAME S NAME=$S(CODE="NW":"New Order",CODE="DC":"Discontinue",CODE="HD":"Hold",CODE="RL":"Release Hold",CODE="RN":"Renewal",CODE="XX":"Change",1:"")
I CODE="NW",$P(OR3,U,11) S NAME=NAME_$S($P(OR3,U,11)=1:" (Change)",$P(OR3,U,11)=2:" (Renewal)",1:"")
Q NAME
;
XACT(X) ; -- Return name of transaction code X
N Y S X=$G(X)
S Y=$S(X="XX":"Edited",X="DC":"Discontinued",X="HD":"Held",X="RL":"Hold Released",X="FW":"Forwarded",X="CA":"Cancelled",1:"")
Q Y
;
DATE(X) ; -- Return date formatted as 00/00/0000 00:00
N T,Y S T=$P(X,".",2)_"0000"
S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
I T S Y=Y_" "_$E(T,1,2)_":"_$E(T,3,4)
Q Y
;
USER(X) ; -- Returns NAME (TITLE) of New Person X
N X0,Y S X0=$G(^VA(200,+X,0)),Y=$P(X0,U)
S:$P(X0,U,9) Y=Y_" ("_$E($P($G(^DIC(3.1,+$P(X0,U,9),0)),U),1,15)_")"
Q Y
;
SIG(X) ; -- Returns text of signature status X
N Y S Y=""
I X=0 S Y="ON CHART WITH WRITTEN ORDERS"
I X=1 S Y="ELECTRONICALLY SIGNED"
I X=2 S Y="NOT SIGNED"
I X=3 S Y="NOT REQUIRED"
I X=4 S Y="ON CHART WITH PRINTED ORDERS"
I X=5 S Y="NOT REQUIRED DUE TO SERVICE CANCEL/LAPSE"
I X=6 S Y="SERVICE CORRECTION TO SIGNED ORDER"
Q Y
;
SERVCORR() ; -- Returns 1 or 0, if current ACTION is a serv corr change
N Y,NATURE,I,X S Y=0
G:ORACT'="XX" SCQ
S NATURE=+$P(ACTION,U,12),NATURE=$P($G(^ORD(100.02,NATURE,0)),U,2)
I "^S^I^"'[(U_NATURE_U) G SCQ
S I=$O(^OR(100,ORIFN,8,ORI),-1),X=$G(^(I,0))
I $P(X,U,3)'=$P(ACTION,U,3),$P(X,U,5)'=$P(ACTION,U,3) G SCQ ;show prov
S Y=1
SCQ Q Y
;
EVENT(ORTX,DC) ; -- Returns patient event info for EVT
N EVT1,REL,X,Y,I,ORMAX
S ORTX(1)="" ;177
S EVT1=$G(^ORE(100.2,EVT,1)),REL=$G(^ORE(100.2,EVT,2,ORIFN,0))
; Return event data if AutoDC or auto-released by an event:
I $G(DC)!(REL&'$L($P(REL,U,2))&($P(EVT1,U,2)!$P(EVT1,U,4))) D Q
. S Y=$S($P(EVT1,U,5):$P(EVT1,U,5),1:EVT) ;parent owns Activity
. S Y=+$O(^ORE(100.2,+Y,10,0)),Y=$G(^(Y,0)),X=$P(Y,U,4) Q:'$L(X)
. S X=$S(X="A":"ADMISSION",X="T":"TRANSFER",X="D":"DISCHARGE",X="S":"SPECIALTY CHANGE",1:$S($P(EVT1,U)>$$DPI^ORUTL1("SR*3.0*157"):"IN TO O.R.",1:"OUT OF O.R."))_" on "_$$DATE($P(EVT1,U)) ;243
. S ORTX(1)=X,ORTX=1,ORMAX=56
. I $P(Y,U,6) S X=$S($P(Y,U,4)="D":"from ",1:"to ")_$$GET1^DIQ(45.7,+$P(Y,U,6)_",",.01) D TXT^ORCHTAB
. I $P(Y,U,7) S X="on "_$$GET1^DIQ(42,+$P(Y,U,7)_",",.01) D TXT^ORCHTAB
S X=$$USER(+$P(ACTION,U,17))_" on "_$$DATE($P(ACTION,U,16))
I ORIFN'=+$P($G(^ORE(100.2,EVT,0)),U,4),$P(REL,U,2)="MN" S X=X_" (manually released)"
S ORTX(1)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQ20 10143 printed Apr 09, 2024@21:38:09 Page 2
ORQ20 ; SLC/MKB - Detailed Order Report cont ;Dec 02, 2020@15:20:07
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,27,92,94,116,141,177,186,190,215,243,434,493,539**;Dec 17, 1997;Build 41
+2 ;
+3 ;Reference to file #123 supported by ICR #2586
ACT ; -- add Activity [from ^ORQ2]
+1 NEW ORACT,ORPACK,ORUCID
SET ORACT=$PIECE(ACTION,U,2)
+2 ;skip canc actions
IF ORACT'="NW"
IF $PIECE(ACTION,U,4)=5
IF $PIECE(ACTION,U,15)=13
QUIT
+3 NEW NVA,USER
if $PIECE(^ORD(100.98,$PIECE(^OR(100,+ORIFN,0),U,11),0),U)="NON-VA MEDICATIONS"
SET NVA=1
+4 SET CNT=CNT+1
SET @ORY@(CNT)=$$DATE($PIECE(ACTION,U))_" "_$$ACTION(ORACT)
+5 IF $PIECE(ACTION,U,13)
SET @ORY@(CNT)=@ORY@(CNT)_" entered by "_$$USER(+$PIECE(ACTION,U,13))
+6 ;Show original order text
IF ORACT="NW"
Begin DoDot:1
+7 NEW ORZ,I,ORIGVIEW
SET ORIGVIEW=2
DO TEXT^ORQ12(.ORZ,ORIFN_";1",80)
+8 ;493
SET ORPACK=$GET(^OR(100,+ORIFN,4))
IF $PIECE(ORPACK,";",2)="GMRC"
Begin DoDot:2
+9 SET ORPACK=+ORPACK
SET ORUCID=$$GET1^DIQ(123,ORPACK,80)
+10 IF ORUCID]""
SET CNT=CNT+1
SET @ORY@(CNT)=" UCID: "_ORUCID
End DoDot:2
+11 SET CNT=CNT+1
SET @ORY@(CNT)=" Order Text: "_$GET(ORZ(1))
+12 SET I=1
FOR
SET I=$ORDER(ORZ(I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$GET(ORZ(I))
End DoDot:1
+13 ;Changed - show new text
IF ORACT="XX"
Begin DoDot:1
+14 NEW ORZ,I,ORIGVIEW
SET ORIGVIEW=2
DO TEXT^ORQ12(.ORZ,ORIFN_";"_ORI,80)
+15 SET CNT=CNT+1
SET @ORY@(CNT)=" Changed to: "_$GET(ORZ(1))
+16 SET I=1
FOR
SET I=$ORDER(ORZ(I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$GET(ORZ(I))
End DoDot:1
A1 ;Nature of Order/Release
IF $PIECE(ACTION,U,12)
Begin DoDot:1
+1 NEW ORZ
SET ORZ=$GET(^ORD(100.02,+$PIECE(ACTION,U,12),0))
+2 SET CNT=CNT+1
SET @ORY@(CNT)=" Nature of Order: "_$PIECE(ORZ,U)
+3 ;see event
IF $PIECE(OR0,U,17)
IF (ORACT="NW")
QUIT
+4 IF "^V^P^"[(U_$PIECE(ORZ,U,2)_U)
IF $PIECE(ACTION,U,16)
SET CNT=CNT+1
SET @ORY@(CNT)=" Released by: "_$$USER(+$PIECE(ACTION,U,17))_" on "_$$DATE($PIECE(ACTION,U,16))
End DoDot:1
+5 ;Delayed Release Event
IF $PIECE(OR0,U,17)&(ORACT="NW")
Begin DoDot:1
+6 NEW EVT,X,ORV,I
SET EVT=+$PIECE(OR0,U,17)
SET X=$$NAME^OREVNTX(EVT)
+7 if $EXTRACT(X,1,8)="Delayed "
SET X=$EXTRACT(X,9,99)
+8 IF $GET(^ORE(100.2,EVT,1))
IF '$PIECE(ACTION,U,16)
SET X=X_" on "_$$DATE(+^(1))
+9 SET CNT=CNT+1
SET @ORY@(CNT)=" Delayed Until: "_X
if '$PIECE(ACTION,U,16)
QUIT
+10 DO EVENT(.ORV)
SET CNT=CNT+1
SET @ORY@(CNT)=" Released by: "_ORV(1)
+11 SET I=1
FOR
SET I=$ORDER(ORV(I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$GET(ORV(I))
End DoDot:1
A2 IF $PIECE(ACTION,U,5)
SET CNT=CNT+1
SET @ORY@(CNT)=$SELECT($PIECE(ACTION,U,4)=7:" Dig",1:" Elec")_" Signature: "_$$USER(+$PIECE(ACTION,U,5))_" on "_$$DATE($PIECE(ACTION,U,6))
+1 IF '$PIECE(ACTION,U,5)!($PIECE(ACTION,U,3)'=$PIECE(ACTION,U,5))
IF '$$SERVCORR
SET CNT=CNT+1
SET @ORY@(CNT)=" "_$SELECT($DATA(NVA):"Documented by:",1:"Ordered by: ")_" "_$$USER(+$PIECE(ACTION,U,3))
+2 IF '$PIECE(ACTION,U,5)
IF $LENGTH($PIECE(ACTION,U,4))
Begin DoDot:1
+3 IF $PIECE(ACTION,U,4)=0
Begin DoDot:2
+4 SET USER=$$USER(+$PIECE(ACTION,U,7))
+5 SET CNT=CNT+1
+6 IF USER'=""
SET @ORY@(CNT)=" Released by: "_USER_" on "_$$DATE($PIECE(ACTION,U,16))
+7 IF USER=""
SET @ORY@(CNT)=" Released: "_$$DATE($PIECE(ACTION,U,16))
End DoDot:2
+8 ;186
SET CNT=CNT+1
SET @ORY@(CNT)=" Signature: "_$$SIG($PIECE(ACTION,U,4))
End DoDot:1
+9 ;I '$P(ACTION,U,5),$L($P(ACTION,U,4)) S:$P(ACTION,U,4)=0 CNT=CNT+1,@ORY@(CNT)=" Released by: "_$$USER(+$P(ACTION,U,7))_" on "_$$DATE($P(ACTION,U,16)) S CNT=CNT+1,@ORY@(CNT)=" Signature: "_$$SIG($P(ACTION,U,4)) ;186
+10 IF $PIECE(ACTION,U,9)
SET CNT=CNT+1
SET @ORY@(CNT)=" Nurse Verified: "_$SELECT($PIECE(ACTION,U,8):$$USER(+$PIECE(ACTION,U,8))_" on ",1:"")_$$DATE($PIECE(ACTION,U,9))
+11 IF $PIECE(ACTION,U,11)
SET CNT=CNT+1
SET @ORY@(CNT)=" Clerk Verified: "_$SELECT($PIECE(ACTION,U,10):$$USER(+$PIECE(ACTION,U,10))_" on ",1:"")_$$DATE($PIECE(ACTION,U,11))
+12 IF $PIECE(ACTION,U,19)
SET CNT=CNT+1
SET @ORY@(CNT)=" Chart Reviewed: "_$SELECT($PIECE(ACTION,U,18):$$USER(+$PIECE(ACTION,U,18))_" on ",1:"")_$$DATE($PIECE(ACTION,U,19))
A3 IF $PIECE(ACTION,U,2)="DC"
IF $LENGTH(OR6)
SET X=$SELECT($LENGTH($PIECE(OR6,U,5)):$PIECE(OR6,U,5),$PIECE(OR6,U,4):$PIECE($GET(^ORD(100.03,+$PIECE(OR6,U,4),0)),U),$PIECE(OR6,U):$PIECE($GET(^ORD(100.02,+$PIECE(OR6,U),0)),U),1:"")
if $LENGTH(X)
SET CNT=CNT+1
SET @ORY@(CNT)=" Reason for DC: "_X
+1 ;add backdoor comments
IF $LENGTH($GET(^OR(100,ORIFN,8,ORI,1)))
SET X=^(1)
Begin DoDot:1
+2 NEW LBL,I
SET LBL=""
+3 ;DC shown above
IF $PIECE(ACTION,U,15)=""
IF $PIECE(ACTION,U,2)'="DC"
SET LBL=" Comments: "
+4 ;NW shown in ORQ2
IF $PIECE(ACTION,U,15)=13
IF $PIECE(ACTION,U,2)'="NW"
SET LBL=" Cancelled: "
+5 if '$LENGTH(LBL)
QUIT
IF $LENGTH(X)'>56
SET CNT=CNT+1
SET @ORY@(CNT)=LBL_X
QUIT
+6 SET DIWL=1
SET DIWR=56
SET DIWF="C56"
KILL ^UTILITY($JOB,"W")
DO ^DIWP
+7 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=LBL_^(I,0)
SET LBL=" "
End DoDot:1
+8 ;Ward comments
IF $DATA(^OR(100,ORIFN,8,ORI,5))
Begin DoDot:1
+9 NEW X,ORJ
KILL ^UTILITY($JOB,"W")
+10 SET ORJ=0
FOR
SET ORJ=$ORDER(^OR(100,ORIFN,8,ORI,5,ORJ))
if ORJ'>0
QUIT
SET X=^(ORJ,0)
DO ^DIWP
+11 SET ORJ=0
FOR
SET ORJ=$ORDER(^UTILITY($JOB,"W",DIWL,ORJ))
if ORJ'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$SELECT(ORJ=1:" Ward/Clinic Cmmts: ",1:" ")_^(ORJ,0)
+12 KILL ^UTILITY($JOB,"W")
End DoDot:1
A4 IF $PIECE(ACTION,U,2)="HD"
IF $GET(^OR(100,ORIFN,8,ORI,2))
SET X2=^(2)
SET CNT=CNT+1
SET @ORY@(CNT)=" Hold Released: "_$$FMTE^XLFDT($PIECE(X2,U),"2P")_" by "_$$USER($PIECE(X2,U,2))
+1 NEW X3,F,Y
+2 ;Un-/Flagged
IF $DATA(^OR(100,ORIFN,8,ORI,3))
Begin DoDot:1
+3 ;N X S X=$G(^OR(100,ORIFN,8,ORI,3))
+4 SET X3=$GET(^OR(100,ORIFN,8,ORI,3))
+5 SET CNT=CNT+1
SET @ORY@(CNT)=" Flagged by: "_$$USER(+$PIECE(X3,U,4))_" on "_$$DATE($PIECE(X3,U,3))
+6 SET CNT=CNT+1
SET @ORY@(CNT)=" "_$PIECE(X3,U,5)
+7 IF $PIECE(X3,U,10)'=""
SET CNT=CNT+1
SET @ORY@(CNT)=" No Action Alert: "_$$DATE($PIECE(X3,U,10))
End DoDot:1
+8 ;flagged recipients ;p539
+9 SET ORJ=0
SET F=0
FOR
SET ORJ=$ORDER(^OR(100,ORIFN,8,ORI,6,ORJ))
if 'ORJ
QUIT
SET Y=^(ORJ,0)
Begin DoDot:1
+10 SET CNT=CNT+1
SET @ORY@(CNT)=$SELECT('F:" Recipients: ",1:" ")_$$USER(+Y)_" added on "_$$DATE($PIECE(Y,U,2))
SET F=1
End DoDot:1
+11 ;flagged comments ;p539
+12 NEW DIWL,DIWR,DIWF,X,I,ORK
+13 SET ORJ=0
SET F=0
FOR
SET ORJ=$ORDER(^OR(100,ORIFN,8,ORI,9,ORJ))
if 'ORJ
QUIT
SET Y=^(ORJ,0)
Begin DoDot:1
+14 SET CNT=CNT+1
SET @ORY@(CNT)=$SELECT('F:" Comments by: ",1:" ")_$$USER($PIECE(Y,U,2))_" on "_$$DATE(+Y)
SET F=1
+15 SET DIWL=24
SET DIWR=110
SET DIWF="I24"
KILL ^UTILITY($JOB,"W")
+16 SET ORK=0
FOR
SET ORK=$ORDER(^OR(100,ORIFN,8,ORI,9,ORJ,"COM",ORK))
if 'ORK
QUIT
SET X=^(ORK,0)
DO ^DIWP
+17 SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if 'I
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=^(I,0)
End DoDot:1
+18 KILL ^UTILITY($JOB,"W")
+19 IF $PIECE($GET(X3),U)=0
Begin DoDot:1
+20 SET CNT=CNT+1
SET @ORY@(CNT)=" Unflagged by: "_$$USER(+$PIECE(X3,U,7))_" on "_$$DATE($PIECE(X3,U,6))
+21 SET CNT=CNT+1
SET @ORY@(CNT)=" "_$PIECE(X3,U,8)
End DoDot:1
+22 ;flagged history ;p539
+23 KILL ORFHY
+24 IF $DATA(^OR(100,ORIFN,8,ORI,"FHIS"))
DO GETHST^ORWDXA1(.ORFHY,ORIFN_";"_ORI)
+25 IF $DATA(ORFHY)
Begin DoDot:1
+26 SET CNT=CNT+1
SET @ORY@(CNT)=" ***Order Flag History***"
+27 SET ORJ=0
SET F=0
FOR
SET ORJ=$ORDER(ORFHY(ORJ))
if 'ORJ
QUIT
SET Y=ORFHY(ORJ)
SET CNT=CNT+1
SET @ORY@(CNT)=" "_Y
+28 KILL ORFHY
End DoDot:1
A5 ;disposition/RTC Orders
+1 IF $DATA(^OR(100,ORIFN,8,ORI,4))
Begin DoDot:1
+2 NEW S
SET X=$GET(^OR(100,ORIFN,8,ORI,4))
+3 IF +$PIECE(X,U)>0
SET CNT=CNT+1
SET @ORY@(CNT)=" Disposition by: "_$$USER(+$PIECE(X,U))_" on "_$$DATE($PIECE(X,U,2))
End DoDot:1
+4 QUIT
+5 ;
DC ; -- Add Reason for DC
+1 SET CNT=CNT+1
SET @ORY@(CNT)=$$DATE($PIECE(OR6,U,3))_$SELECT($PIECE(OR6,U,8):" Auto-",1:" ")_"Discontinued"
+2 IF $PIECE(OR6,U,8)
Begin DoDot:1
+3 NEW EVT,PKG,ORV,I
+4 SET EVT=$PIECE(OR6,U,8)
SET PKG=$PIECE($GET(^ORE(100.2,+EVT,3,ORIFN,0)),U,2)
+5 SET @ORY@(CNT)=@ORY@(CNT)_" by "_$SELECT(PKG="FH":"DIETETICS",PKG="LR":"LABORATORY",PKG="PS":"PHARMACY",1:"CPRS")
+6 DO EVENT(.ORV,1)
SET CNT=CNT+1
SET @ORY@(CNT)=" Patient Movement: "_ORV(1)
+7 SET I=1
FOR
SET I=$ORDER(ORV(I))
if I'>0
QUIT
SET CNT=CNT+1
SET @ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$GET(ORV(I))
End DoDot:1
QUIT
+8 ;don't show user name if auto-dc
IF $PIECE(OR6,U,2)
IF $PIECE($GET(^ORD(100.02,+$PIECE(OR6,U),0)),U,2)'="A"
SET @ORY@(CNT)=@ORY@(CNT)_" by "_$$USER($PIECE(OR6,U,2))
+9 NEW X
SET X=$SELECT($LENGTH($PIECE(OR6,U,5)):$PIECE(OR6,U,5),$PIECE(OR6,U,4):$PIECE($GET(^ORD(100.03,+$PIECE(OR6,U,4),0)),U),$PIECE(OR6,U):$PIECE($GET(^ORD(100.02,+$PIECE(OR6,U),0)),U),1:"")
if $LENGTH(X)
SET CNT=CNT+1
SET @ORY@(CNT)=" Reason for DC: "_X
+10 QUIT
+11 ;
ACTION(CODE) ; -- Return name of action CODE
+1 NEW NAME
SET NAME=$SELECT(CODE="NW":"New Order",CODE="DC":"Discontinue",CODE="HD":"Hold",CODE="RL":"Release Hold",CODE="RN":"Renewal",CODE="XX":"Change",1:"")
+2 IF CODE="NW"
IF $PIECE(OR3,U,11)
SET NAME=NAME_$SELECT($PIECE(OR3,U,11)=1:" (Change)",$PIECE(OR3,U,11)=2:" (Renewal)",1:"")
+3 QUIT NAME
+4 ;
XACT(X) ; -- Return name of transaction code X
+1 NEW Y
SET X=$GET(X)
+2 SET Y=$SELECT(X="XX":"Edited",X="DC":"Discontinued",X="HD":"Held",X="RL":"Hold Released",X="FW":"Forwarded",X="CA":"Cancelled",1:"")
+3 QUIT Y
+4 ;
DATE(X) ; -- Return date formatted as 00/00/0000 00:00
+1 NEW T,Y
SET T=$PIECE(X,".",2)_"0000"
+2 SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_(1700+$EXTRACT(X,1,3))
+3 IF T
SET Y=Y_" "_$EXTRACT(T,1,2)_":"_$EXTRACT(T,3,4)
+4 QUIT Y
+5 ;
USER(X) ; -- Returns NAME (TITLE) of New Person X
+1 NEW X0,Y
SET X0=$GET(^VA(200,+X,0))
SET Y=$PIECE(X0,U)
+2 if $PIECE(X0,U,9)
SET Y=Y_" ("_$EXTRACT($PIECE($GET(^DIC(3.1,+$PIECE(X0,U,9),0)),U),1,15)_")"
+3 QUIT Y
+4 ;
SIG(X) ; -- Returns text of signature status X
+1 NEW Y
SET Y=""
+2 IF X=0
SET Y="ON CHART WITH WRITTEN ORDERS"
+3 IF X=1
SET Y="ELECTRONICALLY SIGNED"
+4 IF X=2
SET Y="NOT SIGNED"
+5 IF X=3
SET Y="NOT REQUIRED"
+6 IF X=4
SET Y="ON CHART WITH PRINTED ORDERS"
+7 IF X=5
SET Y="NOT REQUIRED DUE TO SERVICE CANCEL/LAPSE"
+8 IF X=6
SET Y="SERVICE CORRECTION TO SIGNED ORDER"
+9 QUIT Y
+10 ;
SERVCORR() ; -- Returns 1 or 0, if current ACTION is a serv corr change
+1 NEW Y,NATURE,I,X
SET Y=0
+2 if ORACT'="XX"
GOTO SCQ
+3 SET NATURE=+$PIECE(ACTION,U,12)
SET NATURE=$PIECE($GET(^ORD(100.02,NATURE,0)),U,2)
+4 IF "^S^I^"'[(U_NATURE_U)
GOTO SCQ
+5 SET I=$ORDER(^OR(100,ORIFN,8,ORI),-1)
SET X=$GET(^(I,0))
+6 ;show prov
IF $PIECE(X,U,3)'=$PIECE(ACTION,U,3)
IF $PIECE(X,U,5)'=$PIECE(ACTION,U,3)
GOTO SCQ
+7 SET Y=1
SCQ QUIT Y
+1 ;
EVENT(ORTX,DC) ; -- Returns patient event info for EVT
+1 NEW EVT1,REL,X,Y,I,ORMAX
+2 ;177
SET ORTX(1)=""
+3 SET EVT1=$GET(^ORE(100.2,EVT,1))
SET REL=$GET(^ORE(100.2,EVT,2,ORIFN,0))
+4 ; Return event data if AutoDC or auto-released by an event:
+5 IF $GET(DC)!(REL&'$LENGTH($PIECE(REL,U,2))&($PIECE(EVT1,U,2)!$PIECE(EVT1,U,4)))
Begin DoDot:1
+6 ;parent owns Activity
SET Y=$SELECT($PIECE(EVT1,U,5):$PIECE(EVT1,U,5),1:EVT)
+7 SET Y=+$ORDER(^ORE(100.2,+Y,10,0))
SET Y=$GET(^(Y,0))
SET X=$PIECE(Y,U,4)
if '$LENGTH(X)
QUIT
+8 ;243
SET X=$SELECT(X="A":"ADMISSION",X="T":"TRANSFER",X="D":"DISCHARGE",X="S":"SPECIALTY CHANGE",1:$SELECT($PIECE(EVT1,U)>$$DPI^ORUTL1("SR*3.0*157"):"IN TO O.R.",1:"OUT OF O.R."))_" on "_$$DATE($PIECE(EVT1,U))
+9 SET ORTX(1)=X
SET ORTX=1
SET ORMAX=56
+10 IF $PIECE(Y,U,6)
SET X=$SELECT($PIECE(Y,U,4)="D":"from ",1:"to ")_$$GET1^DIQ(45.7,+$PIECE(Y,U,6)_",",.01)
DO TXT^ORCHTAB
+11 IF $PIECE(Y,U,7)
SET X="on "_$$GET1^DIQ(42,+$PIECE(Y,U,7)_",",.01)
DO TXT^ORCHTAB
End DoDot:1
QUIT
+12 SET X=$$USER(+$PIECE(ACTION,U,17))_" on "_$$DATE($PIECE(ACTION,U,16))
+13 IF ORIFN'=+$PIECE($GET(^ORE(100.2,EVT,0)),U,4)
IF $PIECE(REL,U,2)="MN"
SET X=X_" (manually released)"
+14 SET ORTX(1)=X
+15 QUIT
