BGPMUUT6 ;IHS/MSC/MGH - Find is med is active on date ;02-Mar-2011 16:47;DU
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
Q
FIND(DFN,TAX,BDATE,MEDTYPE,EDATE) ; EP
;This function is designed to see if the patient has any INPT ONLY
;in the given taxonomy that were active on the date(s) in question
;
N BGPYR,BGPIND,BGPINDIC,BGPNODE,BGPRX,BGPTYPE,BGPIDX,BGPMED,BGPEND,FOUND
K ^TMP("PS",$J)
;Start by getting the patients drugs from admit to discharge
D OCL^PSOORRL(DFN,BDATE,EDATE)
S BGPIND=0,BGPINDIC="",FOUND=0
F S BGPIND=$O(^TMP("PS",$J,BGPIND)) Q:'+BGPIND!(+FOUND) D
.S BGPNODE=$G(^TMP("PS",$J,BGPIND,0))
.S BGPRX=+($P(BGPNODE,U,1))
.Q:$L($P(BGPNODE,U,2))=0 ;Discard Blank Meds
.;Only use the type of meds chosen (OP,UD,IV)
.S BGPTYPE=$P($P(BGPNODE,U),";",2)
.S BGPTYPE=$S(BGPTYPE="O":"OP",BGPTYPE="I":"UD",1:"")
.I $O(^TMP("PS",$J,BGPIND,"A",0))>0 S BGPTYPE="IV"
.E I $O(^TMP("PS",$J,BGPIND,"B",0))>0 S BGPTYPE="IV"
.I BGPTYPE=MEDTYPE!(MEDTYPE="ALL") D
..S BGPMED=$P(BGPNODE,U,2)
..N IDX,ID
..S ID=$P(BGPNODE,U),IDX=+ID,ID=$E(ID,$L(IDX)+1,$L(ID))
..;Check date on unit dose
..I ID="U;I" S FOUND=$$INPAT(DFN,IDX,ID,BDATE,EDATE,TAX) Q:+FOUND
..;Check dates on IVs
..I ID="V;I" S FOUND=$$IV(DFN,IDX,ID,BDATE,EDATE,TAX) Q:+FOUND
Q FOUND
INPAT(DFN,IDX,ID,BDATE,BGPEND,TAX) ;EP
N RESULT,NODE,NODE2,DISP,NDC,X
S RESULT=0
S NODE=$G(^PS(55,DFN,5,IDX,0))
S NODE2=$G(^PS(55,DFN,5,IDX,2))
I $P($P(NODE2,U,2),".",1)=BDATE!($P(NODE2,U,2)<BDATE) D ;Med started
.I ($P($P(NODE2,U,4),".",1)=$P(BGPEND,".",1))!($P(NODE2,U,4)>BGPEND) D
..;Med was active in range suggested
..;Now find the dispense drug(s) and see if they are in the taxonomy
..S X=0 F S X=$O(^PS(55,DFN,5,IDX,1,X)) Q:'+X!(+RESULT) D
...S DISP=$G(^PS(55,DFN,5,IDX,1,X,0))
...S DRUG=$P(DISP,U,1)
...S RESULT=$$NDC^BGPMUUT4(DRUG,TAX)
Q RESULT
Q
IV(DFN,IDX,ID,BDATE,BGPEND,TAX) ;EP
N RESULT,NODE,ADD,SOL,DRUG,GDRUG
S RESULT=0
S NODE=$G(^PS(55,DFN,"IV",IDX,0))
I ($P($P(NODE,U,2),".",1)=BDATE)!($P(NODE,U,2)<BDATE) D ;Med started
.I ($P($P(NODE,U,3),".",1)=$P(BGPEND,".",1))!($P(NODE,U,3)>BGPEND) D
..;Med was active, now find the dispense drug and see if in taxonomy
..S ADD=0 F S ADD=$O(^PS(55,DFN,"IV",IDX,"AD",ADD)) Q:ADD=""!(+RESULT) D
...S DRUG=$P($G(^PS(55,DFN,"IV",IDX,"AD",ADD,0)),U,1)
...I +DRUG S GDRUG=$P($G(^PS(52.6,DRUG,0)),U,2)
...S RESULT=$$NDC^BGPMUUT4(GDRUG,TAX)
..I '+RESULT D
...S SOL=0 F S SOL=$O(^PS(55,DFN,"IV",IDX,"SOL",SOL)) Q:SOL=""!(+RESULT) D
....S DRUG=$P($G(^PS(55,DFN,"IV",IDX,"SOL",SOL,0)),U,1)
....I +DRUG S GDRUG=$P($G(^PS(52.7,DRUG,0)),U,2)
....S RESULT=$$NDC^BGPMUUT4(GDRUG,TAX)
Q RESULT
BGPMUUT6 ;IHS/MSC/MGH - Find is med is active on date ;02-Mar-2011 16:47;DU
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 QUIT
FIND(DFN,TAX,BDATE,MEDTYPE,EDATE) ; EP
+1 ;This function is designed to see if the patient has any INPT ONLY
+2 ;in the given taxonomy that were active on the date(s) in question
+3 ;
+4 NEW BGPYR,BGPIND,BGPINDIC,BGPNODE,BGPRX,BGPTYPE,BGPIDX,BGPMED,BGPEND,FOUND
+5 KILL ^TMP("PS",$JOB)
+6 ;Start by getting the patients drugs from admit to discharge
+7 DO OCL^PSOORRL(DFN,BDATE,EDATE)
+8 SET BGPIND=0
SET BGPINDIC=""
SET FOUND=0
+9 FOR
SET BGPIND=$ORDER(^TMP("PS",$JOB,BGPIND))
IF '+BGPIND!(+FOUND)
QUIT
Begin DoDot:1
+10 SET BGPNODE=$GET(^TMP("PS",$JOB,BGPIND,0))
+11 SET BGPRX=+($PIECE(BGPNODE,U,1))
+12 ;Discard Blank Meds
IF $LENGTH($PIECE(BGPNODE,U,2))=0
QUIT
+13 ;Only use the type of meds chosen (OP,UD,IV)
+14 SET BGPTYPE=$PIECE($PIECE(BGPNODE,U),";",2)
+15 SET BGPTYPE=$SELECT(BGPTYPE="O":"OP",BGPTYPE="I":"UD",1:"")
+16 IF $ORDER(^TMP("PS",$JOB,BGPIND,"A",0))>0
SET BGPTYPE="IV"
+17 IF '$TEST
IF $ORDER(^TMP("PS",$JOB,BGPIND,"B",0))>0
SET BGPTYPE="IV"
+18 IF BGPTYPE=MEDTYPE!(MEDTYPE="ALL")
Begin DoDot:2
+19 SET BGPMED=$PIECE(BGPNODE,U,2)
+20 NEW IDX,ID
+21 SET ID=$PIECE(BGPNODE,U)
SET IDX=+ID
SET ID=$EXTRACT(ID,$LENGTH(IDX)+1,$LENGTH(ID))
+22 ;Check date on unit dose
+23 IF ID="U;I"
SET FOUND=$$INPAT(DFN,IDX,ID,BDATE,EDATE,TAX)
IF +FOUND
QUIT
+24 ;Check dates on IVs
+25 IF ID="V;I"
SET FOUND=$$IV(DFN,IDX,ID,BDATE,EDATE,TAX)
IF +FOUND
QUIT
End DoDot:2
End DoDot:1
+26 QUIT FOUND
INPAT(DFN,IDX,ID,BDATE,BGPEND,TAX) ;EP
+1 NEW RESULT,NODE,NODE2,DISP,NDC,X
+2 SET RESULT=0
+3 SET NODE=$GET(^PS(55,DFN,5,IDX,0))
+4 SET NODE2=$GET(^PS(55,DFN,5,IDX,2))
+5 ;Med started
IF $PIECE($PIECE(NODE2,U,2),".",1)=BDATE!($PIECE(NODE2,U,2)<BDATE)
Begin DoDot:1
+6 IF ($PIECE($PIECE(NODE2,U,4),".",1)=$PIECE(BGPEND,".",1))!($PIECE(NODE2,U,4)>BGPEND)
Begin DoDot:2
+7 ;Med was active in range suggested
+8 ;Now find the dispense drug(s) and see if they are in the taxonomy
+9 SET X=0
FOR
SET X=$ORDER(^PS(55,DFN,5,IDX,1,X))
IF '+X!(+RESULT)
QUIT
Begin DoDot:3
+10 SET DISP=$GET(^PS(55,DFN,5,IDX,1,X,0))
+11 SET DRUG=$PIECE(DISP,U,1)
+12 SET RESULT=$$NDC^BGPMUUT4(DRUG,TAX)
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT RESULT
+14 QUIT
IV(DFN,IDX,ID,BDATE,BGPEND,TAX) ;EP
+1 NEW RESULT,NODE,ADD,SOL,DRUG,GDRUG
+2 SET RESULT=0
+3 SET NODE=$GET(^PS(55,DFN,"IV",IDX,0))
+4 ;Med started
IF ($PIECE($PIECE(NODE,U,2),".",1)=BDATE)!($PIECE(NODE,U,2)<BDATE)
Begin DoDot:1
+5 IF ($PIECE($PIECE(NODE,U,3),".",1)=$PIECE(BGPEND,".",1))!($PIECE(NODE,U,3)>BGPEND)
Begin DoDot:2
+6 ;Med was active, now find the dispense drug and see if in taxonomy
+7 SET ADD=0
FOR
SET ADD=$ORDER(^PS(55,DFN,"IV",IDX,"AD",ADD))
IF ADD=""!(+RESULT)
QUIT
Begin DoDot:3
+8 SET DRUG=$PIECE($GET(^PS(55,DFN,"IV",IDX,"AD",ADD,0)),U,1)
+9 IF +DRUG
SET GDRUG=$PIECE($GET(^PS(52.6,DRUG,0)),U,2)
+10 SET RESULT=$$NDC^BGPMUUT4(GDRUG,TAX)
End DoDot:3
+11 IF '+RESULT
Begin DoDot:3
+12 SET SOL=0
FOR
SET SOL=$ORDER(^PS(55,DFN,"IV",IDX,"SOL",SOL))
IF SOL=""!(+RESULT)
QUIT
Begin DoDot:4
+13 SET DRUG=$PIECE($GET(^PS(55,DFN,"IV",IDX,"SOL",SOL,0)),U,1)
+14 IF +DRUG
SET GDRUG=$PIECE($GET(^PS(52.7,DRUG,0)),U,2)
+15 SET RESULT=$$NDC^BGPMUUT4(GDRUG,TAX)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT RESULT
