source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDPS3.m@ 949

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1ORWDPS3 ; SLC/KCM/JLI - Order Dialogs, Menus;01/18/2006
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,94,116,132,187,195,215**;Dec 17, 1997
3MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP^ORWDXM4)
4 N IVDIALOG,OI K ^TMP("PS",$J)
5 S IVDIALOG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
6 S ORDIALOG=$O(^ORD(101.41,"AB","PS MEDS",0))
7 I +$P($G(^OR(100,+ORIT,0)),U,5)=IVDIALOG S ORDIALOG=IVDIALOG
8 S ORDG=+$P(^ORD(101.41,ORDIALOG,0),U,5)
9 D GETDLG^ORCD(ORDIALOG)
10 D GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
11 ;I ORDIALOG=IVDIALOG Q
12 S OI=$$VAL^ORCD("MEDICATION")
13 I ORDIALOG'=IVDIALOG,'$$MEDOK(OI,ORCAT) D SETERR(ORIT,"This may not be ordered as an "_$S(ORCAT="I":"in",1:"out")_"patient drug.") Q
14 I +$G(OI)>0,$G(^ORD(101.43,OI,.1)),(^(.1)<$$NOW^XLFDT) D SETERR(ORIT,"This may no longer be ordered.") Q
15 I (ORDIALOG'=IVDIALOG),(ORCAT="I") D OUT^ORCMED
16 I (ORDIALOG'=IVDIALOG),(ORCAT="O") D IN^ORCMED
17 S ORWPSWRG="" ; force interactive dialog for transfers
18 Q
19MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
20 N P S P=$S(CAT="I":1,1:2)
21 I ORIMO S P=1
22 N THEGRP,INPTGRP
23 S THEGRP=0
24 I $D(ORIT),+ORIT S THEGRP=$P($G(^OR(100,+ORIT,0)),U,11)
25 S INPTGRP=$O(^ORD(100.98,"B","UD RX",0))
26 I P=2,(INPTGRP=THEGRP),($P($G(^ORD(101.43,+OI,"PS")),U,1)=2) Q 2
27 E Q $P($G(^ORD(101.43,+OI,"PS")),U,P)
28 ;
29SETERR(ID,X) ; sets LST to rejection with error message
30 D GETTXT^ORWORR(.LST,ID)
31 S LST(0)="8^0",LST(.5)=X,LST(.6)=""
32 Q
33 ;
34PS ; setup environment for medications
35 D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds
36 K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
37 N PROMPT,OI
38 S PROMPT=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
39 S OI=""
40 I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV Q:$G(ORQUIT)
41 N PSOI
42 S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) D START^PSSJORDF(PSOI,ORCAT)
43 S PROMPT=$O(^ORD(101.41,"AB","OR GTX SCHEDULE",0))
44 I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1)
45 I (ORCAT="I"),$L($G(ORSCH)) D
46 . S ORSD=""
47 . I $L($G(^DPT(+ORVP,.1))) S ORSD=$$STARTSTP^PSJORPOE(+ORVP,ORSCH,PSOI,+$G(ORWARD),"")
48 . I $P(ORSD,U)="NEXT" S $P(ORSD,U)="NEXTA"
49 S PROMPT=$O(^ORD(101.41,"AB","OR GTX DAYS SUPPLY",0))
50 I $D(ORDIALOG(PROMPT,1)) S ORDSUP=ORDIALOG(PROMPT,1)
51 S PROMPT=$O(^ORD(101.41,"AB","OR GTX DISPENSE DRUG",0))
52 I $D(ORDIALOG(PROMPT,1)) S ORDRUG=ORDIALOG(PROMPT,1)
53 S PROMPT=$O(^ORD(101.41,"AB","OR GTX REFILLS",0))
54 I $D(ORDIALOG(PROMPT,1)) S OREFILLS=ORDIALOG(PROMPT,1)
55 I ORCAT="O" S ORCOPAY=$$ASKSC^ORCDPS1
56 I ORCAT="I" S PROMPT=$O(^ORD(101.41,"AB","OR GTX START DATE/TIME",0)) D
57 . I $L($P($G(ORSD),U)),'$D(ORDIALOG(PROMPT,1)) S ORDIALOG(PROMPT,1)=$P(ORSD,U)
58 ; create a SIG if none exists (i.e., when copying pre-POE orders)
59 I '$L($G(ORDIALOG($$PTR^ORCD("OR GTX SIG"),1))) D
60 . N ORDOSE,ORDRUG,ORWPSOI,PROMPT,DRUG
61 . S PROMPT=$$PTR^ORCD("OR GTX INSTRUCTIONS")
62 . S ORDRUG=$G(ORDIALOG($$PTR^ORCD("OR GTX DISPENSE DRUG"),1))
63 . S ORWPSOI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
64 . I ORWPSOI S ORWPSOI=+$P($G(^ORD(101.43,+ORWPSOI,0)),U,2)
65 . D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,$S(ORCAT="I":"U",1:"O"),ORVP) ; dflt doses
66 . D D1^ORCDPS2 ; set up ORDOSE & xrefs in ORDIALOG
67 . S DRUG=$G(ORDOSE("DD",+ORDRUG))
68 . I DRUG,ORCAT="O" D RESETID^ORCDPS
69 . D SIG^ORCDPS2
70 Q
71AUTHMED ; sets ORQUIT if not authorized to write meds
72 N NOAUTH,NAME
73 D AUTH^ORWDPS32(.NOAUTH,ORNP)
74 I +NOAUTH D
75 . S ORQUIT=1
76 . S LST(0)="8^0"
77 . S NAME=$P($G(^VA(200,+ORNP,20)),U,2)
78 . I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1)
79 . S LST(.5)=NAME_" is not authorized to write med orders."
80 Q
81MEDACTV ; sets ORQUIT if the orderable item is not active for a med
82 Q:'$G(OI)
83 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D
84 . S ORQUIT=1
85 . S LST(0)="8^0"
86 . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore."
87 I $D(ORQUIT) Q:ORQUIT
88 ; copied from ORDITM^ORCDPS1 to make sure quick order if for right dialog
89 N ORPS,PSOI,ORIV,ORINPT
90 S ORINPT=$$INPT^ORCD
91 S ORPS=$G(^ORD(101.43,+OI,"PS")),PSOI=+$P($G(^(0)),U,2)
92 S ORIV=$S($P(ORPS,U)=2:1,1:0)
93 I $G(ORCAT)="O",'$P(ORPS,U,2),'ORIMO S LST(.5)="This drug may not be used in an outpatient order."
94 I $G(ORCAT)="I" D
95 . I $G(ORINPT),'$P(ORPS,U),'ORIMO S LST(.5)="This drug may not be used in an inpatient order."
96 . I '$G(ORINPT),'ORIV,'ORIMO S LST(.5)="This drug may not be ordered for an outpatient."
97 I $L($G(LST(.5))) S ORQUIT=1,LST(0)="8^0"
98 Q
Note: See TracBrowser for help on using the repository browser.