source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDLG.m@ 861

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

initial load of WorldVistAEHR
File size: 9.2 KB
RevLine 
[613]1ORCDLG ;SLC/MKB-Order dialogs ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,7,46,60,79,94,141**;Dec 17, 1997
3 ;
4EN(ORDIALOG) ; -- process ORDIALOG
5 Q:'ORDIALOG N TITLE,TYPE,MSG K ^TMP("ORWORD",$J)
6 S TITLE=$G(^ORD(101.41,ORDIALOG,0)),TYPE=$P(TITLE,U,4),MSG=$P(TITLE,U,3),TITLE=$P(TITLE,U,2)
7 W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
8 I $L(MSG) W $C(7),!!,MSG H 2 Q ;disabled
9 D SET:TYPE="O",MENU:TYPE="M",ADD:(TYPE="D")!(TYPE="Q")!(TYPE="A")
10 K ^TMP("ORWORD",$J)
11 Q
12 ;
13SET ; -- prompt for new order set
14 N ORSET,ORSEQ,ORSITM,ORSTOP,ORPARENT,ORCHLD,ORS0,ORSIFN,ORPIFN,ORLAST,ORSLOG,X,OREV0
15 S ORSET=+ORDIALOG Q:'ORSET Q:'$D(^ORD(101.41,ORSET))
16 I $G(OREVENT) S X=+$P($G(^ORE(100.2,OREVENT,0)),U,2),OREV0=$G(^ORD(100.5,X,0))
17 X:$D(^ORD(101.41,ORSET,3)) ^(3) ; Entry action
18 S ORPARENT=$P($G(^ORD(101.41,ORSET,5)),U,6) ;,ORHDR=$P($G(^(5)),U,7)
19 S ORSLOG=+$E($$NOW^XLFDT,1,12) D:ORPARENT SET^ORCSAVE(+ORDIALOG) ;Parent
20S1 S ORSEQ=0 F S ORSEQ=$O(^ORD(101.41,ORSET,10,"B",ORSEQ)) Q:ORSEQ'>0!($G(ORSTOP)) S ORSITM=0 F S ORSITM=$O(^ORD(101.41,ORSET,10,"B",ORSEQ,ORSITM)) Q:'ORSITM D Q:$G(ORSTOP)
21 . S ORS0=$G(^ORD(101.41,ORSET,10,ORSITM,0)) K ORSIFN
22 . I $G(OREVENT),$G(ORDSET),+$P(ORS0,U,2)=+$P(OREV0,U,4) Q ;Evt Ord Dlg
23 . D:$P(ORS0,U,2) EN(+$P(ORS0,U,2))
24 . I $G(ORSTOP) Q:$G(DIROUT) K:$$CONT ORSTOP Q
25 . I ORPARENT,$G(ORSIFN) S ORCHLD=+$G(ORCHLD)+1,ORCHLD(ORSIFN,0)=ORSIFN,ORLAST=ORSIFN
26S2 I $G(ORSTOP) D G SQ ; delete orders
27 . N DA,DIK
28 . S DA=0 F S DA=$O(ORCHLD(DA)) Q:DA'>0 S DIK="^OR(100," D ^DIK
29 . W !?10,"... orders cancelled.",! H 1
30 I ORPARENT,$G(ORCHLD) M ^OR(100,ORPIFN,2)=ORCHLD S ^OR(100,ORPIFN,2,0)="^100.002PA^"_ORLAST_U_ORCHLD
31 ;W !?10,"... orders placed.",! H 1
32SQ X:$D(^ORD(101.41,ORSET,4)) ^(4) ; Exit action
33 Q
34 ;
35MENU ; -- prompt for menu
36 N ORI,ORY,XQORM
37 S ORI=$$LOCK^ORDD41(ORDIALOG) I 'ORI W !!,$P(ORI,U,2) H 2 Q
38 X:$D(^ORD(101.41,ORDIALOG,3)) ^(3) G:$G(ORQUIT) MNQ ;Entry action
39 S XQORM("W")="W $S($P(X,U,5)=""H"":IOUON,1:"""")_$P(X,U,3)_IOUOFF"
40 S ORI=$G(^ORD(101.41,ORDIALOG,5)) S:$P(ORI,U,2) XQORM("M")=$P(ORI,U,2)
41 S XQORM=ORDIALOG_";ORD(101.41,",XQORM(0)="AD" D EN^XQORM
42 I Y'>0 S:$G(ORSET)&(X["^") ORSTOP=1 G MNQ
43 M ORY=Y S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 D EN(+$P(ORY(ORI),U,2))
44MNQ X:$D(^ORD(101.41,ORDIALOG,4)) ^(4) ;Exit action
45 D UNLOCK^ORDD41(ORDIALOG)
46 Q
47 ;
48ORDER(ORDIALOG) ; -- Execute ORDIALOG, return ORIFN or ^ if unsuccessful
49 K ^TMP("ORWORD",$J) Q:'$G(ORDIALOG) "^"
50 N TITLE,TYPE,MSG,NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
51 S TITLE=$G(^ORD(101.41,ORDIALOG,0)),TYPE=$P(TITLE,U,4),MSG=$P(TITLE,U,3),TITLE=$P(TITLE,U,2)
52 W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
53 I $L(MSG) W $C(7),!!,MSG H 2 Q "^" ;disabled
54 I TYPE'="D",TYPE'="Q" W $C(7),!!,"Invalid order dialog!" H 2 Q "^"
55 D ADD0 S:'$G(ORIFN) ORIFN="^"
56 K ^TMP("ORWORD",$J)
57 Q ORIFN
58 ;
59ADD ; -- prompt for new order
60 ; Requires: ORDIALOG = Order Dialog ifn
61 ; ORNP = Ordering Provider (ifn in #200)
62 ; ORVP = Patient (vptr to #2)
63 ; Optional: ORL = Patient Location (vptr to #44)
64 ; ORTS = Treating Specialty (ifn in #45.7)
65 ; ORSET = Order Set (ifn in #101.41, from SET)
66 ; $$ORDER enters at ADD0 to be able to return ORIFN
67 ;
68 N NODE0,FIRST,ORDG,ORQUIT,VERIFY,ACTION,ASK,AUTO,ORIFN,ORTYPE,ORCHECK,ORNMSP,ORDUZ,ORLOG
69ADD0 S VALMBCK="R",FIRST=1 Q:'ORDIALOG
70 S NODE0=$G(^ORD(101.41,ORDIALOG,0)),AUTO=$P($G(^(5)),U,8)
71 S ORTYPE=$P(NODE0,U,4),ORDG=+$P(NODE0,U,5),ORDUZ=DUZ
72 S ORLOG=+$$NOW,VERIFY=$P(NODE0,U,8),ASK=$P(NODE0,U,9)
73 D @("GET"_$S(ORTYPE="Q":"Q",1:"")_"DLG^ORCD(+ORDIALOG)")
74 I ORDIALOG'>0 W $C(7),!!,"Invalid dialog - cannot place order!" H 1 Q
75 S ORNMSP=$P($G(^ORD(101.41,ORDIALOG,0)),U,7),ORNMSP=$$NMSP^ORCD(ORNMSP)
76 I '$$ACTIVE W $C(7),!!,"Inactive orderable item(s) - cannot place order!" H 1 Q
77 X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) ADDQ ; entry action
78 G:ORTYPE="A" ADDQ ; action only
79 D DISPLAY^ORCHECK ; pkg order check
80ADD1 D DIALOG ; Loop thru prompts or components
81 I $G(ORQUIT) S:$G(ORSET) ORSTOP=1 G:$G(ORSTOP)!$G(DIROUT)!FIRST ADDQ K ORQUIT
82 D ACCEPT^ORCHECK() S ACTION="P"
83 I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) D ;event occurred
84 . W !!,"This release event has occurred since you started writing delayed orders."
85 . W !,"The orders that were signed have now been released; this and any other"
86 . W !,"unsigned orders will be released immediately upon signature. The Orders"
87 . W !,"tab will be refreshed in the Active Orders view when finished."
88 . K OREVENT S $P(^TMP("OR",$J,"ORDERS",0),U,3,4)="^1" ;default view
89 . N X W !!,"Press <return> to continue ..." R X:DTIME
90 I VERIFY!$G(ORCHECK) D DISPLAY S ACTION=$$OK G:ACTION="^" ADDQ
91 I ACTION="E" S FIRST=0 K ORCHECK G ADD1
92 I ACTION="C" W !?10,"... order cancelled.",! ;G ADDQ
93 I ACTION="P" D EN^ORCSAVE D
94 . I '$G(ORIFN) W !?10,"... ERROR - unable to place order.",! H 1 Q
95 . S ^TMP("ORNEW",$J,ORIFN,1)="" S:$G(ORSET) ORSIFN=ORIFN
96 . I '$D(^TMP("ORECALL",$J,ORDIALOG)) M ^(ORDIALOG)=ORDIALOG M:$D(^TMP("ORWORD",$J)) ^TMP("ORECALL",$J,ORDIALOG)=^TMP("ORWORD",$J) ;1st values
97 . W !?10,"... order placed.",!
98 I ASK,$$ANOTHER D KVALUES S FIRST=1,ORLOG=+$$NOW G ADD1
99ADDQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) ; exit action
100 Q
101 ;
102DIALOG ; -- loop through prompts in dialog
103 N SEQ,DA K ORQUIT
104 I $G(ORTYPE)'="A" S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0!($G(ORQUIT)) S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D Q:$G(ORQUIT)
105 . Q:$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,11) ; child
106 . D EN^ORCDLG1(DA)
107 Q
108 ;
109ANOTHER() ; -- Add another order?
110 I ASK>1 Q 1 ; Don't ask, go right to another order
111 N X,Y,DIR
112 S DIR("A")="Add another "_$P(^ORD(101.41,+ORDIALOG,0),U,2)_" order? "
113 S DIR(0)="YA",DIR("B")="NO" D ^DIR
114 Q +Y
115 ;
116CONT() ; -- continue w/set?
117 N X,Y,DIR
118 S DIR(0)="YA",DIR("A")="Do you want to continue with this order set? "
119 S DIR("?")="Enter NO if you wish to cancel the entire order set; YES will cancel only this one order."
120 S DIR("B")="YES" D ^DIR
121 Q +Y
122 ;
123DISPLAY ; -- Display new order on screen
124 N SEQ,DA,X,PROMPT,MULT,I,TITLE
125 W !!,$$REPEAT^XLFSTR("-",79)
126 S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
127 . S X=$G(^ORD(101.41,+ORDIALOG,10,DA,0)) Q:$P(X,U,11) ;child
128 . S PROMPT=$P(X,U,2),MULT=$P(X,U,7) Q:$P(X,U,9)["*" ;hide
129 . Q:'PROMPT S I=$O(ORDIALOG(PROMPT,0)) Q:'I ; no values
130 . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
131 . W !,$J(TITLE,30)
132 . I $E(ORDIALOG(PROMPT,0))="W" W $E($G(^TMP("ORWORD",$J,PROMPT,I,1,0)),1,40)_$S($L($G(^(0)))>40:" ...",$O(^TMP("ORWORD",$J,PROMPT,I,1)):" ...",1:"") Q
133 . W $$ITEM(PROMPT,I) Q:'MULT Q:'$O(ORDIALOG(PROMPT,I)) ; done
134 . F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 W !?30,$$ITEM(PROMPT,I)
135 W !,$$REPEAT^XLFSTR("-",79),!
136 I $G(ORCHECK) W "Order Checks:" D LIST^ORCHECK("NEW")
137 Q
138 ;
139ITEM(P,I) ; -- Display each item in dialog
140 N ITEM,SEQ,DA,IFN,X,ORDTXT
141 S ITEM=$$EXT^ORCD(P,I) I $E(ORDIALOG(P,0))="R",$G(ORTYPE)'="Z",'$G(OREVENT) S X=ORDIALOG(P,I) S:'X ITEM=ITEM_$$DATE(X)
142 I $D(^ORD(101.41,+ORDIALOG,10,"DAD",P)) S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"DAD",P,SEQ)) Q:SEQ'>0 S DA=$O(^(SEQ,0)) D
143 . S IFN=$P(^ORD(101.41,+ORDIALOG,10,DA,0),U,2),ORDTXT=$G(^(2)) Q:$P(^(0),U,9)["*"
144 . Q:'$D(ORDIALOG(IFN,I)) Q:$E(ORDIALOG(IFN,0))="W"
145 . S X=$$EXT^ORCD(IFN,I) Q:'$L(X)
146 . S:$L($P(ORDTXT,U,4)) X=$$GETXT^ORCSAVE1($P(ORDTXT,U,4))_" "_X
147 . S:$L($P(ORDTXT,U,5)) X=X_" "_$$GETXT^ORCSAVE1($P(ORDTXT,U,5))
148 . S ITEM=ITEM_" "_X
149 Q ITEM
150 ;
151DATE(X) ; -- Returns resolved date
152 N Y,%DT S %DT="T"
153 D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT"
154 D ADMIN^ORCSAVE2("NEXT"):X="NEXTA",ADMIN^ORCSAVE2("CLOSEST"):X="CLOSEST"
155 D ^%DT S:Y'>0 Y="" I Y>0 S Y=" ("_$$FMTE^XLFDT(Y,2)_")"
156 Q Y
157 ;
158OK() ; -- Ready to save?
159 N X,Y,DIR
160 S DIR(0)="SA^P:PLACE;E:EDIT;C:CANCEL;",DIR("A")="(P)lace, (E)dit, or (C)ancel this order? ",DIR("B")="PLACE"
161 S DIR("?")="Enter P to place this order, or E to change any of the displayed values; enter C to quit without placing this order"
162 D ^DIR S:$D(DTOUT) Y="^"
163 Q Y
164 ;
165KVALUES ; -- kill ORDIALOG("ORDERABLE ITEM",#) value nodes
166 N PTR,INST K ORIFN,ORCHECK,^TMP("ORWORD",$J)
167 S PTR=0 F S PTR=$O(ORDIALOG(PTR)) Q:PTR'>0 D
168 . K ORDIALOG(PTR,"LIST") S INST=0
169 . F S INST=$O(ORDIALOG(PTR,INST)) Q:INST'>0 K ORDIALOG(PTR,INST)
170 Q
171 ;
172NOW() ; -- Returns current Date Ordered for new order
173 N Y I $G(ORSLOG) S Y=ORSLOG ; timestamp for order set
174 E S Y=+$E($$NOW^XLFDT,1,12)
175 Q Y
176 ;
177ACTIVE() ; -- Returns 1 or 0, if orderable item(s) are active
178 ; [Uses ORDIALOG(),ORDG,ORNMSP]
179 N OI,NOW,I,ITM,X,Y
180 S OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM"),NOW=$$NOW^XLFDT,Y=1
181 S I=0 F S I=+$O(ORDIALOG(OI,I)) Q:I'>0 D Q:'Y
182 . S ITM=+$G(ORDIALOG(OI,I)) Q:ITM'>0
183 . S X=$G(^ORD(101.43,ITM,.1)) I X,X<NOW S Y=0 Q ;inactive
184 I 'Y,ORNMSP?1"PS".E D ;ck for new OI, if PS
185 . Q:$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)="IV RX" ;skip fluids
186 . Q:$G(ORCAT)="I"&$G(ORENEW) ;skip Inpt renewals
187 . N DD,J,DRUG,PSOI S DD=+$$PTR^ORCD("OR GTX DISPENSE DRUG")
188 . S J=+$O(ORDIALOG(DD,0)),DRUG=+$G(ORDIALOG(DD,J)) ;first one
189 . S PSOI=+$P($G(^ORD(101.43,+$G(ORDIALOG(OI,1)),0)),U,2)
190 . S X=$$ITEM^PSSUTIL1(PSOI,DRUG) Q:X'>0
191 . S ITM=+$O(^ORD(101.43,"ID",+$P(X,U,2)_";99PSP",0)) Q:ITM'>0
192 . S X=$G(^ORD(101.43,ITM,.1)) I X,X<NOW Q ;just checking
193 . S ORDIALOG(OI,1)=ITM,Y=1
194 Q Y
Note: See TracBrowser for help on using the repository browser.