source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMENU2.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1ORCMENU2 ;SLC/MKB-Review New Orders ;4/5/01 21:32
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,48,72,108**;Dec 17, 1997
3EN ; -- main entry point
4 I '$$MORE W !!,"You have no new or unsigned orders for this patient." S VALMBCK="" H 1 Q
5EN1 ; -- enter here from ORCHART when exiting chart
6 N ORTAB K OREBLD D EN^VALM("OR NEW ORDERS")
7 Q
8 ;
9EX ; -- main exit point
10 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)=""
11 S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
12 K OREBUILD,OREBLD
13 Q
14 ;
15INIT ; -- init variables and list array
16 I $G(ORRV),'$$MORE S VALMBCK="Q" Q
17 W !,"Searching the patient's chart ..."
18 D CLEAN^VALM10 S ORTAB="NEW" D EN^ORCHTAB
19 S VALMCNT=+$G(^TMP("OR",$J,"NEW",0)),VALM("TITLE")=$G(^("TITLE"))
20 M ^TMP("VALM VIDEO",$J,VALMEVL)=^TMP("OR",$J,ORTAB,"VIDEO")
21 S VALMBG=1,VALMBCK="R"
22 Q
23 ;
24PHDR ; -- protocol menu header code
25 S VALMSG=$$MSG^ORCHART D SHOW^VALM
26 S:$G(OREBUILD) OREBLD=1 K ORNMBR,OREBUILD
27 S XQORM("#")=$O(^ORD(101,"B","ORC NEW ACTIONS",0))_"^1:"_+$P($G(^TMP("OR",$J,"NEW",0)),U,2)
28 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")
29 S XQORM("KEY","DC")=$O(^ORD(101,"B","ORC DISCONTINUE ORDERS",0))_"^1"
30 S XQORM("KEY","ED")=$O(^ORD(101,"B","ORC CHANGE ORDERS",0))_"^1"
31 S XQORM("KEY","DT")=$O(^ORD(101,"B","ORC DETAILED DISPLAY",0))_"^1"
32 S XQORM("KEY","$")=$O(^ORD(101,"B","ORC SIGN ORDERS",0))_"^1"
33 S XQORM("KEY","SIGN")=XQORM("KEY","$")
34 Q
35 ;
36HELP ; -- help code
37 N X W !!,"Enter the display numbers of the items you wish to act on; a menu of"
38 W !,"available actions will then be presented for selection."
39 W !,"Press <return> to continue ..." R X:DTIME S VALMBCK=""
40 Q
41 ;
42EXIT ; -- exit code
43 K ^TMP("OR",$J,"NEW")
44 Q
45 ;
46NOTIF ; -- Trigger notification for new orders left unsigned
47 Q:'$O(^TMP("ORNEW",$J,0)) N ORIFN,ORDA,ORA0,ORERR S ORIFN=0
48 F S ORIFN=$O(^TMP("ORNEW",$J,ORIFN)) Q:ORIFN'>0 S ORDA=0 D
49 . F S ORDA=$O(^TMP("ORNEW",$J,ORIFN,ORDA)) Q:ORDA'>0 D
50 .. S ORA0=$G(^OR(100,+ORIFN,8,+ORDA,0))
51 .. I ORDA,$P(ORA0,U,4)=2 S ORNP=$P(ORA0,U,3) D NOTIF^ORCSIGN
52 .. 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
53 .. D UNLK1^ORX2(+ORIFN)
54 Q
55 ;
56SIGNALL ; -- sign all new orders
57 N ORNMBR,ORMAX,I,LNG
58 S ORMAX=+$P($G(^TMP("OR",$J,"NEW",0)),U,2),ORNMBR=""
59 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
60 D EN^ORCSIGN I '$$MORE S VALMBCK="Q" Q
61 D EX^ORCACT
62 Q
63 ;
64MORE() ; -- More orders to process?
65 I $O(^TMP("ORNEW",$J,0)) Q 1
66 N Y S Y=0 I $D(^XUSEC("ORES",DUZ)) D
67 . N IDX,IFN,ACT,ROOT,ENT,PAR
68 . S ENT="ALL"_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+^(5),1:"")
69 . S PAR=$$GET^XPAR(ENT,"OR UNSIGNED ORDERS ON EXIT") Q:PAR'>0
70 . I PAR=2,$O(^OR(100,"AS",ORVP,0)) S Y=1 Q
71 . S IDX=$NA(@"^OR(100,""AS"",ORVP)"),ROOT=$TR(IDX,")",",")
72 . 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
73 Q Y
Note: See TracBrowser for help on using the repository browser.