BGPMUD04 ; IHS/MSC/SAT - MU measure NQF0012 ;06-JUN-2011 15:43;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;code to collect meaningful use report Prenatal HIV Screening
ENTRY ;EP
; expects:
; DFN = patient code from VA PATIENT file
; BGPBDATE = begin date of report
; BGPEDATE = end date of report
; BGPPROV = provider code from NEW PERSON file
; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
; Print Routine: PENTRY^BGPMUDP2
; Delimited Routine: DENTRY^BGPMUDD2
N BGPP,BGPDEN,BGPNUM,BGPDT,BGPSEX,END,FIRST,IEN,START,VDATE,VIEN,VIEN1
N BGPEDC,BGPENSTR,BGPEXC,BGPHFI,BGPHIV1,BGPHIV2,BGPLDATE,BGPSCRN
S BGPDEN=0
S BGPNUM=0
S BGPEXC=0
S BGPNSTR="" ; <NDC code> OR <CPT code> ; [date in FM format]
S BGPDSTR=""
S (BGPEDC,BGPENSTR,BGPLDATE,BGPP,BGPSCRN)=""
K BGPPNA
;only check female
S BGPSEX=$$SEX^AUPNPAT(DFN)
Q:BGPSEX'="F"
;
S BGPD="" ; diagnosis found for prenatal visit (list of dates by ;)
;
;look for a delivery live birth procedure during the reporting period
S BGPP=$$DLBCPT(DFN,BGPBDATE,BGPEDATE,"BGPMU DELIVERY LIVE BIRTH CPT")
;S BGPP=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU DELIVERY LIVE BIRTH CPT")
I 'BGPP S BGPP=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU DELIVERY LIVE BIRTH DX")
Q:'BGPP
;
;look for prenatal visit with EP within 300 days of birth
S START=9999999-$$FMADD^XLFDT($P(BGPP,U,3),-300),END=9999999-$P(BGPP,U,3)
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D
..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
..;Check provider, determine if there are visits with ICD codes for prenatal visit
..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
...S BGPD=""
...D EMD(DFN,VIEN,.BGPD,BGPDT) ;determine if ICD for prenatal visit
...S:BGPD'="" BGPPNA(BGPDT)=VIEN
;quit if no diagnosis for prenatal visit
Q:'$D(BGPPNA)
;getting here means this patient is in the denominator
S BGPDEN=1
S VIEN1="",VIEN1=$O(BGPPNA(VIEN1))
S BGPDSTR="DEL:"_$$DATE^BGPMUUTL($P(BGPP,U,3))_";"_"EN:"_$$DATE^BGPMUUTL(VIEN1)
;
;check for HIV screening within 30 days of first 2 prenatal visits
S BGPCNT=0
S BGPH="" F S BGPH=$O(BGPPNA(BGPH)) Q:BGPH="" Q:BGPCNT>1 Q:+BGPSCRN D
.S BGPCNT=BGPCNT+1
.S BGPDT=BGPH
.K LABDATA
.D LAB(.LABDATA,DFN,"BGPMU HIV PRENATAL SCRN LOINC","BGPMU HIV PRENATAL SCREEN CPT",BGPDT,$$FMADD^XLFDT(BGPDT,30))
.I +LABDATA&($P($P(LABDATA,U,2),".",1)<=$$FMADD^XLFDT(BGPDT,30)) D
..S BGPNUM=1
..S BGPNSTR="M:HIV "_$$DATE^BGPMUUTL($P($P(LABDATA,U,2),".",1))
;
;setup 'not met' string
I 'BGPNUM S BGPNSTR="NM:"
;
;Check exclusions if not in numerator
I 'BGPNUM S BGPEXC=$$EXCLUDE(DFN)
S:+BGPEXC BGPNSTR="Excluded"
D TOTAL(DFN)
; check these
K BGPP,BGPDEN,BGPNUM,BGPDT,BGPSEX,END,FIRST,IEN,START,VDATE,VIEN
K BGPEDC,BGPENSTR,BGPEXC,BGPHFI,BGPHIV1,BGPHIV2,BGPLDATE,BGPPNA,BGPSCRN
Q
;
TOTAL(DFN) ;See where this patient ends up
; BGPNSTR = Numerator String: <Delivery Date text> ";" <Prenatal encounter date text> ";" <Numerator met LOINC and Date text>
; BGPDSTR = Numerator Not Met String: <Delivery Date text> ";" <Prenatal encounter date text> ";" <Numerator not met text>
; BGPESTR = Excluded String: <Delivery Date text> (empty 3rd ; piece indicates Excluded)
;if we got here, this patient is in the denominator
N BGPDT,PTCNT,DENCT,NUMCT,NOTCT,TOTALS,PT1
S TOTALS=$G(^TMP("BGPMU0012",$J,BGPMUTF,"TOT"))
S NUMCT=+$G(^TMP("BGPMU0012",$J,BGPMUTF,"NUM"))
S NOTCT=+$G(^TMP("BGPMU0012",$J,BGPMUTF,"NOT"))
S DENCT=+$G(^TMP("BGPMU0012",$J,BGPMUTF,"DEN"))
S EXCCT=+$G(^TMP("BGPMU0012",$J,BGPMUTF,"EXC"))
S PTCNT=$P(TOTALS,U,1),PT1=$P(TOTALS,U,2)
S PTCNT=PTCNT+1
S PT1=PT1+1
I BGPDEN D
.S DENCT=DENCT+1 S ^TMP("BGPMU0012",$J,BGPMUTF,"DEN")=DENCT
.S ^TMP("BGPMU0012",$J,"PAT",BGPMUTF,"DEN",DENCT)=DFN
.I +BGPEXC D
..S EXCCT=EXCCT+1
..S ^TMP("BGPMU0012",$J,BGPMUTF,"EXC")=EXCCT
..S ^TMP("BGPMU0012",$J,"PAT",BGPMUTF,"EXC",PT1)=DFN_U_BGPDSTR_U_BGPNSTR
.I '+BGPEXC D
..I BGPNUM D
...S NUMCT=NUMCT+1
...S ^TMP("BGPMU0012",$J,BGPMUTF,"NUM")=NUMCT
...S ^TMP("BGPMU0012",$J,"PAT",BGPMUTF,"NUM",PT1)=DFN_U_BGPDSTR_U_BGPNSTR
..I 'BGPNUM D
...S NOTCT=NOTCT+1
...S ^TMP("BGPMU0012",$J,BGPMUTF,"NOT")=NOTCT
...S ^TMP("BGPMU0012",$J,"PAT",BGPMUTF,"NOT",PT1)=DFN_U_BGPDSTR_U_BGPNSTR
S ^TMP("BGPMU0012",$J,BGPMUTF,"TOT")=PTCNT_U_PT1
;Setup iCare array for patient
S BGPICARE("MU.EP.0012.1",BGPMUTF)=BGPDEN_U_BGPNUM_U_""_U_$G(BGPDSTR)_";"_$G(BGPNSTR)
Q
;
;look for ICD codes for prenatal visit
EMD(DFN,VIEN,BGPD,BGPDT) ;
N BGPI,BGPTMP
S X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU PRENATAL VISIT DX")
I +X S BGPD=BGPD_$S(BGPD'="":";",1:"")_$G(BGPDT)
Q BGPD
;
EXCLUDE(DFN) ;
N BGPADM,BGPBIRTH,BGPHIV
S REASON=0
S BGPCNT=0
S BGPBIRTH=$$GET1^DIQ(2,DFN_",",.03,"I")
S BGPH="" F S BGPH=$O(BGPPNA(BGPH)) Q:BGPH="" Q:BGPCNT>2 Q:+REASON D
.S BGPCNT=BGPCNT+1
.S BGPDT=BGPH
.S VIEN=BGPPNA(BGPH)
.;check for HIV diagnosis during prenatal visit
.S X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU HIV DX")
.I +X S REASON=X Q
.;check for HIV diagnosis prior to prenatal visit
.S BGPADM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
.S X=$$LASTDX^BGPMUUT2(DFN,$P(BGPBIRTH,".",1),$P(BGPADM,".",1),"BGPMU HIV DX")
.I +X S REASON=X Q
.;check for Lab refusal
.S X=$$LABREF^BGPMUUT2(DFN,$P(BGPADM,".",1),$$FMADD^XLFDT($P(BGPADM,".",1),30),"BGPMU HIV PRENATAL SCRN LOINC","BGPMU HIV PRENATAL SCREEN CPT")
.I +X S REASON=X Q
;check for active/inactive HIV diagnosis on problem list
S BGPHIV=$$PLTAX^BGPMUUT1(DFN,"BGPMU HIV DX")
I +BGPHIV S REASON=BGPHIV
Q REASON
;
DLBCPT(DFN,BDATE,EDATE,TAX) ;check for event date of CPT to be within date range
N BGPR,BGPVCPT
N CPTT,RESULT,TIEN,VCPT
S (BGPR,BGPVCPT)=""
S (CPTT,TIEN,VCPT)=""
S RESULT=0
;check for valid input
I '$G(DFN) Q 0
I $G(TAX)="" Q 0
I $G(EDATE)="" Q 0
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN 0
I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
;check for CPT for patient checking CPT event dates
F S BGPVCPT=$O(^AUPNVCPT("C",DFN,BGPVCPT)) Q:BGPVCPT="" Q:RESULT'=0 D
.S VCPT=$P($G(^AUPNVCPT(BGPVCPT,0)),U,1),CPTT=$P($G(^ICPT(VCPT,0)),U,1)
.I $$ICD^ATXCHK(CPTT,TIEN,1) D
..S CPTDATE=$P($P($G(^AUPNVCPT(BGPVCPT,12)),U,1),".",1)
..I (CPTDATE>=BDATE)&(CPTDATE<=EDATE) D
...S VST=$P($G(^AUPNVCPT(BGPVCPT,0)),U,3),VDATE=$P($G(^AUPNVSIT(VST,0)),U,1)
...S RESULT=1_U_CPTT_U_CPTDATE_U_VDATE
Q RESULT
;
LAB(LABDATA,DFN,LTAX,CTAX,BGPDT,EDATE) ;Look for LABs
N BDT,CPT,CPTP,EDT,LOINC,LOINCP,VIEN,VLABP
S LABDATA=0 ;1 U <COLLECTION DATE/TIME> U LOINC U CPT U <RESULT DATE/TIME>
S LTIEN="" S LTIEN=$O(^ATXAX("B",LTAX,0))
S CTIEN="" S CTIEN=$O(^ATXAX("B",CTAX,0))
Q:('LTIEN)&('LTIEN) 0
S BDT=9999999-BGPDT,EDT=9999999-EDATE
F S EDT=$O(^AUPNVSIT("AA",DFN,EDT)) Q:EDT="" Q:$P(EDT,".",1)>BDT D
.S VIEN="" F S VIEN=$O(^AUPNVSIT("AA",DFN,EDT,VIEN)) Q:VIEN="" D
..Q:'$D(^AUPNVLAB("AD",VIEN))
..I +LTIEN D
...S VLABP="" F S VLABP=$O(^AUPNVLAB("AD",VIEN,VLABP)) Q:VLABP="" Q:+LABDATA D
....S LOINCP=$P($G(^AUPNVLAB(VLABP,11)),U,13)
....S VLABDT=$P($G(^AUPNVLAB(VLABP,12)),U,1)
....S VLABRDT=$P($G(^AUPNVLAB(VLABP,12)),U,12)
....I +LOINCP D
.....S LOINC=$P($G(^LAB(95.3,LOINCP,0)),U,1)_"-"_$P($G(^LAB(95.3,LOINCP,0)),U,15)
.....I $D(^ATXAX(LTIEN,21,"B",LOINC)) S LABDATA=1_U_VLABDT_U_LOINC_U_U_VLABRDT
....I ('LABDATA)&(+CTIEN) D
.....S LAB60=$P(^AUPNVLAB(VLABP,0),U,1)
.....S SITE="" F S SITE=$O(^LAB(60,LAB60,1,SITE)) Q:SITE="" D
......S CPT=$P($G(^LAB(60,LAB60,1,SITE,3)),U,1)
......I (+CPT) I $D(^ATXAX(CTIEN,21,"B",CPT)) S LABDATA=1_U_VLABDT_U_U_CPT_U_VLABRDT
Q LABDATA
;
TEST ; debug target
S U="^"
S DT=$$DT^XLFDT()
S DFN=608 ; DFN = patient code from VA PATIENT file
S BGPBDATE=3100101 ; BGPBDATE = begin date of report
S BGPEDATE=3101231 ; BGPEDATE = end date of report
S BGPPROV=2 ; BGPPROV = provider code from NEW PERSON file
S BGPMUTF="C" ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
D ENTRY
Q
BGPMUD04 ; IHS/MSC/SAT - MU measure NQF0012 ;06-JUN-2011 15:43;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;code to collect meaningful use report Prenatal HIV Screening
ENTRY ;EP
+1 ; expects:
+2 ; DFN = patient code from VA PATIENT file
+3 ; BGPBDATE = begin date of report
+4 ; BGPEDATE = end date of report
+5 ; BGPPROV = provider code from NEW PERSON file
+6 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
+7 ; Print Routine: PENTRY^BGPMUDP2
+8 ; Delimited Routine: DENTRY^BGPMUDD2
+9 NEW BGPP,BGPDEN,BGPNUM,BGPDT,BGPSEX,END,FIRST,IEN,START,VDATE,VIEN,VIEN1
+10 NEW BGPEDC,BGPENSTR,BGPEXC,BGPHFI,BGPHIV1,BGPHIV2,BGPLDATE,BGPSCRN
+11 SET BGPDEN=0
+12 SET BGPNUM=0
+13 SET BGPEXC=0
+14 ; <NDC code> OR <CPT code> ; [date in FM format]
SET BGPNSTR=""
+15 SET BGPDSTR=""
+16 SET (BGPEDC,BGPENSTR,BGPLDATE,BGPP,BGPSCRN)=""
+17 KILL BGPPNA
+18 ;only check female
+19 SET BGPSEX=$$SEX^AUPNPAT(DFN)
+20 IF BGPSEX'="F"
QUIT
+21 ;
+22 ; diagnosis found for prenatal visit (list of dates by ;)
SET BGPD=""
+23 ;
+24 ;look for a delivery live birth procedure during the reporting period
+25 SET BGPP=$$DLBCPT(DFN,BGPBDATE,BGPEDATE,"BGPMU DELIVERY LIVE BIRTH CPT")
+26 ;S BGPP=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU DELIVERY LIVE BIRTH CPT")
+27 IF 'BGPP
SET BGPP=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU DELIVERY LIVE BIRTH DX")
+28 IF 'BGPP
QUIT
+29 ;
+30 ;look for prenatal visit with EP within 300 days of birth
+31 SET START=9999999-$$FMADD^XLFDT($PIECE(BGPP,U,3),-300)
SET END=9999999-$PIECE(BGPP,U,3)
+32 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+33 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+34 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+35 ;Check provider, determine if there are visits with ICD codes for prenatal visit
+36 IF $$PRV^BGPMUUT1(VIEN,BGPPROV)
Begin DoDot:3
+37 SET BGPD=""
+38 ;determine if ICD for prenatal visit
DO EMD(DFN,VIEN,.BGPD,BGPDT)
+39 IF BGPD'=""
SET BGPPNA(BGPDT)=VIEN
End DoDot:3
End DoDot:2
End DoDot:1
+40 ;quit if no diagnosis for prenatal visit
+41 IF '$DATA(BGPPNA)
QUIT
+42 ;getting here means this patient is in the denominator
+43 SET BGPDEN=1
+44 SET VIEN1=""
SET VIEN1=$ORDER(BGPPNA(VIEN1))
+45 SET BGPDSTR="DEL:"_$$DATE^BGPMUUTL($PIECE(BGPP,U,3))_";"_"EN:"_$$DATE^BGPMUUTL(VIEN1)
+46 ;
+47 ;check for HIV screening within 30 days of first 2 prenatal visits
+48 SET BGPCNT=0
+49 SET BGPH=""
FOR
SET BGPH=$ORDER(BGPPNA(BGPH))
IF BGPH=""
QUIT
IF BGPCNT>1
QUIT
IF +BGPSCRN
QUIT
Begin DoDot:1
+50 SET BGPCNT=BGPCNT+1
+51 SET BGPDT=BGPH
+52 KILL LABDATA
+53 DO LAB(.LABDATA,DFN,"BGPMU HIV PRENATAL SCRN LOINC","BGPMU HIV PRENATAL SCREEN CPT",BGPDT,$$FMADD^XLFDT(BGPDT,30))
+54 IF +LABDATA&($PIECE($PIECE(LABDATA,U,2),".",1)<=$$FMADD^XLFDT(BGPDT,30))
Begin DoDot:2
+55 SET BGPNUM=1
+56 SET BGPNSTR="M:HIV "_$$DATE^BGPMUUTL($PIECE($PIECE(LABDATA,U,2),".",1))
End DoDot:2
End DoDot:1
+57 ;
+58 ;setup 'not met' string
+59 IF 'BGPNUM
SET BGPNSTR="NM:"
+60 ;
+61 ;Check exclusions if not in numerator
+62 IF 'BGPNUM
SET BGPEXC=$$EXCLUDE(DFN)
+63 IF +BGPEXC
SET BGPNSTR="Excluded"
+64 DO TOTAL(DFN)
+65 ; check these
+66 KILL BGPP,BGPDEN,BGPNUM,BGPDT,BGPSEX,END,FIRST,IEN,START,VDATE,VIEN
+67 KILL BGPEDC,BGPENSTR,BGPEXC,BGPHFI,BGPHIV1,BGPHIV2,BGPLDATE,BGPPNA,BGPSCRN
+68 QUIT
+69 ;
TOTAL(DFN) ;See where this patient ends up
+1 ; BGPNSTR = Numerator String: <Delivery Date text> ";" <Prenatal encounter date text> ";" <Numerator met LOINC and Date text>
+2 ; BGPDSTR = Numerator Not Met String: <Delivery Date text> ";" <Prenatal encounter date text> ";" <Numerator not met text>
+3 ; BGPESTR = Excluded String: <Delivery Date text> (empty 3rd ; piece indicates Excluded)
+4 ;if we got here, this patient is in the denominator
+5 NEW BGPDT,PTCNT,DENCT,NUMCT,NOTCT,TOTALS,PT1
+6 SET TOTALS=$GET(^TMP("BGPMU0012",$JOB,BGPMUTF,"TOT"))
+7 SET NUMCT=+$GET(^TMP("BGPMU0012",$JOB,BGPMUTF,"NUM"))
+8 SET NOTCT=+$GET(^TMP("BGPMU0012",$JOB,BGPMUTF,"NOT"))
+9 SET DENCT=+$GET(^TMP("BGPMU0012",$JOB,BGPMUTF,"DEN"))
+10 SET EXCCT=+$GET(^TMP("BGPMU0012",$JOB,BGPMUTF,"EXC"))
+11 SET PTCNT=$PIECE(TOTALS,U,1)
SET PT1=$PIECE(TOTALS,U,2)
+12 SET PTCNT=PTCNT+1
+13 SET PT1=PT1+1
+14 IF BGPDEN
Begin DoDot:1
+15 SET DENCT=DENCT+1
SET ^TMP("BGPMU0012",$JOB,BGPMUTF,"DEN")=DENCT
+16 SET ^TMP("BGPMU0012",$JOB,"PAT",BGPMUTF,"DEN",DENCT)=DFN
+17 IF +BGPEXC
Begin DoDot:2
+18 SET EXCCT=EXCCT+1
+19 SET ^TMP("BGPMU0012",$JOB,BGPMUTF,"EXC")=EXCCT
+20 SET ^TMP("BGPMU0012",$JOB,"PAT",BGPMUTF,"EXC",PT1)=DFN_U_BGPDSTR_U_BGPNSTR
End DoDot:2
+21 IF '+BGPEXC
Begin DoDot:2
+22 IF BGPNUM
Begin DoDot:3
+23 SET NUMCT=NUMCT+1
+24 SET ^TMP("BGPMU0012",$JOB,BGPMUTF,"NUM")=NUMCT
+25 SET ^TMP("BGPMU0012",$JOB,"PAT",BGPMUTF,"NUM",PT1)=DFN_U_BGPDSTR_U_BGPNSTR
End DoDot:3
+26 IF 'BGPNUM
Begin DoDot:3
+27 SET NOTCT=NOTCT+1
+28 SET ^TMP("BGPMU0012",$JOB,BGPMUTF,"NOT")=NOTCT
+29 SET ^TMP("BGPMU0012",$JOB,"PAT",BGPMUTF,"NOT",PT1)=DFN_U_BGPDSTR_U_BGPNSTR
End DoDot:3
End DoDot:2
End DoDot:1
+30 SET ^TMP("BGPMU0012",$JOB,BGPMUTF,"TOT")=PTCNT_U_PT1
+31 ;Setup iCare array for patient
+32 SET BGPICARE("MU.EP.0012.1",BGPMUTF)=BGPDEN_U_BGPNUM_U_""_U_$GET(BGPDSTR)_";"_$GET(BGPNSTR)
+33 QUIT
+34 ;
+35 ;look for ICD codes for prenatal visit
EMD(DFN,VIEN,BGPD,BGPDT) ;
+1 NEW BGPI,BGPTMP
+2 SET X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU PRENATAL VISIT DX")
+3 IF +X
SET BGPD=BGPD_$SELECT(BGPD'="":";",1:"")_$GET(BGPDT)
+4 QUIT BGPD
+5 ;
EXCLUDE(DFN) ;
+1 NEW BGPADM,BGPBIRTH,BGPHIV
+2 SET REASON=0
+3 SET BGPCNT=0
+4 SET BGPBIRTH=$$GET1^DIQ(2,DFN_",",.03,"I")
+5 SET BGPH=""
FOR
SET BGPH=$ORDER(BGPPNA(BGPH))
IF BGPH=""
QUIT
IF BGPCNT>2
QUIT
IF +REASON
QUIT
Begin DoDot:1
+6 SET BGPCNT=BGPCNT+1
+7 SET BGPDT=BGPH
+8 SET VIEN=BGPPNA(BGPH)
+9 ;check for HIV diagnosis during prenatal visit
+10 SET X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU HIV DX")
+11 IF +X
SET REASON=X
QUIT
+12 ;check for HIV diagnosis prior to prenatal visit
+13 SET BGPADM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
+14 SET X=$$LASTDX^BGPMUUT2(DFN,$PIECE(BGPBIRTH,".",1),$PIECE(BGPADM,".",1),"BGPMU HIV DX")
+15 IF +X
SET REASON=X
QUIT
+16 ;check for Lab refusal
+17 SET X=$$LABREF^BGPMUUT2(DFN,$PIECE(BGPADM,".",1),$$FMADD^XLFDT($PIECE(BGPADM,".",1),30),"BGPMU HIV PRENATAL SCRN LOINC","BGPMU HIV PRENATAL SCREEN CPT")
+18 IF +X
SET REASON=X
QUIT
End DoDot:1
+19 ;check for active/inactive HIV diagnosis on problem list
+20 SET BGPHIV=$$PLTAX^BGPMUUT1(DFN,"BGPMU HIV DX")
+21 IF +BGPHIV
SET REASON=BGPHIV
+22 QUIT REASON
+23 ;
DLBCPT(DFN,BDATE,EDATE,TAX) ;check for event date of CPT to be within date range
+1 NEW BGPR,BGPVCPT
+2 NEW CPTT,RESULT,TIEN,VCPT
+3 SET (BGPR,BGPVCPT)=""
+4 SET (CPTT,TIEN,VCPT)=""
+5 SET RESULT=0
+6 ;check for valid input
+7 IF '$GET(DFN)
QUIT 0
+8 IF $GET(TAX)=""
QUIT 0
+9 IF $GET(EDATE)=""
QUIT 0
+10 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+11 IF $GET(BDATE)=""
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+12 ;check for CPT for patient checking CPT event dates
+13 FOR
SET BGPVCPT=$ORDER(^AUPNVCPT("C",DFN,BGPVCPT))
IF BGPVCPT=""
QUIT
IF RESULT'=0
QUIT
Begin DoDot:1
+14 SET VCPT=$PIECE($GET(^AUPNVCPT(BGPVCPT,0)),U,1)
SET CPTT=$PIECE($GET(^ICPT(VCPT,0)),U,1)
+15 IF $$ICD^ATXCHK(CPTT,TIEN,1)
Begin DoDot:2
+16 SET CPTDATE=$PIECE($PIECE($GET(^AUPNVCPT(BGPVCPT,12)),U,1),".",1)
+17 IF (CPTDATE>=BDATE)&(CPTDATE<=EDATE)
Begin DoDot:3
+18 SET VST=$PIECE($GET(^AUPNVCPT(BGPVCPT,0)),U,3)
SET VDATE=$PIECE($GET(^AUPNVSIT(VST,0)),U,1)
+19 SET RESULT=1_U_CPTT_U_CPTDATE_U_VDATE
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT RESULT
+21 ;
LAB(LABDATA,DFN,LTAX,CTAX,BGPDT,EDATE) ;Look for LABs
+1 NEW BDT,CPT,CPTP,EDT,LOINC,LOINCP,VIEN,VLABP
+2 ;1 U <COLLECTION DATE/TIME> U LOINC U CPT U <RESULT DATE/TIME>
SET LABDATA=0
+3 SET LTIEN=""
SET LTIEN=$ORDER(^ATXAX("B",LTAX,0))
+4 SET CTIEN=""
SET CTIEN=$ORDER(^ATXAX("B",CTAX,0))
+5 IF ('LTIEN)&('LTIEN)
QUIT 0
+6 SET BDT=9999999-BGPDT
SET EDT=9999999-EDATE
+7 FOR
SET EDT=$ORDER(^AUPNVSIT("AA",DFN,EDT))
IF EDT=""
QUIT
IF $PIECE(EDT,".",1)>BDT
QUIT
Begin DoDot:1
+8 SET VIEN=""
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,EDT,VIEN))
IF VIEN=""
QUIT
Begin DoDot:2
+9 IF '$DATA(^AUPNVLAB("AD",VIEN))
QUIT
+10 IF +LTIEN
Begin DoDot:3
+11 SET VLABP=""
FOR
SET VLABP=$ORDER(^AUPNVLAB("AD",VIEN,VLABP))
IF VLABP=""
QUIT
IF +LABDATA
QUIT
Begin DoDot:4
+12 SET LOINCP=$PIECE($GET(^AUPNVLAB(VLABP,11)),U,13)
+13 SET VLABDT=$PIECE($GET(^AUPNVLAB(VLABP,12)),U,1)
+14 SET VLABRDT=$PIECE($GET(^AUPNVLAB(VLABP,12)),U,12)
+15 IF +LOINCP
Begin DoDot:5
+16 SET LOINC=$PIECE($GET(^LAB(95.3,LOINCP,0)),U,1)_"-"_$PIECE($GET(^LAB(95.3,LOINCP,0)),U,15)
+17 IF $DATA(^ATXAX(LTIEN,21,"B",LOINC))
SET LABDATA=1_U_VLABDT_U_LOINC_U_U_VLABRDT
End DoDot:5
+18 IF ('LABDATA)&(+CTIEN)
Begin DoDot:5
+19 SET LAB60=$PIECE(^AUPNVLAB(VLABP,0),U,1)
+20 SET SITE=""
FOR
SET SITE=$ORDER(^LAB(60,LAB60,1,SITE))
IF SITE=""
QUIT
Begin DoDot:6
+21 SET CPT=$PIECE($GET(^LAB(60,LAB60,1,SITE,3)),U,1)
+22 IF (+CPT)
IF $DATA(^ATXAX(CTIEN,21,"B",CPT))
SET LABDATA=1_U_VLABDT_U_U_CPT_U_VLABRDT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT LABDATA
+24 ;
TEST ; debug target
+1 SET U="^"
+2 SET DT=$$DT^XLFDT()
+3 ; DFN = patient code from VA PATIENT file
SET DFN=608
+4 ; BGPBDATE = begin date of report
SET BGPBDATE=3100101
+5 ; BGPEDATE = end date of report
SET BGPEDATE=3101231
+6 ; BGPPROV = provider code from NEW PERSON file
SET BGPPROV=2
+7 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
SET BGPMUTF="C"
+8 DO ENTRY
+9 QUIT
