ORCHANGE ;SLC/MKB-Change View utilities ; 08 May 2002 2:12 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,72,141,243**;Dec 17, 1997;Build 242
EN ; -- Change view of current list
N XQORM,Y,ORI
S XQORM=$G(^TMP("OR",$J,"CURRENT","CHANGE")),VALMBCK=""
I 'XQORM W !!,"No other views of this list currently available" H 2 Q
S Y=$S(ORTAB="NOTES"!(ORTAB="SUMMRIES"):"1\",ORTAB="ORDERS":"\",1:"")
S XQORM(0)=Y_"AD" K Y
S XQORM("A")=$S($L($G(^ORD(101,+XQORM,28))):^(28),1:"Select attribute(s) to change: ")
D EN^XQORM S ORI=0
F S ORI=$O(Y(ORI)) Q:ORI'>0 X:$D(^ORD(101,+$P(Y(ORI),U,2),20)) ^(20)
I $G(^TMP("OR",$J,"CURRENT",0))'=$G(^TMP("OR",$J,ORTAB,0)) K VALMBG D TAB^ORCHART(ORTAB,1)
Q
;
RANGE ; -- Get new date range for list
N HDR,OLD,NEW,REQ,BEG,END
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3)
S REQ=$S(ORTAB="XRAYS":1,ORTAB="REPORTS":1,1:0)
I ($P(HDR,";",3)=2)!($P(HDR,";",3)=5) D Q
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,THISTS
. S THISTS=" only active "
. I $P(HDR,";",3)=5 S THISTS=" expiring "
. W !,"Date range can not be selected when viewing"_THISTS_"orders."
. S DIR(0)="E" D ^DIR
S OLD=$P(HDR,";"),NEW=$$START(OLD,REQ) Q:NEW="^" S BEG=NEW
I BEG="" S END="" G RQ
S OLD=$P(HDR,";",2),NEW=$$STOP(OLD,REQ) Q:NEW="^" S END=NEW
I END<BEG S NEW=END,END=BEG,BEG=NEW ; switch
RQ S $P(HDR,";",1,2)=$P(BEG,U,2)_";"_$P(END,U,2)
S $P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
START(CURRENT,REQD) ; -- Return new beginning date
N X,Y,DIR
S DIR(0)="DA"_$S('$G(REQD):"O",1:"")_"^::ETX",DIR("A")="Beginning Date[/time]: "
S:$L($G(CURRENT)) DIR("B")=$S(CURRENT?7N.1".".6N:$$FMTE^XLFDT(CURRENT),1:CURRENT)
S DIR("?")="Enter the earliest date [and time] from which you want to see data; a null response will return all data on this patient"
D ^DIR S:$D(DTOUT) Y="^" S:X="@" Y="" S:Y Y=Y_U_X
Q Y
;
STOP(CURRENT,REQD) ; -- Return new ending date
N X,Y,DIR
S DIR(0)="DA"_$S('$G(REQD):"O",1:"")_"^::ETX",DIR("A")="Ending Date[/time]: "
S:$L($G(CURRENT)) DIR("B")=$S(CURRENT?7N.1".".6N:$$FMTE^XLFDT(CURRENT),1:CURRENT)
S DIR("?")="Enter the latest date [and time] for which you want to see data; a null response will assume TODAY"
D ^DIR S:$D(DTOUT) Y="^" S:X="@" Y="" S:Y Y=Y_U_X
Q Y
;
MAX ; -- Get new max # of items to list
N X,Y,DIR
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),X=$P(HDR,";",5)
S DIR(0)="NAO^1:999" S:X DIR("B")=X
S DIR("A")="Maximum # of items to display: "
S DIR("?")="Enter the total number of items you wish to be displayed here"
D ^DIR Q:'Y
S $P(HDR,";",5)=Y,$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
AUTHOR(USER) ; -- Select new author of note
N X,Y,DIC D FULL^VALM1 S VALMBCK="R"
S DIC=200,DIC(0)="AEQM",DIC("A")="Select AUTHOR: "
S:$G(USER) DIC("B")=$P($G(^VA(200,+USER,0)),U)
D ^DIC S:Y'>0 Y=""
Q +Y
;
LISTHDR ; -- List available subhdrs
N HDR,DONE,CNT D FULL^VALM1
W !!,"Choose from:" S HDR="",(CNT,DONE)=0,VALMBCK="R"
F S HDR=$O(^TMP("OR",$J,"CURRENT","HDR",HDR)) Q:HDR="" D Q:DONE
. S CNT=CNT+1 I CNT>(IOSL-2) S CNT=0 I '$$MORE^ORCD S DONE=1 Q
. W !," "_HDR
Q
;
LRSUB ; -- Return lab subscript to jump to in list
; Available subscripts in ^TMP("OR",$J,"IDX",name)=line #
I '$D(^TMP("OR",$J,"CURRENT","HDR")) W !!,"There are no section headers defined for this report." H 3 Q
N X,Y,DIR,XP,P,CNT,MATCH D FULL^VALM1 S VALMBCK="R"
LRS S DIR(0)="FAO^1:30",DIR("A")="Select Lab Section: "
S DIR("A",1)="Available sections in this report:",X=""
F I=2:1 S X=$O(^TMP("OR",$J,"CURRENT","HDR",X)) Q:X="" S DIR("A",I)=" "_X
S DIR("?")="Enter the lab section from which to wish to see results; the display will scroll to the top of the selected section" ;,DIR("??")="^D LISTHDR^ORCHANGE"
D ^DIR Q:"^"[Y
S XP=$$UP^XLFSTR(X)
I $G(^TMP("OR",$J,"CURRENT","HDR",XP)) S VALMBG=^(XP),VALMBCK="R" Q
S CNT=0,P=XP F S P=$O(^TMP("OR",$J,"CURRENT","HDR",P)) Q:$E(P,1,$L(XP))'=XP S CNT=CNT+1,MATCH(CNT)=+$G(^(P))_U_P ; line# ^ hdr name
I 'CNT W $C(7)," ??" G LRS
I CNT=1 S VALMBG=+MATCH(CNT),VALMBCK="R",P=$P(MATCH(1),U,2) W $E(P,$L(X)+1,$L(P)) Q
LRS1 K DIR S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
F I=1:1:CNT S DIR("A",I)=I_" "_$P(MATCH(I),U,2)
S DIR("?")="Select the lab section you want to go to, by number"
D ^DIR Q:$D(DTOUT)!($D(DUOUT)) I 'Y K DIR G LRS
S VALMBG=+MATCH(Y),VALMBCK="R"
Q
;
DGROUP ; -- Select new service (display group)
N X,Y,Z,ZZ,DIC,HDR,DONE,HELP
D FULL^VALM1 S VALMBCK="R"
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),Z=$P(HDR,";",4),ZZ=+$O(^ORD(100.98,"B",$S($L(Z):Z,1:"ALL"),0))
S HELP="Enter the service or section from which you wish to see orders for this patient."
S DONE=0 F D Q:DONE
. W !!,"Select Service/Section: "_$P(^ORD(100.98,+ZZ,0),U)_"//"
. R X:DTIME S:'$T X="^" I X["^" S DONE=1 Q
. I X="" S DONE=1 Q ; no change
. I X["?" W !!,HELP,!,"Choose from:" D DG^ORCHANG1(1,"DISP") Q
. S DIC=100.98,DIC(0)="NEQZ" D ^DIC S:Y>0 Z=$P(Y(0),U,3),ZZ=+Y,DONE=1
S $P(HDR,";",4)=Z,$P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U
Q
;
CS ; -- Select new consult service
N GMRCDG,GMRCBUF,GMRCACT,GMRCQUT,GMRCGRP,HDR
D FULL^VALM1,ASRV^GMRCASV S VALMBCK="R" Q:$D(GMRCQUT)
S:$G(GMRCDG) HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),$P(HDR,";",4)=GMRCDG,$P(^(0),U,3,4)=HDR_U
K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
Q
;
REMOVE ; -- Remove preferred view
N ORDEL S ORDEL=1
SAVE ; -- Save current view as preferred
Q:'$$OK($G(ORDEL)) N X,Y,PARAM
S X=$S($G(ORDEL):"@",1:$P($G(^TMP("OR",$J,ORTAB,0)),U,3)),Y=""
;S:$G(ORTAB)="MEDS" Y=$S($P(X,";",3):"IN",1:"OUT")_"PT "
S:$G(ORTAB)="LABS" Y=$S($G(ORWARD):"IN",1:"OUT")_"PT "
S PARAM="ORCH CONTEXT "_Y_$G(ORTAB)
D EN^XPAR("USR",PARAM,1,X) W " ...done." H 1
Q
;
OK(DEL) ; -- Are you sure you want to save/remove view of ORTAB?
N X,Y,DIR S DIR(0)="YA"
S DIR("A")="Are you sure you want to "_$S($G(DEL):"remove",1:"save the current view as")_" your preference? "
S:$G(DEL) DIR("?",1)="Enter YES if you wish to remove your preferred view of this chart tab and use",DIR("?")="the default view next time, or NO to quit without changing anything."
S:'$G(DEL) DIR("?",1)="Enter YES if you wish to use these same parameters again the next time the ",DIR("?")=$$LOWER^VALM1(ORTAB)_" tab is created for you, or NO to quit without saving anything."
D ^DIR
Q +Y
;
RETURN ; -- Return to preferred view of ORTAB
S $P(^TMP("OR",$J,ORTAB,0),U,4)=1
Q
ORCHANGE ;SLC/MKB-Change View utilities ; 08 May 2002 2:12 PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**27,72,141,243**;Dec 17, 1997;Build 242
EN ; -- Change view of current list
+1 NEW XQORM,Y,ORI
+2 SET XQORM=$GET(^TMP("OR",$JOB,"CURRENT","CHANGE"))
SET VALMBCK=""
+3 IF 'XQORM
WRITE !!,"No other views of this list currently available"
HANG 2
QUIT
+4 SET Y=$SELECT(ORTAB="NOTES"!(ORTAB="SUMMRIES"):"1\",ORTAB="ORDERS":"\",1:"")
+5 SET XQORM(0)=Y_"AD"
KILL Y
+6 SET XQORM("A")=$SELECT($LENGTH($GET(^ORD(101,+XQORM,28))):^(28),1:"Select attribute(s) to change: ")
+7 DO EN^XQORM
SET ORI=0
+8 FOR
SET ORI=$ORDER(Y(ORI))
IF ORI'>0
QUIT
IF $DATA(^ORD(101,+$PIECE(Y(ORI),U,2),20))
XECUTE ^(20)
+9 IF $GET(^TMP("OR",$JOB,"CURRENT",0))'=$GET(^TMP("OR",$JOB,ORTAB,0))
KILL VALMBG
DO TAB^ORCHART(ORTAB,1)
+10 QUIT
+11 ;
RANGE ; -- Get new date range for list
+1 NEW HDR,OLD,NEW,REQ,BEG,END
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
+3 SET REQ=$SELECT(ORTAB="XRAYS":1,ORTAB="REPORTS":1,1:0)
+4 IF ($PIECE(HDR,";",3)=2)!($PIECE(HDR,";",3)=5)
Begin DoDot:1
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,THISTS
+6 SET THISTS=" only active "
+7 IF $PIECE(HDR,";",3)=5
SET THISTS=" expiring "
+8 WRITE !,"Date range can not be selected when viewing"_THISTS_"orders."
+9 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+10 SET OLD=$PIECE(HDR,";")
SET NEW=$$START(OLD,REQ)
IF NEW="^"
QUIT
SET BEG=NEW
+11 IF BEG=""
SET END=""
GOTO RQ
+12 SET OLD=$PIECE(HDR,";",2)
SET NEW=$$STOP(OLD,REQ)
IF NEW="^"
QUIT
SET END=NEW
+13 ; switch
IF END<BEG
SET NEW=END
SET END=BEG
SET BEG=NEW
RQ SET $PIECE(HDR,";",1,2)=$PIECE(BEG,U,2)_";"_$PIECE(END,U,2)
+1 SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+2 QUIT
+3 ;
START(CURRENT,REQD) ; -- Return new beginning date
+1 NEW X,Y,DIR
+2 SET DIR(0)="DA"_$SELECT('$GET(REQD):"O",1:"")_"^::ETX"
SET DIR("A")="Beginning Date[/time]: "
+3 IF $LENGTH($GET(CURRENT))
SET DIR("B")=$SELECT(CURRENT?7N.1".".6N:$$FMTE^XLFDT(CURRENT),1:CURRENT)
+4 SET DIR("?")="Enter the earliest date [and time] from which you want to see data; a null response will return all data on this patient"
+5 DO ^DIR
IF $DATA(DTOUT)
SET Y="^"
IF X="@"
SET Y=""
IF Y
SET Y=Y_U_X
+6 QUIT Y
+7 ;
STOP(CURRENT,REQD) ; -- Return new ending date
+1 NEW X,Y,DIR
+2 SET DIR(0)="DA"_$SELECT('$GET(REQD):"O",1:"")_"^::ETX"
SET DIR("A")="Ending Date[/time]: "
+3 IF $LENGTH($GET(CURRENT))
SET DIR("B")=$SELECT(CURRENT?7N.1".".6N:$$FMTE^XLFDT(CURRENT),1:CURRENT)
+4 SET DIR("?")="Enter the latest date [and time] for which you want to see data; a null response will assume TODAY"
+5 DO ^DIR
IF $DATA(DTOUT)
SET Y="^"
IF X="@"
SET Y=""
IF Y
SET Y=Y_U_X
+6 QUIT Y
+7 ;
MAX ; -- Get new max # of items to list
+1 NEW X,Y,DIR
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET X=$PIECE(HDR,";",5)
+3 SET DIR(0)="NAO^1:999"
IF X
SET DIR("B")=X
+4 SET DIR("A")="Maximum # of items to display: "
+5 SET DIR("?")="Enter the total number of items you wish to be displayed here"
+6 DO ^DIR
IF 'Y
QUIT
+7 SET $PIECE(HDR,";",5)=Y
SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+8 QUIT
+9 ;
AUTHOR(USER) ; -- Select new author of note
+1 NEW X,Y,DIC
DO FULL^VALM1
SET VALMBCK="R"
+2 SET DIC=200
SET DIC(0)="AEQM"
SET DIC("A")="Select AUTHOR: "
+3 IF $GET(USER)
SET DIC("B")=$PIECE($GET(^VA(200,+USER,0)),U)
+4 DO ^DIC
IF Y'>0
SET Y=""
+5 QUIT +Y
+6 ;
LISTHDR ; -- List available subhdrs
+1 NEW HDR,DONE,CNT
DO FULL^VALM1
+2 WRITE !!,"Choose from:"
SET HDR=""
SET (CNT,DONE)=0
SET VALMBCK="R"
+3 FOR
SET HDR=$ORDER(^TMP("OR",$JOB,"CURRENT","HDR",HDR))
IF HDR=""
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
IF CNT>(IOSL-2)
SET CNT=0
IF '$$MORE^ORCD
SET DONE=1
QUIT
+5 WRITE !," "_HDR
End DoDot:1
IF DONE
QUIT
+6 QUIT
+7 ;
LRSUB ; -- Return lab subscript to jump to in list
+1 ; Available subscripts in ^TMP("OR",$J,"IDX",name)=line #
+2 IF '$DATA(^TMP("OR",$JOB,"CURRENT","HDR"))
WRITE !!,"There are no section headers defined for this report."
HANG 3
QUIT
+3 NEW X,Y,DIR,XP,P,CNT,MATCH
DO FULL^VALM1
SET VALMBCK="R"
LRS SET DIR(0)="FAO^1:30"
SET DIR("A")="Select Lab Section: "
+1 SET DIR("A",1)="Available sections in this report:"
SET X=""
+2 FOR I=2:1
SET X=$ORDER(^TMP("OR",$JOB,"CURRENT","HDR",X))
IF X=""
QUIT
SET DIR("A",I)=" "_X
+3 ;,DIR("??")="^D LISTHDR^ORCHANGE"
SET DIR("?")="Enter the lab section from which to wish to see results; the display will scroll to the top of the selected section"
+4 DO ^DIR
IF "^"[Y
QUIT
+5 SET XP=$$UP^XLFSTR(X)
+6 IF $GET(^TMP("OR",$JOB,"CURRENT","HDR",XP))
SET VALMBG=^(XP)
SET VALMBCK="R"
QUIT
+7 ; line# ^ hdr name
SET CNT=0
SET P=XP
FOR
SET P=$ORDER(^TMP("OR",$JOB,"CURRENT","HDR",P))
IF $EXTRACT(P,1,$LENGTH(XP))'=XP
QUIT
SET CNT=CNT+1
SET MATCH(CNT)=+$GET(^(P))_U_P
+8 IF 'CNT
WRITE $CHAR(7)," ??"
GOTO LRS
+9 IF CNT=1
SET VALMBG=+MATCH(CNT)
SET VALMBCK="R"
SET P=$PIECE(MATCH(1),U,2)
WRITE $EXTRACT(P,$LENGTH(X)+1,$LENGTH(P))
QUIT
LRS1 KILL DIR
SET DIR(0)="NAO^1:"_CNT
SET DIR("A")="Select 1-"_CNT_": "
+1 FOR I=1:1:CNT
SET DIR("A",I)=I_" "_$PIECE(MATCH(I),U,2)
+2 SET DIR("?")="Select the lab section you want to go to, by number"
+3 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
IF 'Y
KILL DIR
GOTO LRS
+4 SET VALMBG=+MATCH(Y)
SET VALMBCK="R"
+5 QUIT
+6 ;
DGROUP ; -- Select new service (display group)
+1 NEW X,Y,Z,ZZ,DIC,HDR,DONE,HELP
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET Z=$PIECE(HDR,";",4)
SET ZZ=+$ORDER(^ORD(100.98,"B",$SELECT($LENGTH(Z):Z,1:"ALL"),0))
+4 SET HELP="Enter the service or section from which you wish to see orders for this patient."
+5 SET DONE=0
FOR
Begin DoDot:1
+6 WRITE !!,"Select Service/Section: "_$PIECE(^ORD(100.98,+ZZ,0),U)_"//"
+7 READ X:DTIME
IF '$TEST
SET X="^"
IF X["^"
SET DONE=1
QUIT
+8 ; no change
IF X=""
SET DONE=1
QUIT
+9 IF X["?"
WRITE !!,HELP,!,"Choose from:"
DO DG^ORCHANG1(1,"DISP")
QUIT
+10 SET DIC=100.98
SET DIC(0)="NEQZ"
DO ^DIC
IF Y>0
SET Z=$PIECE(Y(0),U,3)
SET ZZ=+Y
SET DONE=1
End DoDot:1
IF DONE
QUIT
+11 SET $PIECE(HDR,";",4)=Z
SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U
+12 QUIT
+13 ;
CS ; -- Select new consult service
+1 NEW GMRCDG,GMRCBUF,GMRCACT,GMRCQUT,GMRCGRP,HDR
+2 DO FULL^VALM1
DO ASRV^GMRCASV
SET VALMBCK="R"
IF $DATA(GMRCQUT)
QUIT
+3 IF $GET(GMRCDG)
SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET $PIECE(HDR,";",4)=GMRCDG
SET $PIECE(^(0),U,3,4)=HDR_U
+4 KILL ^TMP("GMRCS",$JOB),^TMP("GMRCSLIST",$JOB)
+5 QUIT
+6 ;
REMOVE ; -- Remove preferred view
+1 NEW ORDEL
SET ORDEL=1
SAVE ; -- Save current view as preferred
+1 IF '$$OK($GET(ORDEL))
QUIT
NEW X,Y,PARAM
+2 SET X=$SELECT($GET(ORDEL):"@",1:$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3))
SET Y=""
+3 ;S:$G(ORTAB)="MEDS" Y=$S($P(X,";",3):"IN",1:"OUT")_"PT "
+4 IF $GET(ORTAB)="LABS"
SET Y=$SELECT($GET(ORWARD):"IN",1:"OUT")_"PT "
+5 SET PARAM="ORCH CONTEXT "_Y_$GET(ORTAB)
+6 DO EN^XPAR("USR",PARAM,1,X)
WRITE " ...done."
HANG 1
+7 QUIT
+8 ;
OK(DEL) ; -- Are you sure you want to save/remove view of ORTAB?
+1 NEW X,Y,DIR
SET DIR(0)="YA"
+2 SET DIR("A")="Are you sure you want to "_$SELECT($GET(DEL):"remove",1:"save the current view as")_" your preference? "
+3 IF $GET(DEL)
SET DIR("?",1)="Enter YES if you wish to remove your preferred view of this chart tab and use"
SET DIR("?")="the default view next time, or NO to quit without changing anything."
+4 IF '$GET(DEL)
SET DIR("?",1)="Enter YES if you wish to use these same parameters again the next time the "
SET DIR("?")=$$LOWER^VALM1(ORTAB)_" tab is created for you, or NO to quit without saving anything."
+5 DO ^DIR
+6 QUIT +Y
+7 ;
RETURN ; -- Return to preferred view of ORTAB
+1 SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,4)=1
+2 QUIT
