BGPMUUT7 ;IHS/MSC/MGH - Find if radiology procuedure is in taxonomy ;13-Apr-2011 16:27;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
Q
FIND(DFN,TAX,BDATE,EDATE) ; EP
N BEGIN,START,END,FIRST,PT,ORDER,IEN,OI,TIEN,CODE,CODSYS,ORDERTE,OIN,ORDTE
S ORDER=0
S BEGIN=BDATE+1
S START=9999999-BDATE,END=9999999-EDATE
S FIRST=END-1
S PT=DFN_";DPT("
F S FIRST=$O(^OR(100,"AR",PT,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+ORDER) D
.S IEN="" F S IEN=$O(^OR(100,"AR",PT,FIRST,IEN)) Q:IEN=""!(+ORDER) D
..S OI=0 S OI=$O(^OR(100,IEN,.1,OI)) Q:OI="" D
...S OIN=$G(^OR(100,IEN,.1,OI,0))
...Q:'OIN
...S CODE=$P($G(^ORD(101.43,OIN,0)),U,3)
...S CODSYS=$P($G(^ORD(101.43,OIN,0)),U,4)
...I CODSYS="CPT4" D
....S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) I 'TIEN S ORDER=0 Q
....S ORDER=$$ICD^ATXCHK(CODE,TIEN,1)
....S ORDTE=$P($G(^OR(100,IEN,0)),U,7)
....I ORDER=1 S ORDER=1_U_ORDTE
Q ORDER
PSFIND(DFN,TAX,BDATE,EDATE) ;EP
;Find a pharmacy order
N BEGIN,START,END,FIRST,PT,ORDER,IEN,DGTYP,DGRP,MED
S ORDER=0
S BEGIN=BDATE+1
S START=9999999-BDATE,END=9999999-EDATE
S FIRST=END-1
S PT=DFN_";DPT("
F S FIRST=$O(^OR(100,"AR",PT,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(+ORDER) D
.S IEN="" F S IEN=$O(^OR(100,"AR",PT,FIRST,IEN)) Q:IEN=""!(+ORDER) D
..S DGRP=$P($G(^OR(100,IEN,0)),U,11)
..I DGRP'="" D
...S DGTYP=$P($G(^ORD(100.98,DGRP,0)),U,3)
...I DGTYP["RX" D
....S MED=0
....S MED=$$LKP(IEN,TAX)
....I +MED S ORDER=1_U_$P(MED,U,2)
Q ORDER
LKP(IEN,TAX) ;Lookup the order
N OI,DRUG,RESULT,I,ZERO
S RESULT=0
S I=0 F S I=$O(^OR(100,IEN,4.5,I)) Q:I=""!(+RESULT) D
.S ZERO=$G(^OR(100,IEN,4.5,I,0))
.I $P(ZERO,U,4)="DRUG" D
.S DRUG=$P($G(^OR(100,IEN,4.5,I,1)),U,1)
.S RESULT=$$NDC^BGPMUUT4(DRUG,TAX)
Q RESULT
BGPMUUT7 ;IHS/MSC/MGH - Find if radiology procuedure is in taxonomy ;13-Apr-2011 16:27;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 QUIT
FIND(DFN,TAX,BDATE,EDATE) ; EP
+1 NEW BEGIN,START,END,FIRST,PT,ORDER,IEN,OI,TIEN,CODE,CODSYS,ORDERTE,OIN,ORDTE
+2 SET ORDER=0
+3 SET BEGIN=BDATE+1
+4 SET START=9999999-BDATE
SET END=9999999-EDATE
+5 SET FIRST=END-1
+6 SET PT=DFN_";DPT("
+7 FOR
SET FIRST=$ORDER(^OR(100,"AR",PT,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)!(+ORDER)
QUIT
Begin DoDot:1
+8 SET IEN=""
FOR
SET IEN=$ORDER(^OR(100,"AR",PT,FIRST,IEN))
IF IEN=""!(+ORDER)
QUIT
Begin DoDot:2
+9 SET OI=0
SET OI=$ORDER(^OR(100,IEN,.1,OI))
IF OI=""
QUIT
Begin DoDot:3
+10 SET OIN=$GET(^OR(100,IEN,.1,OI,0))
+11 IF 'OIN
QUIT
+12 SET CODE=$PIECE($GET(^ORD(101.43,OIN,0)),U,3)
+13 SET CODSYS=$PIECE($GET(^ORD(101.43,OIN,0)),U,4)
+14 IF CODSYS="CPT4"
Begin DoDot:4
+15 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
SET ORDER=0
QUIT
+16 SET ORDER=$$ICD^ATXCHK(CODE,TIEN,1)
+17 SET ORDTE=$PIECE($GET(^OR(100,IEN,0)),U,7)
+18 IF ORDER=1
SET ORDER=1_U_ORDTE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT ORDER
PSFIND(DFN,TAX,BDATE,EDATE) ;EP
+1 ;Find a pharmacy order
+2 NEW BEGIN,START,END,FIRST,PT,ORDER,IEN,DGTYP,DGRP,MED
+3 SET ORDER=0
+4 SET BEGIN=BDATE+1
+5 SET START=9999999-BDATE
SET END=9999999-EDATE
+6 SET FIRST=END-1
+7 SET PT=DFN_";DPT("
+8 FOR
SET FIRST=$ORDER(^OR(100,"AR",PT,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)!(+ORDER)
QUIT
Begin DoDot:1
+9 SET IEN=""
FOR
SET IEN=$ORDER(^OR(100,"AR",PT,FIRST,IEN))
IF IEN=""!(+ORDER)
QUIT
Begin DoDot:2
+10 SET DGRP=$PIECE($GET(^OR(100,IEN,0)),U,11)
+11 IF DGRP'=""
Begin DoDot:3
+12 SET DGTYP=$PIECE($GET(^ORD(100.98,DGRP,0)),U,3)
+13 IF DGTYP["RX"
Begin DoDot:4
+14 SET MED=0
+15 SET MED=$$LKP(IEN,TAX)
+16 IF +MED
SET ORDER=1_U_$PIECE(MED,U,2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT ORDER
LKP(IEN,TAX) ;Lookup the order
+1 NEW OI,DRUG,RESULT,I,ZERO
+2 SET RESULT=0
+3 SET I=0
FOR
SET I=$ORDER(^OR(100,IEN,4.5,I))
IF I=""!(+RESULT)
QUIT
Begin DoDot:1
+4 SET ZERO=$GET(^OR(100,IEN,4.5,I,0))
+5 IF $PIECE(ZERO,U,4)="DRUG"
Begin DoDot:2
End DoDot:2
+6 SET DRUG=$PIECE($GET(^OR(100,IEN,4.5,I,1)),U,1)
+7 SET RESULT=$$NDC^BGPMUUT4(DRUG,TAX)
End DoDot:1
+8 QUIT RESULT
