- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHANGE 6431 printed Feb 18, 2025@23:54:56 Page 2
- 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