Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCDPSIV

ORCDPSIV.m

Go to the documentation of this file.
  1. ORCDPSIV ;SLC/MKB-Pharmacy IV dialog utilities ;06/17/10
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,38,48,158,195,243,296,280,388,467,499**;Dec 17, 1997;Build 165
  1. ;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to IVDEA^PSSUTIL1 in ICR #3784
  1. ; Reference to ^PSIVSP in ICR #2945
  1. ; Reference to ^PSJORUT2 in ICR #2402
  1. ; Reference to ^PSSDSAPA in ICR #5504
  1. ; Reference to ^PSSGS0 in ICR #3423
  1. ;
  1. CKSCH ; -- validate schedule [Called from P-S Action]
  1. N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET) K ORSD
  1. D EN^PSSGS0(.ORX,"I")
  1. I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX Q
  1. W $C(7),!,"Enter a standard schedule for administering this medication."
  1. Q
  1. ISONETIM(SCH) ;
  1. N DUR
  1. I SCH="" Q 0
  1. K ^TMP($J,"ORCDPSIV GETSCHTYP")
  1. D ZERO^PSS51P1(,SCH,"PSJ","O","ORCDPSIV GETSCHTYP")
  1. I $D(^TMP($J,"ORCDPSIV GETSCHTYP","B",SCH)) D Q 1
  1. .S DUR=$$PTR^ORCD("OR GTX DURATION")
  1. .I $G(ORDIALOG(DUR,1))="" Q
  1. .S ORDIALOG(DUR,1)=""
  1. .W !,"IV Orders with a schedule type of one-time cannot have a duration."
  1. .W !,"The duration has been deleted from this quick order." H 1
  1. K ^TMP($J,"ORCDPSIV GETSCHTYP")
  1. Q 0
  1. ;
  1. ADDFRD(ORDIALOG,INST,PROMPT) ;
  1. N ADDFRIEN,ADDIEN,OI,PSOI,RESULT
  1. S RESULT=""
  1. I $G(ORIVTYPE)'="C" Q RESULT
  1. S ADDFRIEN=$O(^ORD(101.41,"AB","OR GTX ADDITIVE FREQUENCY","")) I 'ADDFRIEN Q RESULT
  1. S ADDIEN=$O(^ORD(101.41,"AB","OR GTX ADDITIVE","")) I 'ADDIEN Q RESULT
  1. S RESULT=$$RECALL^ORCD(PROMPT,INST) I RESULT'="" Q RESULT
  1. S OI=$G(ORDIALOG(ADDIEN,INST)) I OI="" Q RESULT
  1. S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2) I +PSOI'>0 Q RESULT
  1. S RESULT=$$IV^PSSDSAPA(+PSOI)
  1. S RESULT=$S(RESULT="A":"All Bags",RESULT=1:"1 Bag/Day",1:"")
  1. Q RESULT
  1. ;
  1. ADDFRQC ;
  1. I $G(ORIVTYPE)'="C" Q
  1. W !,"Select from the list of the codes below to assign an additive frequency for this additive."
  1. W !,"A = All Bags"
  1. W !,"1 = 1 Bag/Day"
  1. W !,"S = See Comments"
  1. W !
  1. Q
  1. ADDFRQI ;
  1. S X=$$UP^XLFSTR(X)
  1. I X'="A",X'=1,X'="S" D ADDFRQC K X Q
  1. I X="A" S X="All Bags" Q
  1. I X=1 S X="1 Bag/Day" Q
  1. I X="S" S X="See Comments"
  1. Q
  1. ;
  1. PROVIDER ; -- Check provider, if authorized to write med orders
  1. 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
  1. N PS,NAME S PS=$G(^VA(200,+$G(ORNP),"PS")),NAME=$P($G(^(20)),U,2)
  1. I '$L(NAME) S NAME=$P(^VA(200,+$G(ORNP),0),U)
  1. I '$P(PS,U) W $C(7),!!,NAME_" is not authorized to write medication orders!" S ORQUIT=1
  1. 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
  1. I $G(ORQUIT) W !,"You must select another provider to continue.",! S PS=$$MEDPROV I PS S ORXNP=ORNP,ORNP=PS K ORQUIT
  1. Q
  1. ;
  1. MEDPROV() ; -- Return ordering med provider
  1. N X,Y,D,DIC
  1. S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER"
  1. S DIC("S")="I $P($G(^(""PS"")),U),'$P(^(""PS""),U,4)!($P(^(""PS""),U,4)>$$NOW^XLFDT)"
  1. D IX^DIC S:Y>0 Y=+Y I Y'>0 S Y="^"
  1. Q Y
  1. ;
  1. CHANGED(TYPE) ; -- Kill dependent values when OI changes
  1. N PROMPTS,NAME,PTR,P,I
  1. Q:'$L($G(TYPE)) S PROMPTS=""
  1. S:TYPE="B" PROMPTS="VOLUME"
  1. S:TYPE="A" PROMPTS="STRENGTH PSIV^UNITS"
  1. I TYPE="T" D
  1. .S PROMPTS="INFUSION RATE^SCHEDULE^ADDITIVE FREQUENCY"
  1. .S PTR=$O(^ORD(101.41,"AB","OR GTX DURATION","")) Q:'PTR
  1. .I $G(ORDIALOG(PTR,1))["DOSES" S PROMPTS=PROMPTS_U_"DURATION"
  1. ;
  1. F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
  1. . S PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) Q:'PTR
  1. . K ORDIALOG(PTR,ORI)
  1. . ;S I=0 F S I=$O(ORDIALOG(PTR,I)) Q:I'>0 K ORDIALOG(PTR,I)
  1. . K ORDIALOG(PTR,"LIST")
  1. Q
  1. ;
  1. INACTIVE(TYPE) ; -- Check OI inactive date
  1. N OI,X,I,PSOI,DEA,EXIT,ORDEA S:$G(TYPE)'="A" TYPE="S"
  1. S OI=+$G(ORDIALOG(PROMPT,INST)) Q:OI'>0
  1. I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D Q ;inactive
  1. . S X=$S(TYPE="A":"additive",1:"solution"),ORQUIT=1
  1. . W $C(7),!,"This "_X_" may not be ordered anymore. Please select another."
  1. S I=$S(TYPE="A":4,1:3) I '$P($G(^ORD(101.43,OI,"PS")),U,I) D Q
  1. . S X=$S(TYPE="A":"an additive",1:"a solution"),ORQUIT=1
  1. . W $C(7),!,"This item may not be ordered as "_X_"."
  1. S EXIT=$$INPT^ORCD I EXIT=0 D ROUTECHK Q
  1. Q:'$L($T(IVDEA^PSSUTIL1)) ;DBIA #3784
  1. S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2)
  1. S DEA=$$IVDEA^PSSUTIL1(PSOI,TYPE) I DEA>0 D Q:$G(ORQUIT)
  1. .;*499 - Support multiple DEA numbers for a provider
  1. . I $G(ORNP) S ORDEA=$$PRDEA^XUSER(ORNP) I '$L(ORDEA),'$L($P($G(^VA(200,+ORNP,"PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S ORQUIT=1 Q
  1. . I DEA=1 W $C(7),!,"This order will require a wet signature!"
  1. D ROUTECHK
  1. Q
  1. ;
  1. VOLUME ; -- get allowable volumes for solution
  1. N PSOI,ORY,CNT,I,XORY K ORDIALOG(PROMPT,"LIST")
  1. S PSOI=+$P($G(^ORD(101.43,+$$VAL^ORCD("SOLUTION",INST),0)),U,2)_"B"
  1. D ENVOL^PSJORUT2(PSOI,.ORY) Q:'ORY
  1. ;S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",+ORY(I))=+ORY(I)
  1. S (I,CNT)=0 F S I=$O(ORY(I)) Q:I'>0 D
  1. . S CNT=CNT+1
  1. . S XORY(I)=+ORY(I) I XORY(I)<1,$E(XORY(I),1,2)'="0." S XORY(I)=0_XORY(I)
  1. . S ORDIALOG(PROMPT,"LIST",XORY(I))=XORY(I)
  1. S ORDIALOG(PROMPT,"LIST")=CNT_"^1"
  1. Q
  1. ;
  1. UNITS ; -- get allowable units for current additive
  1. N PSOI,ORY,I,UNITS
  1. S PSOI=+$P(^ORD(101.43,+ORDIALOG($$PTR^ORCD("OR GTX ADDITIVE"),INST),0),U,2)_"A"
  1. D ENVOL^PSJORUT2(PSOI,.ORY)
  1. S I=$O(ORY(0)) Q:'I S UNITS=$P($G(ORY(I)),U,2)
  1. S ORDIALOG($$PTR^ORCD("OR GTX UNITS"),INST)=UNITS
  1. W !," (Units for this additive are "_UNITS_")"
  1. Q
  1. ;
  1. PREMIX() ; -- Returns 1 or 0, if IV base is a premix solution
  1. N BASE,PS,I,Y
  1. S BASE=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),Y=0
  1. S I=0 F S I=$O(ORDIALOG(BASE,I)) Q:I'>0 D Q:Y
  1. . S PS=$G(^ORD(101.43,+$G(ORDIALOG(BASE,I)),"PS"))
  1. . I $P(PS,U,3)&($P(PS,U,4)) S Y=1
  1. Q Y
  1. ;
  1. IVRTEENT ;
  1. N ARRAY,DIR,RIEN,TROUTE
  1. I ORTYPE'="Z" Q
  1. S RIEN=$P($G(ORDIALOG("B","ROUTE")),U,2) Q:RIEN'>0
  1. S EXIT=0,TROUTE=$G(ORDIALOG(RIEN,1)) Q:TROUTE'>0
  1. I $$IVRTESCR(TROUTE)=1 Q
  1. S ORDIALOG(RIEN,1)=""
  1. W !!,"The selected route is not a valid route for this order."
  1. W !,"Select a new route for this order from the list of routes below."
  1. D RTEDISP(.ARRAY)
  1. Q
  1. ;
  1. BIVOI(ARRAY) ;
  1. N CNT,NUM,OIIEN,OTYPE
  1. S CNT=0
  1. F OTYPE="SOLUTION","ADDITIVE" D
  1. .S OIIEN=+$P($G(ORDIALOG("B",OTYPE)),U,2) I OIIEN>0 D
  1. ..S NUM=0 F S NUM=$O(ORDIALOG(OIIEN,NUM)) Q:NUM'>0 I +$G(ORDIALOG(OIIEN,NUM))>0 D
  1. ...S CNT=CNT+1,ARRAY(CNT)=ORDIALOG(OIIEN,NUM)
  1. Q
  1. ;
  1. LVROUTES ;
  1. N ARRAY,ROUTES
  1. D BIVOI(.ARRAY)
  1. D IVDOSFRM^ORWDPS33(.ROUTES,.ARRAY,1)
  1. D RTEDISP(.ROUTES)
  1. Q
  1. ;
  1. RTEDISP(ROUTES) ;
  1. N CNT
  1. S CNT="" F S CNT=$O(ROUTES(CNT)) Q:CNT'>0 D
  1. .W !,$P($G(ROUTES(CNT)),U,2)
  1. Q
  1. ;
  1. IVRTESCR(Y) ;
  1. N ARRAY,ROUTES,VALUE
  1. D BIVOI(.ARRAY)
  1. S VALUE=$$IVQOVAL^ORWDPS33(.ARRAY,Y) I VALUE'="" Q 1
  1. Q 0
  1. ;
  1. ROUTECHK ;
  1. N CNT,IEN,ROUTE,VALUE
  1. S RIEN=$P($G(ORDIALOG("B","ROUTE")),U,2) Q:RIEN'>0
  1. S TROUTE=$G(ORDIALOG(RIEN,1)) Q:TROUTE'>0
  1. I $$IVRTESCR(TROUTE)=1 Q
  1. S ORDIALOG(RIEN,1)=""
  1. W !!,"The route defined for this order is an invalid route."
  1. W !,"You will need to define a new route for this order."
  1. Q
  1. ;
  1. ENRATE ; -- set display text, help based on IV TYPE
  1. N X,MSG S X=$G(ORIVTYPE),MSG=""
  1. S ORDIALOG(PROMPT,"A")=$S(X="I":"Infuse over time (min): ",1:"Infusion Rate (ml/hr): ")
  1. S MSG="Enter the "_$S(X="I":"number of minutes over which to infuse this medication.",1:"infusion rate, as the number of ml/hr or Text@Number of Labels per day. ")
  1. S ORDIALOG(PROMPT,"?")=MSG,ORDIALOG(PROMPT,"??")=MSG ;p388
  1. I X="I" D
  1. .N RATEI,RATEV,TIME,UNIT
  1. .S RATEI=$P($G(ORDIALOG("B","INFUSION RATE")),U,2) Q:RATEI'>0
  1. .S RATEV=$G(ORDIALOG(RATEI,1)) Q:'$L(RATEV)
  1. .I RATEV'["INFUSE OVER" Q
  1. .S TIME=$P(RATEV," ",3)
  1. .S UNIT=$P(RATEV," ",4)
  1. .I TIME["." Q
  1. .I UNIT="Hours" S TIME=TIME*60
  1. .S ORDIALOG(RATEI,1)=TIME
  1. Q
  1. ;
  1. INF ; -- input transform for INFUSION RATE
  1. N ALPHA,CNT,EXIT,FAIL,LDEC,RDEC,TEMP
  1. I $G(ORIVTYPE)="I" D Q
  1. .I X["." W !,"Infuse Over Time must be a whole number." K X Q
  1. .I $L(X)>4 W !,"Infuse Over Time cannot exceed 4 characters for minutes." K X Q
  1. .S FAIL=0
  1. .F CNT=1:1:$L(X) D I FAIL=1 Q
  1. ..I ($A($E(X,CNT))<48)!($A($E(X,CNT))>58) S FAIL=1
  1. .I FAIL=1 W !,"Infuse Over Time must be a whole number." K X Q
  1. K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
  1. I $G(ORIVTYPE)="C" D Q
  1. .S TEMP=$E(X,($L(X)-5),$L(X))
  1. .I X["@",$$UP^XLFSTR(TEMP)=" ML/HR" Q
  1. .S ALPHA=0
  1. .I X'["@",X'["." D I ALPHA=1 K X Q
  1. ..F CNT=1:1:$L(X) D I ALPHA=1 Q
  1. ...I ($A($E(X,CNT))<48)!($A($E(X,CNT))>58) S ALPHA=1
  1. .S EXIT=0
  1. .I X[".",X'["@" D I EXIT=1 K X Q
  1. ..S LDEC=$P(X,"."),RDEC=$P(X,".",2)
  1. ..I LDEC="" W !,"Infusion Rate required a leading numeric value." S EXIT=1
  1. ..I $L(RDEC)>1 W !,"Infusion Rate cannot exceed one decimal place." S EXIT=1
  1. ..S ALPHA=0
  1. ..F CNT=1:1:$L(LDEC) D I ALPHA=1 S EXIT=1 Q
  1. ...I ($A($E(LDEC,CNT))<48)!($A($E(LDEC,CNT))>58) S ALPHA=1
  1. ..I $L(RDEC)=0 Q
  1. ..F CNT=1:1:$L(RDEC) D I ALPHA=1 S EXIT=1 Q
  1. ...I ($A($E(RDEC,CNT))<48)!($A($E(RDEC,CNT))>58) S ALPHA=1
  1. .D ORINF^PSIVSP Q
  1. ; -- assume #minutes for now
  1. K:(X'=+X)!(X<1)!(X>999) X ;range?
  1. Q
  1. ;
  1. VALIDAYS(X) ; -- Validate IV duration
  1. N UNITS,X1,X2,Y,I
  1. I X'?1.N." "1.A Q 0
  1. S UNITS="^MIN^HOURS^DAYS^M^H^D^",(X1,X2)=""
  1. 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)
  1. I 'X1 Q 0
  1. I UNITS'[(U_X2_U) Q 0
  1. Q 1
  1. ;
  1. VALDURA(X) ;-- Validate IV duration/limitation
  1. K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
  1. ;
  1. IVPSI ;INPUT-TRANSFORM
  1. I $L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) S X="" Q
  1. I $L(X)>1,X[" " W !,"Spaces are not allow in the duration." K X Q
  1. I $E(X)=0 W !,!,"Duration cannot start with a zero." K X Q
  1. I X["." W !,!,"Invalid duration or total volume.",!,"Duration has to be integer value!" S X="" Q
  1. S X=$$UP^XLFSTR(X)
  1. I X["DOSES" D Q
  1. .I $G(ORIVTYPE)'="I" K X W !,"Continuous IV Orders cannot have DOSES as a duration." Q
  1. .I +$P(X,"DOSES")<1,+$P(X,"DOSES")>200000 W !,"Invalid number of Doses.",! K X Q
  1. I (X'?.N1.2A),(X'?.N1".".N1.2A) W !,!,"Invalid duration or total volume.",! S X="" Q
  1. I (X?.N1A) D
  1. . I (X["L")!(X["H")!(X["D") Q
  1. . E W !,!,"Invalid duration or total volume.",! S X="" Q
  1. I (X?.N1".".N1A) D
  1. . I X["L" Q
  1. . E W !,!,"Invalid duration or total volume.",!,"Duration has to be integer value!",! S X="" Q
  1. I (X?.N2A)!(X?.N1".".N2A) D
  1. . I (X["ML")!(X["CC") Q
  1. . E W !,!,"Invalid duration or total volume",! S X="" Q
  1. I X="" K X
  1. Q
  1. ;
  1. IVPSI1 ; ASK ON CONDITION
  1. N DURI,DURV,TEMPX
  1. I $G(OROTSCH)=1 Q
  1. S DURI=$P($G(ORDIALOG("B","LIMITATION")),U,2)
  1. I DURI>0 S DURV=$G(ORDIALOG(DURI,1))
  1. I $L(DURV)>1,$E(DURV)="f",DURV["doses" D
  1. .S TEMPX=$P(DURV," ",5)_"DOSES"
  1. .I TEMPX'="",TEMPX'=DURV S ORDIALOG(DURI,1)=TEMPX
  1. N INT,IVTYPE,ONETIME,TYPE,SCH,SCHNAME
  1. D IVDURT($G(ORIVTYPE))
  1. ;I $G(ORIVTYPE)'="I" D G IVPS1X
  1. ;.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."
  1. ;.W !,"(Examples: 1500ML, 1000CC, 1L, 3D, or 72H)",!
  1. ;W !,"This field is optional a value does not need to be entered."
  1. ;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 or DOSES to set limitation."
  1. ;W !,"(Examples: 1500ML, 1000CC, 1L, 3D, 72H, or 10DOSES)",!
  1. IVPS1X ;
  1. ;W !,"This field is optional a value does not need to be entered."
  1. I 1
  1. Q
  1. ;
  1. IVDURT(TYPE) ;
  1. I TYPE'="I" D G IVDURX
  1. .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."
  1. .W !,"(Examples: 1500ML, 1000CC, 1L, 3D, or 72H)",!
  1. W !,"This field is optional a value does not need to be entered."
  1. 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 or DOSES to set limitation."
  1. W !,"(Examples: 1500ML, 1000CC, 1L, 3D, 72H, or 10DOSES)",!
  1. IVDURX ;
  1. W !,"This field is optional a value does not need to be entered."
  1. Q
  1. ;
  1. IVDURH ;
  1. D IVDURT($G(ORIVTYPE))
  1. Q
  1. ;