- BGP5EL4 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
- ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
- ;
- I18 ;EP
- S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
- S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- I BGPAGEB<55 S BGPSTOP=1 Q
- I 'BGPACTCL S BGPSTOP=1 Q
- S BGPD1=1
- I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
- I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
- I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
- I BGPAGEB>84 S BGPD5=1
- D CHEL^BGP5D73
- S BGPVALUE="AC|||"_$P(BGPVALUE,"|||",2)
- K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPLDL
- Q
- ;
- PALLCARE ;EP
- S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10)=0
- S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- I BGPAGEB<55 S BGPSTOP=1 Q
- I 'BGPACTCL S BGPSTOP=1 Q
- S BGPD1=1
- I BGPAGEB>54,BGPAGEB<65 S BGPD2=1
- I BGPAGEB>64,BGPAGEB<75 S BGPD3=1
- I BGPAGEB>74,BGPAGEB<85 S BGPD4=1
- I BGPAGEB>84 S BGPD5=1
- S BGPVAL=$$PCV^BGP5D24(DFN,BGPBDATE,BGPEDATE) ;return #visits^list string
- S BGPN1=$P(BGPVAL,U)
- ;S BGPCANCE=$$CANCER^BGP5D24(DFN,BGPBDATE,BGPEDATE)
- ;I BGPCANCE S BGPD6=1 D
- ;.I BGPAGEB>54,BGPAGEB<65 S BGPD7=1
- ;.I BGPAGEB>64,BGPAGEB<75 S BGPD8=1
- ;.I BGPAGEB>74,BGPAGEB<85 S BGPD9=1
- ;.I BGPAGEB>84 S BGPD10=1
- ;S BGPVAL=$$PCV(DFN,BGPBDATE,BGPEDATE) ;return #visits^list string
- S BGPN1=$P(BGPVAL,U)
- ;I BGPCANCE,BGPN1>1 S BGPN5=1
- S BGPVALUE="AC"_"|||"_BGPN1_$S(BGPN1'=1:" visits: ",1:" visit: ")_$P(BGPVAL,U,2)
- K BGPVAL
- Q
- ;
- FUNCTION(P,BDATE,EDATE) ;EP
- S BD=(9999999-BDATE)
- S ED=(9999999-EDATE)-1
- K BGPG
- S (BGP1,BGP2)=0
- F S ED=$O(^AUPNVELD("AA",P,ED)) Q:ED=""!(ED>BD) D
- .S BGPX=0 F S BGPX=$O(^AUPNVELD("AA",P,ED,BGPX)) Q:BGPX'=+BGPX D
- ..S Y=^AUPNVELD(BGPX,0)
- ..I $P(Y,U,4)]"" S:'$O(BGPG("TLT",0)) BGPG("TLT",ED)="",BGP1=1
- ..I $P(Y,U,5)]"" S:'$O(BGPG("BATH",0)) BGPG("BATH",ED)="",BGP1=1
- ..I $P(Y,U,6)]"" S:'$O(BGPG("DRES",0)) BGPG("DRES",ED)="",BGP1=1
- ..I $P(Y,U,7)]"" S:'$O(BGPG("XFER",0)) BGPG("XFER",ED)="",BGP1=1
- ..I $P(Y,U,8)]"" S:'$O(BGPG("FEED",0)) BGPG("FEED",ED)="",BGP1=1
- ..I $P(Y,U,9)]"" S:'$O(BGPG("CONT",0)) BGPG("CONT",ED)="",BGP1=1
- ..I $P(Y,U,11)]"" S:'$O(BGPG("FIN",0)) BGPG("FIN",ED)="",BGP2=1
- ..I $P(Y,U,12)]"" S:'$O(BGPG("COOK",0)) BGPG("COOK",ED)="",BGP2=1
- ..I $P(Y,U,13)]"" S:'$O(BGPG("SHOP",0)) BGPG("SHOP",ED)="",BGP2=1
- ..I $P(Y,U,14)]"" S:'$O(BGPG("HSWK",0)) BGPG("HSWK",ED)="",BGP2=1
- ..I $P(Y,U,15)]"" S:'$O(BGPG("MEDS",0)) BGPG("MEDS",ED)="",BGP2=1
- ..I $P(Y,U,16)]"" S:'$O(BGPG("TRNS",0)) BGPG("TRNS",ED)="",BGP2=1
- K BGPV
- S X="" F S X=$O(BGPG(X)) Q:X="" S ED=$O(BGPG(X,0)) S:$D(BGPV(ED)) BGPV(ED)=BGPV(ED)_", " S BGPV(ED)=$G(BGPV(ED))_X
- S BGPQ=""
- S BGPQ=$S((BGP1+BGP2)=2:1,1:0)_U
- S Y=0 F S Y=$O(BGPV(Y)) Q:Y'=+Y D
- .S $P(BGPQ,U,2)=$P(BGPQ,U,2)_$$DATE^BGP5UTL((9999999-Y))_" "_BGPV(Y)_" "
- K BGPV,BGPG
- Q BGPQ
- ;
- PHNV(P,BDATE,EDATE,HOMELOC) ;EP
- S HOMELOC=$G(HOMELOC)
- K ^TMP($J,"A") S A="^TMP($J,""A"","
- S B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
- I '$D(^TMP($J,"A",1)) Q "0^0^0^0^0^0^0^0^0^0^0^0"
- S (X,Y)=0,C="0^0^0^0^0^0^0^0^0^0^0^0" F S X=$O(^TMP($J,"A",X)) Q:X'=+X S V=$P(^TMP($J,"A",X),U,5) D
- .;S Y=0 I $$CLINIC^APCLV(V,"C")=45 S Y=1 Q
- .S (D,Y,Z)=0
- .F S D=$O(^AUPNVPRV("AD",V,D)) Q:D'=+D S Q=$P(^AUPNVPRV(D,0),U) D
- ..Q:Q=""
- ..S %=$$VALI^XBDIQ1($S($P(^DD(9000010.06,.01,0),U,2)["200":200,1:6),Q,$S($P(^DD(9000010.06,.01,0),U,2)["200":53.5,1:2))
- ..I % S %=$P($G(^DIC(7,+%,9999999)),U)
- ..I %'=13,%'=91 Q ;not a phn or driver
- ..S $P(C,U,1)=$P(C,U,1)+1
- ..I %=91 S $P(C,U,6)=$P(C,U,6)+1
- ..D HOME
- ..D AGE
- Q C
- ;
- HOME ;
- S HV=0
- I $$CLINIC^APCLV(V,"C")=11 S $P(C,U,7)=$P(C,U,7)+1,HV=1 S:%=91 $P(C,U,12)=$P(C,U,12)+1 Q
- Q:HOMELOC=""
- I HOMELOC=$P(^AUPNVSIT(V,0),U,6) S $P(C,U,7)=$P(C,U,7)+1,HV=1 S:%=91 $P(C,U,12)=$P(C,U,12)+1 Q
- Q
- AGE ;
- NEW YRS
- S YRS=$$AGE^AUPNPAT(P,$P($P(^AUPNVSIT(V,0),U),"."))
- I YRS>54,YRS<65 S $P(C,U,2)=$P(C,U,2)+1 S:HV=1 $P(C,U,8)=$P(C,U,8)+1 Q
- I YRS>64,YRS<75 S $P(C,U,3)=$P(C,U,3)+1 S:HV=1 $P(C,U,9)=$P(C,U,9)+1 Q
- I YRS>74,YRS<85 S $P(C,U,4)=$P(C,U,4)+1 S:HV=1 $P(C,U,10)=$P(C,U,10)+1 Q
- I YRS>84 S $P(C,U,5)=$P(C,U,5)+1 S:HV=1 $P(C,U,11)=$P(C,U,11)+1 Q
- W BGPBOMB
- Q
- TXBMD(P,BDATE,EDATE,HOSP) ;EP
- ;first see if there are any procedures in this date range
- S HOSP=$G(HOSP)
- K BGPG
- S BGPG=$$LASTPRC^BGP5UTL1(P,"BGP BMD PROCEDURES",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP5UTL($P(BGPG,U,3))_" PROC "_$P(BGPG,U,2)
- ;now check dx
- S BGPG=$$LASTDX^BGP5UTL1(P,"BGP BMD DXS",BDATE,EDATE)
- I $P(BGPG,U)=1 Q 1_U_$$DATE^BGP5UTL($P(BGPG,U,3))_"DX "_$P(BGPG,U,2)
- ;now check cpts
- S T=$O(^ATXAX("B","BGP BMD CPTS",0))
- S BGPG=$$CPT^BGP5DU(P,BDATE,EDATE,T,5)
- I BGPG]"" Q 1_U_$$DATE^BGP5UTL($P(BGPG,U,1))_" CPT "_$P(BGPG,U,2)
- S T=$O(^ATXAX("B","BGP BMD CPTS",0))
- S BGPG=$$TRAN^BGP5DU(P,BDATE,EDATE,T,5)
- I BGPG]"" Q 1_U_$$DATE^BGP5UTL($P(BGPG,U,1))_" CPT/TRAN "_$P(BGPG,U,2)
- ;now check RAD
- S T=$O(^ATXAX("B","BGP BMD CPTS",0))
- S BGPG=$$RAD^BGP5DU(P,BDATE,EDATE,T,5)
- I BGPG]"" Q 1_U_$$DATE^BGP5UTL($P(BGPG,U,1))_" RAD/CPT "_$P(BGPG,U,2)
- I HOSP Q ""
- ;now check all meds
- K ^TMP($J,"MEDS")
- S G=0 K BGPZ
- S Y="^TMP($J,""MEDS"",",X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
- S T=$O(^ATXAX("B","BGP HEDIS OSTEOPOROSIS DRUGS",0))
- S T1=$O(^ATXAX("B","BGP HEDIS OSTEOPOROSIS NDC",0))
- ;S T2="" I TAX3]"" S T2=$O(^ATXAX("B",TAX3,0))
- S X=0 F S X=$O(^TMP($J,"MEDS",X)) Q:X'=+X!(G) S Y=+$P(^TMP($J,"MEDS",X),U,4) D
- .Q:'$D(^AUPNVMED(Y,0))
- .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
- .S G=0
- .S D=$P(^AUPNVMED(Y,0),U)
- .S C=$P($G(^PSDRUG(D,0)),U,2)
- .;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=X
- .S C=$P($G(^PSDRUG(D,2)),U,4)
- .I C]"",T1,$D(^ATXAX(T1,21,"B",C)) S G=$P(^TMP($J,"MEDS",X),U)
- .I T,$D(^ATXAX(T,21,"B",D)) S G=$P(^TMP($J,"MEDS",X),U)_U_$P(^TMP($J,"MEDS",X),U,2)
- .Q
- K ^TMP($J,"MEDS")
- I G Q 1_U_$$DATE^BGP5UTL($P(G,U,1))_" Med "_$P(G,U,2)
- Q ""
- BGP5EL4 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
- +1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
- +2 ;
- I18 ;EP
- +1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5)=0
- +2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- +3 IF BGPAGEB<55
- SET BGPSTOP=1
- QUIT
- +4 IF 'BGPACTCL
- SET BGPSTOP=1
- QUIT
- +5 SET BGPD1=1
- +6 IF BGPAGEB>54
- IF BGPAGEB<65
- SET BGPD2=1
- +7 IF BGPAGEB>64
- IF BGPAGEB<75
- SET BGPD3=1
- +8 IF BGPAGEB>74
- IF BGPAGEB<85
- SET BGPD4=1
- +9 IF BGPAGEB>84
- SET BGPD5=1
- +10 DO CHEL^BGP5D73
- +11 SET BGPVALUE="AC|||"_$PIECE(BGPVALUE,"|||",2)
- +12 KILL X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPLDL
- +13 QUIT
- +14 ;
- PALLCARE ;EP
- +1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10)=0
- +2 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
- +3 IF BGPAGEB<55
- SET BGPSTOP=1
- QUIT
- +4 IF 'BGPACTCL
- SET BGPSTOP=1
- QUIT
- +5 SET BGPD1=1
- +6 IF BGPAGEB>54
- IF BGPAGEB<65
- SET BGPD2=1
- +7 IF BGPAGEB>64
- IF BGPAGEB<75
- SET BGPD3=1
- +8 IF BGPAGEB>74
- IF BGPAGEB<85
- SET BGPD4=1
- +9 IF BGPAGEB>84
- SET BGPD5=1
- +10 ;return #visits^list string
- SET BGPVAL=$$PCV^BGP5D24(DFN,BGPBDATE,BGPEDATE)
- +11 SET BGPN1=$PIECE(BGPVAL,U)
- +12 ;S BGPCANCE=$$CANCER^BGP5D24(DFN,BGPBDATE,BGPEDATE)
- +13 ;I BGPCANCE S BGPD6=1 D
- +14 ;.I BGPAGEB>54,BGPAGEB<65 S BGPD7=1
- +15 ;.I BGPAGEB>64,BGPAGEB<75 S BGPD8=1
- +16 ;.I BGPAGEB>74,BGPAGEB<85 S BGPD9=1
- +17 ;.I BGPAGEB>84 S BGPD10=1
- +18 ;S BGPVAL=$$PCV(DFN,BGPBDATE,BGPEDATE) ;return #visits^list string
- +19 SET BGPN1=$PIECE(BGPVAL,U)
- +20 ;I BGPCANCE,BGPN1>1 S BGPN5=1
- +21 SET BGPVALUE="AC"_"|||"_BGPN1_$SELECT(BGPN1'=1:" visits: ",1:" visit: ")_$PIECE(BGPVAL,U,2)
- +22 KILL BGPVAL
- +23 QUIT
- +24 ;
- FUNCTION(P,BDATE,EDATE) ;EP
- +1 SET BD=(9999999-BDATE)
- +2 SET ED=(9999999-EDATE)-1
- +3 KILL BGPG
- +4 SET (BGP1,BGP2)=0
- +5 FOR
- SET ED=$ORDER(^AUPNVELD("AA",P,ED))
- IF ED=""!(ED>BD)
- QUIT
- Begin DoDot:1
- +6 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^AUPNVELD("AA",P,ED,BGPX))
- IF BGPX'=+BGPX
- QUIT
- Begin DoDot:2
- +7 SET Y=^AUPNVELD(BGPX,0)
- +8 IF $PIECE(Y,U,4)]""
- IF '$ORDER(BGPG("TLT",0))
- SET BGPG("TLT",ED)=""
- SET BGP1=1
- +9 IF $PIECE(Y,U,5)]""
- IF '$ORDER(BGPG("BATH",0))
- SET BGPG("BATH",ED)=""
- SET BGP1=1
- +10 IF $PIECE(Y,U,6)]""
- IF '$ORDER(BGPG("DRES",0))
- SET BGPG("DRES",ED)=""
- SET BGP1=1
- +11 IF $PIECE(Y,U,7)]""
- IF '$ORDER(BGPG("XFER",0))
- SET BGPG("XFER",ED)=""
- SET BGP1=1
- +12 IF $PIECE(Y,U,8)]""
- IF '$ORDER(BGPG("FEED",0))
- SET BGPG("FEED",ED)=""
- SET BGP1=1
- +13 IF $PIECE(Y,U,9)]""
- IF '$ORDER(BGPG("CONT",0))
- SET BGPG("CONT",ED)=""
- SET BGP1=1
- +14 IF $PIECE(Y,U,11)]""
- IF '$ORDER(BGPG("FIN",0))
- SET BGPG("FIN",ED)=""
- SET BGP2=1
- +15 IF $PIECE(Y,U,12)]""
- IF '$ORDER(BGPG("COOK",0))
- SET BGPG("COOK",ED)=""
- SET BGP2=1
- +16 IF $PIECE(Y,U,13)]""
- IF '$ORDER(BGPG("SHOP",0))
- SET BGPG("SHOP",ED)=""
- SET BGP2=1
- +17 IF $PIECE(Y,U,14)]""
- IF '$ORDER(BGPG("HSWK",0))
- SET BGPG("HSWK",ED)=""
- SET BGP2=1
- +18 IF $PIECE(Y,U,15)]""
- IF '$ORDER(BGPG("MEDS",0))
- SET BGPG("MEDS",ED)=""
- SET BGP2=1
- +19 IF $PIECE(Y,U,16)]""
- IF '$ORDER(BGPG("TRNS",0))
- SET BGPG("TRNS",ED)=""
- SET BGP2=1
- End DoDot:2
- End DoDot:1
- +20 KILL BGPV
- +21 SET X=""
- FOR
- SET X=$ORDER(BGPG(X))
- IF X=""
- QUIT
- SET ED=$ORDER(BGPG(X,0))
- IF $DATA(BGPV(ED))
- SET BGPV(ED)=BGPV(ED)_", "
- SET BGPV(ED)=$GET(BGPV(ED))_X
- +22 SET BGPQ=""
- +23 SET BGPQ=$SELECT((BGP1+BGP2)=2:1,1:0)_U
- +24 SET Y=0
- FOR
- SET Y=$ORDER(BGPV(Y))
- IF Y'=+Y
- QUIT
- Begin DoDot:1
- +25 SET $PIECE(BGPQ,U,2)=$PIECE(BGPQ,U,2)_$$DATE^BGP5UTL((9999999-Y))_" "_BGPV(Y)_" "
- End DoDot:1
- +26 KILL BGPV,BGPG
- +27 QUIT BGPQ
- +28 ;
- PHNV(P,BDATE,EDATE,HOMELOC) ;EP
- +1 SET HOMELOC=$GET(HOMELOC)
- +2 KILL ^TMP($JOB,"A")
- SET A="^TMP($J,""A"","
- +3 SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(B,A)
- +4 IF '$DATA(^TMP($JOB,"A",1))
- QUIT "0^0^0^0^0^0^0^0^0^0^0^0"
- +5 SET (X,Y)=0
- SET C="0^0^0^0^0^0^0^0^0^0^0^0"
- FOR
- SET X=$ORDER(^TMP($JOB,"A",X))
- IF X'=+X
- QUIT
- SET V=$PIECE(^TMP($JOB,"A",X),U,5)
- Begin DoDot:1
- +6 ;S Y=0 I $$CLINIC^APCLV(V,"C")=45 S Y=1 Q
- +7 SET (D,Y,Z)=0
- +8 FOR
- SET D=$ORDER(^AUPNVPRV("AD",V,D))
- IF D'=+D
- QUIT
- SET Q=$PIECE(^AUPNVPRV(D,0),U)
- Begin DoDot:2
- +9 IF Q=""
- QUIT
- +10 SET %=$$VALI^XBDIQ1($SELECT($PIECE(^DD(9000010.06,.01,0),U,2)["200":200,1:6),Q,$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)["200":53.5,1:2))
- +11 IF %
- SET %=$PIECE($GET(^DIC(7,+%,9999999)),U)
- +12 ;not a phn or driver
- IF %'=13
- IF %'=91
- QUIT
- +13 SET $PIECE(C,U,1)=$PIECE(C,U,1)+1
- +14 IF %=91
- SET $PIECE(C,U,6)=$PIECE(C,U,6)+1
- +15 DO HOME
- +16 DO AGE
- End DoDot:2
- End DoDot:1
- +17 QUIT C
- +18 ;
- HOME ;
- +1 SET HV=0
- +2 IF $$CLINIC^APCLV(V,"C")=11
- SET $PIECE(C,U,7)=$PIECE(C,U,7)+1
- SET HV=1
- IF %=91
- SET $PIECE(C,U,12)=$PIECE(C,U,12)+1
- QUIT
- +3 IF HOMELOC=""
- QUIT
- +4 IF HOMELOC=$PIECE(^AUPNVSIT(V,0),U,6)
- SET $PIECE(C,U,7)=$PIECE(C,U,7)+1
- SET HV=1
- IF %=91
- SET $PIECE(C,U,12)=$PIECE(C,U,12)+1
- QUIT
- +5 QUIT
- AGE ;
- +1 NEW YRS
- +2 SET YRS=$$AGE^AUPNPAT(P,$PIECE($PIECE(^AUPNVSIT(V,0),U),"."))
- +3 IF YRS>54
- IF YRS<65
- SET $PIECE(C,U,2)=$PIECE(C,U,2)+1
- IF HV=1
- SET $PIECE(C,U,8)=$PIECE(C,U,8)+1
- QUIT
- +4 IF YRS>64
- IF YRS<75
- SET $PIECE(C,U,3)=$PIECE(C,U,3)+1
- IF HV=1
- SET $PIECE(C,U,9)=$PIECE(C,U,9)+1
- QUIT
- +5 IF YRS>74
- IF YRS<85
- SET $PIECE(C,U,4)=$PIECE(C,U,4)+1
- IF HV=1
- SET $PIECE(C,U,10)=$PIECE(C,U,10)+1
- QUIT
- +6 IF YRS>84
- SET $PIECE(C,U,5)=$PIECE(C,U,5)+1
- IF HV=1
- SET $PIECE(C,U,11)=$PIECE(C,U,11)+1
- QUIT
- +7 WRITE BGPBOMB
- +8 QUIT
- TXBMD(P,BDATE,EDATE,HOSP) ;EP
- +1 ;first see if there are any procedures in this date range
- +2 SET HOSP=$GET(HOSP)
- +3 KILL BGPG
- +4 SET BGPG=$$LASTPRC^BGP5UTL1(P,"BGP BMD PROCEDURES",BDATE,EDATE)
- +5 IF $PIECE(BGPG,U)=1
- QUIT 1_U_$$DATE^BGP5UTL($PIECE(BGPG,U,3))_" PROC "_$PIECE(BGPG,U,2)
- +6 ;now check dx
- +7 SET BGPG=$$LASTDX^BGP5UTL1(P,"BGP BMD DXS",BDATE,EDATE)
- +8 IF $PIECE(BGPG,U)=1
- QUIT 1_U_$$DATE^BGP5UTL($PIECE(BGPG,U,3))_"DX "_$PIECE(BGPG,U,2)
- +9 ;now check cpts
- +10 SET T=$ORDER(^ATXAX("B","BGP BMD CPTS",0))
- +11 SET BGPG=$$CPT^BGP5DU(P,BDATE,EDATE,T,5)
- +12 IF BGPG]""
- QUIT 1_U_$$DATE^BGP5UTL($PIECE(BGPG,U,1))_" CPT "_$PIECE(BGPG,U,2)
- +13 SET T=$ORDER(^ATXAX("B","BGP BMD CPTS",0))
- +14 SET BGPG=$$TRAN^BGP5DU(P,BDATE,EDATE,T,5)
- +15 IF BGPG]""
- QUIT 1_U_$$DATE^BGP5UTL($PIECE(BGPG,U,1))_" CPT/TRAN "_$PIECE(BGPG,U,2)
- +16 ;now check RAD
- +17 SET T=$ORDER(^ATXAX("B","BGP BMD CPTS",0))
- +18 SET BGPG=$$RAD^BGP5DU(P,BDATE,EDATE,T,5)
- +19 IF BGPG]""
- QUIT 1_U_$$DATE^BGP5UTL($PIECE(BGPG,U,1))_" RAD/CPT "_$PIECE(BGPG,U,2)
- +20 IF HOSP
- QUIT ""
- +21 ;now check all meds
- +22 KILL ^TMP($JOB,"MEDS")
- +23 SET G=0
- KILL BGPZ
- +24 SET Y="^TMP($J,""MEDS"","
- SET X=P_"^ALL MED;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(X,Y)
- +25 SET T=$ORDER(^ATXAX("B","BGP HEDIS OSTEOPOROSIS DRUGS",0))
- +26 SET T1=$ORDER(^ATXAX("B","BGP HEDIS OSTEOPOROSIS NDC",0))
- +27 ;S T2="" I TAX3]"" S T2=$O(^ATXAX("B",TAX3,0))
- +28 SET X=0
- FOR
- SET X=$ORDER(^TMP($JOB,"MEDS",X))
- IF X'=+X!(G)
- QUIT
- SET Y=+$PIECE(^TMP($JOB,"MEDS",X),U,4)
- Begin DoDot:1
- +29 IF '$DATA(^AUPNVMED(Y,0))
- QUIT
- +30 IF $$UP^XLFSTR($PIECE($GET(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
- QUIT
- +31 SET G=0
- +32 SET D=$PIECE(^AUPNVMED(Y,0),U)
- +33 SET C=$PIECE($GET(^PSDRUG(D,0)),U,2)
- +34 ;I C]"",T2,$D(^ATXAX(T2,21,"B",C)) S G=X
- +35 SET C=$PIECE($GET(^PSDRUG(D,2)),U,4)
- +36 IF C]""
- IF T1
- IF $DATA(^ATXAX(T1,21,"B",C))
- SET G=$PIECE(^TMP($JOB,"MEDS",X),U)
- +37 IF T
- IF $DATA(^ATXAX(T,21,"B",D))
- SET G=$PIECE(^TMP($JOB,"MEDS",X),U)_U_$PIECE(^TMP($JOB,"MEDS",X),U,2)
- +38 QUIT
- End DoDot:1
- +39 KILL ^TMP($JOB,"MEDS")
- +40 IF G
- QUIT 1_U_$$DATE^BGP5UTL($PIECE(G,U,1))_" Med "_$PIECE(G,U,2)
- +41 QUIT ""
