- 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 Feb 18, 2025@23:55:19 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