ORKPS ; slc/CLA - Order checking support procedures for medications ;08-Apr-2013 14:54;DU
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,1010**;Dec 17, 1997;Build 47
;Modified - IHS/MSC/MGH - 08/21/2012 - Upper case for take med for order check
;Modified - IHS/MSC/MGH - 04/05/2013 - Compound drugs check+10
Q
CHECK(YY,DFN,MED,OI,ORKDG) ; return drug order checks
;YY: returned array of data
;DFN: patient id
;MED: drug ien [file #50]
;OI: orderable item ien [file #101.43
;ORKDG: display group (should be PSI, PSIV, PSO or PSH)
; returned info: varies for ^TMP($J x-ref - refer to listings below
N CMP,CMPDR,CDRG,SAVEDFN
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
N ORDFN S ORDFN=DFN
;IHS/MSC/MGH Find compound meds for order checking
S CMP=$P($G(^PSDRUG(MED,999999935)),U,1)
I CMP=1 D
.S CMPDR=0
.F S CMPDR=$O(^PSDRUG(MED,999999936,CMPDR)) Q:'+CMPDR D
..S CDRG=$P($G(^PSDRUG(MED,999999936,CMPDR,0)),U,1)
..S SAVEDFN=DFN
..D EN^PSOORDRG(DFN,CDRG)
..D PROCESS^ORKPS1(OI,ORDFN,ORKDG)
..S DFN=SAVEDFN
..;end IHS mod
E D
.D EN^PSOORDRG(DFN,MED)
.D PROCESS^ORKPS1(OI,ORDFN,ORKDG)
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
Q
CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG) ; return drug order checks for session
N ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI
N ORKFLG,ORSESS,ORPSPKG,ORPSA,ORKDD,ORSNUM,ORNUM,DUPX,DUPORN
N ORDFN S ORDFN=DFN
S ORKFLG=0
S ORNUM=$P(ORKA,"|",5)
;
;get other session med orders:
I $D(^TMP("ORKA",$J)) D
.S CNT=^TMP("ORKA",$J) F CNTX=1:1:CNT D
..S ORSESS=$G(^TMP("ORKA",$J,CNTX))
..Q:'$L(ORSESS)
..S ORPSPKG=$P(ORSESS,"|",2)
..Q:'$L(ORPSPKG)
..Q:$E(ORPSPKG,1,2)'="PS"
..S ORSNUM=$P(ORSESS,"|",5)
..S ORKOI=$P(ORSESS,"|")
..;quit if same order/oi:
..Q:((+$G(ORNUM)=+$G(ORSNUM))&(+$G(OI)=+$G(ORKOI)))
..S:ORPSPKG="PSJ" ORPSPKG="PSI"
..S ORKDRUG=$P($P(ORSESS,"|",3),U,4)
..;
..;if no disp drug selected get disp drug(s) from OI:
..I +$G(ORKDRUG)<1,$L(ORKOI) D
...I "IOH"[$E(ORPSPKG,3) D OI2DD(.ORPSA,ORKOI,$E(ORPSPKG,3)) D
....S ORKDD=0 F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
.....S ORKDRUG=+ORKDD
.....S:+$G(ORKDRUG)>0 ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM
...K ORPSA ;need to clean out between calls to OI2DD
..;
..Q:+$G(ORKDRUG)<1
..;if dispense drug selected add to array:
..S ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM
;
;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
..;only process vs. unsigned med order if disp drug is assoc w/order:
..Q:+$G(ORKDRUG)<1
..S ORPSPKG=$$DGRX^ORQOR2(+ORKORN)
..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
..S ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN
;
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
I $D(ORKDRUGA) D DRGCHK^PSOORDRG(DFN,MED,.ORKDRUGA)
;I '$D(ORKDRUGA) D EN^PSOORDRG(DFN,MED)
D PROCESS^ORKPS1(OI,ORDFN,ORKDG)
K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")
Q
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)
.;IHS/MSC/MGH Make it uppercase
.S ORKARX=$$UP^XLFSTR(ORKARX)
.F ORJ=1:1:ORCNT S ORKMEDP=$P(ORKMED,U,ORJ) D
..I $L(ORKMEDP),(ORKARX[ORKMEDP) S ORKRSLT="1^"_ORKARX
Q ORKRSLT
SOLUT(OI) ;extrinsic function returns 1 (true) if the orderable item is
; a solution (IV Base)
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.IVB RX",OITEXT)) 1
Q ""
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
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 I +$G(CREARSLT)<1 D
.S TEST=$P(ORY(ORI),U)
.Q:+$G(TEST)<1
.F ORJ=1:1:ORX I +$G(CREARSLT)<1 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 CREARSLT=1
Q:+$G(CREARSLT)<1 "0^"
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
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(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
N PSOI
Q:'$D(^ORD(101.43,OROI,0))
S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
Q:+$G(PSOI)<1
S:ORPSPKG="H" ORPSPKG="X" ;if non-va med need to pass api "X"
D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
Q
ORKPS ; slc/CLA - Order checking support procedures for medications ;08-Apr-2013 14:54;DU
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,1010**;Dec 17, 1997;Build 47
+2 ;Modified - IHS/MSC/MGH - 08/21/2012 - Upper case for take med for order check
+3 ;Modified - IHS/MSC/MGH - 04/05/2013 - Compound drugs check+10
+4 QUIT
CHECK(YY,DFN,MED,OI,ORKDG) ; return drug order checks
+1 ;YY: returned array of data
+2 ;DFN: patient id
+3 ;MED: drug ien [file #50]
+4 ;OI: orderable item ien [file #101.43
+5 ;ORKDG: display group (should be PSI, PSIV, PSO or PSH)
+6 ; returned info: varies for ^TMP($J x-ref - refer to listings below
+7 NEW CMP,CMPDR,CDRG,SAVEDFN
+8 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")
+9 NEW ORDFN
SET ORDFN=DFN
+10 ;IHS/MSC/MGH Find compound meds for order checking
+11 SET CMP=$PIECE($GET(^PSDRUG(MED,999999935)),U,1)
+12 IF CMP=1
Begin DoDot:1
+13 SET CMPDR=0
+14 FOR
SET CMPDR=$ORDER(^PSDRUG(MED,999999936,CMPDR))
IF '+CMPDR
QUIT
Begin DoDot:2
+15 SET CDRG=$PIECE($GET(^PSDRUG(MED,999999936,CMPDR,0)),U,1)
+16 SET SAVEDFN=DFN
+17 DO EN^PSOORDRG(DFN,CDRG)
+18 DO PROCESS^ORKPS1(OI,ORDFN,ORKDG)
+19 SET DFN=SAVEDFN
+20 ;end IHS mod
End DoDot:2
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 DO EN^PSOORDRG(DFN,MED)
+23 DO PROCESS^ORKPS1(OI,ORDFN,ORKDG)
End DoDot:1
+24 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")
+25 QUIT
CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG) ; return drug order checks for session
+1 NEW ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI
+2 NEW ORKFLG,ORSESS,ORPSPKG,ORPSA,ORKDD,ORSNUM,ORNUM,DUPX,DUPORN
+3 NEW ORDFN
SET ORDFN=DFN
+4 SET ORKFLG=0
+5 SET ORNUM=$PIECE(ORKA,"|",5)
+6 ;
+7 ;get other session med orders:
+8 IF $DATA(^TMP("ORKA",$JOB))
Begin DoDot:1
+9 SET CNT=^TMP("ORKA",$JOB)
FOR CNTX=1:1:CNT
Begin DoDot:2
+10 SET ORSESS=$GET(^TMP("ORKA",$JOB,CNTX))
+11 IF '$LENGTH(ORSESS)
QUIT
+12 SET ORPSPKG=$PIECE(ORSESS,"|",2)
+13 IF '$LENGTH(ORPSPKG)
QUIT
+14 IF $EXTRACT(ORPSPKG,1,2)'="PS"
QUIT
+15 SET ORSNUM=$PIECE(ORSESS,"|",5)
+16 SET ORKOI=$PIECE(ORSESS,"|")
+17 ;quit if same order/oi:
+18 IF ((+$GET(ORNUM)=+$GET(ORSNUM))&(+$GET(OI)=+$GET(ORKOI)))
QUIT
+19 IF ORPSPKG="PSJ"
SET ORPSPKG="PSI"
+20 SET ORKDRUG=$PIECE($PIECE(ORSESS,"|",3),U,4)
+21 ;
+22 ;if no disp drug selected get disp drug(s) from OI:
+23 IF +$GET(ORKDRUG)<1
IF $LENGTH(ORKOI)
Begin DoDot:3
+24 IF "IOH"[$EXTRACT(ORPSPKG,3)
DO OI2DD(.ORPSA,ORKOI,$EXTRACT(ORPSPKG,3))
Begin DoDot:4
+25 SET ORKDD=0
FOR
SET ORKDD=$ORDER(ORPSA(ORKDD))
IF 'ORKDD
QUIT
Begin DoDot:5
+26 SET ORKDRUG=+ORKDD
+27 IF +$GET(ORKDRUG)>0
SET ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM
End DoDot:5
End DoDot:4
+28 ;need to clean out between calls to OI2DD
KILL ORPSA
End DoDot:3
+29 ;
+30 IF +$GET(ORKDRUG)<1
QUIT
+31 ;if dispense drug selected add to array:
+32 SET ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM
End DoDot:2
End DoDot:1
+33 ;
+34 ;get unsigned medication orders:
+35 SET HOR=0
SET SEQ=0
+36 SET HOR=$ORDER(^TMP("ORR",$JOB,HOR))
IF +$GET(HOR)>0
Begin DoDot:1
+37 FOR
SET SEQ=$ORDER(^TMP("ORR",$JOB,HOR,SEQ))
IF +SEQ<1
QUIT
Begin DoDot:2
+38 SET ORKORN=+$PIECE(^TMP("ORR",$JOB,HOR,SEQ),U)
SET DUPORN=0
+39 IF +$GET(ORKORN)<1
QUIT
+40 IF +ORKORN=+ORNUM
QUIT
+41 IF $PIECE(^OR(100,+ORKORN,8,$PIECE(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC"
QUIT
+42 IF $PIECE(^ORD(100.01,$PIECE(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED"
QUIT
+43 ;get disp drug for order
SET ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG")
+44 ;only process vs. unsigned med order if disp drug is assoc w/order:
+45 IF +$GET(ORKDRUG)<1
QUIT
+46 SET ORPSPKG=$$DGRX^ORQOR2(+ORKORN)
+47 SET ORPSPKG=$SELECT(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDICATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PSH",1:"")
+48 SET DUPX=""
FOR
SET DUPX=$ORDER(ORKDRUGA(DUPX))
IF 'DUPX!(DUPORN=1)
QUIT
Begin DoDot:3
+49 IF ORKORN=ORKDRUGA(DUPX)
SET DUPORN=1
End DoDot:3
+50 ;quit if already processed drug order
IF DUPORN=1
QUIT
+51 SET ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN
End DoDot:2
End DoDot:1
+52 ;
+53 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")
+54 IF $DATA(ORKDRUGA)
DO DRGCHK^PSOORDRG(DFN,MED,.ORKDRUGA)
+55 ;I '$D(ORKDRUGA) D EN^PSOORDRG(DFN,MED)
+56 DO PROCESS^ORKPS1(OI,ORDFN,ORKDG)
+57 KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")
+58 QUIT
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 ;IHS/MSC/MGH Make it uppercase
+14 SET ORKARX=$$UP^XLFSTR(ORKARX)
+15 FOR ORJ=1:1:ORCNT
SET ORKMEDP=$PIECE(ORKMED,U,ORJ)
Begin DoDot:2
+16 IF $LENGTH(ORKMEDP)
IF (ORKARX[ORKMEDP)
SET ORKRSLT="1^"_ORKARX
End DoDot:2
End DoDot:1
+17 QUIT ORKRSLT
SOLUT(OI) ;extrinsic function returns 1 (true) if the orderable item is
+1 ; a solution (IV Base)
+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.IVB RX",OITEXT))
QUIT 1
+8 QUIT ""
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
+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
IF +$GET(CREARSLT)<1
Begin DoDot:1
+20 SET TEST=$PIECE(ORY(ORI),U)
+21 IF +$GET(TEST)<1
QUIT
+22 FOR ORJ=1:1:ORX
IF +$GET(CREARSLT)<1
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 IF CDT'<BDT
SET CREARSLT=1
End DoDot:2
End DoDot:1
+29 IF +$GET(CREARSLT)<1
QUIT "0^"
+30 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
+2 SET NUMRX=0
+3 IF +$GET(DFN)<1
QUIT NUMRX
+4 ;
+5 ;check to determine if inpatient or outpatient:
+6 DO ADM^VADPT2
+7 SET ORPTYPE=$SELECT(+$GET(VADMVT)>0:"I",1:"O")
+8 ;
+9 KILL ^TMP("PS",$JOB)
+10 ;if no date range, returns active meds for pt
DO OCL^PSOORRL(DFN,"","")
+11 NEW X
+12 SET X=0
+13 FOR
SET X=$ORDER(^TMP("PS",$JOB,X))
IF X<1
QUIT
Begin DoDot:1
+14 SET ORX=$GET(^TMP("PS",$JOB,X,0))
+15 SET ORY=$PIECE(ORX,U)
+16 ;order entry order number
SET ORNUM=$PIECE(ORX,U,8)
+17 ;medication status from pharmacy
SET ORS=$PIECE(ORX,U,9)
+18 ;pending renewal flag (1: pending renewal)
SET ORPRENEW=$PIECE(ORX,U,14)
+19 IF +ORX<1
QUIT
+20 ;quit if med is not pt type (inpt/outpt)
IF $PIECE(ORY,";",2)'=ORPTYPE
QUIT
+21 ;quit if status is a non-active type:
+22 IF $GET(ORS)="EXPIRED"
QUIT
+23 IF $GET(ORS)["DISCONTINUE"
QUIT
+24 IF $GET(ORS)="DELETED"
QUIT
+25 IF +$GET(ORPRENEW)>0
QUIT
+26 ;quit if a supply
IF $$SUPPLY($$OI^ORQOR2(ORNUM))=1
QUIT
+27 SET NUMRX=NUMRX+1
End DoDot:1
+28 KILL ^TMP("PS",$JOB)
+29 QUIT NUMRX
OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
+1 NEW PSOI
+2 IF '$DATA(^ORD(101.43,OROI,0))
QUIT
+3 SET PSOI=$PIECE($PIECE(^ORD(101.43,OROI,0),U,2),";")
+4 IF +$GET(PSOI)<1
QUIT
+5 ;if non-va med need to pass api "X"
IF ORPSPKG="H"
SET ORPSPKG="X"
+6 DO DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
+7 QUIT
