- 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
