ORCMENU2 ;SLC/MKB-Review New Orders ;4/5/01 21:32
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,48,72,108**;Dec 17, 1997
EN ; -- main entry point
I '$$MORE W !!,"You have no new or unsigned orders for this patient." S VALMBCK="" H 1 Q
EN1 ; -- enter here from ORCHART when exiting chart
N ORTAB K OREBLD D EN^VALM("OR NEW ORDERS")
Q
;
EX ; -- main exit point
I $G(OREBUILD)!$G(OREBLD) F TAB="ORDERS","COVER","MEDS","LABS","XRAYS","CONSULTS" D:TAB=$G(ORTAB) TAB^ORCHART(TAB,1) I TAB'=$G(ORTAB),$D(^TMP("OR",$J,TAB,0)) S $P(^(0),U)=""
S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
K OREBUILD,OREBLD
Q
;
INIT ; -- init variables and list array
I $G(ORRV),'$$MORE S VALMBCK="Q" Q
W !,"Searching the patient's chart ..."
D CLEAN^VALM10 S ORTAB="NEW" D EN^ORCHTAB
S VALMCNT=+$G(^TMP("OR",$J,"NEW",0)),VALM("TITLE")=$G(^("TITLE"))
M ^TMP("VALM VIDEO",$J,VALMEVL)=^TMP("OR",$J,ORTAB,"VIDEO")
S VALMBG=1,VALMBCK="R"
Q
;
PHDR ; -- protocol menu header code
S VALMSG=$$MSG^ORCHART D SHOW^VALM
S:$G(OREBUILD) OREBLD=1 K ORNMBR,OREBUILD
S XQORM("#")=$O(^ORD(101,"B","ORC NEW ACTIONS",0))_"^1:"_+$P($G(^TMP("OR",$J,"NEW",0)),U,2)
I XQORM("B")="Quit",$P($G(^TMP("OR",$J,"NEW",0)),U,2) S XQORM("B")=$S('$$GET^XPAR("ALL","ORPF NEW ORDERS DEFAULT"):"Sign All Orders",1:"Sign & Release")
S XQORM("KEY","DC")=$O(^ORD(101,"B","ORC DISCONTINUE ORDERS",0))_"^1"
S XQORM("KEY","ED")=$O(^ORD(101,"B","ORC CHANGE ORDERS",0))_"^1"
S XQORM("KEY","DT")=$O(^ORD(101,"B","ORC DETAILED DISPLAY",0))_"^1"
S XQORM("KEY","$")=$O(^ORD(101,"B","ORC SIGN ORDERS",0))_"^1"
S XQORM("KEY","SIGN")=XQORM("KEY","$")
Q
;
HELP ; -- help code
N X W !!,"Enter the display numbers of the items you wish to act on; a menu of"
W !,"available actions will then be presented for selection."
W !,"Press <return> to continue ..." R X:DTIME S VALMBCK=""
Q
;
EXIT ; -- exit code
K ^TMP("OR",$J,"NEW")
Q
;
NOTIF ; -- Trigger notification for new orders left unsigned
Q:'$O(^TMP("ORNEW",$J,0)) N ORIFN,ORDA,ORA0,ORERR S ORIFN=0
F S ORIFN=$O(^TMP("ORNEW",$J,ORIFN)) Q:ORIFN'>0 S ORDA=0 D
. F S ORDA=$O(^TMP("ORNEW",$J,ORIFN,ORDA)) Q:ORDA'>0 D
.. S ORA0=$G(^OR(100,+ORIFN,8,+ORDA,0))
.. I ORDA,$P(ORA0,U,4)=2 S ORNP=$P(ORA0,U,3) D NOTIF^ORCSIGN
.. I ORDA,$P(ORA0,U,4)=3,$$VALID^ORCACT0(ORIFN_";"_ORDA,"ES",.ORERR) D EN^ORCSEND(ORIFN_";"_ORDA,,3,1,,,.ORERR) ;release if ES not req'd
.. D UNLK1^ORX2(+ORIFN)
Q
;
SIGNALL ; -- sign all new orders
N ORNMBR,ORMAX,I,LNG
S ORMAX=+$P($G(^TMP("OR",$J,"NEW",0)),U,2),ORNMBR=""
F I=1:1:ORMAX S LNG=$L(ORNMBR)+$L(I)+1 S:LNG'>255 ORNMBR=ORNMBR_I_"," I LNG>255 W !,"Range too large; only items #1-"_(I-1)_" will be signed." Q
D EN^ORCSIGN I '$$MORE S VALMBCK="Q" Q
D EX^ORCACT
Q
;
MORE() ; -- More orders to process?
I $O(^TMP("ORNEW",$J,0)) Q 1
N Y S Y=0 I $D(^XUSEC("ORES",DUZ)) D
. N IDX,IFN,ACT,ROOT,ENT,PAR
. S ENT="ALL"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"")
. S PAR=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT") Q:PAR'>0
. I PAR=2,$O(^OR(100,"AS",ORVP,0)) S Y=1 Q
. S IDX=$NA(@"^OR(100,""AS"",ORVP)"),ROOT=$TR(IDX,")",",")
. F S IDX=$Q(@IDX) Q:$E(IDX,1,$L(ROOT))'=ROOT S IFN=+$P(IDX,",",5),ACT=+$P(IDX,",",6) I PAR=1,$P($G(^OR(100,IFN,8,ACT,0)),U,3)=DUZ S Y=1 Q
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCMENU2 3306 printed Sep 11, 2024@02:48:40 Page 2
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,48,72,108**;Dec 17, 1997
EN ; -- main entry point
+1 IF '$$MORE
WRITE !!,"You have no new or unsigned orders for this patient."
SET VALMBCK=""
HANG 1
QUIT
EN1 ; -- enter here from ORCHART when exiting chart
+1 NEW ORTAB
KILL OREBLD
DO EN^VALM("OR NEW ORDERS")
+2 QUIT
+3 ;
EX ; -- main exit point
+1 IF $GET(OREBUILD)!$GET(OREBLD)
FOR TAB="ORDERS","COVER","MEDS","LABS","XRAYS","CONSULTS"
if TAB=$GET(ORTAB)
DO TAB^ORCHART(TAB,1)
IF TAB'=$GET(ORTAB)
IF $DATA(^TMP("OR",$JOB,TAB,0))
SET $PIECE(^(0),U)=""
+2 if $DATA(^TMP("OR",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+3 KILL OREBUILD,OREBLD
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 IF $GET(ORRV)
IF '$$MORE
SET VALMBCK="Q"
QUIT
+2 WRITE !,"Searching the patient's chart ..."
+3 DO CLEAN^VALM10
SET ORTAB="NEW"
DO EN^ORCHTAB
+4 SET VALMCNT=+$GET(^TMP("OR",$JOB,"NEW",0))
SET VALM("TITLE")=$GET(^("TITLE"))
+5 MERGE ^TMP("VALM VIDEO",$JOB,VALMEVL)=^TMP("OR",$JOB,ORTAB,"VIDEO")
+6 SET VALMBG=1
SET VALMBCK="R"
+7 QUIT
+8 ;
PHDR ; -- protocol menu header code
+1 SET VALMSG=$$MSG^ORCHART
DO SHOW^VALM
+2 if $GET(OREBUILD)
SET OREBLD=1
KILL ORNMBR,OREBUILD
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","ORC NEW ACTIONS",0))_"^1:"_+$PIECE($GET(^TMP("OR",$JOB,"NEW",0)),U,2)
+4 IF XQORM("B")="Quit"
IF $PIECE($GET(^TMP("OR",$JOB,"NEW",0)),U,2)
SET XQORM("B")=$SELECT('$$GET^XPAR("ALL","ORPF NEW ORDERS DEFAULT"):"Sign All Orders",1:"Sign & Release")
+5 SET XQORM("KEY","DC")=$ORDER(^ORD(101,"B","ORC DISCONTINUE ORDERS",0))_"^1"
+6 SET XQORM("KEY","ED")=$ORDER(^ORD(101,"B","ORC CHANGE ORDERS",0))_"^1"
+7 SET XQORM("KEY","DT")=$ORDER(^ORD(101,"B","ORC DETAILED DISPLAY",0))_"^1"
+8 SET XQORM("KEY","$")=$ORDER(^ORD(101,"B","ORC SIGN ORDERS",0))_"^1"
+9 SET XQORM("KEY","SIGN")=XQORM("KEY","$")
+10 QUIT
+11 ;
HELP ; -- help code
+1 NEW X
WRITE !!,"Enter the display numbers of the items you wish to act on; a menu of"
+2 WRITE !,"available actions will then be presented for selection."
+3 WRITE !,"Press <return> to continue ..."
READ X:DTIME
SET VALMBCK=""
+4 QUIT
+5 ;
EXIT ; -- exit code
+1 KILL ^TMP("OR",$JOB,"NEW")
+2 QUIT
+3 ;
NOTIF ; -- Trigger notification for new orders left unsigned
+1 if '$ORDER(^TMP("ORNEW",$JOB,0))
QUIT
NEW ORIFN,ORDA,ORA0,ORERR
SET ORIFN=0
+2 FOR
SET ORIFN=$ORDER(^TMP("ORNEW",$JOB,ORIFN))
if ORIFN'>0
QUIT
SET ORDA=0
Begin DoDot:1
+3 FOR
SET ORDA=$ORDER(^TMP("ORNEW",$JOB,ORIFN,ORDA))
if ORDA'>0
QUIT
Begin DoDot:2
+4 SET ORA0=$GET(^OR(100,+ORIFN,8,+ORDA,0))
+5 IF ORDA
IF $PIECE(ORA0,U,4)=2
SET ORNP=$PIECE(ORA0,U,3)
DO NOTIF^ORCSIGN
+6 ;release if ES not req'd
IF ORDA
IF $PIECE(ORA0,U,4)=3
IF $$VALID^ORCACT0(ORIFN_";"_ORDA,"ES",.ORERR)
DO EN^ORCSEND(ORIFN_";"_ORDA,,3,1,,,.ORERR)
+7 DO UNLK1^ORX2(+ORIFN)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SIGNALL ; -- sign all new orders
+1 NEW ORNMBR,ORMAX,I,LNG
+2 SET ORMAX=+$PIECE($GET(^TMP("OR",$JOB,"NEW",0)),U,2)
SET ORNMBR=""
+3 FOR I=1:1:ORMAX
SET LNG=$LENGTH(ORNMBR)+$LENGTH(I)+1
if LNG'>255
SET ORNMBR=ORNMBR_I_","
IF LNG>255
WRITE !,"Range too large; only items #1-"_(I-1)_" will be signed."
QUIT
+4 DO EN^ORCSIGN
IF '$$MORE
SET VALMBCK="Q"
QUIT
+5 DO EX^ORCACT
+6 QUIT
+7 ;
MORE() ; -- More orders to process?
+1 IF $ORDER(^TMP("ORNEW",$JOB,0))
QUIT 1
+2 NEW Y
SET Y=0
IF $DATA(^XUSEC("ORES",DUZ))
Begin DoDot:1
+3 NEW IDX,IFN,ACT,ROOT,ENT,PAR
+4 SET ENT="ALL"_$SELECT($GET(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"")
+5 SET PAR=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT")
if PAR'>0
QUIT
+6 IF PAR=2
IF $ORDER(^OR(100,"AS",ORVP,0))
SET Y=1
QUIT
+7 SET IDX=$NAME(@"^OR(100,""AS"",ORVP)")
SET ROOT=$TRANSLATE(IDX,")",",")
+8 FOR
SET IDX=$QUERY(@IDX)
if $EXTRACT(IDX,1,$LENGTH(ROOT))'=ROOT
QUIT
SET IFN=+$PIECE(IDX,",",5)
SET ACT=+$PIECE(IDX,",",6)
IF PAR=1
IF $PIECE($GET(^OR(100,IFN,8,ACT,0)),U,3)=DUZ
SET Y=1
QUIT
End DoDot:1
+9 QUIT Y
