source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCACT4.m@ 1361

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

initial load of WorldVistAEHR
File size: 7.0 KB
RevLine 
[613]1ORCACT4 ;SLC/MKB-Act on orders cont ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,116,141,149,190**;Dec 17, 1997
3XX ; -- Edit/Change order ORIFN
4 N ORDIALOG,ORQUIT,FIRST,X,OREDIT,ORCHECK,ORSTS,ORDA,OR0,ORDG,ORNMSP,OREVENT,ORDUZ,ORLOG,ORTYPE
5 K ^TMP("ORWORD",$J) S FIRST=0,ORTYPE="D"
6 S OR0=$G(^OR(100,+ORIFN,0)),ORSTS=$P(^(3),U,3),ORDG=$P(OR0,U,11)
7 I $P(OR0,U,17),ORSTS=10 S OREVENT=$P(OR0,U,17)
8 S OREDIT=$S(ORSTS=11:0,ORSTS=10:0,1:1),ORNMSP=$$NMSP^ORCD($P(OR0,U,14))
9 S X=$P(OR0,U,5) I X'["101.41" D ; 2.5
10 . N X,WP S ORDIALOG=$$PTR^ORCD("OR GXTEXT WORD PROCESSING ORDER")
11 . D GETDLG^ORCD(ORDIALOG) S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1")
12 . S ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)"
13 . M ^TMP("ORWORD",$J,WP,1)=^OR(100,+ORIFN,1) ; edit order text
14 . S X=$O(^TMP("ORWORD",$J,WP,1,0)) I X,$E(^(X,0),1,3)=">> " S ^TMP("ORWORD",$J,WP,1,X,0)=$E(^OR(100,+ORIFN,1,X,0),4,999)
15 I X["101.41" S ORDIALOG=+X S:$P($G(^ORD(101.41,+X,0)),U,4)'="D" ORDIALOG=+$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,4) D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
16 X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) XXQ ; entry action
17 D DISPLAY^ORCHECK ;pkg order checks
18XX1 D DIALOG^ORCDLG G:$G(ORQUIT)&FIRST XXQ
19 I '$$CHANGED W !!,"Nothing changed!" H 2 Q
20 D ACCEPT^ORCHECK(),DISPLAY^ORCDLG S X=$$OK(ORACT)
21 G:X="^" XXQ I X="E" K ORCHECK G XX1
22 I X="C" W !?10,"... changes cancelled.",! G XXQ
23 I X="P" D XX^ORCSAVE W !?10,$S(ORIFN:"... changes placed.",1:"ERROR"),! S:ORIFN ^TMP("ORNEW",$J,ORIFN,1)=""
24XXQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) K ^TMP("ORWORD",$J) ; exit action
25 Q
26 ;
27CHANGED() ; -- Returns 1 or 0, if order was actually changed
28 N OROLD,P,I,Y D GETORDER^ORCD(+ORIFN,"OROLD") S Y=0
29 S P=0 F S P=$O(ORDIALOG(P)) Q:P'>0 D Q:Y
30 . S I=0 F S I=$O(OROLD(P,I)) Q:I'>0 D CHK Q:Y
31 . Q:Y S I=0 F S I=$O(ORDIALOG(P,I)) Q:I'>0 D CHK Q:Y
32 Q Y
33 ;
34CHK N OLD,NEW S OLD=$G(OROLD(P,I)),NEW=$G(ORDIALOG(P,I)) S:NEW'=OLD Y=1
35 ;I $E(ORDIALOG(P,0))'="W" S:NEW'=OLD Y=1 Q
36 ;I @OLD@(0)'=@NEW@(0) S Y=1
37 Q
38 ;
39RN ; -- Renew order ORIFN
40 N ORDIALOG,ORQUIT,FIRST,ORENEW,ORCHECK,ORDA,OR0,OR3,ORDG,ORNMSP,ORDUZ,ORLOG,ORTYPE,X
41 K ^TMP("ORWORD",$J) S FIRST=0,ORENEW=1,ORTYPE="D"
42 S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORDIALOG=+$P(OR0,U,5)
43 S ORNMSP=$$NMSP^ORCD($P(OR0,U,14)),ORDG=$P(OR0,U,11)
44 I $P(OR3,U,9) D Q:$G(ORQUIT)
45 . I $$DOSES($P(OR3,U,9))'>1 Q ;dose+Now only - ok
46 . W !,$C(7),"This is part of a complex order, which must be renewed in its entirety:"
47 . S I=0 F S I=$O(^OR(100,+$P(OR3,U,9),8,1,.1,I)) Q:I<1 S X=$G(^(I,0)) W:$$UP^XLFSTR(X)'=" FIRST DOSE NOW" !,X
48 . S:'$$OKALL ORQUIT=1 I '$G(ORQUIT) S ORIFN=+$P(OR3,U,9)
49 I $P(OR0,U,5)["101.41" S:$P($G(^ORD(101.41,ORDIALOG,0)),U,4)'="D" ORDIALOG=+$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,4) D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN) K ORDIALOG($$PTR^ORCD("OR GTX NOW"),1)
50 I $P(OR0,U,5)'["101.41" D ; protocol -> use WP dialog for renewal
51 . N STOP,WP,X S ORDIALOG=$$PTR^ORCD("OR GXTEXT WORD PROCESSING ORDER")
52 . D GETDLG^ORCD(ORDIALOG)
53 . S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1"),ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" M ^TMP("ORWORD",$J,WP,1)=^OR(100,+ORIFN,1)
54 . S X=$O(^TMP("ORWORD",$J,WP,1,0)) I X,$E(^(X,0),1,3)=">> " S ^TMP("ORWORD",$J,WP,1,X,0)=$E(^OR(100,+ORIFN,1,X,0),4,999)
55 . S STOP=$P(OR0,U,9) I STOP,STOP>$$NOW^XLFDT S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=STOP
56 X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) RNQ ; entry action
57 D DISPLAY^ORCHECK ;pkg order checks
58RN1 D DIALOG^ORCDLG G:$G(ORQUIT) RNQ
59 D ACCEPT^ORCHECK() S X="P"
60 I $G(ORCHECK) D DISPLAY^ORCDLG S X=$$OK(ORACT) G:X="^" RNQ
61 I X="C" W !?10,"... renewal cancelled.",! G RNQ
62 I X="P" D RN^ORCSAVE W !?10,$S(ORIFN:"... order renewed.",1:"ERROR"),! S:ORIFN ^TMP("ORNEW",$J,ORIFN,1)=""
63RNQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) K ^TMP("ORWORD",$J)
64 Q
65 ;
66DOSES(IFN) ; -- Return #doses in order IFN
67 N I,P,CNT S (I,CNT)=0
68 F S I=$O(^OR(100,IFN,4.5,"ID","INSTR",I)) Q:I<1 S CNT=CNT+1
69 Q CNT
70 ;
71OKALL() ; -- OK to renew all child orders of complex?
72 N X,Y,DIR,DTOUT,DUOUT,DIROUT,DIRUT
73 S DIR(0)="YA",DIR("A")=" ...OK? ",DIR("B")="YES"
74 S DIR("?")="Enter YES to continue and renew the entire complex order as shown, or NO to quit."
75 D ^DIR S:$D(DTOUT)!(X["^") Y="^"
76 Q Y
77 ;
78RW ; -- Rewrite order ORIFN
79 N ORDIALOG,ORQUIT,FIRST,OREWRITE,ORCHECK,ORDA,OR0,ORDG,ORNMSP,ORDUZ,ORLOG,ORTYPE,X
80 K ^TMP("ORWORD",$J) S FIRST=1,OREWRITE=1,ORTYPE="D"
81 S OR0=$G(^OR(100,+ORIFN,0)),ORNMSP=$$NMSP^ORCD($P(OR0,U,14)),ORDG=$P(OR0,U,11),ORDIALOG=+$P(OR0,U,5)
82 I $P(OR0,U,5)["101.41" D ;get dialog, responses
83 . S:$P($G(^ORD(101.41,ORDIALOG,0)),U,4)'="D" ORDIALOG=+$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,4)
84 . I ORNMSP="PS",$G(OREVENT) D ;use generic Meds dlg
85 .. N X S X=$P($G(^ORD(100.98,+ORDG,0)),U,3)
86 .. Q:X="IV RX" Q:X="SPLY" ;don't switch these
87 .. S ORDIALOG=+$O(^ORD(101.41,"AB","PS MEDS",0))
88 . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
89 . S X=$$PTR^ORCD("OR GTX URGENCY") K:$G(ORDIALOG(X,1))=99 ORDIALOG(X,1)
90 I $P(OR0,U,5)'["101.41" D ; protocol -> use WP dialog for renewal
91 . N WP,X S ORDIALOG=$$PTR^ORCD("OR GXTEXT WORD PROCESSING ORDER")
92 . D GETDLG^ORCD(ORDIALOG)
93 . S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1"),ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" M ^TMP("ORWORD",$J,WP,1)=^OR(100,+ORIFN,1)
94 . S X=$O(^TMP("ORWORD",$J,WP,1,0)) I X,$E(^(X,0),1,3)=">> " S ^TMP("ORWORD",$J,WP,1,X,0)=$E(^OR(100,+ORIFN,1,X,0),4,999)
95 X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) RWQ
96 D DISPLAY^ORCHECK ;pkg order checks
97RW1 D DIALOG^ORCDLG G:$G(ORQUIT)&FIRST RWQ
98 D ACCEPT^ORCHECK() ;($S(FIRST:"ALL",1:""))
99 I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) D ;event occurred
100 . W !!,"This release event has occurred since you started copying delayed orders."
101 . W !,"The orders that were signed have now been released; this and any other"
102 . W !,"unsigned orders will be released immediately upon signature."
103 . N X W !!,"Press <return> to continue ..." R X:DTIME K OREVENT
104 D DISPLAY^ORCDLG S X=$$OK^ORCDLG G:X="^" RWQ
105 I X="E" S FIRST=0 K ORCHECK G RW1
106 I X="C" W !?10,"... order cancelled.",! G RWQ
107 I X="P" D
108 . N OLDIFN,ORSRC S OLDIFN=+ORIFN,ORSRC="C" K ORIFN D EN^ORCSAVE
109 . W !?10,$S($G(ORIFN):"... order rewritten.",1:"ERROR"),!
110 . I $G(ORIFN) S ^TMP("ORNEW",$J,ORIFN,1)="" S:$D(^OR(100,OLDIFN,5)) ^OR(100,ORIFN,5)=^OR(100,OLDIFN,5)
111RWQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) K ^TMP("ORWORD",$J)
112 Q
113 ;
114HD ; -- Hold order ORIFN
115 N X S X=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP) Q:'X
116 S ^TMP("ORNEW",$J,+ORIFN,X)=""
117 W !?10,"... hold order placed."
118 Q
119 ;
120RL ; -- Release hold on order ORIFN
121 N X S X=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP) Q:'X
122 S ^TMP("ORNEW",$J,+ORIFN,X)=""
123 W !?10,"... release hold order placed."
124 Q
125 ;
126OK(ACT) ; -- Ready to save?
127 N X,Y,DIR
128 S DIR(0)="SA^P:PLACE;C:CANCEL;"_$S(ACT'="RN":"E:EDIT;",1:"")
129 S:ACT="XX" DIR("A")="(P)lace, (E)dit, or (C)ancel changes? ",DIR("?")="Enter P to save the changes to this order, or E to change any of the displayed values; enter C to quit without changing this order"
130 S:ACT="RN" DIR("A")="(P)lace or (C)ancel renewal? ",DIR("?")="Enter P to save this renewal or C to quit without renewing this order"
131 S DIR("B")="PLACE" D ^DIR S:$D(DTOUT) Y="^"
132 Q Y
Note: See TracBrowser for help on using the repository browser.