| 1 | ORWDPS33 ; SLC/KCM - Pharmacy Calls for GUI Dialog ; 01/26/2008
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;This routine move several RPCs from ORWDPS32 because of the routine size
|
|---|
| 5 | ;
|
|---|
| 6 | COMPLOC(ORY,ORID,LOC) ;
|
|---|
| 7 | S ORY=0
|
|---|
| 8 | I LOC'=+$P($G(^OR(100,+ORID,0)),U,10) S ORY=1
|
|---|
| 9 | Q
|
|---|
| 10 | DOSES(LST,OI) ; return doses for an orderable item - TEST ONLY
|
|---|
| 11 | N ORTMP,ORI,ORJ,ILST,LTSA,NDF,ORWDRG,VAPN,X,PSTYPE S PSTYPE="O"
|
|---|
| 12 | D ENDD^PSJORUTL("^^^"_+$P($G(^ORD(101.43,OI,0)),"^",2),PSTYPE,.ORTMP)
|
|---|
| 13 | S ORI=0 F S ORI=$O(ORTMP(ORI)) Q:'ORI S ORWDRG=+ORTMP(ORI) D
|
|---|
| 14 | . K ^TMP($J,"ORWDPS32 DRUG")
|
|---|
| 15 | . D NDF^PSS50(+ORWDRG,,,,,"ORWDPS32 DRUG")
|
|---|
| 16 | . S VAPN=$P($G(^TMP($J,"ORWDPS32 DRUG",+ORWDRG,22)),U),NDF=$P($G(^TMP($J,"ORWDPS32 DRUG",+ORWDRG,20)),U)
|
|---|
| 17 | . S X=$$DFSU^PSNAPIS(NDF,VAPN)
|
|---|
| 18 | . S LSTA($P(X,U,4),$P(X,U,6))=""
|
|---|
| 19 | . I +$P(X,U,4)=$P(X,U,4) S LSTA($P(X,U,4)*2,$P(X,U,6))=""
|
|---|
| 20 | K ^TMP($J,"ORWDPS32 DRUG")
|
|---|
| 21 | S ORI="",ILST=0 F S ORI=$O(LSTA(ORI)) Q:ORI="" D
|
|---|
| 22 | . S ORJ="" F S ORJ=$O(LSTA(ORI,ORJ)) Q:ORJ="" D
|
|---|
| 23 | . . S ILST=ILST+1,LST(ILST)=ORI_" "_ORJ
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | DRUGMSG(VAL,IEN) ; return any message associated with a dispense drug
|
|---|
| 27 | N X S X=$$ENDCM^PSJORUTL(IEN)
|
|---|
| 28 | S VAL=$P(X,U,2)_U_$P(X,U,4)
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | FORMALT(ORLST,IEN,PSTYPE) ; return a list of formulary alternatives
|
|---|
| 32 | D ENRFA^PSJORUTL(IEN,PSTYPE,.ORLST)
|
|---|
| 33 | S I=0 F S I=$O(ORLST(I)) Q:'I D
|
|---|
| 34 | . S OI=+$O(^ORD(101.43,"ID",+$P(ORLST(I),U,4)_";99PSP",0))
|
|---|
| 35 | . S $P(ORLST(I),U,4)=OI I OI S $P(ORLST(I),U,5)=$P(^ORD(101.43,OI,0),U)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ISVALIV(RESULT,ORID,ACTION) ;
|
|---|
| 39 | N ARRAY,CNT,ID,IVD,NUM,ORDERID,OUTPUT,ROUTE,ROUTEID,TYPE
|
|---|
| 40 | S TYPE=$S(ACTION="XFR":"transfered",ACTION="RN":"renewed",1:"copied")
|
|---|
| 41 | S IVD=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) Q:IVD'>0
|
|---|
| 42 | I +$P($G(^OR(100,+ORID,0)),U,5)'=IVD Q
|
|---|
| 43 | S ORDERID="",ROUTEID="",CNT=0
|
|---|
| 44 | F S ORDERID=$O(^OR(100,+ORID,4.5,"ID","ORDERABLE",ORDERID)) Q:ORDERID'>0 D
|
|---|
| 45 | .I +$G(^OR(100,+ORID,4.5,ORDERID,1))'>0 Q
|
|---|
| 46 | .S CNT=CNT+1,ARRAY(CNT)=^OR(100,+ORID,4.5,ORDERID,1)
|
|---|
| 47 | S ROUTEID=+$O(^OR(100,+ORID,4.5,"ID","ROUTE","")) I ROUTEID'>0 D Q
|
|---|
| 48 | .S RESULT="This order contains an invalid route it cannot be "_TYPE_"."
|
|---|
| 49 | S ROUTE=+$G(^OR(100,+ORID,4.5,ROUTEID,1)) I ROUTE'>0 D Q
|
|---|
| 50 | .S RESULT="This order contains an invalid route it cannot be "_TYPE_"."
|
|---|
| 51 | S OUTPUT=$$IVQOVAL(.ARRAY,ROUTE) I OUTPUT="" D
|
|---|
| 52 | .;S TYPE=$S(ACTION="XFR":"transfered",ACTION="RN":"renewed",1:"copied")
|
|---|
| 53 | .S RESULT="This order contains an invalid route it cannot be "_TYPE_"."
|
|---|
| 54 | I RESULT'="" Q
|
|---|
| 55 | N IVTYPE,IVTYPEID,INFUSEID,INFUSE
|
|---|
| 56 | S IVTYPEID=+$O(^OR(100,+ORID,4.5,"ID","TYPE","")) I IVTYPEID'>0 D Q
|
|---|
| 57 | .S RESULT="This order contains an invalid IV Type it cannot be "_TYPE_"."
|
|---|
| 58 | S IVTYPE=$G(^OR(100,+ORID,4.5,IVTYPEID,1)) I IVTYPE="" D Q
|
|---|
| 59 | .S RESULT="This order contains an invalid IV Type it cannot be "_TYPE_"."
|
|---|
| 60 | S INFUSEID=+$O(^OR(100,+ORID,4.5,"ID","RATE","")) Q:INFUSEID'>0
|
|---|
| 61 | S INFUSE=$G(^OR(100,+ORID,4.5,INFUSEID,1)) Q:INFUSE=""
|
|---|
| 62 | I $$VALINF^ORWDXM3(IVTYPE,INFUSE)=0 D
|
|---|
| 63 | .;S TYPE=$S(ACTION="XFR":"transfered",ACTION="RN":"renewed",1:"copied")
|
|---|
| 64 | .S RESULT="This order contains an invalid infusion rate it cannot be "_TYPE_"."
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | IVQOVAL(ARRAY,ROUTE) ;
|
|---|
| 68 | N CNT,RARR,RESULT
|
|---|
| 69 | S RESULT=""
|
|---|
| 70 | D IVDOSFRM(.RARR,.ARRAY,0,1)
|
|---|
| 71 | S CNT="" F S CNT=$O(RARR(CNT)) Q:CNT'>0!(RESULT'="") D
|
|---|
| 72 | .I $P(RARR(CNT),U)=ROUTE S RESULT=RARR(CNT) Q
|
|---|
| 73 | Q RESULT
|
|---|
| 74 | ;
|
|---|
| 75 | IVDOSFRM(LST,ORDERIDS,DEFAULT,ALLIV) ;
|
|---|
| 76 | N ARRAY,CNT,CNT1,OI,POI
|
|---|
| 77 | S OI="",CNT=0,CNT1=0
|
|---|
| 78 | F S OI=$O(ORDERIDS(OI)) Q:OI'>0 D
|
|---|
| 79 | .S POI=+$P($G(^ORD(101.43,$G(ORDERIDS(OI)),0)),U,2) Q:POI'>0
|
|---|
| 80 | .S CNT=CNT+1
|
|---|
| 81 | .S ARRAY(CNT)=POI
|
|---|
| 82 | I CNT=0 Q
|
|---|
| 83 | S ARRAY(0)=CNT
|
|---|
| 84 | D START1^PSSJORDF(.ARRAY,ALLIV)
|
|---|
| 85 | S CNT="" F S CNT=$O(ARRAY(CNT)) Q:CNT'>0 D
|
|---|
| 86 | .S CNT1=CNT1+1,LST(CNT1)=$G(ARRAY(CNT))
|
|---|
| 87 | ;this temp should be killed by Pharmacy. This will be removed once
|
|---|
| 88 | ;Pharmacy send an update
|
|---|
| 89 | K ^TMP("PSJMR",$J)
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | ISSPLY(VAL,IEN) ; return true if orderable item is a supply
|
|---|
| 93 | S VAL=0
|
|---|
| 94 | I $P($G(^ORD(101.43,IEN,"PS")),U,5)=1 S VAL=1
|
|---|
| 95 | Q
|
|---|
| 96 | IVAMT(VAL,OI,ORWTYP) ; return UNITS^AMOUNT |^AMOUNT^AMOUNT...| for IV soln
|
|---|
| 97 | N I,PSOI,ORWY,AMT
|
|---|
| 98 | S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2)_ORWTYP,VAL=""
|
|---|
| 99 | D ENVOL^PSJORUT2(PSOI,.ORWY)
|
|---|
| 100 | I ORWTYP="B" D
|
|---|
| 101 | . S I=0 F S I=$O(ORWY(I)) Q:I'>0 S AMT(+ORWY(I))="" D
|
|---|
| 102 | . . I ORWY(I)<1 D ;SBR
|
|---|
| 103 | . . . K AMT(+ORWY(I))
|
|---|
| 104 | . . . S AMT(0_+ORWY(I))=""
|
|---|
| 105 | . S AMT=0,VAL="ML" F S AMT=$O(AMT(AMT)) Q:AMT'>0 S VAL=VAL_U_AMT
|
|---|
| 106 | I ORWTYP="A" D
|
|---|
| 107 | . S I=+$O(ORWY(0)) S VAL=$P($G(ORWY(I)),U,2)
|
|---|
| 108 | . I '$L(VAL) S VAL="ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL"
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | MEDISIV(VAL,IEN) ; return true if orderable item is IV medication
|
|---|
| 112 | S VAL=0
|
|---|
| 113 | I $P($G(^ORD(101.43,IEN,"PS")),U)=2 S VAL=1
|
|---|
| 114 | Q
|
|---|
| 115 | ;
|
|---|
| 116 | SCSTS(VAL,ORVP,ORDRUG) ; return service connected eligibility for patient
|
|---|
| 117 | N ORWP94 S ORWP94=$O(^ORD(101.41,"AB","PS MEDS",0))>0
|
|---|
| 118 | I $L($T(SC^PSOCP)),$$SC^PSOCP(+ORVP,+$G(ORDRUG)) S VAL=0 G XSCSTS
|
|---|
| 119 | I 'ORWP94,(+$$RXST^IBARXEU(+ORVP)>0) S VAL=0 G XSCSTS
|
|---|
| 120 | S VAL=1
|
|---|
| 121 | XSCSTS Q
|
|---|
| 122 | ;
|
|---|
| 123 | VALQTY(OK,X) ; validate a quantity, return 1 if valid, 0 if not
|
|---|
| 124 | ; to be compatible with LM, make sure X is integer from 1 to 240
|
|---|
| 125 | ; this is based on the input transform from 52,7
|
|---|
| 126 | K:(+X'>0)!(+X>99999999)!(X'?.8N.1".".2N)!($L(X)>12) X
|
|---|
| 127 | S OK=$S($D(X):1,1:0)
|
|---|
| 128 | Q
|
|---|
| 129 | ;
|
|---|
| 130 | VALRATE(VAL,X) ; return "1" (true) if IV rate text is valid
|
|---|
| 131 | I $E($RE($$UPPER^ORWDPS32(X)),1,5)="RH/LM" S X=$E(X,1,$L(X)-5)
|
|---|
| 132 | S X=$$TRIM^ORWDPS32(X)
|
|---|
| 133 | D ORINF^PSIVSP S VAL=$G(X) ;S OK=$S($D(X):1,1:0)
|
|---|
| 134 | Q
|
|---|
| 135 | VALSCH(OK,X,PSTYPE) ; validate a schedule, return 1 if valid, 0 if not
|
|---|
| 136 | I '$L($T(EN^PSSGSGUI)) S OK=-1 Q
|
|---|
| 137 | I $E($T(EN^PSSGSGUI),1,4)="EN(X" D
|
|---|
| 138 | . N ORX S ORX=$G(X) D EN^PSSGSGUI(.ORX,$G(PSTYPE,"I"))
|
|---|
| 139 | . K X S:$D(ORX) X=ORX
|
|---|
| 140 | E D
|
|---|
| 141 | . D EN^PSSGSGUI
|
|---|
| 142 | S OK=$S($D(X):1,1:0)
|
|---|
| 143 | Q
|
|---|
| 144 | ;
|
|---|
