BGPMUD07 ; IHS/MSC/SAT - MU measure NQF0027 ;12-JUL-2011 15:43;DU
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;code to collect meaningful use report SMOKING CESSATION MEDICAL ASSIST
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: P27ENT^BGPMUDP?
; Delimited Routine: D27ENT^BGPMUDD?
N BGPDEN,BGPNUM1,BGPNUM2,BGPNOT1,BGPNOT2,BGPDT,BGPAGEE,VIEN
N BGPHFI
N END,HF,N2CPT,START,TOPC,TOPCL,TOPIEN,VPEDD,VPEDIEN
S HF=0
S (BGPDEN,BGPNUM1,BGPNUM2,BGPNOT1,BGPNOT2)=0
S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
;quit if not 18 by the end of the reporting period
Q:BGPAGEE<18
;look for 1 outpatient encounter with the EP back to 730 days prior to the end of the reporting period
S START=9999999-$$FMADD^XLFDT(BGPEDATE,-730),END=9999999-BGPEDATE
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:+BGPDEN
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:+BGPDEN
..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
..;Check provider, determine if there are visits with E&M codes
..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
...S X=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU CTRL HIGH BP EM")
...I +X S BGPDEN=1_U_"EN:"_$$DATE^BGPMUUTL(BGPDT)
...I '+BGPDEN D
....S X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ENC OUTPATIENT ICD")
....I +X S BGPDEN=1_U_"EN:"_$$DATE^BGPMUUTL(BGPDT)
;quit if visits with E&M code(s) not found for given DFN
Q:'+BGPDEN
;
;check numerator 1
S HF=$$HF(DFN,"BGPMU TOB SMOKER HF")
S BGPDENT=""
I +HF D
.S BGPNUM1="M:"_$P(HF,U,2)_" "_$$DATE^BGPMUUTL($P(HF,U,4)) ;patient is in numerator 1
.S BGPNUM1=1_U_$$FL(BGPNUM1,17,";")
.S BGPDENT="HF:"_$$DATE^BGPMUUTL($P(HF,U,4))
I 'BGPNUM1 D
.S HF=$$HF(DFN,"BGPMU TOB NON-USER HF")
.S BGPNOT1="NM:"_$S(+HF:$P(HF,U,2)_" "_$$DATE^BGPMUUTL($P(HF,U,4)),1:"")
.S BGPNOT1=1_U_$$FL(BGPNOT1,17,";")
;
;check numerator 2
I +BGPNUM1 D
.S N2CPT=$$CPT^BGPMUUT1(DFN,$$FMADD^XLFDT(BGPEDATE,-365),BGPEDATE,"BGPMU TOBACCO USE CESS COUNSEL")
.I +N2CPT S BGPNUM2=1_U_"M:"_$P(N2CPT,U,2)_" "_$$DATE^BGPMUUTL($P(N2CPT,U,3))
.I '+BGPNUM2 D
..S START=9999999-$$FMADD^XLFDT(BGPEDATE,-365)
..S END=9999999-BGPEDATE
..S VPEDD=END-1 F S VPEDD=$O(^AUPNVPED("AA",DFN,VPEDD)) Q:VPEDD="" D
...S VPEDIEN=0 F S VPEDIEN=$O(^AUPNVPED("AA",DFN,VPEDD,VPEDIEN)) Q:VPEDIEN="" D
....S TOPIEN=$P(^AUPNVPED(VPEDIEN,0),U,1)
....Q:TOPIEN=""
....S TOPC=$P(^AUTTEDT(TOPIEN,0),U,2)
....S TOPCL=$L(TOPC)
....I ("TO"=$E(TOPC,1,2))!("TO"=$E(TOPC,TOPCL-1,TOPCL))!("SHS"=$E(TOPC,TOPCL-2,TOPCL)) S BGPNUM2="M:"_TOPC_" "_$$DATE^BGPMUUTL((9999999-VPEDD)),BGPNUM2=1_U_$$FL(BGPNUM2,17,";")
S:'+BGPNUM2 BGPNOT2=1_U_"NM:"
;
D TOTAL(DFN)
; check these
K BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y,TERMINAL,NORMAL,FOLLOW,EXCEPT
Q
;
TOTAL(DFN) ;See where this patient ends up
; BGPDSTR = Denominator string: encounter dates in FM format pieced by ";"
; BGPNSTR = Numerator string: <health factor text> ";" <health factor edit date in FM format>
;if we got here, this patient is in the denominator
N BGPDT,PTCNT,DENCT,NUMCT,NOTCT,TOTALS,PT1
S TOTALS=$G(^TMP("BGPMU0027",$J,BGPMUTF,"TOT"))
S NUMCT1=+$G(^TMP("BGPMU0027",$J,BGPMUTF,"NUM",1))
S NUMCT2=+$G(^TMP("BGPMU0027",$J,BGPMUTF,"NUM",2))
S NOTCT1=+$G(^TMP("BGPMU0027",$J,BGPMUTF,"NOT",1))
S NOTCT2=+$G(^TMP("BGPMU0027",$J,BGPMUTF,"NOT",2))
S DENCT=+$G(^TMP("BGPMU0027",$J,BGPMUTF,"DEN",1))
S EXCCT=+$G(^TMP("BGPMU0027",$J,BGPMUTF,"EXC",1))
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("BGPMU0027",$J,BGPMUTF,"DEN",1)=DENCT
.S ^TMP("BGPMU0027",$J,"PAT",BGPMUTF,"DEN",1,DENCT)=DFN
.I +BGPNUM1 D
..S NUMCT1=NUMCT1+1
..S ^TMP("BGPMU0027",$J,BGPMUTF,"NUM",1)=NUMCT1
..S ^TMP("BGPMU0027",$J,"PAT",BGPMUTF,"NUM",1,PT1)=DFN_U_$P(BGPDEN,U,2)_U_$P(BGPNUM1,U,2)
.I '+BGPNUM1 D
..S NOTCT1=NOTCT1+1
..S ^TMP("BGPMU0027",$J,BGPMUTF,"NOT",1)=NOTCT1
..S ^TMP("BGPMU0027",$J,"PAT",BGPMUTF,"NOT",1,PT1)=DFN_U_$P(BGPDEN,U,2)_U_$P(BGPNOT1,U,2)
.I +BGPNUM2 D
..S NUMCT2=NUMCT2+1
..S ^TMP("BGPMU0027",$J,BGPMUTF,"NUM",2)=NUMCT2
..S ^TMP("BGPMU0027",$J,"PAT",BGPMUTF,"NUM",2,PT1)=DFN_U_$P(BGPDEN,U,2)_U_$P(BGPNUM2,U,2)
.I '+BGPNUM2 D
..S NOTCT2=NOTCT2+1
..S ^TMP("BGPMU0027",$J,BGPMUTF,"NOT",2)=NOTCT2
..S ^TMP("BGPMU0027",$J,"PAT",BGPMUTF,"NOT",2,PT1)=DFN_U_$P(BGPDEN,U,2)_";"_BGPDENT_U_$P(BGPNOT2,U,2)
;
S ^TMP("BGPMU0027",$J,BGPMUTF,"TOT")=PTCNT_U_PT1
;Setup iCare array for patient
S BGPICARE("MU.EP.0027.1",BGPMUTF)=1_U_+BGPNUM1_U_""_U_$P(BGPDEN,U,2)_";"_$P($G(BGPNUM1),U,2)
S BGPICARE("MU.EP.0027.2",BGPMUTF)=1_U_+BGPNUM2_U_""_U_$P(BGPDEN,U,2)_";"_$P($G(BGPNUM2),U,2)
Q
;
HF(DFN,TAX) ;look in health factors for values in given taxonomy
N BGPDT,BGPH,BGPHFN,BGPTOBN,BGPTOBU
S TIEN="" S TIEN=$O(^ATXAX("B",TAX,TIEN)) Q:'TIEN 0
S BGPHF=0 ;health factor found flag
S END=9999999-BGPEDATE,START=9999999-$$FMADD^XLFDT(BGPEDATE,-365)
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:BGPHF
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:BGPHF
..S BGPIEN="" F S BGPIEN=$O(^AUPNVHF("AD",VIEN,BGPIEN)) Q:'+BGPIEN D
...S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
...S BGPHNOD=$G(^AUPNVHF(BGPIEN,0))
...S BGPHFI=$P(BGPHNOD,U,1)
...S BGPHFC=$P(^AUTTHF(BGPHFI,0),U,2)
...S BGPHFN=$P(^AUTTHF(BGPHFI,0),U,1)
...I $D(^ATXAX(TIEN,21,"B",BGPHFN)) S BGPHF=1_"^"_BGPHFN_"^"_BGPHFC_"^"_BGPDT
Q BGPHF
;
FL(STRING,WIDTH,DELIM) ;
N FLI,TSTRING
S:$G(DELIM)="" DELIM="^"
S RETURN=""
Q:$L(STRING)<=WIDTH STRING
S TSTRING=STRING
S TSTRINGL=$L(TSTRING)
F Q:TSTRING="" D
.S TSA=0
.I WIDTH>=$L(TSTRING) S RETURN=RETURN_DELIM_TSTRING,TSTRING=""
.Q:TSTRING=""
.I $E(TSTRING,1,WIDTH)'[" " D
..S RETURN=$S(RETURN'="":RETURN_DELIM,1:"")_$E(TSTRING,1,WIDTH)
..S TSTRING=$E(TSTRING,WIDTH+1,TSTRINGL)
..S TSTRINGL=$L(TSTRING)
..S TSA=1
.Q:TSA
.S FLI=WIDTH
.F Q:FLI<1 D
..I $E(TSTRING,FLI)=" " D
...S RETURN=$S(RETURN'="":RETURN_DELIM,1:"")_$E(TSTRING,1,FLI-1)
...S TSTRING=$E(TSTRING,FLI+1,TSTRINGL)
...S TSTRINGL=$L(TSTRING)
...S FLI=1
..S FLI=FLI-1
Q RETURN
;
TEST ; debug target
;S U="^"
;S DT=$$DT^XLFDT()
;S DFN=184 ; DFN = patient code from VA PATIENT file
;S BGPBDATE=3100930 ; BGPBDATE = begin date of report
;S BGPEDATE=3110801 ; 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
;S ZSAT=$$HF(175,"BGPMU TOB SMOKER HF")
;W ZSAT
Q
BGPMUD07 ; IHS/MSC/SAT - MU measure NQF0027 ;12-JUL-2011 15:43;DU
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;code to collect meaningful use report SMOKING CESSATION MEDICAL ASSIST
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: P27ENT^BGPMUDP?
+8 ; Delimited Routine: D27ENT^BGPMUDD?
+9 NEW BGPDEN,BGPNUM1,BGPNUM2,BGPNOT1,BGPNOT2,BGPDT,BGPAGEE,VIEN
+10 NEW BGPHFI
+11 NEW END,HF,N2CPT,START,TOPC,TOPCL,TOPIEN,VPEDD,VPEDIEN
+12 SET HF=0
+13 SET (BGPDEN,BGPNUM1,BGPNUM2,BGPNOT1,BGPNOT2)=0
+14 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+15 ;quit if not 18 by the end of the reporting period
+16 IF BGPAGEE<18
QUIT
+17 ;look for 1 outpatient encounter with the EP back to 730 days prior to the end of the reporting period
+18 SET START=9999999-$$FMADD^XLFDT(BGPEDATE,-730)
SET END=9999999-BGPEDATE
+19 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+20 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+21 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+22 ;Check provider, determine if there are visits with E&M codes
+23 IF $$PRV^BGPMUUT1(VIEN,BGPPROV)
Begin DoDot:3
+24 SET X=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU CTRL HIGH BP EM")
+25 IF +X
SET BGPDEN=1_U_"EN:"_$$DATE^BGPMUUTL(BGPDT)
+26 IF '+BGPDEN
Begin DoDot:4
+27 SET X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ENC OUTPATIENT ICD")
+28 IF +X
SET BGPDEN=1_U_"EN:"_$$DATE^BGPMUUTL(BGPDT)
End DoDot:4
End DoDot:3
End DoDot:2
IF +BGPDEN
QUIT
End DoDot:1
IF +BGPDEN
QUIT
+29 ;quit if visits with E&M code(s) not found for given DFN
+30 IF '+BGPDEN
QUIT
+31 ;
+32 ;check numerator 1
+33 SET HF=$$HF(DFN,"BGPMU TOB SMOKER HF")
+34 SET BGPDENT=""
+35 IF +HF
Begin DoDot:1
+36 ;patient is in numerator 1
SET BGPNUM1="M:"_$PIECE(HF,U,2)_" "_$$DATE^BGPMUUTL($PIECE(HF,U,4))
+37 SET BGPNUM1=1_U_$$FL(BGPNUM1,17,";")
+38 SET BGPDENT="HF:"_$$DATE^BGPMUUTL($PIECE(HF,U,4))
End DoDot:1
+39 IF 'BGPNUM1
Begin DoDot:1
+40 SET HF=$$HF(DFN,"BGPMU TOB NON-USER HF")
+41 SET BGPNOT1="NM:"_$SELECT(+HF:$PIECE(HF,U,2)_" "_$$DATE^BGPMUUTL($PIECE(HF,U,4)),1:"")
+42 SET BGPNOT1=1_U_$$FL(BGPNOT1,17,";")
End DoDot:1
+43 ;
+44 ;check numerator 2
+45 IF +BGPNUM1
Begin DoDot:1
+46 SET N2CPT=$$CPT^BGPMUUT1(DFN,$$FMADD^XLFDT(BGPEDATE,-365),BGPEDATE,"BGPMU TOBACCO USE CESS COUNSEL")
+47 IF +N2CPT
SET BGPNUM2=1_U_"M:"_$PIECE(N2CPT,U,2)_" "_$$DATE^BGPMUUTL($PIECE(N2CPT,U,3))
+48 IF '+BGPNUM2
Begin DoDot:2
+49 SET START=9999999-$$FMADD^XLFDT(BGPEDATE,-365)
+50 SET END=9999999-BGPEDATE
+51 SET VPEDD=END-1
FOR
SET VPEDD=$ORDER(^AUPNVPED("AA",DFN,VPEDD))
IF VPEDD=""
QUIT
Begin DoDot:3
+52 SET VPEDIEN=0
FOR
SET VPEDIEN=$ORDER(^AUPNVPED("AA",DFN,VPEDD,VPEDIEN))
IF VPEDIEN=""
QUIT
Begin DoDot:4
+53 SET TOPIEN=$PIECE(^AUPNVPED(VPEDIEN,0),U,1)
+54 IF TOPIEN=""
QUIT
+55 SET TOPC=$PIECE(^AUTTEDT(TOPIEN,0),U,2)
+56 SET TOPCL=$LENGTH(TOPC)
+57 IF ("TO"=$EXTRACT(TOPC,1,2))!("TO"=$EXTRACT(TOPC,TOPCL-1,TOPCL))!("SHS"=$EXTRACT(TOPC,TOPCL-2,TOPCL))
SET BGPNUM2="M:"_TOPC_" "_$$DATE^BGPMUUTL((9999999-VPEDD))
SET BGPNUM2=1_U_$$FL(BGPNUM2,17,";")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+58 IF '+BGPNUM2
SET BGPNOT2=1_U_"NM:"
+59 ;
+60 DO TOTAL(DFN)
+61 ; check these
+62 KILL BGPL,BGPLWTS,BGPLHTS,%,X,BGPLWTS1,BGPLHTS1,Y,TERMINAL,NORMAL,FOLLOW,EXCEPT
+63 QUIT
+64 ;
TOTAL(DFN) ;See where this patient ends up
+1 ; BGPDSTR = Denominator string: encounter dates in FM format pieced by ";"
+2 ; BGPNSTR = Numerator string: <health factor text> ";" <health factor edit date in FM format>
+3 ;if we got here, this patient is in the denominator
+4 NEW BGPDT,PTCNT,DENCT,NUMCT,NOTCT,TOTALS,PT1
+5 SET TOTALS=$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"TOT"))
+6 SET NUMCT1=+$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"NUM",1))
+7 SET NUMCT2=+$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"NUM",2))
+8 SET NOTCT1=+$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"NOT",1))
+9 SET NOTCT2=+$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"NOT",2))
+10 SET DENCT=+$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"DEN",1))
+11 SET EXCCT=+$GET(^TMP("BGPMU0027",$JOB,BGPMUTF,"EXC",1))
+12 SET PTCNT=$PIECE(TOTALS,U,1)
SET PT1=$PIECE(TOTALS,U,2)
+13 SET PTCNT=PTCNT+1
+14 SET PT1=PT1+1
+15 IF BGPDEN
Begin DoDot:1
+16 SET DENCT=DENCT+1
SET ^TMP("BGPMU0027",$JOB,BGPMUTF,"DEN",1)=DENCT
+17 SET ^TMP("BGPMU0027",$JOB,"PAT",BGPMUTF,"DEN",1,DENCT)=DFN
+18 IF +BGPNUM1
Begin DoDot:2
+19 SET NUMCT1=NUMCT1+1
+20 SET ^TMP("BGPMU0027",$JOB,BGPMUTF,"NUM",1)=NUMCT1
+21 SET ^TMP("BGPMU0027",$JOB,"PAT",BGPMUTF,"NUM",1,PT1)=DFN_U_$PIECE(BGPDEN,U,2)_U_$PIECE(BGPNUM1,U,2)
End DoDot:2
+22 IF '+BGPNUM1
Begin DoDot:2
+23 SET NOTCT1=NOTCT1+1
+24 SET ^TMP("BGPMU0027",$JOB,BGPMUTF,"NOT",1)=NOTCT1
+25 SET ^TMP("BGPMU0027",$JOB,"PAT",BGPMUTF,"NOT",1,PT1)=DFN_U_$PIECE(BGPDEN,U,2)_U_$PIECE(BGPNOT1,U,2)
End DoDot:2
+26 IF +BGPNUM2
Begin DoDot:2
+27 SET NUMCT2=NUMCT2+1
+28 SET ^TMP("BGPMU0027",$JOB,BGPMUTF,"NUM",2)=NUMCT2
+29 SET ^TMP("BGPMU0027",$JOB,"PAT",BGPMUTF,"NUM",2,PT1)=DFN_U_$PIECE(BGPDEN,U,2)_U_$PIECE(BGPNUM2,U,2)
End DoDot:2
+30 IF '+BGPNUM2
Begin DoDot:2
+31 SET NOTCT2=NOTCT2+1
+32 SET ^TMP("BGPMU0027",$JOB,BGPMUTF,"NOT",2)=NOTCT2
+33 SET ^TMP("BGPMU0027",$JOB,"PAT",BGPMUTF,"NOT",2,PT1)=DFN_U_$PIECE(BGPDEN,U,2)_";"_BGPDENT_U_$PIECE(BGPNOT2,U,2)
End DoDot:2
End DoDot:1
+34 ;
+35 SET ^TMP("BGPMU0027",$JOB,BGPMUTF,"TOT")=PTCNT_U_PT1
+36 ;Setup iCare array for patient
+37 SET BGPICARE("MU.EP.0027.1",BGPMUTF)=1_U_+BGPNUM1_U_""_U_$PIECE(BGPDEN,U,2)_";"_$PIECE($GET(BGPNUM1),U,2)
+38 SET BGPICARE("MU.EP.0027.2",BGPMUTF)=1_U_+BGPNUM2_U_""_U_$PIECE(BGPDEN,U,2)_";"_$PIECE($GET(BGPNUM2),U,2)
+39 QUIT
+40 ;
HF(DFN,TAX) ;look in health factors for values in given taxonomy
+1 NEW BGPDT,BGPH,BGPHFN,BGPTOBN,BGPTOBU
+2 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B",TAX,TIEN))
IF 'TIEN
QUIT 0
+3 ;health factor found flag
SET BGPHF=0
+4 SET END=9999999-BGPEDATE
SET START=9999999-$$FMADD^XLFDT(BGPEDATE,-365)
+5 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+6 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+7 SET BGPIEN=""
FOR
SET BGPIEN=$ORDER(^AUPNVHF("AD",VIEN,BGPIEN))
IF '+BGPIEN
QUIT
Begin DoDot:3
+8 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+9 SET BGPHNOD=$GET(^AUPNVHF(BGPIEN,0))
+10 SET BGPHFI=$PIECE(BGPHNOD,U,1)
+11 SET BGPHFC=$PIECE(^AUTTHF(BGPHFI,0),U,2)
+12 SET BGPHFN=$PIECE(^AUTTHF(BGPHFI,0),U,1)
+13 IF $DATA(^ATXAX(TIEN,21,"B",BGPHFN))
SET BGPHF=1_"^"_BGPHFN_"^"_BGPHFC_"^"_BGPDT
End DoDot:3
End DoDot:2
IF BGPHF
QUIT
End DoDot:1
IF BGPHF
QUIT
+14 QUIT BGPHF
+15 ;
FL(STRING,WIDTH,DELIM) ;
+1 NEW FLI,TSTRING
+2 IF $GET(DELIM)=""
SET DELIM="^"
+3 SET RETURN=""
+4 IF $LENGTH(STRING)<=WIDTH
QUIT STRING
+5 SET TSTRING=STRING
+6 SET TSTRINGL=$LENGTH(TSTRING)
+7 FOR
IF TSTRING=""
QUIT
Begin DoDot:1
+8 SET TSA=0
+9 IF WIDTH>=$LENGTH(TSTRING)
SET RETURN=RETURN_DELIM_TSTRING
SET TSTRING=""
+10 IF TSTRING=""
QUIT
+11 IF $EXTRACT(TSTRING,1,WIDTH)'[" "
Begin DoDot:2
+12 SET RETURN=$SELECT(RETURN'="":RETURN_DELIM,1:"")_$EXTRACT(TSTRING,1,WIDTH)
+13 SET TSTRING=$EXTRACT(TSTRING,WIDTH+1,TSTRINGL)
+14 SET TSTRINGL=$LENGTH(TSTRING)
+15 SET TSA=1
End DoDot:2
+16 IF TSA
QUIT
+17 SET FLI=WIDTH
+18 FOR
IF FLI<1
QUIT
Begin DoDot:2
+19 IF $EXTRACT(TSTRING,FLI)=" "
Begin DoDot:3
+20 SET RETURN=$SELECT(RETURN'="":RETURN_DELIM,1:"")_$EXTRACT(TSTRING,1,FLI-1)
+21 SET TSTRING=$EXTRACT(TSTRING,FLI+1,TSTRINGL)
+22 SET TSTRINGL=$LENGTH(TSTRING)
+23 SET FLI=1
End DoDot:3
+24 SET FLI=FLI-1
End DoDot:2
End DoDot:1
+25 QUIT RETURN
+26 ;
TEST ; debug target
+1 ;S U="^"
+2 ;S DT=$$DT^XLFDT()
+3 ;S DFN=184 ; DFN = patient code from VA PATIENT file
+4 ;S BGPBDATE=3100930 ; BGPBDATE = begin date of report
+5 ;S BGPEDATE=3110801 ; BGPEDATE = end date of report
+6 ;S BGPPROV=2 ; BGPPROV = provider code from NEW PERSON file
+7 ;S BGPMUTF="C" ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
+8 ;D ENTRY
+9 ;S ZSAT=$$HF(175,"BGPMU TOB SMOKER HF")
+10 ;W ZSAT
+11 QUIT
