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

BGP8PC15.m

Go to the documentation of this file. 
  1. BGP8PC15 ; IHS/CMI/LAB - measure I2 ; 02 Feb 2018  11:25 AM
  1.  ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
  1.  ;
  1. WAC ;EP
  1.  S (BGPN1,BGPN2,BGPN3,BGPD1)=0
  1.  S (BGPDV,BGPVITAL,BGPNC,BGPPA)=""
  1.  S BGPVALUE=""
  1.  K BGPV
  1.  ;
  1.  I BGPAGEE<3 S BGPSTOP=1 G WACE  ;18 or greater during time period
  1.  I BGPAGEB>17 S BGPSTOP=1 G WACE  ;75 or less during time period
  1.  ;
  1.  ;S BGPDV=$$ENC15(DFN,BGPBDATE,BGPEDATE) I BGPDV="" S BGPSTOP=1 G WACE
  1.  ;GET ALL OUTPATIENT ENCOUNTERS
  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(DFN,BGPBDATE,BGPEDATE,"BGPV")
  1.  ;now loop through and check Face to Face and .17 in visit and check v cpts attached to the visit
  1.  K BGPOV
  1.  S X=0 F  S X=$O(BGPV(X)) Q:X'=+X  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^BGP8PC2(V) I Y]"" S G=1_U_$$DATE^BGP8UTL(D)_" FTOF: "_Y,BGPOV(V)="" Q
  1.  .;is .17 a cpt we want?
  1.  .S Y=$$VALI^XBDIQ1(9000010,V,.17)
  1.  .I Y,$$OFFCPT15(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2),BGPOV(V)="" Q
  1.  .;now check all V CPTs
  1.  .S Z=0 F  S Z=$O(^AUPNVCPT("AD",V,Z)) Q:Z'=+Z  D
  1.  ..S Y=$P($G(^AUPNVCPT(Z,0)),U,1)
  1.  ..I Y,$$OFFCPT15(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2),BGPOV(V)="" Q
  1.  I G S BGPDV=G
  1.  I BGPDV="" S BGPSTOP=1 G WACE
  1.  ;now what about exclusions?
  1.  I $$HOSPIND^BGP8PC2(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 G WACE  ;no hospice pts
  1.  ;PREG?
  1.  I $$PREG^BGP8PC16(DFN,BGPBDATE,BGPEDATE) S BGPSTOP=1 G WACE
  1.  ;
  1.  S BGPD1=1
  1.  ;
  1.  S BGPVAL=""
  1.  S BGPVITAL=$$HWBMIP(DFN,BGPBDATE,BGPEDATE) I $P(BGPVITAL,U,1) S BGPN1=1
  1.  D NC
  1.  I $P(BGPNC,U,1) S BGPN2=1
  1.  D PA
  1.  I $P(BGPPA,U,1) S BGPN3=1
  1.  S BGPVALUE=""
  1.  ;S BGPVALUE="ENC "_$P(BGPDV,U,2)_"|||"  ;hit denominator
  1.  I BGPN1 S BGPVALUE=BGPVALUE_"***N1 "_$P(BGPVITAL,U,2)
  1.  I BGPN2 S:BGPVALUE]"" BGPVALUE=BGPVALUE_";" S BGPVALUE=BGPVALUE_"***N2 NUTR COUN: "_$P(BGPNC,U,2)
  1.  I BGPN3 S:BGPVALUE]"" BGPVALUE=BGPVALUE_";" S BGPVALUE=BGPVALUE_"***N3 PHYS ACT COUN: "_$P(BGPPA,U,2)
  1.  S BGPVALUE="ENC "_$P(BGPDV,U,2)_"|||"_BGPVALUE
  1.  ;
  1. WACE ;
  1.  K V,BGPDV,BGPVAL,BGPV,BGPOV,BGPVITAL,BGPNC,BGPPA
  1.  Q
  1. ENC15(P,BDATE,EDATE) ;EP  - have encounter per CMS122v6
  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.  .Q:"AORS"'[$P(^AUPNVSIT(V,0),U,7)  ;outpatient only
  1.  .S D=$$VD^APCLV(V)
  1.  .S Y=$$FTOF^BGP8PC2(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,$$OFFCPT15(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,$$OFFCPT15(Y) S G=1_U_$$DATE^BGP8UTL(D)_" CPT: "_$P($$CPT^ICPTCOD(Y),U,2) Q
  1.  Q G
  1. OFFCPT15(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 0-17 CPTS",0)),1) Q 1
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC PREVCARE IOV 0-17 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 PREVCARE IND COUN CPTS",0)),1) Q 1
  1.  I $$ICD^ATXAPI(C,$O(^ATXAX("B","BGP IPC PREVCARE GRP COUN CPTS",0)),1) Q 1
  1.  Q ""
  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 ""
  1. HWBMIP(P,BDATE,EDATE) ;
  1.  ;has ht, wt and bmip?
  1.  NEW X,Y,Z,H,W,B
  1.  S W=$$LASTITEM^BGP8DU(P,BDATE,EDATE,"MEASUREMENT","WT") I W="" Q ""
  1.  S H=$$LASTITEM^BGP8DU(P,BDATE,EDATE,"MEASUREMENT","HT") I H="" Q ""
  1.  S B=$$LASTITEM^BGP8DU(P,BDATE,EDATE,"MEASUREMENT","BMIP") I B="" Q ""
  1.  Q 1_U_$$DATE^BGP8UTL($P(H,U,2))_" HT "_$P(H,U,4)_" "_$$DATE^BGP8UTL($P(W,U,2))_" WT "_$P(W,U,4)_" "_$$DATE^BGP8UTL($P(B,U,2))_" BMIP "_$P(B,U,4)
  1. NC ;
  1.  S BGPNC=""
  1.  NEW X,Y,Z,V,G
  1.  S G=""
  1.  S V=0 F  S V=$O(BGPOV(V)) Q:V'=+V!(G)  D
  1.  .;cpt
  1.  .S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G)  D
  1.  ..S C=$P($G(^AUPNVCPT(X,0)),U,1)
  1.  ..I 'C Q
  1.  ..I $$ICD^BGP8UTL2(C,$O(^ATXAX("B","BGP IPC NUTR COUN CPTS",0)),1) S G=1_U_$$DATE^BGP8UTL($$VD^APCLV(V))_" CPT: "_$$VAL^XBDIQ1(9000010.18,X,.01)
  1.  .;NOW CHECK V POV FOR SNOMED
  1.  .S X=0 F  S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G)  D
  1.  ..S C=$$VAL^XBDIQ1(9000010.07,X,1101) Q:C=""
  1.  ..I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC NUTRITION",C)) S G=1_U_$$DATE^BGP8UTL($$VD^APCLV(V))_" SNOMED: "_C
  1.  S BGPNC=G
  1.  Q
  1. PA ;
  1.  S BGPPA=""
  1.  NEW X,Y,Z,V,G
  1.  S G=""
  1.  S V=0 F  S V=$O(BGPOV(V)) Q:V'=+V!(G)  D
  1.  .;NOW CHECK V POV FOR SNOMED
  1.  .S X=0 F  S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G)  D
  1.  ..S C=$$VAL^XBDIQ1(9000010.07,X,1101) Q:C=""
  1.  ..I $D(^XTMP("BGPSNOMEDSUBSET",$J,"PXRM BGP IPC PHYS ACT",C)) S G=1_U_$$DATE^BGP8UTL($$VD^APCLV(V))_" SNOMED: "_C
  1.  S BGPPA=G
  1.  Q