source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPSIV.m@ 1150

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

revised back to 6/30/08 version

File size: 4.3 KB
Line 
1ORCDPSIV ;SLC/MKB-Pharmacy IV dialog utilities ;11/25/02 09:47
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,38,48,158,195**;Dec 17, 1997
3PROVIDER ; -- Check provider, if authorized to write med orders
4 I $D(^XUSEC("OREMAS",DUZ)),'$$GET^XPAR("ALL","OR OREMAS MED ORDERS") W $C(7),!!,"OREMAS key holders may not enter medication orders." S ORQUIT=1 Q
5 N PS,NAME S PS=$G(^VA(200,+$G(ORNP),"PS")),NAME=$P($G(^(20)),U,2)
6 I '$L(NAME) S NAME=$P(^VA(200,+$G(ORNP),0),U)
7 I '$P(PS,U) W $C(7),!!,NAME_" is not authorized to write medication orders!" S ORQUIT=1
8 I $P(PS,U,4),$$NOW^XLFDT>$P(PS,U,4) W $C(7),!!,NAME_" is no longer authorized to write medication orders!" S ORQUIT=1
9 I $G(ORQUIT) W !,"You must select another provider to continue.",! S PS=$$MEDPROV I PS S ORXNP=ORNP,ORNP=PS K ORQUIT
10 Q
11 ;
12MEDPROV() ; -- Return ordering med provider
13 N X,Y,D,DIC
14 S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER"
15 S DIC("S")="I $P($G(^(""PS"")),U),'$P(^(""PS""),U,4)!($P(^(""PS""),U,4)>$$NOW^XLFDT)"
16 D IX^DIC S:Y>0 Y=+Y I Y'>0 S Y="^"
17 Q Y
18 ;
19CHANGED(TYPE) ; -- Kill dependent values when OI changes
20 N PROMPTS,NAME,PTR,P,I
21 Q:'$L($G(TYPE)) S PROMPTS=""
22 S:TYPE="B" PROMPTS="VOLUME"
23 S:TYPE="A" PROMPTS="STRENGTH PSIV^UNITS"
24 F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
25 . S PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) Q:'PTR
26 . S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
27 . K ORDIALOG(PTR,"LIST")
28 Q
29 ;
30INACTIVE(TYPE) ; -- Check OI inactive date
31 N OI,X,I,PSOI,DEA S:$G(TYPE)'="A" TYPE="S"
32 S OI=+$G(ORDIALOG(PROMPT,INST)) Q:OI'>0
33 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D Q ;inactive
34 . S X=$S(TYPE="A":"additive",1:"solution"),ORQUIT=1
35 . W $C(7),!,"This "_X_" may not be ordered anymore. Please select another."
36 S I=$S(TYPE="A":4,1:3) I '$P($G(^ORD(101.43,OI,"PS")),U,I) D Q
37 . S X=$S(TYPE="A":"an additive",1:"a solution"),ORQUIT=1
38 . W $C(7),!,"This item may not be ordered as "_X_"."
39 Q:'$$INPT^ORCD Q:'$L($T(IVDEA^PSSUTIL1)) ;DBIA #3784
40 S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2)
41 S DEA=$$IVDEA^PSSUTIL1(PSOI,TYPE) I DEA>0 D Q:$G(ORQUIT)
42 . I $G(ORNP),'$L($P($G(^VA(200,+ORNP,"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S ORQUIT=1 Q
43 . I DEA=1 W $C(7),!,"This order will require a wet signature!"
44 Q
45 ;
46VOLUME ; -- get allowable volumes for solution
47 N PSOI,ORY,CNT,I K ORDIALOG(PROMPT,"LIST")
48 S PSOI=+$P($G(^ORD(101.43,+$$VAL^ORCD("SOLUTION",INST),0)),U,2)_"B"
49 D ENVOL^PSJORUT2(PSOI,.ORY) Q:'ORY
50 S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",+ORY(I))=+ORY(I)
51 S ORDIALOG(PROMPT,"LIST")=CNT_"^1"
52 Q
53 ;
54UNITS ; -- get allowable units for current additive
55 N PSOI,ORY,I,UNITS
56 S PSOI=+$P(^ORD(101.43,+ORDIALOG($$PTR^ORCD("OR GTX ADDITIVE"),INST),0),U,2)_"A"
57 D ENVOL^PSJORUT2(PSOI,.ORY)
58 S I=$O(ORY(0)) Q:'I S UNITS=$P($G(ORY(I)),U,2)
59 S ORDIALOG($$PTR^ORCD("OR GTX UNITS"),INST)=UNITS
60 W !," (Units for this additive are "_UNITS_")"
61 Q
62 ;
63PREMIX() ; -- Returns 1 or 0, if IV base is a premix solution
64 N BASE,PS,I,Y
65 S BASE=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),Y=0
66 S I=0 F S I=$O(ORDIALOG(BASE,I)) Q:I'>0 D Q:Y
67 . S PS=$G(^ORD(101.43,+$G(ORDIALOG(BASE,I)),"PS"))
68 . I $P(PS,U,3)&($P(PS,U,4)) S Y=1
69 Q Y
70 ;
71VALIDAYS(X) ; -- Validate IV duration
72 N UNITS,X1,X2,Y,I
73 I X'?1.N." "1.A Q 0 ; invalid format
74 S UNITS="^MIN^HOURS^DAYS^M^H^D^",(X1,X2)=""
75 F I=1:1:$L(X) S Y=$E(X,I) S:Y?1N X1=X1_Y S:Y?1A X2=X2_$$UP^XLFSTR(Y)
76 I 'X1 Q 0
77 I UNITS'[(U_X2_U) Q 0
78 Q 1
79 ;
80VALDURA(X) ;-- Validate IV duration/limitation
81 K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
82 ;
83IVPSI ;INPUT-TRANSFORM
84 I $L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) S X="" Q
85 S X=$$UP^XLFSTR(X)
86 I (X'?.N1.2A),(X'?.N1".".N1.2A) W !,!,"Invalid duration or total volume.",! S X="" Q
87 I (X?.N1A) D
88 . I (X["L")!(X["H")!(X["D") Q
89 . E W !,!,"Invalid duration or total volume.",! S X="" Q
90 I (X?.N1".".N1A) D
91 . I X["L" Q
92 . E W !,!,"Invalid duration or total volume.",!,"Duration has to be integer value!",! S X="" Q
93 I (X?.N2A)!(X?.N1".".N2A) D
94 . I (X["ML")!(X["CC") Q
95 . E W !,!,"Invalid duration or total volume",! S X="" Q
96 I X="" K X
97 Q
98 ;
99IVPSI1 ; ASK ON CONDITION
100 W !,!,"Enter the length of administrative time or total volume for IV fluid order followed by ML or CC for milliliters, L for liters, D for days, H for hours to set limitation."
101 W !,"(Examples: 1500ML, 1000CC, 1.5L, 3D, or 72H)",!
102 Q
Note: See TracBrowser for help on using the repository browser.