ORCHANG2 ;SLC/MKB - Change View status ;Feb 11, 2020@14:33:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,72,68,141,215,243,515**;Dec 17, 1997;Build 8
;
;Reference to STATUS^TIUSRVL supported by IA #3039
;
ORDERS ; -- Select new order status
N X,Y,HDR,I,DOMAIN,DEFAULT,PROMPT,HELP,STS
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=""
F I=1:1 S X=$T(ORDSTS+I) Q:$P(X,";",4)="ZZZZ" D SET
S DOMAIN(0)=I-1,PROMPT="Select Order Status: "
S HELP="Enter the status of orders you wish to see listed here."
D EN Q:Y="^" S STS=+$G(DOMAIN(Y))
I "^8^9^10^20^"[(U_STS_U) D Q:Y="^"
. N STRT,STOP,Z
. S STRT=$$START^ORCHANGE("NOW-24H") I STRT="^" S Y="^" Q
. S STOP=$$STOP^ORCHANGE("NOW") I STOP="^" S Y="^" Q
. I STOP<STRT S Z=STRT,STRT=STOP,STOP=Z
. S $P(HDR,";",1,2)=$P(STRT,U,2)_";"_$P(STOP,U,2)
S $P(HDR,";",3)=STS,$P(HDR,";",8)=""
I (STS=2)!(STS=5) D
. I $P(HDR,";")'="" D
. . N THISTS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. . S THISTS=" only active "
. . S:STS=5 THISTS=" expiring "
. . W !,"Date range can not be selected when viewing"_THISTS_"orders"
. . W !,"and will be cleared."
. . S DIR(0)="E" D ^DIR
. S $P(HDR,";",1,2)=";"
I STS=6,$P(HDR,";")="" S $P(HDR,";",1,2)="T;T@23:59"
S $P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
STSLST(ORY) ; -- Returns array of order views as
; ORY(n) = id ^ name ^ parent id [^+ if has members]
N I,X,CNT S CNT=0
F I=1:1 S X=$T(ORDSTS+I) Q:$P(X,";",4)="ZZZZ" S CNT=CNT+1,ORY(CNT)=$TR($P(X,";",3,6),";","^")
; include specific patient events??
Q
;
ORDSTS ;;#;Name of Order Context
;;1;All;0;+
;;2;Active (includes pending, recent activity);1
;;23;Current (Active & Pending status only);1
;;3;Discontinued;1
;;28;Discontinued/Entered in Error;1
;;4;Completed/Expired;1
;;5;Expiring;1
;;7;Pending;1
;;18;On Hold;1
;;19;New Orders;1
;;11;Unsigned;1
;;8;Unverified Inpatient by anyone;1;+
;;9;Unverified (IP) by Nursing;8
;;10;Unverified (IP) by Clerk;8
;;20;Unverified (IP) Chart Review;8
;;29;Unverified Outpatient by anyone;1;+
;;30;Unverified (OP) by Nursing;29
;;31;Unverified (OP) by Clerk;29
;;32;Unverified (OP) Chart Review;29
;;13;Verbal/Phoned;1;+
;;14;Verbal/Phoned unsigned;13
;;12;Flagged;1
;;6;Recent Activity (defaults to today's orders);1
;;24;Delayed (all events);1;+
;;15;Delayed Admission;24
;;17;Delayed Transfer;24
;;16;Delayed Discharge;24
;;25;Delayed Return from O.R.;24
;;26;Delayed for Manual Release;24
;;22;Lapsed (never processed);1
;;;ZZZZ
;
STS ; -- Select new [order or consult] status
N HDR,DEFAULT,DOMAIN,PROMPT,HELP,X,Y,I
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=""
S (I,Y)=0 F S I=$O(^ORD(100.01,I)) Q:I'>0 Q:I=99 S X=$G(^(I,0)) D
. Q:"^1^2^5^6^8^9^13^"'[(U_I_U) S Y=Y+1
. S DOMAIN(Y)=I_U_$$LOWER^VALM1($P(X,U)),DOMAIN("B",$P(X,U))=Y
. S:I=$P(HDR,";",3) DEFAULT=$P(DOMAIN(Y),U,2)
S Y=Y+1,DOMAIN(Y)="^All Statuses",DOMAIN("B","ALL STATUSES")=Y
S DOMAIN(0)=Y,PROMPT="Select Consult Status: "
S HELP="Enter the status of consults you wish to see listed here."
D EN Q:Y="^"
S $P(HDR,";",3)=$P(DOMAIN(Y),U),$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
TIU ; -- Select new document status
N X,Y,ORY,I,CNT,HDR,DOMAIN,DEFAULT,PROMPT,HELP
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=$P(HDR,";",3)
D STATUS^TIUSRVL(.ORY)
S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 S CNT=CNT+1,DOMAIN(CNT)=ORY(I),DOMAIN("B",$$UP^XLFSTR($P(ORY(I),U,2)))=CNT
S DOMAIN(0)=CNT,PROMPT="Select Signature Status: "
S HELP="Enter the signature status you would like to screen on"
D EN Q:Y="^"
S $P(HDR,";",3)=$P(DOMAIN(Y),U,2),$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
PLIST ; -- Select problem status
N X,Y,HDR,I,ID,NAME,DOMAIN,DEFAULT,PROMPT,HELP
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3)
F I=1:1 S X=$T(PLSTS+I) Q:$P(X,";",4)="ZZZZ" D SET
S DOMAIN(0)=I-1,PROMPT="Select Problem Status: "
S HELP="Enter the status of the problems you wish to see listed here."
D EN Q:Y="^"
S $P(HDR,";",3)=$P(DOMAIN(Y),U),$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
PLSTS ;;I;name
;;A;active
;;I;inactive
;;B;both active & inactive
;;;ZZZZ
;
SET ; -- set DOMAIN(I)=ID^NAME, DEFAULT from X=";;ID;NAME"
N ID,NAME
S ID=$P(X,";",3),NAME=$P(X,";",4)
S DOMAIN(I)=ID_U_NAME,DOMAIN("B",$$UP^XLFSTR(NAME))=I
S:ID=$P(HDR,";",3) DEFAULT=NAME
Q
;
EN ; -- Select new status via DOMAIN(), PROMPT, DEFAULT, HELP
N DONE S DONE=0,Y="" F D Q:DONE
. W !,PROMPT_$S($L(DEFAULT):DEFAULT_"//",1:"")
. R X:DTIME S:'$T X="^" I X["^" S Y="^",DONE=1 Q
. S:X="" X=DEFAULT I X="" S Y="^",DONE=1 Q
. I X["?" W !!,HELP D LIST Q
. D I 'Y W $C(7),!,HELP Q
. . N XP,XY,CNT,MATCH,DIR,I
. . S X=$$UP^XLFSTR(X),Y=+$G(DOMAIN("B",X)) Q:Y ; done
. . S CNT=0,XP=X F S XP=$O(DOMAIN("B",XP)) Q:XP="" Q:$E(XP,1,$L(X))'=X S CNT=CNT+1,XY=+DOMAIN("B",XP),MATCH(CNT)=XY_U_$P(DOMAIN(XY),U,2)
. . Q:'CNT
. . I CNT=1 S Y=+MATCH(1),XP=$P(MATCH(1),U,2) W $E(XP,$L(X)+1,$L(XP)) Q
. . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
. . F I=1:1:CNT S DIR("A",I)=$J(I,3)_" "_$P(MATCH(I),U,2)
. . S DIR("?")="Select the desired value, by number"
. . I CNT>3 D FULL^VALM1 S VALMBCK="R" ;need to scroll
. . D ^DIR I $D(DIRUT) S Y="" Q
. . S Y=+MATCH(Y) W " "_$P(DOMAIN(Y),U,2)
. S DONE=1
Q
;
LIST ; -- List order statuses in DOMAIN
N I,Z,CNT,DONE D FULL^VALM1 S VALMBCK="R"
S CNT=0 W !,"Choose from:"
F I=1:1:DOMAIN(0) D Q:$G(DONE)
. S CNT=CNT+1 W ! I CNT>(IOSL-3) D Q:$G(DONE)
.. W ?3,"'^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1 S CNT=1
. W $C(13)," "_$P(DOMAIN(I),U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHANG2 5646 printed Dec 13, 2024@02:28:21 Page 2
ORCHANG2 ;SLC/MKB - Change View status ;Feb 11, 2020@14:33:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,72,68,141,215,243,515**;Dec 17, 1997;Build 8
+2 ;
+3 ;Reference to STATUS^TIUSRVL supported by IA #3039
+4 ;
ORDERS ; -- Select new order status
+1 NEW X,Y,HDR,I,DOMAIN,DEFAULT,PROMPT,HELP,STS
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET DEFAULT=""
+3 FOR I=1:1
SET X=$TEXT(ORDSTS+I)
if $PIECE(X,";",4)="ZZZZ"
QUIT
DO SET
+4 SET DOMAIN(0)=I-1
SET PROMPT="Select Order Status: "
+5 SET HELP="Enter the status of orders you wish to see listed here."
+6 DO EN
if Y="^"
QUIT
SET STS=+$GET(DOMAIN(Y))
+7 IF "^8^9^10^20^"[(U_STS_U)
Begin DoDot:1
+8 NEW STRT,STOP,Z
+9 SET STRT=$$START^ORCHANGE("NOW-24H")
IF STRT="^"
SET Y="^"
QUIT
+10 SET STOP=$$STOP^ORCHANGE("NOW")
IF STOP="^"
SET Y="^"
QUIT
+11 IF STOP<STRT
SET Z=STRT
SET STRT=STOP
SET STOP=Z
+12 SET $PIECE(HDR,";",1,2)=$PIECE(STRT,U,2)_";"_$PIECE(STOP,U,2)
End DoDot:1
if Y="^"
QUIT
+13 SET $PIECE(HDR,";",3)=STS
SET $PIECE(HDR,";",8)=""
+14 IF (STS=2)!(STS=5)
Begin DoDot:1
+15 IF $PIECE(HDR,";")'=""
Begin DoDot:2
+16 NEW THISTS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+17 SET THISTS=" only active "
+18 if STS=5
SET THISTS=" expiring "
+19 WRITE !,"Date range can not be selected when viewing"_THISTS_"orders"
+20 WRITE !,"and will be cleared."
+21 SET DIR(0)="E"
DO ^DIR
End DoDot:2
+22 SET $PIECE(HDR,";",1,2)=";"
End DoDot:1
+23 IF STS=6
IF $PIECE(HDR,";")=""
SET $PIECE(HDR,";",1,2)="T;T@23:59"
+24 SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+25 QUIT
+26 ;
STSLST(ORY) ; -- Returns array of order views as
+1 ; ORY(n) = id ^ name ^ parent id [^+ if has members]
+2 NEW I,X,CNT
SET CNT=0
+3 FOR I=1:1
SET X=$TEXT(ORDSTS+I)
if $PIECE(X,";",4)="ZZZZ"
QUIT
SET CNT=CNT+1
SET ORY(CNT)=$TRANSLATE($PIECE(X,";",3,6),";","^")
+4 ; include specific patient events??
+5 QUIT
+6 ;
ORDSTS ;;#;Name of Order Context
+1 ;;1;All;0;+
+2 ;;2;Active (includes pending, recent activity);1
+3 ;;23;Current (Active & Pending status only);1
+4 ;;3;Discontinued;1
+5 ;;28;Discontinued/Entered in Error;1
+6 ;;4;Completed/Expired;1
+7 ;;5;Expiring;1
+8 ;;7;Pending;1
+9 ;;18;On Hold;1
+10 ;;19;New Orders;1
+11 ;;11;Unsigned;1
+12 ;;8;Unverified Inpatient by anyone;1;+
+13 ;;9;Unverified (IP) by Nursing;8
+14 ;;10;Unverified (IP) by Clerk;8
+15 ;;20;Unverified (IP) Chart Review;8
+16 ;;29;Unverified Outpatient by anyone;1;+
+17 ;;30;Unverified (OP) by Nursing;29
+18 ;;31;Unverified (OP) by Clerk;29
+19 ;;32;Unverified (OP) Chart Review;29
+20 ;;13;Verbal/Phoned;1;+
+21 ;;14;Verbal/Phoned unsigned;13
+22 ;;12;Flagged;1
+23 ;;6;Recent Activity (defaults to today's orders);1
+24 ;;24;Delayed (all events);1;+
+25 ;;15;Delayed Admission;24
+26 ;;17;Delayed Transfer;24
+27 ;;16;Delayed Discharge;24
+28 ;;25;Delayed Return from O.R.;24
+29 ;;26;Delayed for Manual Release;24
+30 ;;22;Lapsed (never processed);1
+31 ;;;ZZZZ
+32 ;
STS ; -- Select new [order or consult] status
+1 NEW HDR,DEFAULT,DOMAIN,PROMPT,HELP,X,Y,I
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET DEFAULT=""
+3 SET (I,Y)=0
FOR
SET I=$ORDER(^ORD(100.01,I))
if I'>0
QUIT
if I=99
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+4 if "^1^2^5^6^8^9^13^"'[(U_I_U)
QUIT
SET Y=Y+1
+5 SET DOMAIN(Y)=I_U_$$LOWER^VALM1($PIECE(X,U))
SET DOMAIN("B",$PIECE(X,U))=Y
+6 if I=$PIECE(HDR,";",3)
SET DEFAULT=$PIECE(DOMAIN(Y),U,2)
End DoDot:1
+7 SET Y=Y+1
SET DOMAIN(Y)="^All Statuses"
SET DOMAIN("B","ALL STATUSES")=Y
+8 SET DOMAIN(0)=Y
SET PROMPT="Select Consult Status: "
+9 SET HELP="Enter the status of consults you wish to see listed here."
+10 DO EN
if Y="^"
QUIT
+11 SET $PIECE(HDR,";",3)=$PIECE(DOMAIN(Y),U)
SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+12 QUIT
+13 ;
TIU ; -- Select new document status
+1 NEW X,Y,ORY,I,CNT,HDR,DOMAIN,DEFAULT,PROMPT,HELP
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET DEFAULT=$PIECE(HDR,";",3)
+3 DO STATUS^TIUSRVL(.ORY)
+4 SET (I,CNT)=0
FOR
SET I=$ORDER(ORY(I))
if I'>0
QUIT
SET CNT=CNT+1
SET DOMAIN(CNT)=ORY(I)
SET DOMAIN("B",$$UP^XLFSTR($PIECE(ORY(I),U,2)))=CNT
+5 SET DOMAIN(0)=CNT
SET PROMPT="Select Signature Status: "
+6 SET HELP="Enter the signature status you would like to screen on"
+7 DO EN
if Y="^"
QUIT
+8 SET $PIECE(HDR,";",3)=$PIECE(DOMAIN(Y),U,2)
SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+9 QUIT
+10 ;
PLIST ; -- Select problem status
+1 NEW X,Y,HDR,I,ID,NAME,DOMAIN,DEFAULT,PROMPT,HELP
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
+3 FOR I=1:1
SET X=$TEXT(PLSTS+I)
if $PIECE(X,";",4)="ZZZZ"
QUIT
DO SET
+4 SET DOMAIN(0)=I-1
SET PROMPT="Select Problem Status: "
+5 SET HELP="Enter the status of the problems you wish to see listed here."
+6 DO EN
if Y="^"
QUIT
+7 SET $PIECE(HDR,";",3)=$PIECE(DOMAIN(Y),U)
SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+8 QUIT
+9 ;
PLSTS ;;I;name
+1 ;;A;active
+2 ;;I;inactive
+3 ;;B;both active & inactive
+4 ;;;ZZZZ
+5 ;
SET ; -- set DOMAIN(I)=ID^NAME, DEFAULT from X=";;ID;NAME"
+1 NEW ID,NAME
+2 SET ID=$PIECE(X,";",3)
SET NAME=$PIECE(X,";",4)
+3 SET DOMAIN(I)=ID_U_NAME
SET DOMAIN("B",$$UP^XLFSTR(NAME))=I
+4 if ID=$PIECE(HDR,";",3)
SET DEFAULT=NAME
+5 QUIT
+6 ;
EN ; -- Select new status via DOMAIN(), PROMPT, DEFAULT, HELP
+1 NEW DONE
SET DONE=0
SET Y=""
FOR
Begin DoDot:1
+2 WRITE !,PROMPT_$SELECT($LENGTH(DEFAULT):DEFAULT_"//",1:"")
+3 READ X:DTIME
if '$TEST
SET X="^"
IF X["^"
SET Y="^"
SET DONE=1
QUIT
+4 if X=""
SET X=DEFAULT
IF X=""
SET Y="^"
SET DONE=1
QUIT
+5 IF X["?"
WRITE !!,HELP
DO LIST
QUIT
+6 Begin DoDot:2
+7 NEW XP,XY,CNT,MATCH,DIR,I
+8 ; done
SET X=$$UP^XLFSTR(X)
SET Y=+$GET(DOMAIN("B",X))
if Y
QUIT
+9 SET CNT=0
SET XP=X
FOR
SET XP=$ORDER(DOMAIN("B",XP))
if XP=""
QUIT
if $EXTRACT(XP,1,$LENGTH(X))'=X
QUIT
SET CNT=CNT+1
SET XY=+DOMAIN("B",XP)
SET MATCH(CNT)=XY_U_$PIECE(DOMAIN(XY),U,2)
+10 if 'CNT
QUIT
+11 IF CNT=1
SET Y=+MATCH(1)
SET XP=$PIECE(MATCH(1),U,2)
WRITE $EXTRACT(XP,$LENGTH(X)+1,$LENGTH(XP))
QUIT
+12 SET DIR(0)="NAO^1:"_CNT
SET DIR("A")="Select 1-"_CNT_": "
+13 FOR I=1:1:CNT
SET DIR("A",I)=$JUSTIFY(I,3)_" "_$PIECE(MATCH(I),U,2)
+14 SET DIR("?")="Select the desired value, by number"
+15 ;need to scroll
IF CNT>3
DO FULL^VALM1
SET VALMBCK="R"
+16 DO ^DIR
IF $DATA(DIRUT)
SET Y=""
QUIT
+17 SET Y=+MATCH(Y)
WRITE " "_$PIECE(DOMAIN(Y),U,2)
End DoDot:2
IF 'Y
WRITE $CHAR(7),!,HELP
QUIT
+18 SET DONE=1
End DoDot:1
if DONE
QUIT
+19 QUIT
+20 ;
LIST ; -- List order statuses in DOMAIN
+1 NEW I,Z,CNT,DONE
DO FULL^VALM1
SET VALMBCK="R"
+2 SET CNT=0
WRITE !,"Choose from:"
+3 FOR I=1:1:DOMAIN(0)
Begin DoDot:1
+4 SET CNT=CNT+1
WRITE !
IF CNT>(IOSL-3)
Begin DoDot:2
+5 WRITE ?3,"'^' TO STOP: "
READ Z:DTIME
if '$TEST!(Z["^")
SET DONE=1
SET CNT=1
End DoDot:2
if $GET(DONE)
QUIT
+6 WRITE $CHAR(13)," "_$PIECE(DOMAIN(I),U,2)
End DoDot:1
if $GET(DONE)
QUIT
+7 QUIT
