- ORKPS ; SLC/CLA - Order checking support procedures for medications ;Oct 27, 2023@10:53:17
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,316,272,346,345,382,469,535**;Dec 17, 1997;Build 20
- ;Reference to CPRS^PSODDPR4 in ICR #5366
- ;Reference to CPRS^PSODDPR8 in ICR #5784
- ;Reference to OCL^PSOORRL in ICR #2400
- ;Reference to $$PRE^PSSDSAPK in ICR #5497
- ;Reference to $$DRG^PSSDSAPM in ICR #5570
- ;Reference to ADM^VADPT2 in ICR #325
- ;Reference to ^DIC(42 in ICR #10039 (Field 44)
- ;Reference to NOW^%DTC in ICR #10000
- ;Reference to NDF^PSS50 in ICR #4533
- ;Reference to DRGIEN^PSS52P7 in ICR #4550
- ;Reference to OERR^VADPT in ICR #10061
- ;Reference to ADM^VADPT2 in ICR #325
- ;Reference to $$FMADD^XLFDT,$$FMTE^XLFDT in ICR #10103
- ;Reference to $$UP^XLFSTR in ICR #10104
- ;Reference to $$GET^XPAR in ICR #2263
- ;
- Q
- CHECK(YY,DFN,MED,OI,ORKDG,OROIL,ORSUPPLY,ORIVTYPE,ORIVRAN,ORDODSG) ; return drug order checks
- ;YY: returned array of data
- ;DFN: patient id
- ;MED: drug ien [file #50] ^ generic name [file #50]
- ;OI: orderable item ien [file #101.43]
- ;ORKDG: display group (should be PSI, PSIV, PSO or PSH)
- ;OROIL: list of items ordered
- ;ORSUPPLY: pharmacy orderable item ien [file #50.7] if it resolves to one or more supply items
- ; 0 if the pharmacy orderable item does not resolve to any supply items
- ;ORIVTYPE: the MED type as sent from Infusion Order Dialog
- ; A for additive
- ; B for base
- ;ORIVRAN: FLAG THAT DENOTES IF ALL COMPONENTS OF INFUSION ORDER HAVE ALREADY BEEN PROCESSED
- ; 1 FOR ALREADY PROCESSED
- ; EMPTY STRING FOR NOT YET PROCESSED
- ;ORDODSG: FLAG THAT DENOTES IF DOSAGE CHECKS SHOULD BE PERFORMED
- ; 1 FOR PERFORM DOSAGE CHECKS
- ; 0 FOR DO NOT PERFORM DOSAGE CHECKS
- ; returned info: varies for ^TMP($J x-ref - refer to listings below
- N OR2CRITN,OR2CRITF,OR2CRITD,OR2SIGN,OR2SIGF,OR2SIGD,OR2DUPN,OR2DUPF,OR2DUPD,OR2DUPCN,OR2DUPCF,OR2DUPCD
- N ORPHDG,ORKSOIA,ORDOCHKS
- D PARAMS^ORKCHK6("CRITICAL DRUG INTERACTION",.OR2CRITN,.OR2CRITF,.OR2CRITD)
- D PARAMS^ORKCHK6("SIGNIFICANT DRUG INTERACTION",.OR2SIGN,.OR2SIGF,.OR2SIGD)
- D PARAMS^ORKCHK6("DUPLICATE DRUG THERAPY",.OR2DUPCN,.OR2DUPCF,.OR2DUPCD)
- N ORDFN,ORKA,ORPTY,ORPHOI,OROILI,ORKAI S ORDFN=DFN
- S ORPHOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
- S ORPTY=$S($G(ORKDG)="PSI":"I;",$G(ORKDG)="PSIV":"I;",$G(ORKDG)="PSO":"O;",$G(ORKDG)="PSH":"O;",1:"O;")
- S ORPHDG=$S(ORKDG="PSI":"U",ORKDG="PSIV":"I",ORKDG="PSO":"O",ORKDG="PSH":"N",1:"")
- I $G(ORIVTYPE)'="A" D Q:'ORDOCHKS ; Don't do checks if pharmacy does not want us to
- .S ORDOCHKS=$$PRE^PSSDSAPK(ORPHOI,ORPHDG)
- .S:'ORDODSG ORDODSG=ORDOCHKS
- S:$G(ORIVTYPE)="A" ORDODSG=1
- I +MED,('ORIVRAN) S ORKA(1)=MED_U_$$GETPSNM(+MED),ORKAI=1
- ;ADD ALL COMPONENTS OF IV ORDER SO WE ONLY HAVE TO DO A SINGLE PRE CALL
- I ORKDG="PSIV",('ORIVRAN) D
- .S ORIVRAN=1,OROILI=0 F S OROILI=$O(OROIL(OROILI)) Q:'OROILI D
- ..N OR2OI,OR2PSOI,OR2PHDG
- ..I 'OROIL(OROILI) Q
- ..I +OROIL(OROILI)=OI Q
- ..S OR2OI=+OROIL(OROILI)
- ..S OR2PSOI=+$P($G(^ORD(101.43,+OR2OI,0)),U,2)
- ..S OR2PHDG=$P(OROIL(OROILI),U,2)
- ..S OR2PHDG=$S(OR2PHDG="PSI":"U",OR2PHDG="PSIV":"I",OR2PHDG="PSO":"O",OR2PHDG="PSH":"N",1:"")
- ..Q:OR2PHDG'="I"
- ..I $P($P(OROIL(OROILI),U,3),";")="B",$$PRE^PSSDSAPK(OR2PSOI,OR2PHDG)=0 Q
- ..I $P($P(OROIL(OROILI),U,3),";")="B",$P($P(OROIL(OROILI),U,3),";",2)="",$G(ORREN)=1 D
- ...N ORVOLID,ORVOLVAL S ORVOLVAL="",ORVOLID=$O(^OR(100,+$G(ORIFN),4.5,"ID","VOLUME",""))
- ...I ORVOLID>0 S ORVOLVAL=$G(^OR(100,+$G(ORIFN),4.5,ORVOLID,1))
- ...S OROIL(OROILI)=OROIL(OROILI)_ORVOLVAL
- ..N ORUSID
- ..S ORUSID=$$USID^ORWDXC(OROIL(OROILI))
- ..S ORKAI=ORKAI+1,ORKA(ORKAI)=$P(ORUSID,U,4)_U_$$GETPSNM($P(ORUSID,U,4))
- D:$D(ORKA) CPRS^PSODDPR4(ORDFN,"OROCOUT"_ORPTY,.ORKA,ORPTY_+$G(^OR(100,+$G(ORIFN),4)))
- I +ORSUPPLY D
- .S ORKSOIA(+ORSUPPLY)=$G(ORIFN)
- .D CPRS^PSODDPR8(ORDFN,"OROCOUT"_ORPTY,.ORKSOIA,ORPHDG_";"_+$G(^OR(100,+$G(ORNUM),4)),$S($D(ORKA):1,1:""))
- I $D(ORKA)!($D(ORKSOIA))!(ORIVRAN) D
- .S:OR2CRITF_OR2SIGF_OR2DUPCF["E" ^TMP($J,"ORENHCHK")=1
- .D PROCESS^ORKPS1(OI,ORDFN,ORKDG,+ORSUPPLY_U_+MED,"OROCOUT"_ORPTY)
- Q
- CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG,ORSUPPLY,ORIVTYPE) ; return drug order checks for session
- ;ORSUPPLY: pharmacy orderable item ien [file #50.7] if it resolves to one or more supply items
- ; 0 if the pharmacy orderable item does not resolve to any supply items
- ;ORIVTYPE: the MED type as sent from Infusion Order Dialog
- ; A for additive
- ; B for base
- N ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI,ORPHOI
- N ORKFLG,ORSESS,ORPSPKG,ORPSA,ORSNUM,ORNUM,DUPX,DUPORN,ORPTY
- N ORKSOIA,ORRET,ORDFN,ORPHDG S ORDFN=DFN
- S ORPTY=$S($G(ORKDG)="PSI":"I;",$G(ORKDG)="PSIV":"I;",$G(ORKDG)="PSO":"O;",$G(ORKDG)="PSH":"O;",1:"O;")
- S ORPHDG=$S(ORKDG="PSI":"U",ORKDG="PSIV":"I",ORKDG="PSO":"O",ORKDG="PSH":"N",1:"")
- I '$D(^TMP($J,"OROCOUT"_ORPTY)) D
- .S ORKFLG=0
- .S ORNUM=$P(ORKA,"|",5)
- .S ORPHOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
- .I $G(ORIVTYPE)'="A",'$$PRE^PSSDSAPK(ORPHOI,ORPHDG) Q ; Don't do checks if pharmacy does not want us to
- .;get unsigned medication orders:
- .S HOR=0,SEQ=0
- .S HOR=$O(^TMP("ORR",$J,HOR))
- .I +$G(HOR)>0 D
- ..F S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1 D
- ...S ORKORN=+$P(^TMP("ORR",$J,HOR,SEQ),U),DUPORN=0
- ...Q:+$G(ORKORN)<1
- ...Q:+ORKORN=+ORNUM
- ...Q:$P(^OR(100,+ORKORN,8,$P(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC"
- ...Q:$P(^ORD(100.01,$P(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED"
- ...S ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG") ;get disp drug for order
- ...S ORPSPKG=$$DGRX^ORQOR2(+ORKORN)
- ...S:ORPSPKG="CLINIC INFUSIONS" ORPSPKG="IV MEDICATIONS" ; OR*3*430
- ...S ORPSPKG=$S(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDICATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PSH",1:"")
- ...S DUPX="" F S DUPX=$O(ORKDRUGA(DUPX)) Q:'DUPX!(DUPORN=1) D
- ....S:ORKORN=ORKDRUGA(DUPX) DUPORN=1
- ...Q:DUPORN=1 ;quit if already processed drug order
- ...I +$G(ORKDRUG)<1,$L(ORPSPKG)>0 D
- ....N OROI S OROI=$$OI^ORX8(+ORKORN)
- ....S ORRET=$$OI2DD(+OROI,$S($G(ORKDG)="PSI":"I",$G(ORKDG)="PSIV":"I",$G(ORKDG)="PSO":"O",$G(ORKDG)="PSH":"O",1:"O"),1)
- ....I +$P(ORRET,";",4) S ORKSOIA(+$P(ORRET,";",4))=ORKORN
- ....I +ORRET S ORKDRUG=+ORRET
- ...;only process vs. unsigned med order if disp drug is assoc w/order:
- ...Q:+$G(ORKDRUG)<1
- ...I ORPSPKG="PSIV" D
- ....;loop through each OI in the IV order
- ....N OR2I
- ....S OR2I=0 F S OR2I=$O(^OR(100,+ORKORN,4.5,"ID","ORDERABLE",OR2I)) Q:'OR2I D
- .....N OR2OI,OR2DRUG
- .....S OR2OI=$G(^OR(100,+ORKORN,4.5,OR2I,1))
- .....Q:'OR2OI
- .....;get the drug for each OI
- .....S OR2DRUG=$$OI2DD(+OR2OI,"I",1)
- .....;check if drug should be add it and add it if so
- .....I $$IVADD(OR2DRUG,OR2OI) S ORKDRUGA(+OR2DRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN_U_$$GETPSNM(+OR2DRUG)
- ...I ORPSPKG'="PSIV" S ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN_U_$$GETPSNM(+ORKDRUG)
- ...; OR*3*469 - Load all components (solution and additive) of IV for order checking
- ... I ORPSPKG="PSIV" D
- .... N ORX,ORRET S ORX=0 F S ORX=+$O(^OR(100,ORKORN,4.5,"ID","ORDERABLE",ORX)) Q:'ORX D
- ..... S ORRET=$$OI2DD(+$G(^OR(100,ORKORN,4.5,ORX,1)),"I",1) Q:'ORRET
- ..... I +$P(ORRET,";",4) S ORKSOIA(+$P(ORRET,";",4))=ORKORN
- ..... I '$D(ORKDRUGA(+ORRET_";PSIV;"_ORKORN)) S ORKDRUGA(+ORRET_";PSIV;"_ORKORN)=ORKORN_U_$$GETPSNM(+ORRET)
- .... Q ; end of OR*3*469 change
- .N ORPROSP,CNT
- .S CNT=1
- .S:+MED ORPROSP(CNT)=MED_U_$$GETPSNM(+MED)_U_+$G(ORNUM),CNT=CNT+1
- .N I S I="" F S I=$O(ORKDRUGA(I)) Q:'I S ORPROSP(CNT)=+I_U_$P(ORKDRUGA(I),U,2)_U_U_$P(ORKDRUGA(I),U,1),CNT=CNT+1
- .D SHRNKPR
- .D CPRS^PSODDPR4(DFN,"OROCOUT"_ORPTY,.ORPROSP,ORPTY_+$G(^OR(100,+$G(ORNUM),4)))
- .I +ORSUPPLY D
- ..S ORKSOIA(+ORSUPPLY)=$G(ORNUM)
- ..D:$D(ORKSOIA)>9 CPRS^PSODDPR8(DFN,"OROCOUT"_ORPTY,.ORKSOIA,ORPHDG_";"_+$G(^OR(100,+$G(ORNUM),4)),1)
- D PROCESS^ORKPS1(OI,ORDFN,ORKDG,+ORSUPPLY_U_+MED,"OROCOUT"_ORPTY)
- Q
- IVADD(ORDRUG,OROI) ;RETURN YES OR NO IF SHOULD ADD THE IV ITEM
- N ORRET
- ;default is yes to add it, will always be 1 for an additive
- S ORRET=1
- ;check if drug is a base
- K ^TMP($J,"ORBASECHECK")
- D DRGIEN^PSS52P7(ORDRUG,,"ORBASECHECK")
- I $P($G(^TMP($J,"ORBASECHECK",0),0),U)>0 D ;GOT A BASE HERE
- .;if drug is a base, check if pharmacy says we can add it or not
- .N ORPHOI
- .S ORPHOI=+$P($G(^ORD(101.43,+OROI,0)),U,2)
- .S ORRET=$$PRE^PSSDSAPK(ORPHOI,"I")
- K ^TMP($J,"ORBASECHECK")
- Q ORRET
- SHRNKPR ;REMOVE DUPLICATS FROM PROSPECTIVE LIST
- Q:'$D(ORPROSP)
- N ORX,ORI S ORI=0 F S ORI=$O(ORPROSP(ORI)) Q:'ORI S ORX=ORPROSP(ORI) D
- .N ORJ S ORJ=ORI F S ORJ=$O(ORPROSP(ORJ)) Q:'ORJ I ORX=ORPROSP(ORJ) K ORPROSP(ORJ)
- Q
- GETPSNM(ORIEN) ;GET THE FILE 50 .01 FIELD FROM A FILE 50 IEN
- N RET K ^TMP($J,"ORRETNM")
- D NDF^PSS50(ORIEN,,,,,"ORRETNM") S RET=$G(^TMP($J,"ORRETNM",ORIEN,.01))
- K ^TMP($J,"ORRETNM")
- Q RET
- TAKEMED(ORKDFN,ORKMED) ;extrinsic function returns med orderable item if any
- ;active med patient is taking contains any piece of ORKMED
- ;ORKDFN patient DFN
- ;ORKMED meds to check vs. active med list in format MED1^MED2^MED3...
- Q:'$L($G(ORKDFN)) "0^Patient not identified."
- Q:'$L($G(ORKMED)) "0^Medication not identified."
- N ORKARX,ORKY,ORI,ORJ,ORCNT,ORKMEDP,ORKRSLT
- D LIST^ORQQPS(.ORKY,ORKDFN,"","")
- Q:$P(ORKY(1),U)="" "0^No active meds found."
- S ORKRSLT="0^No matching meds found."
- S ORCNT=$L(ORKMED,U)
- S ORI=0 F S ORI=$O(ORKY(ORI)) Q:ORI<1 D
- .S ORKARX=$P(ORKY(ORI),U,2)
- .F ORJ=1:1:ORCNT S ORKMEDP=$P(ORKMED,U,ORJ) D
- ..I $L(ORKMEDP),($$UP^XLFSTR(ORKARX)[ORKMEDP) S ORKRSLT="1^"_ORKARX ;DJE/VM *316 use uppercase in comparison
- Q ORKRSLT
- POLYRX(DFN) ;extrins funct rtns 1 if patient exceeds polypharmacy, 0 if not
- N ORSLT,ORENT,ORLOC,ORPAR,ORMEDS
- S ORSLT=0
- Q:'$L(DFN) ORSLT
- S VA200="" D OERR^VADPT
- S ORLOC=+$G(^DIC(42,+VAIN(4),44))
- K VA200,VAIN
- S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
- S ORPAR=$$GET^XPAR(ORENT,"ORK POLYPHARMACY",1,"I")
- S ORMEDS=$$NUMRX(DFN)
- I $G(ORMEDS)>$G(ORPAR) S ORSLT=1
- Q ORSLT
- GLCREAT(DFN) ;extrinsic function returns patient's (DFN) most recent serum
- ; creatinine within # of days from parameter ORK GLUCOPHAGE CREATININE
- ; results format: test id^result units flag ref range collect d/t^result
- ; used by order check GLUCOPHAGE-LAB RESULTS
- N ORLOC,ORPAR,ORDAYS
- N BDT,CDT,ORY,ORX,ORZ,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE,SPECIMEN,VAIN,VADM,RSLTS
- Q:'$L(DFN) "0^"
- S ORDAYS=$$GCDAYS(DFN)
- Q:'$L(ORDAYS) "0^"
- D NOW^%DTC
- S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
- K %
- Q:'$L($G(BDT)) "0^"
- S LABFILE=$$TERMLKUP^ORB31(.ORY,"SERUM CREATININE")
- Q:'$D(ORY) "0^" ;no link between SERUM CREATININE and local lab test
- Q:$G(LABFILE)'=60 "0^"
- S SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")
- Q:'$D(ORX) "0^" ;no link between SERUM SPECIMEN and local specimen
- Q:$G(SPECFILE)'=61 "0^"
- F ORI=1:1:ORY D
- .S TEST=$P(ORY(ORI),U)
- .Q:+$G(TEST)<1
- .F ORJ=1:1:ORX D
- ..S SPECIMEN=$P(ORX(ORJ),U)
- ..Q:+$G(SPECIMEN)<1
- ..S ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)
- ..Q:'$L($G(ORZ))
- ..S CDT=$P(ORZ,U,7)
- ..I CDT'<BDT S RSLTS(CDT)=ORZ,CREARSLT=1 ;*SMT Use RSLTS as array.
- Q:+$G(CREARSLT)<1 "0^"
- S CDT=$O(RSLTS(0)),ORZ=RSLTS(CDT) ;*SMT
- 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)
- GCDAYS(DFN) ;extrinsic function to return number of days to look for
- ; glucophage serum creatinine result
- Q:'$L(DFN) ""
- N ORLOC,ORENT,ORDAYS
- ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
- ;reliably determined, and many simultaneous outpt locations can occur):
- S VA200="" D OERR^VADPT
- S ORLOC=+$G(^DIC(42,+VAIN(4),44))
- K VA200,VAIN
- S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
- S ORDAYS=$$GET^XPAR(ORENT,"ORK GLUCOPHAGE CREATININE",1,"I")
- Q:$L(ORDAYS) ORDAYS
- Q ""
- SUPPLY(OI) ;extrinsic function returns 1 (true) if the orderable item is
- ; a supply
- Q:+$G(OI)<1 ""
- N OITEXT
- S OITEXT=$G(^ORD(101.43,OI,0))
- Q:'$L(OITEXT) ""
- S OITEXT=$P(OITEXT,U)
- Q:$D(^ORD(101.43,"S.SPLY",OITEXT)) 1
- Q ""
- NUMRX(DFN) ;extrinsic funct returns number of active meds patient is taking
- N NUMRX,ORPTYPE,ORX,ORY,ORS,ORNUM,ORPRENEW,VADMVT
- S NUMRX=0
- Q:+$G(DFN)<1 NUMRX
- ;check to determine if inpatient or outpatient:
- D ADM^VADPT2
- S ORPTYPE=$S(+$G(VADMVT)>0:"I",1:"O")
- K ^TMP("PS",$J)
- D OCL^PSOORRL(DFN,"","") ;if no date range, returns active meds for pt
- N X
- S X=0
- F S X=$O(^TMP("PS",$J,X)) Q:X<1 D
- .S ORX=$G(^TMP("PS",$J,X,0))
- .S ORY=$P(ORX,U)
- .S ORNUM=$P(ORX,U,8) ;order entry order number
- .S ORS=$P(ORX,U,9) ;medication status from pharmacy
- .S ORPRENEW=$P(ORX,U,14) ;pending renewal flag (1: pending renewal)
- .Q:+ORX<1
- .Q:$P(ORY,";",2)'=ORPTYPE ;quit if med is not pt type (inpt/outpt)
- .;quit if status is a non-active type:
- .Q:$G(ORS)="EXPIRED"
- .Q:$G(ORS)["DISCONTINUE"
- .Q:$G(ORS)="DELETED"
- .Q:+$G(ORPRENEW)>0
- .Q:$$SUPPLY($$OI^ORQOR2(ORNUM))=1 ;quit if a supply
- .S NUMRX=NUMRX+1
- K ^TMP("PS",$J)
- Q NUMRX
- OI2DD(OROI,ORPSPKG,ORCHKTYP) ;rtn dispense drugs for a PS OI
- ;ORCHKTYP: TYPE OF ORDER CHECK SYSTEM IS PERFORMING
- ; 1 FOR ENHANCED ORDER CHECKS
- ; 2 FOR DOSAGE ORDER CHECK
- N PSOI,ORRET
- Q:'$D(^ORD(101.43,OROI,0)) ""
- S PSOI=+$P(^ORD(101.43,OROI,0),U,2)
- Q:PSOI<1 ""
- S:ORPSPKG="H" ORPSPKG="X" ;if non-va med need to pass api "X"
- S ORRET=$$DRG^PSSDSAPM(PSOI,ORPSPKG,ORCHKTYP)
- I ORCHKTYP=1,(+$P(ORRET,";",4)) S $P(ORRET,";",4)=PSOI
- Q ORRET
- GLEGFR(DFN) ;extrinsic function returns patient's (DFN) most recent eGFR
- ; within # of days from parameter ORK METFORMIN EGFR
- ; results format: test id^result units flag ref range collect d/t^result
- ; used by order check METFORMIN EGFR-LAB RESULTS
- N ORLOC,ORPAR,ORDAYS,ORRSLT
- N BDT,CDT,ORY,ORX,ORX1,ORZ,TEST,ORI,ORJ,EGFRRSLT,LABFILE,SPECFILE,SPECFILE1,SPECIMEN,VAIN,VADM,RSLTS
- Q:'$L(DFN) "0^"
- S ORDAYS=$$GEDAYS(DFN)
- Q:'$L(ORDAYS) "0^"
- D NOW^%DTC
- S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
- K %
- Q:'$L($G(BDT)) "0^"
- S LABFILE=$$TERMLKUP^ORB31(.ORY,"EGFR")
- Q:'$D(ORY) "0^" ;no link between EGFR and local lab test
- Q:$G(LABFILE)'=60 "0^"
- S SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")
- S SPECFILE1=$$TERMLKUP^ORB31(.ORX1,"PLASMA SPECIMEN")
- I $D(ORX1) D
- .N CNT,I
- .S CNT=+$O(ORX(""),-1)
- .S I=0 F S I=$O(ORX1(I)) Q:I="" D
- ..S CNT=CNT+1
- ..S ORX(CNT)=$G(ORX1)
- Q:'$D(ORX) "0^" ;no link between SERUM SPECIMEN/PLASMA SPECIMEN and local specimen
- Q:(($G(SPECFILE)'=61)&($G(SPECFILE1)'=61)) "0^"
- F ORI=1:1:ORY D
- .S TEST=$P(ORY(ORI),U)
- .Q:+$G(TEST)<1
- .F ORJ=1:1:ORX D
- ..S SPECIMEN=$P(ORX(ORJ),U)
- ..Q:+$G(SPECIMEN)<1
- ..S ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)
- ..Q:'$L($G(ORZ))
- ..S CDT=$P(ORZ,U,7)
- ..I CDT'<BDT S RSLTS(CDT)=ORZ,EGFRRSLT=1 ;*SMT Use RSLTS as array.
- Q:+$G(EGFRRSLT)<1 "0^"
- S CDT=$O(RSLTS(0)),ORZ=RSLTS(CDT) ;*SMT
- S ORRSLT=$P(ORZ,U,3) I $L(+ORRSLT)'=$L(ORRSLT) S ORRSLT=$$RSLTCALC(ORRSLT)
- 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_ORRSLT
- GEDAYS(DFN) ;extrinsic function to return number of days to look for
- ; Metformin eGFR result
- Q:'$L(DFN) ""
- N ORLOC,ORENT,ORDAYS
- ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
- ;reliably determined, and many simultaneous outpt locations can occur):
- S VA200="" D OERR^VADPT
- S ORLOC=+$G(^DIC(42,+VAIN(4),44))
- K VA200,VAIN
- S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"
- S ORDAYS=$$GET^XPAR(ORENT,"ORK METFORMIN EGFR",1,"I")
- Q:$L(ORDAYS) ORDAYS
- Q ""
- RSLTCALC(ORRSLT) ;Recalculate results
- N RMVCHAR
- S RMVCHAR="ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()_-+~?/:;""'{[}]|\<>=` "
- I (ORRSLT["NOT GREATER THAN"!(ORRSLT["NOT LESS THAN")!(ORRSLT["EQUAL")!(ORRSLT["=")!(ORRSLT["'>")!(ORRSLT["'<")) D Q ORRSLT
- . S ORRSLT=+$TR(ORRSLT,RMVCHAR)
- I (ORRSLT["GREATER"!(ORRSLT[">")) D Q ORRSLT
- . S ORRSLT=+$TR(ORRSLT,RMVCHAR)+.00001
- I (ORRSLT["LESS"!(ORRSLT["<")) D Q ORRSLT
- . S ORRSLT=+$TR(ORRSLT,RMVCHAR)-.00001
- Q +$TR(ORRSLT,RMVCHAR)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKPS 16177 printed Jan 18, 2025@03:32:19 Page 2
- ORKPS ; SLC/CLA - Order checking support procedures for medications ;Oct 27, 2023@10:53:17
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,316,272,346,345,382,469,535**;Dec 17, 1997;Build 20
- +2 ;Reference to CPRS^PSODDPR4 in ICR #5366
- +3 ;Reference to CPRS^PSODDPR8 in ICR #5784
- +4 ;Reference to OCL^PSOORRL in ICR #2400
- +5 ;Reference to $$PRE^PSSDSAPK in ICR #5497
- +6 ;Reference to $$DRG^PSSDSAPM in ICR #5570
- +7 ;Reference to ADM^VADPT2 in ICR #325
- +8 ;Reference to ^DIC(42 in ICR #10039 (Field 44)
- +9 ;Reference to NOW^%DTC in ICR #10000
- +10 ;Reference to NDF^PSS50 in ICR #4533
- +11 ;Reference to DRGIEN^PSS52P7 in ICR #4550
- +12 ;Reference to OERR^VADPT in ICR #10061
- +13 ;Reference to ADM^VADPT2 in ICR #325
- +14 ;Reference to $$FMADD^XLFDT,$$FMTE^XLFDT in ICR #10103
- +15 ;Reference to $$UP^XLFSTR in ICR #10104
- +16 ;Reference to $$GET^XPAR in ICR #2263
- +17 ;
- +18 QUIT
- CHECK(YY,DFN,MED,OI,ORKDG,OROIL,ORSUPPLY,ORIVTYPE,ORIVRAN,ORDODSG) ; return drug order checks
- +1 ;YY: returned array of data
- +2 ;DFN: patient id
- +3 ;MED: drug ien [file #50] ^ generic name [file #50]
- +4 ;OI: orderable item ien [file #101.43]
- +5 ;ORKDG: display group (should be PSI, PSIV, PSO or PSH)
- +6 ;OROIL: list of items ordered
- +7 ;ORSUPPLY: pharmacy orderable item ien [file #50.7] if it resolves to one or more supply items
- +8 ; 0 if the pharmacy orderable item does not resolve to any supply items
- +9 ;ORIVTYPE: the MED type as sent from Infusion Order Dialog
- +10 ; A for additive
- +11 ; B for base
- +12 ;ORIVRAN: FLAG THAT DENOTES IF ALL COMPONENTS OF INFUSION ORDER HAVE ALREADY BEEN PROCESSED
- +13 ; 1 FOR ALREADY PROCESSED
- +14 ; EMPTY STRING FOR NOT YET PROCESSED
- +15 ;ORDODSG: FLAG THAT DENOTES IF DOSAGE CHECKS SHOULD BE PERFORMED
- +16 ; 1 FOR PERFORM DOSAGE CHECKS
- +17 ; 0 FOR DO NOT PERFORM DOSAGE CHECKS
- +18 ; returned info: varies for ^TMP($J x-ref - refer to listings below
- +19 NEW OR2CRITN,OR2CRITF,OR2CRITD,OR2SIGN,OR2SIGF,OR2SIGD,OR2DUPN,OR2DUPF,OR2DUPD,OR2DUPCN,OR2DUPCF,OR2DUPCD
- +20 NEW ORPHDG,ORKSOIA,ORDOCHKS
- +21 DO PARAMS^ORKCHK6("CRITICAL DRUG INTERACTION",.OR2CRITN,.OR2CRITF,.OR2CRITD)
- +22 DO PARAMS^ORKCHK6("SIGNIFICANT DRUG INTERACTION",.OR2SIGN,.OR2SIGF,.OR2SIGD)
- +23 DO PARAMS^ORKCHK6("DUPLICATE DRUG THERAPY",.OR2DUPCN,.OR2DUPCF,.OR2DUPCD)
- +24 NEW ORDFN,ORKA,ORPTY,ORPHOI,OROILI,ORKAI
- SET ORDFN=DFN
- +25 SET ORPHOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
- +26 SET ORPTY=$SELECT($GET(ORKDG)="PSI":"I;",$GET(ORKDG)="PSIV":"I;",$GET(ORKDG)="PSO":"O;",$GET(ORKDG)="PSH":"O;",1:"O;")
- +27 SET ORPHDG=$SELECT(ORKDG="PSI":"U",ORKDG="PSIV":"I",ORKDG="PSO":"O",ORKDG="PSH":"N",1:"")
- +28 ; Don't do checks if pharmacy does not want us to
- IF $GET(ORIVTYPE)'="A"
- Begin DoDot:1
- +29 SET ORDOCHKS=$$PRE^PSSDSAPK(ORPHOI,ORPHDG)
- +30 if 'ORDODSG
- SET ORDODSG=ORDOCHKS
- End DoDot:1
- if 'ORDOCHKS
- QUIT
- +31 if $GET(ORIVTYPE)="A"
- SET ORDODSG=1
- +32 IF +MED
- IF ('ORIVRAN)
- SET ORKA(1)=MED_U_$$GETPSNM(+MED)
- SET ORKAI=1
- +33 ;ADD ALL COMPONENTS OF IV ORDER SO WE ONLY HAVE TO DO A SINGLE PRE CALL
- +34 IF ORKDG="PSIV"
- IF ('ORIVRAN)
- Begin DoDot:1
- +35 SET ORIVRAN=1
- SET OROILI=0
- FOR
- SET OROILI=$ORDER(OROIL(OROILI))
- if 'OROILI
- QUIT
- Begin DoDot:2
- +36 NEW OR2OI,OR2PSOI,OR2PHDG
- +37 IF 'OROIL(OROILI)
- QUIT
- +38 IF +OROIL(OROILI)=OI
- QUIT
- +39 SET OR2OI=+OROIL(OROILI)
- +40 SET OR2PSOI=+$PIECE($GET(^ORD(101.43,+OR2OI,0)),U,2)
- +41 SET OR2PHDG=$PIECE(OROIL(OROILI),U,2)
- +42 SET OR2PHDG=$SELECT(OR2PHDG="PSI":"U",OR2PHDG="PSIV":"I",OR2PHDG="PSO":"O",OR2PHDG="PSH":"N",1:"")
- +43 if OR2PHDG'="I"
- QUIT
- +44 IF $PIECE($PIECE(OROIL(OROILI),U,3),";")="B"
- IF $$PRE^PSSDSAPK(OR2PSOI,OR2PHDG)=0
- QUIT
- +45 IF $PIECE($PIECE(OROIL(OROILI),U,3),";")="B"
- IF $PIECE($PIECE(OROIL(OROILI),U,3),";",2)=""
- IF $GET(ORREN)=1
- Begin DoDot:3
- +46 NEW ORVOLID,ORVOLVAL
- SET ORVOLVAL=""
- SET ORVOLID=$ORDER(^OR(100,+$GET(ORIFN),4.5,"ID","VOLUME",""))
- +47 IF ORVOLID>0
- SET ORVOLVAL=$GET(^OR(100,+$GET(ORIFN),4.5,ORVOLID,1))
- +48 SET OROIL(OROILI)=OROIL(OROILI)_ORVOLVAL
- End DoDot:3
- +49 NEW ORUSID
- +50 SET ORUSID=$$USID^ORWDXC(OROIL(OROILI))
- +51 SET ORKAI=ORKAI+1
- SET ORKA(ORKAI)=$PIECE(ORUSID,U,4)_U_$$GETPSNM($PIECE(ORUSID,U,4))
- End DoDot:2
- End DoDot:1
- +52 if $DATA(ORKA)
- DO CPRS^PSODDPR4(ORDFN,"OROCOUT"_ORPTY,.ORKA,ORPTY_+$GET(^OR(100,+$GET(ORIFN),4)))
- +53 IF +ORSUPPLY
- Begin DoDot:1
- +54 SET ORKSOIA(+ORSUPPLY)=$GET(ORIFN)
- +55 DO CPRS^PSODDPR8(ORDFN,"OROCOUT"_ORPTY,.ORKSOIA,ORPHDG_";"_+$GET(^OR(100,+$GET(ORNUM),4)),$SELECT($DATA(ORKA):1,1:""))
- End DoDot:1
- +56 IF $DATA(ORKA)!($DATA(ORKSOIA))!(ORIVRAN)
- Begin DoDot:1
- +57 if OR2CRITF_OR2SIGF_OR2DUPCF["E"
- SET ^TMP($JOB,"ORENHCHK")=1
- +58 DO PROCESS^ORKPS1(OI,ORDFN,ORKDG,+ORSUPPLY_U_+MED,"OROCOUT"_ORPTY)
- End DoDot:1
- +59 QUIT
- CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG,ORSUPPLY,ORIVTYPE) ; return drug order checks for session
- +1 ;ORSUPPLY: pharmacy orderable item ien [file #50.7] if it resolves to one or more supply items
- +2 ; 0 if the pharmacy orderable item does not resolve to any supply items
- +3 ;ORIVTYPE: the MED type as sent from Infusion Order Dialog
- +4 ; A for additive
- +5 ; B for base
- +6 NEW ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI,ORPHOI
- +7 NEW ORKFLG,ORSESS,ORPSPKG,ORPSA,ORSNUM,ORNUM,DUPX,DUPORN,ORPTY
- +8 NEW ORKSOIA,ORRET,ORDFN,ORPHDG
- SET ORDFN=DFN
- +9 SET ORPTY=$SELECT($GET(ORKDG)="PSI":"I;",$GET(ORKDG)="PSIV":"I;",$GET(ORKDG)="PSO":"O;",$GET(ORKDG)="PSH":"O;",1:"O;")
- +10 SET ORPHDG=$SELECT(ORKDG="PSI":"U",ORKDG="PSIV":"I",ORKDG="PSO":"O",ORKDG="PSH":"N",1:"")
- +11 IF '$DATA(^TMP($JOB,"OROCOUT"_ORPTY))
- Begin DoDot:1
- +12 SET ORKFLG=0
- +13 SET ORNUM=$PIECE(ORKA,"|",5)
- +14 SET ORPHOI=+$PIECE($GET(^ORD(101.43,+OI,0)),U,2)
- +15 ; Don't do checks if pharmacy does not want us to
- IF $GET(ORIVTYPE)'="A"
- IF '$$PRE^PSSDSAPK(ORPHOI,ORPHDG)
- QUIT
- +16 ;get unsigned medication orders:
- +17 SET HOR=0
- SET SEQ=0
- +18 SET HOR=$ORDER(^TMP("ORR",$JOB,HOR))
- +19 IF +$GET(HOR)>0
- Begin DoDot:2
- +20 FOR
- SET SEQ=$ORDER(^TMP("ORR",$JOB,HOR,SEQ))
- if +SEQ<1
- QUIT
- Begin DoDot:3
- +21 SET ORKORN=+$PIECE(^TMP("ORR",$JOB,HOR,SEQ),U)
- SET DUPORN=0
- +22 if +$GET(ORKORN)<1
- QUIT
- +23 if +ORKORN=+ORNUM
- QUIT
- +24 if $PIECE(^OR(100,+ORKORN,8,$PIECE(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC"
- QUIT
- +25 if $PIECE(^ORD(100.01,$PIECE(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED"
- QUIT
- +26 ;get disp drug for order
- SET ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG")
- +27 SET ORPSPKG=$$DGRX^ORQOR2(+ORKORN)
- +28 ; OR*3*430
- if ORPSPKG="CLINIC INFUSIONS"
- SET ORPSPKG="IV MEDICATIONS"
- +29 SET ORPSPKG=$SELECT(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDICATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PSH",1:"")
- +30 SET DUPX=""
- FOR
- SET DUPX=$ORDER(ORKDRUGA(DUPX))
- if 'DUPX!(DUPORN=1)
- QUIT
- Begin DoDot:4
- +31 if ORKORN=ORKDRUGA(DUPX)
- SET DUPORN=1
- End DoDot:4
- +32 ;quit if already processed drug order
- if DUPORN=1
- QUIT
- +33 IF +$GET(ORKDRUG)<1
- IF $LENGTH(ORPSPKG)>0
- Begin DoDot:4
- +34 NEW OROI
- SET OROI=$$OI^ORX8(+ORKORN)
- +35 SET ORRET=$$OI2DD(+OROI,$SELECT($GET(ORKDG)="PSI":"I",$GET(ORKDG)="PSIV":"I",$GET(ORKDG)="PSO":"O",$GET(ORKDG)="PSH":"O",1:"O"),1)
- +36 IF +$PIECE(ORRET,";",4)
- SET ORKSOIA(+$PIECE(ORRET,";",4))=ORKORN
- +37 IF +ORRET
- SET ORKDRUG=+ORRET
- End DoDot:4
- +38 ;only process vs. unsigned med order if disp drug is assoc w/order:
- +39 if +$GET(ORKDRUG)<1
- QUIT
- +40 IF ORPSPKG="PSIV"
- Begin DoDot:4
- +41 ;loop through each OI in the IV order
- +42 NEW OR2I
- +43 SET OR2I=0
- FOR
- SET OR2I=$ORDER(^OR(100,+ORKORN,4.5,"ID","ORDERABLE",OR2I))
- if 'OR2I
- QUIT
- Begin DoDot:5
- +44 NEW OR2OI,OR2DRUG
- +45 SET OR2OI=$GET(^OR(100,+ORKORN,4.5,OR2I,1))
- +46 if 'OR2OI
- QUIT
- +47 ;get the drug for each OI
- +48 SET OR2DRUG=$$OI2DD(+OR2OI,"I",1)
- +49 ;check if drug should be add it and add it if so
- +50 IF $$IVADD(OR2DRUG,OR2OI)
- SET ORKDRUGA(+OR2DRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN_U_$$GETPSNM(+OR2DRUG)
- End DoDot:5
- End DoDot:4
- +51 IF ORPSPKG'="PSIV"
- SET ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN_U_$$GETPSNM(+ORKDRUG)
- +52 ; OR*3*469 - Load all components (solution and additive) of IV for order checking
- +53 IF ORPSPKG="PSIV"
- Begin DoDot:4
- +54 NEW ORX,ORRET
- SET ORX=0
- FOR
- SET ORX=+$ORDER(^OR(100,ORKORN,4.5,"ID","ORDERABLE",ORX))
- if 'ORX
- QUIT
- Begin DoDot:5
- +55 SET ORRET=$$OI2DD(+$GET(^OR(100,ORKORN,4.5,ORX,1)),"I",1)
- if 'ORRET
- QUIT
- +56 IF +$PIECE(ORRET,";",4)
- SET ORKSOIA(+$PIECE(ORRET,";",4))=ORKORN
- +57 IF '$DATA(ORKDRUGA(+ORRET_";PSIV;"_ORKORN))
- SET ORKDRUGA(+ORRET_";PSIV;"_ORKORN)=ORKORN_U_$$GETPSNM(+ORRET)
- End DoDot:5
- +58 ; end of OR*3*469 change
- QUIT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +59 NEW ORPROSP,CNT
- +60 SET CNT=1
- +61 if +MED
- SET ORPROSP(CNT)=MED_U_$$GETPSNM(+MED)_U_+$GET(ORNUM)
- SET CNT=CNT+1
- +62 NEW I
- SET I=""
- FOR
- SET I=$ORDER(ORKDRUGA(I))
- if 'I
- QUIT
- SET ORPROSP(CNT)=+I_U_$PIECE(ORKDRUGA(I),U,2)_U_U_$PIECE(ORKDRUGA(I),U,1)
- SET CNT=CNT+1
- +63 DO SHRNKPR
- +64 DO CPRS^PSODDPR4(DFN,"OROCOUT"_ORPTY,.ORPROSP,ORPTY_+$GET(^OR(100,+$GET(ORNUM),4)))
- +65 IF +ORSUPPLY
- Begin DoDot:2
- +66 SET ORKSOIA(+ORSUPPLY)=$GET(ORNUM)
- +67 if $DATA(ORKSOIA)>9
- DO CPRS^PSODDPR8(DFN,"OROCOUT"_ORPTY,.ORKSOIA,ORPHDG_";"_+$GET(^OR(100,+$GET(ORNUM),4)),1)
- End DoDot:2
- End DoDot:1
- +68 DO PROCESS^ORKPS1(OI,ORDFN,ORKDG,+ORSUPPLY_U_+MED,"OROCOUT"_ORPTY)
- +69 QUIT
- IVADD(ORDRUG,OROI) ;RETURN YES OR NO IF SHOULD ADD THE IV ITEM
- +1 NEW ORRET
- +2 ;default is yes to add it, will always be 1 for an additive
- +3 SET ORRET=1
- +4 ;check if drug is a base
- +5 KILL ^TMP($JOB,"ORBASECHECK")
- +6 DO DRGIEN^PSS52P7(ORDRUG,,"ORBASECHECK")
- +7 ;GOT A BASE HERE
- IF $PIECE($GET(^TMP($JOB,"ORBASECHECK",0),0),U)>0
- Begin DoDot:1
- +8 ;if drug is a base, check if pharmacy says we can add it or not
- +9 NEW ORPHOI
- +10 SET ORPHOI=+$PIECE($GET(^ORD(101.43,+OROI,0)),U,2)
- +11 SET ORRET=$$PRE^PSSDSAPK(ORPHOI,"I")
- End DoDot:1
- +12 KILL ^TMP($JOB,"ORBASECHECK")
- +13 QUIT ORRET
- SHRNKPR ;REMOVE DUPLICATS FROM PROSPECTIVE LIST
- +1 if '$DATA(ORPROSP)
- QUIT
- +2 NEW ORX,ORI
- SET ORI=0
- FOR
- SET ORI=$ORDER(ORPROSP(ORI))
- if 'ORI
- QUIT
- SET ORX=ORPROSP(ORI)
- Begin DoDot:1
- +3 NEW ORJ
- SET ORJ=ORI
- FOR
- SET ORJ=$ORDER(ORPROSP(ORJ))
- if 'ORJ
- QUIT
- IF ORX=ORPROSP(ORJ)
- KILL ORPROSP(ORJ)
- End DoDot:1
- +4 QUIT
- GETPSNM(ORIEN) ;GET THE FILE 50 .01 FIELD FROM A FILE 50 IEN
- +1 NEW RET
- KILL ^TMP($JOB,"ORRETNM")
- +2 DO NDF^PSS50(ORIEN,,,,,"ORRETNM")
- SET RET=$GET(^TMP($JOB,"ORRETNM",ORIEN,.01))
- +3 KILL ^TMP($JOB,"ORRETNM")
- +4 QUIT RET
- TAKEMED(ORKDFN,ORKMED) ;extrinsic function returns med orderable item if any
- +1 ;active med patient is taking contains any piece of ORKMED
- +2 ;ORKDFN patient DFN
- +3 ;ORKMED meds to check vs. active med list in format MED1^MED2^MED3...
- +4 if '$LENGTH($GET(ORKDFN))
- QUIT "0^Patient not identified."
- +5 if '$LENGTH($GET(ORKMED))
- QUIT "0^Medication not identified."
- +6 NEW ORKARX,ORKY,ORI,ORJ,ORCNT,ORKMEDP,ORKRSLT
- +7 DO LIST^ORQQPS(.ORKY,ORKDFN,"","")
- +8 if $PIECE(ORKY(1),U)=""
- QUIT "0^No active meds found."
- +9 SET ORKRSLT="0^No matching meds found."
- +10 SET ORCNT=$LENGTH(ORKMED,U)
- +11 SET ORI=0
- FOR
- SET ORI=$ORDER(ORKY(ORI))
- if ORI<1
- QUIT
- Begin DoDot:1
- +12 SET ORKARX=$PIECE(ORKY(ORI),U,2)
- +13 FOR ORJ=1:1:ORCNT
- SET ORKMEDP=$PIECE(ORKMED,U,ORJ)
- Begin DoDot:2
- +14 ;DJE/VM *316 use uppercase in comparison
- IF $LENGTH(ORKMEDP)
- IF ($$UP^XLFSTR(ORKARX)[ORKMEDP)
- SET ORKRSLT="1^"_ORKARX
- End DoDot:2
- End DoDot:1
- +15 QUIT ORKRSLT
- POLYRX(DFN) ;extrins funct rtns 1 if patient exceeds polypharmacy, 0 if not
- +1 NEW ORSLT,ORENT,ORLOC,ORPAR,ORMEDS
- +2 SET ORSLT=0
- +3 if '$LENGTH(DFN)
- QUIT ORSLT
- +4 SET VA200=""
- DO OERR^VADPT
- +5 SET ORLOC=+$GET(^DIC(42,+VAIN(4),44))
- +6 KILL VA200,VAIN
- +7 SET ORENT=+$GET(ORLOC)_";SC(^DIV^SYS^PKG"
- +8 SET ORPAR=$$GET^XPAR(ORENT,"ORK POLYPHARMACY",1,"I")
- +9 SET ORMEDS=$$NUMRX(DFN)
- +10 IF $GET(ORMEDS)>$GET(ORPAR)
- SET ORSLT=1
- +11 QUIT ORSLT
- GLCREAT(DFN) ;extrinsic function returns patient's (DFN) most recent serum
- +1 ; creatinine within # of days from parameter ORK GLUCOPHAGE CREATININE
- +2 ; results format: test id^result units flag ref range collect d/t^result
- +3 ; used by order check GLUCOPHAGE-LAB RESULTS
- +4 NEW ORLOC,ORPAR,ORDAYS
- +5 NEW BDT,CDT,ORY,ORX,ORZ,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE,SPECIMEN,VAIN,VADM,RSLTS
- +6 if '$LENGTH(DFN)
- QUIT "0^"
- +7 SET ORDAYS=$$GCDAYS(DFN)
- +8 if '$LENGTH(ORDAYS)
- QUIT "0^"
- +9 DO NOW^%DTC
- +10 SET BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
- +11 KILL %
- +12 if '$LENGTH($GET(BDT))
- QUIT "0^"
- +13 SET LABFILE=$$TERMLKUP^ORB31(.ORY,"SERUM CREATININE")
- +14 ;no link between SERUM CREATININE and local lab test
- if '$DATA(ORY)
- QUIT "0^"
- +15 if $GET(LABFILE)'=60
- QUIT "0^"
- +16 SET SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")
- +17 ;no link between SERUM SPECIMEN and local specimen
- if '$DATA(ORX)
- QUIT "0^"
- +18 if $GET(SPECFILE)'=61
- QUIT "0^"
- +19 FOR ORI=1:1:ORY
- Begin DoDot:1
- +20 SET TEST=$PIECE(ORY(ORI),U)
- +21 if +$GET(TEST)<1
- QUIT
- +22 FOR ORJ=1:1:ORX
- Begin DoDot:2
- +23 SET SPECIMEN=$PIECE(ORX(ORJ),U)
- +24 if +$GET(SPECIMEN)<1
- QUIT
- +25 SET ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)
- +26 if '$LENGTH($GET(ORZ))
- QUIT
- +27 SET CDT=$PIECE(ORZ,U,7)
- +28 ;*SMT Use RSLTS as array.
- IF CDT'<BDT
- SET RSLTS(CDT)=ORZ
- SET CREARSLT=1
- End DoDot:2
- End DoDot:1
- +29 if +$GET(CREARSLT)<1
- QUIT "0^"
- +30 ;*SMT
- SET CDT=$ORDER(RSLTS(0))
- SET ORZ=RSLTS(CDT)
- +31 QUIT $PIECE(ORZ,U)_U_$PIECE(ORZ,U,3)_" "_$PIECE(ORZ,U,4)_" "_$PIECE(ORZ,U,5)_" ("_$PIECE(ORZ,U,6)_") "_$$FMTE^XLFDT(CDT,"2P")_U_$PIECE(ORZ,U,3)
- GCDAYS(DFN) ;extrinsic function to return number of days to look for
- +1 ; glucophage serum creatinine result
- +2 if '$LENGTH(DFN)
- QUIT ""
- +3 NEW ORLOC,ORENT,ORDAYS
- +4 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
- +5 ;reliably determined, and many simultaneous outpt locations can occur):
- +6 SET VA200=""
- DO OERR^VADPT
- +7 SET ORLOC=+$GET(^DIC(42,+VAIN(4),44))
- +8 KILL VA200,VAIN
- +9 SET ORENT=+$GET(ORLOC)_";SC(^DIV^SYS^PKG"
- +10 SET ORDAYS=$$GET^XPAR(ORENT,"ORK GLUCOPHAGE CREATININE",1,"I")
- +11 if $LENGTH(ORDAYS)
- QUIT ORDAYS
- +12 QUIT ""
- SUPPLY(OI) ;extrinsic function returns 1 (true) if the orderable item is
- +1 ; a supply
- +2 if +$GET(OI)<1
- QUIT ""
- +3 NEW OITEXT
- +4 SET OITEXT=$GET(^ORD(101.43,OI,0))
- +5 if '$LENGTH(OITEXT)
- QUIT ""
- +6 SET OITEXT=$PIECE(OITEXT,U)
- +7 if $DATA(^ORD(101.43,"S.SPLY",OITEXT))
- QUIT 1
- +8 QUIT ""
- NUMRX(DFN) ;extrinsic funct returns number of active meds patient is taking
- +1 NEW NUMRX,ORPTYPE,ORX,ORY,ORS,ORNUM,ORPRENEW,VADMVT
- +2 SET NUMRX=0
- +3 if +$GET(DFN)<1
- QUIT NUMRX
- +4 ;check to determine if inpatient or outpatient:
- +5 DO ADM^VADPT2
- +6 SET ORPTYPE=$SELECT(+$GET(VADMVT)>0:"I",1:"O")
- +7 KILL ^TMP("PS",$JOB)
- +8 ;if no date range, returns active meds for pt
- DO OCL^PSOORRL(DFN,"","")
- +9 NEW X
- +10 SET X=0
- +11 FOR
- SET X=$ORDER(^TMP("PS",$JOB,X))
- if X<1
- QUIT
- Begin DoDot:1
- +12 SET ORX=$GET(^TMP("PS",$JOB,X,0))
- +13 SET ORY=$PIECE(ORX,U)
- +14 ;order entry order number
- SET ORNUM=$PIECE(ORX,U,8)
- +15 ;medication status from pharmacy
- SET ORS=$PIECE(ORX,U,9)
- +16 ;pending renewal flag (1: pending renewal)
- SET ORPRENEW=$PIECE(ORX,U,14)
- +17 if +ORX<1
- QUIT
- +18 ;quit if med is not pt type (inpt/outpt)
- if $PIECE(ORY,";",2)'=ORPTYPE
- QUIT
- +19 ;quit if status is a non-active type:
- +20 if $GET(ORS)="EXPIRED"
- QUIT
- +21 if $GET(ORS)["DISCONTINUE"
- QUIT
- +22 if $GET(ORS)="DELETED"
- QUIT
- +23 if +$GET(ORPRENEW)>0
- QUIT
- +24 ;quit if a supply
- if $$SUPPLY($$OI^ORQOR2(ORNUM))=1
- QUIT
- +25 SET NUMRX=NUMRX+1
- End DoDot:1
- +26 KILL ^TMP("PS",$JOB)
- +27 QUIT NUMRX
- OI2DD(OROI,ORPSPKG,ORCHKTYP) ;rtn dispense drugs for a PS OI
- +1 ;ORCHKTYP: TYPE OF ORDER CHECK SYSTEM IS PERFORMING
- +2 ; 1 FOR ENHANCED ORDER CHECKS
- +3 ; 2 FOR DOSAGE ORDER CHECK
- +4 NEW PSOI,ORRET
- +5 if '$DATA(^ORD(101.43,OROI,0))
- QUIT ""
- +6 SET PSOI=+$PIECE(^ORD(101.43,OROI,0),U,2)
- +7 if PSOI<1
- QUIT ""
- +8 ;if non-va med need to pass api "X"
- if ORPSPKG="H"
- SET ORPSPKG="X"
- +9 SET ORRET=$$DRG^PSSDSAPM(PSOI,ORPSPKG,ORCHKTYP)
- +10 IF ORCHKTYP=1
- IF (+$PIECE(ORRET,";",4))
- SET $PIECE(ORRET,";",4)=PSOI
- +11 QUIT ORRET
- GLEGFR(DFN) ;extrinsic function returns patient's (DFN) most recent eGFR
- +1 ; within # of days from parameter ORK METFORMIN EGFR
- +2 ; results format: test id^result units flag ref range collect d/t^result
- +3 ; used by order check METFORMIN EGFR-LAB RESULTS
- +4 NEW ORLOC,ORPAR,ORDAYS,ORRSLT
- +5 NEW BDT,CDT,ORY,ORX,ORX1,ORZ,TEST,ORI,ORJ,EGFRRSLT,LABFILE,SPECFILE,SPECFILE1,SPECIMEN,VAIN,VADM,RSLTS
- +6 if '$LENGTH(DFN)
- QUIT "0^"
- +7 SET ORDAYS=$$GEDAYS(DFN)
- +8 if '$LENGTH(ORDAYS)
- QUIT "0^"
- +9 DO NOW^%DTC
- +10 SET BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
- +11 KILL %
- +12 if '$LENGTH($GET(BDT))
- QUIT "0^"
- +13 SET LABFILE=$$TERMLKUP^ORB31(.ORY,"EGFR")
- +14 ;no link between EGFR and local lab test
- if '$DATA(ORY)
- QUIT "0^"
- +15 if $GET(LABFILE)'=60
- QUIT "0^"
- +16 SET SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")
- +17 SET SPECFILE1=$$TERMLKUP^ORB31(.ORX1,"PLASMA SPECIMEN")
- +18 IF $DATA(ORX1)
- Begin DoDot:1
- +19 NEW CNT,I
- +20 SET CNT=+$ORDER(ORX(""),-1)
- +21 SET I=0
- FOR
- SET I=$ORDER(ORX1(I))
- if I=""
- QUIT
- Begin DoDot:2
- +22 SET CNT=CNT+1
- +23 SET ORX(CNT)=$GET(ORX1)
- End DoDot:2
- End DoDot:1
- +24 ;no link between SERUM SPECIMEN/PLASMA SPECIMEN and local specimen
- if '$DATA(ORX)
- QUIT "0^"
- +25 if (($GET(SPECFILE)'=61)&($GET(SPECFILE1)'=61))
- QUIT "0^"
- +26 FOR ORI=1:1:ORY
- Begin DoDot:1
- +27 SET TEST=$PIECE(ORY(ORI),U)
- +28 if +$GET(TEST)<1
- QUIT
- +29 FOR ORJ=1:1:ORX
- Begin DoDot:2
- +30 SET SPECIMEN=$PIECE(ORX(ORJ),U)
- +31 if +$GET(SPECIMEN)<1
- QUIT
- +32 SET ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)
- +33 if '$LENGTH($GET(ORZ))
- QUIT
- +34 SET CDT=$PIECE(ORZ,U,7)
- +35 ;*SMT Use RSLTS as array.
- IF CDT'<BDT
- SET RSLTS(CDT)=ORZ
- SET EGFRRSLT=1
- End DoDot:2
- End DoDot:1
- +36 if +$GET(EGFRRSLT)<1
- QUIT "0^"
- +37 ;*SMT
- SET CDT=$ORDER(RSLTS(0))
- SET ORZ=RSLTS(CDT)
- +38 SET ORRSLT=$PIECE(ORZ,U,3)
- IF $LENGTH(+ORRSLT)'=$LENGTH(ORRSLT)
- SET ORRSLT=$$RSLTCALC(ORRSLT)
- +39 QUIT $PIECE(ORZ,U)_U_$PIECE(ORZ,U,3)_" "_$PIECE(ORZ,U,4)_" "_$PIECE(ORZ,U,5)_" ("_$PIECE(ORZ,U,6)_") "_$$FMTE^XLFDT(CDT,"2P")_U_ORRSLT
- GEDAYS(DFN) ;extrinsic function to return number of days to look for
- +1 ; Metformin eGFR result
- +2 if '$LENGTH(DFN)
- QUIT ""
- +3 NEW ORLOC,ORENT,ORDAYS
- +4 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
- +5 ;reliably determined, and many simultaneous outpt locations can occur):
- +6 SET VA200=""
- DO OERR^VADPT
- +7 SET ORLOC=+$GET(^DIC(42,+VAIN(4),44))
- +8 KILL VA200,VAIN
- +9 SET ORENT=+$GET(ORLOC)_";SC(^DIV^SYS^PKG"
- +10 SET ORDAYS=$$GET^XPAR(ORENT,"ORK METFORMIN EGFR",1,"I")
- +11 if $LENGTH(ORDAYS)
- QUIT ORDAYS
- +12 QUIT ""
- RSLTCALC(ORRSLT) ;Recalculate results
- +1 NEW RMVCHAR
- +2 SET RMVCHAR="ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()_-+~?/:;""'{[}]|\<>=` "
- +3 IF (ORRSLT["NOT GREATER THAN"!(ORRSLT["NOT LESS THAN")!(ORRSLT["EQUAL")!(ORRSLT["=")!(ORRSLT["'>")!(ORRSLT["'<"))
- Begin DoDot:1
- +4 SET ORRSLT=+$TRANSLATE(ORRSLT,RMVCHAR)
- End DoDot:1
- QUIT ORRSLT
- +5 IF (ORRSLT["GREATER"!(ORRSLT[">"))
- Begin DoDot:1
- +6 SET ORRSLT=+$TRANSLATE(ORRSLT,RMVCHAR)+.00001
- End DoDot:1
- QUIT ORRSLT
- +7 IF (ORRSLT["LESS"!(ORRSLT["<"))
- Begin DoDot:1
- +8 SET ORRSLT=+$TRANSLATE(ORRSLT,RMVCHAR)-.00001
- End DoDot:1
- QUIT ORRSLT
- +9 QUIT +$TRANSLATE(ORRSLT,RMVCHAR)