ORCHART ;SLC/MKB/REV-OE/RR ;Jul 10, 2023@09:19:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,70,72,92,141,181,588**;Dec 17, 1997;Build 29
EN ; -- main entry point
;
I $$ONEHR^ORACCESS D Q
. W !,"Site has migrated to Electronic Health Record."
. W !,"CPRS List Manager access not allowed."
. H 2
;
K ^TMP("OR",$J) ;ensure fresh start
D EN^ORQPT Q:+$G(ORVP)'>0
D EN^VALM("OR CHART") G:'$G(OREXIT) EN
K OREXIT
Q
;
INIT ; -- init variables and list array
S:'$D(ORTAB) ORTAB=$$UP^XLFSTR($$GET^XPAR("ALL","ORCH INITIAL TAB",1,"E"))
S:ORTAB="DCSUMM" ORTAB="SUMMRIES" S:'$L(ORTAB) ORTAB="COVER"
S ORACTION=0 D TAB(ORTAB)
Q
;
PHDR ; -- protocol header code
N ORM,ORI,ORS,ORSYN K ORNMBR,OREBUILD
S:$G(ORTAB)'="LABS" VALMSG=$$MSG D SHOW^VALM
S:XQORM("B")="Quit" XQORM("B")=$S('$G(DGPMT):"Chart Contents",1:"Close Patient Chart")
S:$G(^TMP("OR",$J,"CURRENT","#")) XQORM("#")=^("#")
S ORM=$S(ORTAB="CONSULTS":+$O(^ORD(101,"B","ORC CONSULT SERVICE MENU",0)),1:+$G(XQORM("#"))),ORI=0 ;set XQORM("KEY",<synonym>)
F S ORI=$O(^ORD(101,ORM,10,"B",ORI)) Q:ORI'>0 I $D(^ORD(101,+ORI,2)) D
. S ORS=0 F S ORS=$O(^ORD(101,+ORI,2,ORS)) Q:ORS'>0 S ORSYN=$G(^(ORS,0)) S:$L(ORSYN) XQORM("KEY",ORSYN)=+ORI_"^1"
S XQORM("KEY","EX")=$O(^ORD(101,"B","ORC EXIT",0))_"^1"
S XQORM("KEY","NEXT")=$O(^ORD(101,"B","ORC NEXT SCREEN",0))_"^1"
S XQORM("KEY","PL")=$O(^ORD(101,"B","ORC PRINT LIST",0))_"^1"
Q
;
HDR ; -- header code
; Expects ORPNM, ORSSN, ORL, ORDOB, ORAGE [, ORPD]
; N DFN S DFN=+ORVP D SLCT1^ORQPT if any are missing ??
N ORX,ORX1,ORX2,ORX3,ORCWAD,L,SP K VALMHDR
S ORX1=$P($G(^DPT(+ORVP,0)),U,3),ORX3=$$FMTE^XLFDT(ORX1,2)_"("_ORAGE_")"
S ORX2="" I +$G(ORL) D S:$L($G(ORL(1))) ORX2=ORX2_"/"_ORL(1)
. S L=$G(^SC(+ORL,0)),ORX2=$P(L,U,2)
. S:'$L(ORX2) ORX2=$E($P(L,U),1,4)
S L=80-$L(ORPNM)-$L(ORSSN)-$L(ORX2)-$L(ORX3),SP=$$REPEAT^XLFSTR(" ",L\3)
S ORX1=ORPNM_SP_ORSSN_SP_ORX2,VALMHDR(1)=ORX1_$J(ORX3,80-$L(ORX1))
S ORX1=$S(ORATTEND:"Attend: "_$$LNAMEF^ORCHTAB(ORATTEND),1:"")
S ORX2="PrimCare: "_$$LNAMEF^ORCHTAB(+$$OUTPTPR^SDUTL3(+ORVP))
S ORX3="PCTeam: "_$P($$OUTPTTM^SDUTL3(+ORVP),U,2)
S ORX=$S($L(ORX1):$$LJ^XLFSTR(ORX1,20),1:"")_ORX2,VALMHDR(2)=$$LJ^XLFSTR(ORX,42)_ORX3
S ORCWAD=$$CWAD^ORQPT2(+ORVP) S:ORCWAD]"" ORCWAD="<"_ORCWAD_">"
S ORX=$S($G(ORTAB)="COVER":"",$G(ORTAB)="REPORTS":"",1:$$VIEW),VALMHDR(3)=ORX_$J(ORCWAD,80-$L(ORX))
Q
;
MSG() ; -- LMgr message bar
Q "Enter the numbers of the items you wish to act on."
;
HELP ; -- help code
N X,DX,DY D FULL^VALM1
W !!,"Enter the display numbers of the items you wish to change or act on; a menu of",!,"available actions will then be presented for selection."
W !!,"To see a different 'page' of the chart, enter CC; if you'd like another view of",!,"the current page, by date range for example, enter CV. You may add new orders"
W !,"for this patient from any page in the chart by entering AD and review them",!,"using RV. Enter ?? to see a list of actions available for navigating the list."
W:ORTAB="PROBLEMS" !!,"* = Acute problem",!,"$ = Unverified problem",!,"# = Problem references inactive code"
W:(ORTAB="SUMMRIES")!(ORTAB="NOTES") !!,"+ = Addenda attached"
W:(ORTAB="ORDERS")!(ORTAB="MEDS") !!,"* = Order has been updated by service"
W:ORTAB="ORDERS" !,"+ = Sub-orders exist"
W !!,"Press <return> to continue ..." R X:DTIME
S VALMBCK="R" S:$G(ORTAB)'="LABS" VALMSG=$$MSG
S (DX,DY)=0 X ^%ZOSF("XY")
Q
;
ITEMHELP ; -- help code for action menus
N X
W !!,"Enter the action you wish to take on the items selected and highlighted",!,"above; each item will be processed in order, one at a time."
W !!,"Press <return> to continue ..." R X:DTIME
S X="?" D DISP^XQORM1 W !
Q
;
EXIT ; -- exit code
I $G(ORVP),$$MORE^ORCMENU2 D ;unsigned orders
. ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q ;msg like 2.5??
. W !!,"You have new or unsigned orders for this patient!" H 1
. S ORRV=1 D EN1^ORCMENU2,NOTIF^ORCMENU2 ;sign, notif if not all signed
D UNLOCK^ORX2(+ORVP) K ^TMP("OR",$J),^TMP("ORNEW",$J),^TMP("LRRR",$J)
K VALMCNT,VALMHDR,VALMBG,ORQUIT,ORVP,ORSEX,ORTAB,ORPNM,ORSSN,ORL,ORDOB,ORAGE,ORPD,ORNP,ORSC,ORTS,ORWARD,ORATTEND,ORNMBR,ORACTION,OREBUILD,OREBLD,ORRV,OREVENT
Q
;
TAB(NEWTAB,REBUILD) ; -- switch focus to new chart tab from ORTAB
S VALMBCK="",VALMBG=$S($G(ORTAB)'=NEWTAB:1,'$G(VALMBG):1,1:VALMBG)
S ORTAB=NEWTAB I '$G(^TMP("OR",$J,ORTAB,0))!($G(REBUILD)) D
. W !,"Searching the patient's chart ..."
. D FULL^VALM1,EN^ORCHTAB ; [re]build list
D CLEAN^VALM10 M ^TMP("OR",$J,"CURRENT")=^TMP("OR",$J,ORTAB)
M ^TMP("VALM VIDEO",$J,VALMEVL)=^TMP("OR",$J,"CURRENT","VIDEO")
I $D(^TMP("OR",$J,"CURRENT","CAPTION")) D
. N FLD,LBL S FLD=""
. F S FLD=$O(^TMP("OR",$J,"CURRENT","CAPTION",FLD)) Q:FLD="" S LBL=$G(^(FLD)) D CHGCAP^VALM(FLD,LBL)
S VALM("TITLE")=$G(^TMP("OR",$J,"CURRENT","TITLE")),VALM("RM")=^("RM")
S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
S VALMCNT=+$G(^TMP("OR",$J,"CURRENT",0)),VALMLFT=$P(VALMDDF("DATA"),U,2)
D HDR S VALMBCK="R" ; reset VALMHDR nodes
Q
;
NEWPAT ; -- Select new patient
I $$MORE^ORCMENU2 D ;unsigned orders
. ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q
. W !!,"You have new or unsigned orders for this patient!" H 1
. S ORRV=1 D EN1^ORCMENU2,NOTIF^ORCMENU2 ;sign, notif if not all signed
N TAB,OLD,T,ORT,CTXT K ORRV S OLD=+ORVP,TAB=ORTAB
D EN^ORQPT I OLD=+ORVP S VALMBCK="R" D:$G(OREBUILD) REBLD^ORCMENU K OREBUILD Q ; no change
S T="" F S T=$O(^TMP("OR",$J,T)) Q:T="" D
. I T="MEDS" K ^TMP("OR",$J,T) Q
. S CTXT=$P($G(^TMP("OR",$J,T,0)),U,3) S:$L(CTXT) ORT(T,0)="^^"_$S(T="NOTES"&($P(CTXT,";",3)=1):"",1:CTXT)_U_$P(^(0),U,4) ; save tab contexts
D UNLOCK^ORX2(+ORVP) K ^TMP("OR",$J),^TMP("ORNEW",$J),^TMP("LRRR",$J)
K VALMHDR,ORTAB,ORNEW,OREBUILD,OREBLD
M ^TMP("OR",$J)=ORT D TAB(TAB) S VALMBCK="R"
Q
;
ORDERS(ACTION) ; -- Return order numbers to act on, if action chosen first
N X,Y,DIR,MAX S:'$L($G(ACTION)) ACTION="act on"
S MAX=+$P($G(^TMP("OR",$J,ORTAB,0)),U,2) Q:MAX'>0 "^"
S DIR(0)="LAO^1:"_MAX,DIR("A")="Select item(s): " S:MAX=1 DIR("B")=1
S DIR("?")="Enter the items you wish to "_ACTION_", as a range or list of numbers"
D ^DIR S:$D(DTOUT)!(Y="") Y="^"
Q Y
;
ALL ; -- Return all items on ORTAB
N X,Y,DIR,MAX
S MAX=+$P($G(^TMP("OR",$J,ORTAB,0)),U,2) Q:MAX'>0 ""
S DIR(0)="L^1:"_MAX,DIR("V")="",X="1-"_MAX D ^DIR
Q Y
;
SELECT(NMBR) ; -- rev video on selected items
N ORI,ORJ,NUM,ROW,ROWS,VALID S VALID=0
F ORI=1:1:$L(NMBR,",") S NUM=$P(NMBR,",",ORI) I NUM D
. I '$L($P($G(@VALMAR@("IDX",NUM)),U)) W !,NUM_" is not a valid selection." H 2 Q
. S VALID=1
. S ROW=$P(@VALMAR@("IDX",NUM),U,2),ROWS=$P(^(NUM),U,3)
. F ORJ=ROW:1:(ROW+ROWS-1) I ORJ'<VALMBG,ORJ'>(VALMBG+VALM("LINES")-1) D
. . K ^TMP("VALM VIDEO",$J,VALMEVL,ORJ)
. . D CNTRL^VALM10(ORJ,1,80,IORVON,IORVOFF)
. . D WRITE^VALM10(ORJ)
I 'VALID S XQORQUIT=1
Q
;
DESELECT(NMBR) ; -- norm video on selected items
N ORI,ORJ,NUM,IFN,ROW,ROWS,ON,OFF,I,IDX
F ORI=1:1:$L(NMBR,",") S NUM=$P(NMBR,",",ORI) I NUM D
. S IDX=$G(@VALMAR@("IDX",NUM)) Q:'$L(IDX) ;invalid NUM
. S IFN=$P(IDX,U),ROW=$P(IDX,U,2),ROWS=$P(IDX,U,3)
. F ORJ=ROW:1:(ROW+ROWS-1) I ORJ'<VALMBG,ORJ'>(VALMBG+VALM("LINES")-1) D
. . K ^TMP("VALM VIDEO",$J,VALMEVL,ORJ) Q:'$L(IFN) ;deleted
. . S ON=IOINHI,OFF=IOINORM
. . I ORTAB="ORDERS",$G(^OR(100,+IFN,8,+$P(IFN,";",2),3)) S ON=IORVON,OFF=IORVOFF ; flagged
. . D CNTRL^VALM10(ORJ,1,5,ON,OFF)
. . I ORTAB="ORDERS" S I=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*UNSIGNED*") I I D CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)
. . I ORTAB="XRAYS" S I=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*ABNORMAL*") I I D CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)
. . I ORTAB="LABS" D CNTRL^VALM10(ORJ,24,2,IOINHI,IOINORM)
. . D:VALMBCK="" WRITE^VALM10(ORJ)
Q
;
CHANGE ; -- Change view of current list
G EN^ORCHANGE
Q
;
REV(ORVP) ; -- Review orders for patient
Q:'$G(ORVP) Q:$D(ZTQUEUED) Q:$G(DGQUIET) ;silent
I $D(SDAMEVT) Q:$S(SDAMEVT=1:0,1:1) ;continue if new appt
Q:'$$GET^XPAR("ALL","ORPF REVIEW ON PATIENT MVMT")
Q:'$$ACCESS^ORCHTAB ;CPRS not in user's option menu tree
N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DFN ;protect DFN
S DFN=+ORVP,ORVP=DFN_";DPT(" Q:'$D(^OR(100,"AC",ORVP)) ; no orders
S DIR(0)="YA",DIR("A")="Review active orders? ",DIR("B")="YES"
S DIR("?")="Answer YES to review this patient's active orders"
D ^DIR Q:Y'>0 K DIR
D SLCT1^ORQPT Q:'$G(ORVP)
S ORTAB="ORDERS" D EN^VALM("OR CHART")
Q
;
VIEW() ; -- return line 3 of header w/current view of tab
N BEGIN,END,ITEMS,STS,TEXT,X
I $G(ORTAB)']"" Q ""
S X=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),TEXT=""
S BEGIN=$P(X,";"),END=$P(X,";",2),STS=$P(X,";",3),ITEMS=$P(X,";",5)
I ORTAB="NOTES",(STS'=5) S TEXT=$S(ITEMS:"up to "_ITEMS,1:"all")_$S(STS=1:" notes",STS=2:" unsigned notes",STS=3:" uncosigned notes",STS=4:" signed notes by author",1:"")
E D
. S:$L(BEGIN)!$L(END) TEXT=$$FDATE^VALM1($$DT^ORCHTAB1(BEGIN))_" thru "_$$FDATE^VALM1($$DT^ORCHTAB1(END))
. I ORTAB="XRAYS",ITEMS>0 S TEXT=$S($L(TEXT):TEXT_", ",1:"")_"limit "_ITEMS
S:$L(TEXT) TEXT="Current View: "_TEXT,TEXT=$J(TEXT,40+($L(TEXT)\2))
Q TEXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHART 9282 printed Dec 13, 2024@02:28:24 Page 2
ORCHART ;SLC/MKB/REV-OE/RR ;Jul 10, 2023@09:19:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,70,72,92,141,181,588**;Dec 17, 1997;Build 29
EN ; -- main entry point
+1 ;
+2 IF $$ONEHR^ORACCESS
Begin DoDot:1
+3 WRITE !,"Site has migrated to Electronic Health Record."
+4 WRITE !,"CPRS List Manager access not allowed."
+5 HANG 2
End DoDot:1
QUIT
+6 ;
+7 ;ensure fresh start
KILL ^TMP("OR",$JOB)
+8 DO EN^ORQPT
if +$GET(ORVP)'>0
QUIT
+9 DO EN^VALM("OR CHART")
if '$GET(OREXIT)
GOTO EN
+10 KILL OREXIT
+11 QUIT
+12 ;
INIT ; -- init variables and list array
+1 if '$DATA(ORTAB)
SET ORTAB=$$UP^XLFSTR($$GET^XPAR("ALL","ORCH INITIAL TAB",1,"E"))
+2 if ORTAB="DCSUMM"
SET ORTAB="SUMMRIES"
if '$LENGTH(ORTAB)
SET ORTAB="COVER"
+3 SET ORACTION=0
DO TAB(ORTAB)
+4 QUIT
+5 ;
PHDR ; -- protocol header code
+1 NEW ORM,ORI,ORS,ORSYN
KILL ORNMBR,OREBUILD
+2 if $GET(ORTAB)'="LABS"
SET VALMSG=$$MSG
DO SHOW^VALM
+3 if XQORM("B")="Quit"
SET XQORM("B")=$SELECT('$GET(DGPMT):"Chart Contents",1:"Close Patient Chart")
+4 if $GET(^TMP("OR",$JOB,"CURRENT","#"))
SET XQORM("#")=^("#")
+5 ;set XQORM("KEY",<synonym>)
SET ORM=$SELECT(ORTAB="CONSULTS":+$ORDER(^ORD(101,"B","ORC CONSULT SERVICE MENU",0)),1:+$GET(XQORM("#")))
SET ORI=0
+6 FOR
SET ORI=$ORDER(^ORD(101,ORM,10,"B",ORI))
if ORI'>0
QUIT
IF $DATA(^ORD(101,+ORI,2))
Begin DoDot:1
+7 SET ORS=0
FOR
SET ORS=$ORDER(^ORD(101,+ORI,2,ORS))
if ORS'>0
QUIT
SET ORSYN=$GET(^(ORS,0))
if $LENGTH(ORSYN)
SET XQORM("KEY",ORSYN)=+ORI_"^1"
End DoDot:1
+8 SET XQORM("KEY","EX")=$ORDER(^ORD(101,"B","ORC EXIT",0))_"^1"
+9 SET XQORM("KEY","NEXT")=$ORDER(^ORD(101,"B","ORC NEXT SCREEN",0))_"^1"
+10 SET XQORM("KEY","PL")=$ORDER(^ORD(101,"B","ORC PRINT LIST",0))_"^1"
+11 QUIT
+12 ;
HDR ; -- header code
+1 ; Expects ORPNM, ORSSN, ORL, ORDOB, ORAGE [, ORPD]
+2 ; N DFN S DFN=+ORVP D SLCT1^ORQPT if any are missing ??
+3 NEW ORX,ORX1,ORX2,ORX3,ORCWAD,L,SP
KILL VALMHDR
+4 SET ORX1=$PIECE($GET(^DPT(+ORVP,0)),U,3)
SET ORX3=$$FMTE^XLFDT(ORX1,2)_"("_ORAGE_")"
+5 SET ORX2=""
IF +$GET(ORL)
Begin DoDot:1
+6 SET L=$GET(^SC(+ORL,0))
SET ORX2=$PIECE(L,U,2)
+7 if '$LENGTH(ORX2)
SET ORX2=$EXTRACT($PIECE(L,U),1,4)
End DoDot:1
if $LENGTH($GET(ORL(1)))
SET ORX2=ORX2_"/"_ORL(1)
+8 SET L=80-$LENGTH(ORPNM)-$LENGTH(ORSSN)-$LENGTH(ORX2)-$LENGTH(ORX3)
SET SP=$$REPEAT^XLFSTR(" ",L\3)
+9 SET ORX1=ORPNM_SP_ORSSN_SP_ORX2
SET VALMHDR(1)=ORX1_$JUSTIFY(ORX3,80-$LENGTH(ORX1))
+10 SET ORX1=$SELECT(ORATTEND:"Attend: "_$$LNAMEF^ORCHTAB(ORATTEND),1:"")
+11 SET ORX2="PrimCare: "_$$LNAMEF^ORCHTAB(+$$OUTPTPR^SDUTL3(+ORVP))
+12 SET ORX3="PCTeam: "_$PIECE($$OUTPTTM^SDUTL3(+ORVP),U,2)
+13 SET ORX=$SELECT($LENGTH(ORX1):$$LJ^XLFSTR(ORX1,20),1:"")_ORX2
SET VALMHDR(2)=$$LJ^XLFSTR(ORX,42)_ORX3
+14 SET ORCWAD=$$CWAD^ORQPT2(+ORVP)
if ORCWAD]""
SET ORCWAD="<"_ORCWAD_">"
+15 SET ORX=$SELECT($GET(ORTAB)="COVER":"",$GET(ORTAB)="REPORTS":"",1:$$VIEW)
SET VALMHDR(3)=ORX_$JUSTIFY(ORCWAD,80-$LENGTH(ORX))
+16 QUIT
+17 ;
MSG() ; -- LMgr message bar
+1 QUIT "Enter the numbers of the items you wish to act on."
+2 ;
HELP ; -- help code
+1 NEW X,DX,DY
DO FULL^VALM1
+2 WRITE !!,"Enter the display numbers of the items you wish to change or act on; a menu of",!,"available actions will then be presented for selection."
+3 WRITE !!,"To see a different 'page' of the chart, enter CC; if you'd like another view of",!,"the current page, by date range for example, enter CV. You may add new orders"
+4 WRITE !,"for this patient from any page in the chart by entering AD and review them",!,"using RV. Enter ?? to see a list of actions available for navigating the list."
+5 if ORTAB="PROBLEMS"
WRITE !!,"* = Acute problem",!,"$ = Unverified problem",!,"# = Problem references inactive code"
+6 if (ORTAB="SUMMRIES")!(ORTAB="NOTES")
WRITE !!,"+ = Addenda attached"
+7 if (ORTAB="ORDERS")!(ORTAB="MEDS")
WRITE !!,"* = Order has been updated by service"
+8 if ORTAB="ORDERS"
WRITE !,"+ = Sub-orders exist"
+9 WRITE !!,"Press <return> to continue ..."
READ X:DTIME
+10 SET VALMBCK="R"
if $GET(ORTAB)'="LABS"
SET VALMSG=$$MSG
+11 SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
+12 QUIT
+13 ;
ITEMHELP ; -- help code for action menus
+1 NEW X
+2 WRITE !!,"Enter the action you wish to take on the items selected and highlighted",!,"above; each item will be processed in order, one at a time."
+3 WRITE !!,"Press <return> to continue ..."
READ X:DTIME
+4 SET X="?"
DO DISP^XQORM1
WRITE !
+5 QUIT
+6 ;
EXIT ; -- exit code
+1 ;unsigned orders
IF $GET(ORVP)
IF $$MORE^ORCMENU2
Begin DoDot:1
+2 ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q ;msg like 2.5??
+3 WRITE !!,"You have new or unsigned orders for this patient!"
HANG 1
+4 ;sign, notif if not all signed
SET ORRV=1
DO EN1^ORCMENU2
DO NOTIF^ORCMENU2
End DoDot:1
+5 DO UNLOCK^ORX2(+ORVP)
KILL ^TMP("OR",$JOB),^TMP("ORNEW",$JOB),^TMP("LRRR",$JOB)
+6 KILL VALMCNT,VALMHDR,VALMBG,ORQUIT,ORVP,ORSEX,ORTAB,ORPNM,ORSSN,ORL,ORDOB,ORAGE,ORPD,ORNP,ORSC,ORTS,ORWARD,ORATTEND,ORNMBR,ORACTION,OREBUILD,OREBLD,ORRV,OREVENT
+7 QUIT
+8 ;
TAB(NEWTAB,REBUILD) ; -- switch focus to new chart tab from ORTAB
+1 SET VALMBCK=""
SET VALMBG=$SELECT($GET(ORTAB)'=NEWTAB:1,'$GET(VALMBG):1,1:VALMBG)
+2 SET ORTAB=NEWTAB
IF '$GET(^TMP("OR",$JOB,ORTAB,0))!($GET(REBUILD))
Begin DoDot:1
+3 WRITE !,"Searching the patient's chart ..."
+4 ; [re]build list
DO FULL^VALM1
DO EN^ORCHTAB
End DoDot:1
+5 DO CLEAN^VALM10
MERGE ^TMP("OR",$JOB,"CURRENT")=^TMP("OR",$JOB,ORTAB)
+6 MERGE ^TMP("VALM VIDEO",$JOB,VALMEVL)=^TMP("OR",$JOB,"CURRENT","VIDEO")
+7 IF $DATA(^TMP("OR",$JOB,"CURRENT","CAPTION"))
Begin DoDot:1
+8 NEW FLD,LBL
SET FLD=""
+9 FOR
SET FLD=$ORDER(^TMP("OR",$JOB,"CURRENT","CAPTION",FLD))
if FLD=""
QUIT
SET LBL=$GET(^(FLD))
DO CHGCAP^VALM(FLD,LBL)
End DoDot:1
+10 SET VALM("TITLE")=$GET(^TMP("OR",$JOB,"CURRENT","TITLE"))
SET VALM("RM")=^("RM")
+11 if $DATA(^TMP("OR",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+12 SET VALMCNT=+$GET(^TMP("OR",$JOB,"CURRENT",0))
SET VALMLFT=$PIECE(VALMDDF("DATA"),U,2)
+13 ; reset VALMHDR nodes
DO HDR
SET VALMBCK="R"
+14 QUIT
+15 ;
NEWPAT ; -- Select new patient
+1 ;unsigned orders
IF $$MORE^ORCMENU2
Begin DoDot:1
+2 ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q
+3 WRITE !!,"You have new or unsigned orders for this patient!"
HANG 1
+4 ;sign, notif if not all signed
SET ORRV=1
DO EN1^ORCMENU2
DO NOTIF^ORCMENU2
End DoDot:1
+5 NEW TAB,OLD,T,ORT,CTXT
KILL ORRV
SET OLD=+ORVP
SET TAB=ORTAB
+6 ; no change
DO EN^ORQPT
IF OLD=+ORVP
SET VALMBCK="R"
if $GET(OREBUILD)
DO REBLD^ORCMENU
KILL OREBUILD
QUIT
+7 SET T=""
FOR
SET T=$ORDER(^TMP("OR",$JOB,T))
if T=""
QUIT
Begin DoDot:1
+8 IF T="MEDS"
KILL ^TMP("OR",$JOB,T)
QUIT
+9 ; save tab contexts
SET CTXT=$PIECE($GET(^TMP("OR",$JOB,T,0)),U,3)
if $LENGTH(CTXT)
SET ORT(T,0)="^^"_$SELECT(T="NOTES"&($PIECE(CTXT,";",3)=1):"",1:CTXT)_U_$PIECE(^(0),U,4)
End DoDot:1
+10 DO UNLOCK^ORX2(+ORVP)
KILL ^TMP("OR",$JOB),^TMP("ORNEW",$JOB),^TMP("LRRR",$JOB)
+11 KILL VALMHDR,ORTAB,ORNEW,OREBUILD,OREBLD
+12 MERGE ^TMP("OR",$JOB)=ORT
DO TAB(TAB)
SET VALMBCK="R"
+13 QUIT
+14 ;
ORDERS(ACTION) ; -- Return order numbers to act on, if action chosen first
+1 NEW X,Y,DIR,MAX
if '$LENGTH($GET(ACTION))
SET ACTION="act on"
+2 SET MAX=+$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,2)
if MAX'>0
QUIT "^"
+3 SET DIR(0)="LAO^1:"_MAX
SET DIR("A")="Select item(s): "
if MAX=1
SET DIR("B")=1
+4 SET DIR("?")="Enter the items you wish to "_ACTION_", as a range or list of numbers"
+5 DO ^DIR
if $DATA(DTOUT)!(Y="")
SET Y="^"
+6 QUIT Y
+7 ;
ALL ; -- Return all items on ORTAB
+1 NEW X,Y,DIR,MAX
+2 SET MAX=+$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,2)
if MAX'>0
QUIT ""
+3 SET DIR(0)="L^1:"_MAX
SET DIR("V")=""
SET X="1-"_MAX
DO ^DIR
+4 QUIT Y
+5 ;
SELECT(NMBR) ; -- rev video on selected items
+1 NEW ORI,ORJ,NUM,ROW,ROWS,VALID
SET VALID=0
+2 FOR ORI=1:1:$LENGTH(NMBR,",")
SET NUM=$PIECE(NMBR,",",ORI)
IF NUM
Begin DoDot:1
+3 IF '$LENGTH($PIECE($GET(@VALMAR@("IDX",NUM)),U))
WRITE !,NUM_" is not a valid selection."
HANG 2
QUIT
+4 SET VALID=1
+5 SET ROW=$PIECE(@VALMAR@("IDX",NUM),U,2)
SET ROWS=$PIECE(^(NUM),U,3)
+6 FOR ORJ=ROW:1:(ROW+ROWS-1)
IF ORJ'<VALMBG
IF ORJ'>(VALMBG+VALM("LINES")-1)
Begin DoDot:2
+7 KILL ^TMP("VALM VIDEO",$JOB,VALMEVL,ORJ)
+8 DO CNTRL^VALM10(ORJ,1,80,IORVON,IORVOFF)
+9 DO WRITE^VALM10(ORJ)
End DoDot:2
End DoDot:1
+10 IF 'VALID
SET XQORQUIT=1
+11 QUIT
+12 ;
DESELECT(NMBR) ; -- norm video on selected items
+1 NEW ORI,ORJ,NUM,IFN,ROW,ROWS,ON,OFF,I,IDX
+2 FOR ORI=1:1:$LENGTH(NMBR,",")
SET NUM=$PIECE(NMBR,",",ORI)
IF NUM
Begin DoDot:1
+3 ;invalid NUM
SET IDX=$GET(@VALMAR@("IDX",NUM))
if '$LENGTH(IDX)
QUIT
+4 SET IFN=$PIECE(IDX,U)
SET ROW=$PIECE(IDX,U,2)
SET ROWS=$PIECE(IDX,U,3)
+5 FOR ORJ=ROW:1:(ROW+ROWS-1)
IF ORJ'<VALMBG
IF ORJ'>(VALMBG+VALM("LINES")-1)
Begin DoDot:2
+6 ;deleted
KILL ^TMP("VALM VIDEO",$JOB,VALMEVL,ORJ)
if '$LENGTH(IFN)
QUIT
+7 SET ON=IOINHI
SET OFF=IOINORM
+8 ; flagged
IF ORTAB="ORDERS"
IF $GET(^OR(100,+IFN,8,+$PIECE(IFN,";",2),3))
SET ON=IORVON
SET OFF=IORVOFF
+9 DO CNTRL^VALM10(ORJ,1,5,ON,OFF)
+10 IF ORTAB="ORDERS"
SET I=$FIND(^TMP("OR",$JOB,ORTAB,ORJ,0),"*UNSIGNED*")
IF I
DO CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)
+11 IF ORTAB="XRAYS"
SET I=$FIND(^TMP("OR",$JOB,ORTAB,ORJ,0),"*ABNORMAL*")
IF I
DO CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)
+12 IF ORTAB="LABS"
DO CNTRL^VALM10(ORJ,24,2,IOINHI,IOINORM)
+13 if VALMBCK=""
DO WRITE^VALM10(ORJ)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
CHANGE ; -- Change view of current list
+1 GOTO EN^ORCHANGE
+2 QUIT
+3 ;
REV(ORVP) ; -- Review orders for patient
+1 ;silent
if '$GET(ORVP)
QUIT
if $DATA(ZTQUEUED)
QUIT
if $GET(DGQUIET)
QUIT
+2 ;continue if new appt
IF $DATA(SDAMEVT)
if $SELECT(SDAMEVT=1
QUIT
+3 if '$$GET^XPAR("ALL","ORPF REVIEW ON PATIENT MVMT")
QUIT
+4 ;CPRS not in user's option menu tree
if '$$ACCESS^ORCHTAB
QUIT
+5 ;protect DFN
NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DFN
+6 ; no orders
SET DFN=+ORVP
SET ORVP=DFN_";DPT("
if '$DATA(^OR(100,"AC",ORVP))
QUIT
+7 SET DIR(0)="YA"
SET DIR("A")="Review active orders? "
SET DIR("B")="YES"
+8 SET DIR("?")="Answer YES to review this patient's active orders"
+9 DO ^DIR
if Y'>0
QUIT
KILL DIR
+10 DO SLCT1^ORQPT
if '$GET(ORVP)
QUIT
+11 SET ORTAB="ORDERS"
DO EN^VALM("OR CHART")
+12 QUIT
+13 ;
VIEW() ; -- return line 3 of header w/current view of tab
+1 NEW BEGIN,END,ITEMS,STS,TEXT,X
+2 IF $GET(ORTAB)']""
QUIT ""
+3 SET X=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET TEXT=""
+4 SET BEGIN=$PIECE(X,";")
SET END=$PIECE(X,";",2)
SET STS=$PIECE(X,";",3)
SET ITEMS=$PIECE(X,";",5)
+5 IF ORTAB="NOTES"
IF (STS'=5)
SET TEXT=$SELECT(ITEMS:"up to "_ITEMS,1:"all")_$SELECT(STS=1:" notes",STS=2:" unsigned notes",STS=3:" uncosigned notes",STS=4:" signed notes by author",1:"")
+6 IF '$TEST
Begin DoDot:1
+7 if $LENGTH(BEGIN)!$LENGTH(END)
SET TEXT=$$FDATE^VALM1($$DT^ORCHTAB1(BEGIN))_" thru "_$$FDATE^VALM1($$DT^ORCHTAB1(END))
+8 IF ORTAB="XRAYS"
IF ITEMS>0
SET TEXT=$SELECT($LENGTH(TEXT):TEXT_", ",1:"")_"limit "_ITEMS
End DoDot:1
+9 if $LENGTH(TEXT)
SET TEXT="Current View: "_TEXT
SET TEXT=$JUSTIFY(TEXT,40+($LENGTH(TEXT)\2))
+10 QUIT TEXT
