Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP8PC2

BGP8PC2.m

Go to the documentation of this file. 
  1. BGP8PC2 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018  11:25 AM
  1.  ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
  1.  ;
  1. DMG ;EP
  1.  S (BGPN1,BGPD1)=0
  1.  S BGPDV=""
  1.  I BGPAGEE<18 S BGPSTOP=1 Q  ;18 or greater during time period
  1.  I BGPAGEB>74 S BGPSTOP=1 Q  ;75 or less during time period
  1.  S V=$$DMRP(DFN,BGPBDATE,BGPEDATE) I 'V S BGPSTOP=1 Q  ;no dm pov or problem list entry
  1.  S BGPDV=$$ENC1(DFN,BGPBDATE,BGPEDATE) I BGPDV="" S BGPSTOP=1 Q  ;no office visit
  1.  ;
  1.  ;now what about exclusions?
  1.  I $$HOSPIND(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 Q  ;no hospice pts
  1.  S BGPD1=1
  1.  S X=$$HGBA1C(DFN,BGPBDATE,BGPEDATE)
  1.  I $E(X)=1 S BGPN1=1
  1.  S BGPVALUE=""
  1.  S BGPVALUE="ENC "_$P(BGPDV,U,2)_"|||"  ;hit denominator
  1.  S BGPVALUE=BGPVALUE_$S(BGPN1:"*** ",1:"")_"A1c: "_$P(X,U,2)_" "_$P(X,U,3)
  1.  I BGPN1 ;S BGPVALUE=BGPVALUE_" **"
  1.  K V,BGPDV
  1.  Q
  1. ENC1(P,BDATE,EDATE) ;EP  - have encounter per CMS122v6
  1.  ;HAS one of the following
  1.  ;1.  cpt in BGP IPC OFFICE VISIT CPTS
  1.  ;2.  snomed in PXRM BGP IPC FACE2FACE
  1.  ;3.  CPT in BGP IPC PREVCARE EOV >=18 CPTS
  1.  ;4.  CPT in BGP IPC PREVCARE IOV >=18 CPTS
  1.  ;5.  CPT in BGP IPC HOMEHEALTH VISIT CPTS
  1.  ;6.  CPT in BGP IPC ANNUAL WELLNESS CPTS
  1.  NEW X,Y,Z,G,BGPV,D
  1.  ;Let's check all Visits, looping through once
  1.  S G=""  ;return variable
  1.  ;get all visits in date range in BGPV
  1.  D ALLV^APCLAPIU(P,BDATE,EDATE,"BGPV")
  1.  ;now loop through and check Face to Face and .17 in visit and check v cpts attached to the visit
  1.  S X=0 F  S X=$O(BGPV(X)) Q:X'=+X!(G)  S V=$P(BGPV(X),U,5)  D
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)  ;no dependent entries
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)  ;deleted
  1.  .S D=$$VD^APCLV(V)
  1.  .S Y=$$FTOF(V) I Y]"" S G=1_U_$$DATE^BGP8UTL(D)_" FTOF: "_Y Q
  1.  .;is .17 a cpt we want?
  1.  .S Y=$$VALI^XBDIQ1(9000010,V,.17)
  1.  .I Y,$$OFFCPT(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2) Q
  1.  .;now check all V CPTs
  1.  .S Z=0 F  S Z=$O(^AUPNVCPT("AD",V,Z)) Q:Z'=+Z!(G)  D
  1.  ..S Y=$P($G(^AUPNVCPT(Z,0)),U,1)
  1.  ..I Y,$$OFFCPT(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2) Q
  1.  Q G
  1. FTOF(V) ;EP
  1.  NEW A,B,C
  1.  S A=0,B=""
  1.  F  S A=$O(^AUPNVSIT(V,28,"B",A)) Q:A=""!(B]"")  D
  1.  .I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC FACE2FACE",A)) S B=A
  1.  Q B
  1. OFFCPT(C) ;EP
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC OFFICE VISIT CPTS",0)),1) Q 1
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC PREVCARE EOV >=18 CPTS",0)),1) Q 1
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC PREVCARE IOV >=18 CPTS",0)),1) Q 1
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC HOMEHEALTH VISIT CPTS",0)),1) Q 1
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC ANNUAL WELLNESS CPTS",0)),1) Q 1
  1.  Q ""
  1. DMRP(P,BDATE,EDATE) ;EP - DM DURING REPORT PERIOD
  1.  NEW X,Y,Z
  1.  I $$PLTAXND^BGP8DU(P,"BGP IPC DIABETES DXS",EDATE,1) Q 1
  1.  I $$IPLSNOND^BGP8DU(P,"PXRM BGP IPC DIABETES",EDATE,1) Q 1
  1.  I $$LASTDX^BGP8UTL1(P,"BGP IPC DIABETES DXS",BDATE,EDATE) Q 1
  1.  Q ""
  1. HOSPIND(P,BDATE,EDATE) ;EP - Hospice indicator IPC
  1.  ;GET ALL VISITS IN TIME PERIOD
  1.  ;CHECK SNOMED FOR INPATIENT AND DSCH
  1.  ;CHECK OUTPATIENT SNOMED IN V POV
  1.  ;CHECK PROBLEM LIST ENTRIES FOR NOT INACTIVE AND NOT DELETED
  1.  ;
  1.  ;1. CHECK V POV FOR SNOMED CODES
  1.  NEW S,Y,T,G,D,M,O,A,B,V
  1.  S T="PXRM BGP IPC HOSPICE"
  1.  S G=""
  1.  S S=0 F  S S=$O(^XTMP("BGPSNOMEDSUBSET",$J,T,S)) Q:S=""!(G)  D
  1.  .Q:'$D(^AUPNVPOV("ASNC",P,S))
  1.  .S D=0 F  S D=$O(^AUPNVPOV("ASNC",P,S,D)) Q:D=""!(G)  D
  1.  ..S Y=9999999-D
  1.  ..Q:Y<BDATE
  1.  ..Q:Y>EDATE
  1.  ..S G=1
  1.  I G Q G
  1.  I $$IPLSNOND^BGP8DU(P,"PXRM BGP IPC HOSPICE",EDATE,1) Q 1
  1.  I G Q G
  1.  ;check all discharges V Hospitalization discharges during the report period
  1.  S X=0,G=""
  1.  F  S X=$O(^AUPNVINP("AC",P,X)) Q:X'=+X!(G)  D
  1.  .Q:'$D(^AUPNVINP(X,0))
  1.  .S D=$P($P(^AUPNVINP(X,0),U),".")
  1.  .I D<BDATE Q
  1.  .I D>EDATE Q
  1.  .;is where seen correct?
  1.  .S V=$P(^AUPNVINP(X,0),U,3)
  1.  .Q:'V
  1.  .S Z=0
  1.  .S A=0 F  S A=$O(^AUPNVSIT(V,26,"B",A)) Q:A=""  I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC INPT ENC",A)) S Z=1
  1.  .S Y=$$VAL^XBDIQ1(9000010.02,X,6107)
  1.  .I Z,Y]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC DISCHG HOSPICE",Y)) S G=1
  1.  .I G Q
  1.  .S A=0 F  S A=$O(^AUPNVSIT(V,28,"B",A)) Q:A=""  I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC INPT ENC",A)) S Z=1
  1.  .S Y=$$VAL^XBDIQ1(9000010.02,X,6107)
  1.  .I Z,Y]"",$D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC DISCHG HOSPICE",Y)) S G=1
  1.  Q G
  1. HGBA1C(P,BDATE,EDATE) ;EP
  1.  NEW BGPG,BGPT,BGPC,T,BGPLT,E,D,B,L,X,J,C,%
  1.  K BGPG,BGPT
  1.  S BGPC=0
  1.  ;now get all loinc/taxonomy tests
  1.  S T=$O(^ATXAX("B","BGP IPC HBA1C LOINC CODES",0))
  1.  S BGPLT=$O(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
  1.  S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)  D
  1.  .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D
  1.  ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D
  1.  ...Q:'$D(^AUPNVLAB(X,0))
  1.  ...I BGPLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BGPLT,21,"B",$P(^AUPNVLAB(X,0),U))) D
  1.  ....;SET RESULT DATE/TIME 999999 WITH TIME, IF BLANK SET VISIT DATE/TIME WITH IEN
  1.  ....S %=$$VDTM^APCLV($P(^AUPNVLAB(X,0),U,3))
  1.  ....S %=(9999999-$P(%,"."))_"."_(9999-$$RZERO^BGP8UTL($P(%,".",2),4)),%=+%
  1.  ....S BGPC=BGPC+1,BGPT(%,X)=$P(^AUPNVLAB(X,0),U,4) Q
  1.  ...Q:'T
  1.  ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
  1.  ...Q:'$$LOINC(J,T)
  1.  ...S %=$$VDTM^APCLV($P(^AUPNVLAB(X,0),U,3))
  1.  ...S %=(9999999-$P(%,"."))_"."_+(9999-$$RZERO^BGP8UTL($P(%,".",2),4)),%=+%
  1.  ...S BGPC=BGPC+1,BGPT(%,X)=$P(^AUPNVLAB(X,0),U,4) Q
  1.  ...Q
  1.  ; now got though and set return value of done 1 or 0^numerator 2-7^date^value
  1.  I '$D(BGPT) Q 1_U_"No HbA1c Tests"
  1.  S D=0,G="" F  S D=$O(BGPT(D)) Q:D=""!(G]"")  D
  1.  .S C=0 F  S C=$O(BGPT(D,C)) Q:C=""  D
  1.  ..S X=BGPT(D,C)
  1.  ..I $$UP^XLFSTR(X)="COMMENT" Q
  1.  ..I X="" Q
  1.  ..I $E(X)[">" S G=1_U_$$DATE^BGP8UTL(9999999-$P(D,"."))_U_X Q
  1.  ..I $E(X)["<" S G=1_U_$$DATE^BGP8UTL(9999999-$P(D,"."))_U_X Q
  1.  ..I $E(X)'=+$E(X) Q
  1.  ..S G=1_U_$$DATE^BGP8UTL(9999999-$P(D,"."))_U_X
  1.  I G="" Q 1_U_"No Tests w/ Result"
  1.  S R=$P(G,U,3)
  1.  I $E(R)=">" Q G
  1.  I $E(R)="<" Q 0_U_$P(G,U,2,3)
  1.  S R=+R
  1.  I R>9 Q G
  1.  Q 0_U_$P(G,U,2,3)
  1. LOINC(A,B) ;EP
  1.  NEW %
  1.  S %=$P($G(^LAB(95.3,A,9999999)),U,2)
  1.  I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
  1.  S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
  1.  I $D(^ATXAX(B,21,"B",%)) Q 1
  1.  Q ""