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

ORKPS.m

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