| 1 | ORKPS ; slc/CLA - Order checking support procedures for medications ;12/15/97 [8/10/05 3:20pm]
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232**;Dec 17, 1997;Build 19
|
|---|
| 3 | Q
|
|---|
| 4 | CHECK(YY,DFN,MED,OI,ORKDG) ; return drug order checks
|
|---|
| 5 | ;YY: returned array of data
|
|---|
| 6 | ;DFN: patient id
|
|---|
| 7 | ;MED: drug ien [file #50]
|
|---|
| 8 | ;OI: orderable item ien [file #101.43
|
|---|
| 9 | ;ORKDG: display group (should be PSI, PSIV, PSO or PSH)
|
|---|
| 10 | ; returned info: varies for ^TMP($J x-ref - refer to listings below
|
|---|
| 11 | K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
|
|---|
| 12 | N ORDFN S ORDFN=DFN
|
|---|
| 13 | D EN^PSOORDRG(DFN,MED)
|
|---|
| 14 | D PROCESS^ORKPS1(OI,ORDFN,ORKDG)
|
|---|
| 15 | K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
|
|---|
| 16 | Q
|
|---|
| 17 | CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG) ; return drug order checks for session
|
|---|
| 18 | N ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI
|
|---|
| 19 | N ORKFLG,ORSESS,ORPSPKG,ORPSA,ORKDD,ORSNUM,ORNUM,DUPX,DUPORN
|
|---|
| 20 | N ORDFN S ORDFN=DFN
|
|---|
| 21 | S ORKFLG=0
|
|---|
| 22 | S ORNUM=$P(ORKA,"|",5)
|
|---|
| 23 | ;
|
|---|
| 24 | ;get other session med orders:
|
|---|
| 25 | I $D(^TMP("ORKA",$J)) D
|
|---|
| 26 | .S CNT=^TMP("ORKA",$J) F CNTX=1:1:CNT D
|
|---|
| 27 | ..S ORSESS=$G(^TMP("ORKA",$J,CNTX))
|
|---|
| 28 | ..Q:'$L(ORSESS)
|
|---|
| 29 | ..S ORPSPKG=$P(ORSESS,"|",2)
|
|---|
| 30 | ..Q:'$L(ORPSPKG)
|
|---|
| 31 | ..Q:$E(ORPSPKG,1,2)'="PS"
|
|---|
| 32 | ..S ORSNUM=$P(ORSESS,"|",5)
|
|---|
| 33 | ..S ORKOI=$P(ORSESS,"|")
|
|---|
| 34 | ..;quit if same order/oi:
|
|---|
| 35 | ..Q:((+$G(ORNUM)=+$G(ORSNUM))&(+$G(OI)=+$G(ORKOI)))
|
|---|
| 36 | ..S:ORPSPKG="PSJ" ORPSPKG="PSI"
|
|---|
| 37 | ..S ORKDRUG=$P($P(ORSESS,"|",3),U,4)
|
|---|
| 38 | ..;
|
|---|
| 39 | ..;if no disp drug selected get disp drug(s) from OI:
|
|---|
| 40 | ..I +$G(ORKDRUG)<1,$L(ORKOI) D
|
|---|
| 41 | ...I "IOH"[$E(ORPSPKG,3) D OI2DD(.ORPSA,ORKOI,$E(ORPSPKG,3)) D
|
|---|
| 42 | ....S ORKDD=0 F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
|
|---|
| 43 | .....S ORKDRUG=+ORKDD
|
|---|
| 44 | .....S:+$G(ORKDRUG)>0 ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM
|
|---|
| 45 | ...K ORPSA ;need to clean out between calls to OI2DD
|
|---|
| 46 | ..;
|
|---|
| 47 | ..Q:+$G(ORKDRUG)<1
|
|---|
| 48 | ..;if dispense drug selected add to array:
|
|---|
| 49 | ..S ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM
|
|---|
| 50 | ;
|
|---|
| 51 | ;get unsigned medication orders:
|
|---|
| 52 | S HOR=0,SEQ=0
|
|---|
| 53 | S HOR=$O(^TMP("ORR",$J,HOR)) I +$G(HOR)>0 D
|
|---|
| 54 | .F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D
|
|---|
| 55 | ..S ORKORN=+$P(^TMP("ORR",$J,HOR,SEQ),U),DUPORN=0
|
|---|
| 56 | ..Q:+$G(ORKORN)<1
|
|---|
| 57 | ..Q:+ORKORN=+ORNUM
|
|---|
| 58 | ..Q:$P(^OR(100,+ORKORN,8,$P(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC"
|
|---|
| 59 | ..Q:$P(^ORD(100.01,$P(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED"
|
|---|
| 60 | ..S ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG") ;get disp drug for order
|
|---|
| 61 | ..;only process vs. unsigned med order if disp drug is assoc w/order:
|
|---|
| 62 | ..Q:+$G(ORKDRUG)<1
|
|---|
| 63 | ..S ORPSPKG=$$DGRX^ORQOR2(+ORKORN)
|
|---|
| 64 | ..S ORPSPKG=$S(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDICATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PSH",1:"")
|
|---|
| 65 | ..S DUPX="" F S DUPX=$O(ORKDRUGA(DUPX)) Q:'DUPX!(DUPORN=1) D
|
|---|
| 66 | ...S:ORKORN=ORKDRUGA(DUPX) DUPORN=1
|
|---|
| 67 | ..Q:DUPORN=1 ;quit if already processed drug order
|
|---|
| 68 | ..S ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN
|
|---|
| 69 | ;
|
|---|
| 70 | K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
|
|---|
| 71 | I $D(ORKDRUGA) D DRGCHK^PSOORDRG(DFN,MED,.ORKDRUGA)
|
|---|
| 72 | ;I '$D(ORKDRUGA) D EN^PSOORDRG(DFN,MED)
|
|---|
| 73 | D PROCESS^ORKPS1(OI,ORDFN,ORKDG)
|
|---|
| 74 | K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
|
|---|
| 75 | Q
|
|---|
| 76 | TAKEMED(ORKDFN,ORKMED) ;extrinsic function returns med orderable item if any
|
|---|
| 77 | ;active med patient is taking contains any piece of ORKMED
|
|---|
| 78 | ;ORKDFN patient DFN
|
|---|
| 79 | ;ORKMED meds to check vs. active med list in format MED1^MED2^MED3...
|
|---|
| 80 | Q:'$L($G(ORKDFN)) "0^Patient not identified."
|
|---|
| 81 | Q:'$L($G(ORKMED)) "0^Medication not identified."
|
|---|
| 82 | N ORKARX,ORKY,ORI,ORJ,ORCNT,ORKMEDP,ORKRSLT
|
|---|
| 83 | D LIST^ORQQPS(.ORKY,ORKDFN,"","")
|
|---|
| 84 | Q:$P(ORKY(1),U)="" "0^No active meds found."
|
|---|
| 85 | S ORKRSLT="0^No matching meds found."
|
|---|
| 86 | S ORCNT=$L(ORKMED,U)
|
|---|
| 87 | S ORI=0 F S ORI=$O(ORKY(ORI)) Q:ORI<1 D
|
|---|
| 88 | .S ORKARX=$P(ORKY(ORI),U,2)
|
|---|
| 89 | .F ORJ=1:1:ORCNT S ORKMEDP=$P(ORKMED,U,ORJ) D
|
|---|
| 90 | ..I $L(ORKMEDP),(ORKARX[ORKMEDP) S ORKRSLT="1^"_ORKARX
|
|---|
| 91 | Q ORKRSLT
|
|---|
| 92 | SOLUT(OI) ;extrinsic function returns 1 (true) if the orderable item is
|
|---|
| 93 | ; a solution (IV Base)
|
|---|
| 94 | Q:+$G(OI)<1 ""
|
|---|
| 95 | N OITEXT
|
|---|
| 96 | S OITEXT=$G(^ORD(101.43,OI,0))
|
|---|
| 97 | Q:'$L(OITEXT) ""
|
|---|
| 98 | S OITEXT=$P(OITEXT,U)
|
|---|
| 99 | Q:$D(^ORD(101.43,"S.IVB RX",OITEXT)) 1
|
|---|
| 100 | Q ""
|
|---|
| 101 | POLYRX(DFN) ;extrins funct rtns 1 if patient exceeds polypharmacy, 0 if not
|
|---|
| 102 | N ORSLT,ORENT,ORLOC,ORPAR,ORMEDS
|
|---|
| 103 | S ORSLT=0
|
|---|
| 104 | Q:'$L(DFN) ORSLT
|
|---|
| 105 | S VA200="" D OERR^VADPT
|
|---|
| 106 | S ORLOC=+$G(^DIC(42,+VAIN(4),44))
|
|---|
| 107 | K VA200,VAIN
|
|---|
| 108 | S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
|
|---|
| 109 | S ORPAR=$$GET^XPAR(ORENT,"ORK POLYPHARMACY",1,"I")
|
|---|
| 110 | S ORMEDS=$$NUMRX(DFN)
|
|---|
| 111 | I $G(ORMEDS)>$G(ORPAR) S ORSLT=1
|
|---|
| 112 | Q ORSLT
|
|---|
| 113 | GLCREAT(DFN) ;extrinsic function returns patient's (DFN) most recent serum
|
|---|
| 114 | ; creatinine within # of days from parameter ORK GLUCOPHAGE CREATININE
|
|---|
| 115 | ; results format: test id^result units flag ref range collect d/t^result
|
|---|
| 116 | ; used by order check GLUCOPHAGE-LAB RESULTS
|
|---|
| 117 | N ORLOC,ORPAR,ORDAYS
|
|---|
| 118 | N BDT,CDT,ORY,ORX,ORZ,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE,SPECIMEN
|
|---|
| 119 | Q:'$L(DFN) "0^"
|
|---|
| 120 | S ORDAYS=$$GCDAYS(DFN)
|
|---|
| 121 | Q:'$L(ORDAYS) "0^"
|
|---|
| 122 | D NOW^%DTC
|
|---|
| 123 | S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
|
|---|
| 124 | K %
|
|---|
| 125 | Q:'$L($G(BDT)) "0^"
|
|---|
| 126 | S LABFILE=$$TERMLKUP^ORB31(.ORY,"SERUM CREATININE")
|
|---|
| 127 | Q:'$D(ORY) "0^" ;no link between SERUM CREATININE and local lab test
|
|---|
| 128 | Q:$G(LABFILE)'=60 "0^"
|
|---|
| 129 | S SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")
|
|---|
| 130 | Q:'$D(ORX) "0^" ;no link between SERUM SPECIMEN and local specimen
|
|---|
| 131 | Q:$G(SPECFILE)'=61 "0^"
|
|---|
| 132 | F ORI=1:1:ORY I +$G(CREARSLT)<1 D
|
|---|
| 133 | .S TEST=$P(ORY(ORI),U)
|
|---|
| 134 | .Q:+$G(TEST)<1
|
|---|
| 135 | .F ORJ=1:1:ORX I +$G(CREARSLT)<1 D
|
|---|
| 136 | ..S SPECIMEN=$P(ORX(ORJ),U)
|
|---|
| 137 | ..Q:+$G(SPECIMEN)<1
|
|---|
| 138 | ..S ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)
|
|---|
| 139 | ..Q:'$L($G(ORZ))
|
|---|
| 140 | ..S CDT=$P(ORZ,U,7)
|
|---|
| 141 | ..I CDT'<BDT S CREARSLT=1
|
|---|
| 142 | Q:+$G(CREARSLT)<1 "0^"
|
|---|
| 143 | Q $P(ORZ,U)_U_$P(ORZ,U,3)_" "_$P(ORZ,U,4)_" "_$P(ORZ,U,5)_" ("_$P(ORZ,U,6)_") "_$$FMTE^XLFDT(CDT,"2P")_U_$P(ORZ,U,3)
|
|---|
| 144 | GCDAYS(DFN) ;extrinsic function to return number of days to look for
|
|---|
| 145 | ; glucophage serum creatinine result
|
|---|
| 146 | Q:'$L(DFN) ""
|
|---|
| 147 | N ORLOC,ORENT,ORDAYS
|
|---|
| 148 | ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
|
|---|
| 149 | ;reliably determined, and many simultaneous outpt locations can occur):
|
|---|
| 150 | S VA200="" D OERR^VADPT
|
|---|
| 151 | S ORLOC=+$G(^DIC(42,+VAIN(4),44))
|
|---|
| 152 | K VA200,VAIN
|
|---|
| 153 | S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
|
|---|
| 154 | S ORDAYS=$$GET^XPAR(ORENT,"ORK GLUCOPHAGE CREATININE",1,"I")
|
|---|
| 155 | Q:$L(ORDAYS) ORDAYS
|
|---|
| 156 | Q ""
|
|---|
| 157 | SUPPLY(OI) ;extrinsic function returns 1 (true) if the orderable item is
|
|---|
| 158 | ; a supply
|
|---|
| 159 | Q:+$G(OI)<1 ""
|
|---|
| 160 | N OITEXT
|
|---|
| 161 | S OITEXT=$G(^ORD(101.43,OI,0))
|
|---|
| 162 | Q:'$L(OITEXT) ""
|
|---|
| 163 | S OITEXT=$P(OITEXT,U)
|
|---|
| 164 | Q:$D(^ORD(101.43,"S.SPLY",OITEXT)) 1
|
|---|
| 165 | Q ""
|
|---|
| 166 | NUMRX(DFN) ;extrinsic funct returns number of active meds patient is taking
|
|---|
| 167 | N NUMRX,ORPTYPE,ORX,ORY,ORS,ORNUM,ORPRENEW
|
|---|
| 168 | S NUMRX=0
|
|---|
| 169 | Q:+$G(DFN)<1 NUMRX
|
|---|
| 170 | ;
|
|---|
| 171 | ;check to determine if inpatient or outpatient:
|
|---|
| 172 | D ADM^VADPT2
|
|---|
| 173 | S ORPTYPE=$S(+$G(VADMVT)>0:"I",1:"O")
|
|---|
| 174 | ;
|
|---|
| 175 | K ^TMP("PS",$J)
|
|---|
| 176 | D OCL^PSOORRL(DFN,"","") ;if no date range, returns active meds for pt
|
|---|
| 177 | N X
|
|---|
| 178 | S X=0
|
|---|
| 179 | F S X=$O(^TMP("PS",$J,X)) Q:X<1 D
|
|---|
| 180 | .S ORX=$G(^TMP("PS",$J,X,0))
|
|---|
| 181 | .S ORY=$P(ORX,U)
|
|---|
| 182 | .S ORNUM=$P(ORX,U,8) ;order entry order number
|
|---|
| 183 | .S ORS=$P(ORX,U,9) ;medication status from pharmacy
|
|---|
| 184 | .S ORPRENEW=$P(ORX,U,14) ;pending renewal flag (1: pending renewal)
|
|---|
| 185 | .Q:+ORX<1
|
|---|
| 186 | .Q:$P(ORY,";",2)'=ORPTYPE ;quit if med is not pt type (inpt/outpt)
|
|---|
| 187 | .;quit if status is a non-active type:
|
|---|
| 188 | .Q:$G(ORS)="EXPIRED"
|
|---|
| 189 | .Q:$G(ORS)["DISCONTINUE"
|
|---|
| 190 | .Q:$G(ORS)="DELETED"
|
|---|
| 191 | .Q:+$G(ORPRENEW)>0
|
|---|
| 192 | .Q:$$SUPPLY($$OI^ORQOR2(ORNUM))=1 ;quit if a supply
|
|---|
| 193 | .S NUMRX=NUMRX+1
|
|---|
| 194 | K ^TMP("PS",$J)
|
|---|
| 195 | Q NUMRX
|
|---|
| 196 | OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
|
|---|
| 197 | N PSOI
|
|---|
| 198 | Q:'$D(^ORD(101.43,OROI,0))
|
|---|
| 199 | S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
|
|---|
| 200 | Q:+$G(PSOI)<1
|
|---|
| 201 | S:ORPSPKG="H" ORPSPKG="X" ;if non-va med need to pass api "X"
|
|---|
| 202 | D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
|
|---|
| 203 | Q
|
|---|
