source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM4.m@ 738

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
[613]1ORWDXM4 ; SLC/KCM - Order Dialogs, Menus;10:42 AM 6 Sep 1998
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,215**;Dec 17, 1997
3 ;
4SETUP ; -- setup dialog (continued from ORWDXM1)
5 ; if xfer med order, setup ORDIALOG differently
6 I ORWMODE,$$ISMED(ORIT),$$CHGSTS(ORCAT,ORIT) D MEDXFER Q
7 ; get base dialog (based on display group) & location of responses
8 I ORWMODE D
9 . S ORDG=$P(^OR(100,+ORIT,0),U,11),ORDIALOG=+$P(^(0),U,5)
10 . S RSPREF="^OR(100,"_+ORIT_",4.5)"
11 E D
12 . N X0 S X0=$G(^ORD(101.41,ORIT,0))
13 . S ORDIALOG=$S($P(X0,U,4)="D":ORIT,1:0)
14 . S ORDG=$P(X0,U,5) Q:'ORDG
15 . I 'ORDIALOG S ORDIALOG=+$$DEFDLG^ORWDXQ(ORDG)
16 . S RSPREF="^ORD(101.41,"_ORIT_",6)"
17 ; setup the ORDIALOG array
18 D GETDLG^ORCD(ORDIALOG)
19 D GETORDER^ORCD(RSPREF)
20 Q
21SETUPS ; -- setup for specific types of dialogs (continued from ORWDXM1)
22 ; pharmacy uses ORCAT to know order package
23 I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0)) S ORCAT="O"
24 I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) D
25 . I ORCAT="O",'ORIMO S ORWPSWRG="" ; not auto-ack, pt not inpt
26 . S ORCAT="I"
27 I ORCAT="O",$D(OREVENT("EFFECTIVE")),(ORDG=+$O(^ORD(100.98,"B","O RX",0))) D
28 . S ORDIALOG($O(^ORD(101.41,"B",X,0)),1)=OREVENT("EFFECTIVE")
29 I ORDIALOG=$O(^ORD(101.41,"B","RA OERR EXAM",0)) D RA^ORWDXM2 G XENV
30 I ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB TESTS",0)) D LR^ORWDXM2 G XENV
31 I ORDIALOG=$O(^ORD(101.41,"B","FHW1",0)) D DO^ORWDXM2 G XENV
32 I ORDIALOG=$O(^ORD(101.41,"B","FHW2",0)) D EL^ORWDXM2 G XENV
33 I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) D UD^ORWDXM2 G XENV
34 I ORDIALOG=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0)) D IV^ORWDXM2 G XENV
35 I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0)) D OP^ORWDXM2 G XENV
36 I ORDIALOG=$O(^ORD(101.41,"B","PSO SUPPLY",0)) D OP^ORWDXM2 G XENV
37 I ORDIALOG=$O(^ORD(101.41,"B","PS MEDS",0)) D PS^ORWDPS3 G XENV
38 I ORDIALOG=$O(^ORD(101.41,"B","VBEC BLOOD BANK",0)) D VB^ORWDXM4 G XENV
39 I ORDIALOG=$O(^ORD(101.41,"B","GMRAOR ALLERGY ENTER/EDIT",0)) S ORQUIT=1
40XENV ; end case
41 Q
42MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP)
43 ;
44 ; use ORWDPS3 if OR*3*94 installed
45 I ORWP94 G MEDXFER^ORWDPS3
46 ;
47 N UDLG,FDLG,ODLG,DLG,OI K ^TMP("PS",$J)
48 S UDLG=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0))
49 S FDLG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
50 S ODLG=$O(^ORD(101.41,"AB","PSO OERR",0))
51 S DLG=$P($G(^OR(100,+ORIT,0)),U,5)
52 S ORDIALOG=$S(+DLG=UDLG:ODLG,+DLG=ODLG:UDLG,+DLG=FDLG:FDLG,1:0)
53 I 'ORDIALOG D SETERR(ORIT,"Incomplete Order Record") Q
54 S ORDG=+$P(^ORD(101.41,ORDIALOG,0),U,5)
55 D GETDLG^ORCD(ORDIALOG)
56 D GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
57 S OI=$$VAL^ORCD("MEDICATION")
58 I '$$MEDOK(OI,ORCAT) D SETERR(ORIT,"This may not be ordered as an "_$S(ORCAT="I":"in",1:"out")_"patient drug.") Q
59 I $G(^ORD(101.43,OI,.1)),(^(.1)<$$NOW^XLFDT) D SETERR(ORIT,"This may no longer be ordered.") Q
60 K ORDIALOG($$PTR("DISPENSE DRUG"),1)
61 K ORDIALOG($$PTR("WORD PROCESSING 1"),1)
62 I ORDIALOG=ODLG D IN2OUT ; could call IN^ORCMED except for writes
63 I ORDIALOG=UDLG D OUT2IN ; could call OUT^ORCMED except for writes
64 Q
65IN2OUT ; -- make inpatient responses into outpatient
66 N I,DDRUG,PKGID,DOSE
67 S DOSE=$G(ORDIALOG($$PTR("INSTRUCTIONS"),1))
68 F I="INSTRUCTIONS","UNITS/DOSE","FREE TEXT","DISPENSE DRUG" K ORDIALOG($$PTR(I),1)
69 S PKGID=$G(^OR(100,+ORIT,4))_";"_$P(^(0),U,12)
70 D OEL^PSOORRL(+ORVP,PKGID) S DDRUG=$G(^TMP("PS",$J,"DD",1,0))
71 I $P(DDRUG,U,3) S ORDIALOG($$PTR("DISPENSE DRUG"),1)=$P(DDRUG,U,3)
72 ; keep instructions if IV med, otherwise use units returned
73 I $P($G(^ORD(101.43,OI,"PS")),U)=2 S ORDIALOG($$PTR("INSTRUCTIONS"),1)=DOSE
74 E S:$P(DDRUG,U,2) ORDIALOG($$PTR("INSTRUCTIONS"),1)=$P(DDRUG,U,2)
75 ; change orderable item if new orderable item returned
76 I $P(DDRUG,U,4),$P(DDRUG,U,4)'=+$P($G(^ORD(101.43,OI,0)),U,2) D
77 . S OI=+$O(^ORD(101.43,"ID",+$P(DDRUG,U,4)_";99PSP",0))
78 . S:OI ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
79 Q
80OUT2IN ; make outpatient responses into inpatient
81 N ORP,ORI,PROMPT,PKGID,DDRUG,ONE
82 D CHANGED^ORCDPS("XFR") ; Kill extra values not in inpt dialog
83 S PKGID=$G(^OR(100,+ORIT,4))_";"_$P(^(0),U,12)
84 D OEL^PSOORRL(+ORVP,PKGID) S DDRUG=$G(^TMP("PS",$J,"DD",1,0))
85 S:$P(DDRUG,U,3) ORDIALOG($$PTR("DISPENSE DRUG"),1)=$P(DDRUG,U,3)
86 I $P(DDRUG,U,4),$P(DDRUG,U,4)'=+$P($G(^ORD(101.43,+OI,0)),U,2) D
87 . S OI=+$O(^ORD(101.43,"ID",+$P(DDRUG,U,4)_";99PSP",0))
88 . S:OI ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
89 S ONE=$O(ORDIALOG($$PTR("INSTRUCTIONS"),0)) ; first inst
90 F ORP="ROUTE","SCHEDULE" D
91 . S ORI=0,PROMPT=$$PTR(ORP)
92 . F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 I ORDIALOG(PROMPT,ORI)=""!(ORI>ONE) K ORDIALOG(PROMPT,ORI)
93 Q
94PTR(NAME) ; -- Returns pointer to OR GTX NAME (copied from ORCMED)
95 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
96 ;
97MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
98 N P S P=$S(CAT="I":1,1:2)
99 Q $P($G(^ORD(101.43,+OI,"PS")),U,P)
100 ;
101CHGSTS(ECAT,IFN) ; return 1 if out to in or in to out
102 N OCAT
103 S OCAT=$P($G(^OR(100,+IFN,0)),U,12)
104 Q OCAT'=ECAT
105 ;
106ISMED(IFN) ; return 1 if this is a pharmacy order
107 N PKG S PKG=$P($G(^OR(100,+IFN,0)),U,14)
108 Q $$NMSP^ORCD(PKG)="PS"
109SETERR(ID,X) ; sets LST to rejection with error message
110 D GETTXT^ORWORR(.LST,ID)
111 S LST(0)="8^0",LST(.5)=X,LST(.6)=""
112 Q
113VB ; setup environment for VBECS
114 ; -- setup ORTIME, ORIMTIME arrays
115 D GETIMES^ORCDLR1
116 ; -- setup ORCOMP, ORTEST, and ORTAS
117 S (ORCOMP,ORTEST,ORTAS)=""
118 N P,I,X,X0 S P=+$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
119 S I=0 F S I=$O(ORDIALOG(P,I)) Q:I<1 S X=+$G(ORDIALOG(P,I)) D
120 . S X0=$G(^ORD(101.43,X,"VB")),X=+$P($G(^(0)),U,2)
121 . I $P(X0,U) S ORCOMP=ORCOMP_$S($L(ORCOMP):U,1:"")_X Q
122 . S ORTEST=ORTEST_$S($L(ORTEST):U,1:"")_X
123 . I X=2 S ORTAS=1
124 Q
125VBASK(I) ; set the ORASK variable for child component prompts in VBECS order
126 I ORDIALOG'=$O(^ORD(101.41,"B","VBEC BLOOD BANK",0)) Q
127 N P S P=+$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
128 N OI S OI=+$G(ORDIALOG(P,I))
129 I +$G(^ORD(101.43,+$G(OI),"VB")) S ORASK=1
130 Q
Note: See TracBrowser for help on using the repository browser.