- 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
