BGPMUC01.m

BGPMUC01 ; IHS/MSC/MGH - MI measure NQF0041 ;02-Mar-2011 11:25;DU

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 ;Code to collect meaningful use report for adult influenza immunization 0041

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

 N BGP1,BGP2,BGPDEN,BGPNUM,BGPDT,END,FIRST,IEN,START,VDATE,VIEN,BGPZ,EXCL,BGPX

 N VCNT,ACNT,BCNT,AENC,BENC,G,CENC,DENC,EENC,FENC,GENC,STRING,STRING2,IMMC,FBDATE,FEDATE

 S (ACNT,BCNT,VCNT)=0

 S (BGPDEN,BGPNUM,EXCL)=0

 ;Pts must be 50 years and older

 Q:BGPAGEB<50

 D FLUDATES

 ;the START date will be the beginning of the previous flu season and the loop below will make appropriate report period checks

 S START=9999999-FBDATE,END=9999999-BGPEDATE

 ;look for 2 visits with E&M codes (outpatient encounters)

 ;    OR   1 visit with E&M codes  (preventive medicine encounter)

 S (BGP1,BGP2)=0

 S (STRING,STRING2)=""

 S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D

 .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN  D

 ..;Check provider, determine if there are visits with E&M codes where at least 2 are needed

 ..I $$PRV^BGPMUUT1(IEN,BGPPROV) D

 ...;check and see if an appropriate CPT code exists

 ...S AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU ENCOUNTER EM")

 ...S BENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU PREV 40 ENCOUNT EM")

 ...S CENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU GRP ENCOUNT EM")

 ...S DENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU IND ENCOUNT EM")

 ...S EENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU PREV OTH ENCOUNT EM")

 ...S FENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU NURS FAC ENCOUNT EM")

 ...S GENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU NURS DC ENCOUNT EM")

 ...;Need 2 or more of BGPMU FLU ENCOUNT EM OR 1 or more of the others

 ...I (+AENC=1) D

 ....S VDATE=$P($P($G(^AUPNVSIT(IEN,0)),U,1),".",1)

 ....S VCNT=VCNT+1

 ....S VIEN(VCNT)=IEN_U_VDATE

 ....;check to see if encounter is within report period

 ....I (VDATE>=BGPBDATE)&(VDATE<=BGPEDATE) D

 .....S ACNT=ACNT+1

 .....S STRING="EN:"_$$DATE^BGPMUUTL(VDATE)

 ...I (+BENC=1)!(+CENC=1)!(+DENC=1)!(+EENC=1)!(+FENC=1)!(+GENC=1) D

 ....S VDATE=$P($P($G(^AUPNVSIT(IEN,0)),U,1),".",1)

 ....S VCNT=VCNT+1

 ....S VIEN(VCNT)=IEN_U_VDATE

 ....;check to see if encounter is within report period

 ....I (VDATE>=BGPBDATE)&(VDATE<=BGPEDATE) D

 .....S BCNT=BCNT+1

 .....I STRING="" S STRING="EN:"_$$DATE^BGPMUUTL(VDATE)

 .....E  S STRING=STRING_";EN:"_$$DATE^BGPMUUTL(VDATE)

 I (ACNT>1)!(BCNT>0) D

 .;count for denominator if encounter falls between Sept-Feb

 .S BGPFLU=$$FLU(DFN)

 .I +BGPFLU D

 ..S BGPDEN=1

 ..;Setup numerator

 ..;get all immunizations

 ..S C="15^16^111^125^126^127^128^135"

 ..S CPTS="90656^90658^90660^90661^90662^90663^90664^90666^90667^90668"

 ..K BGPX D GETIMMS^BGPMUUT2(DFN,BGPEDATE,C,.BGPX,CPTS)

 ..I $D(BGPX) D

 ...S IMMC=""

 ...F  S IMMC=$O(BGPX(IMMC)) Q:IMMC=""  D

 ....S IMMD=BGPX(IMMC)

 ....S IMMV=$P(IMMD,U,2)

 ....S IMMDATE=$P($G(^AUPNVSIT(IMMV,0)),U,1)

 ....I (IMMDATE>FBDATE)&(IMMDATE<FEDATE) D

 .....S BGPNUM=1

 .....S STRING2=$S($P(IMMD,U,3):$P(IMMD,U,1),1:$P($G(^AUTTIMM($P(IMMD,U,1),0)),U,3))_" "_$$DATE^BGPMUUTL($P(IMMDATE,".",1))

 .....Q

 ..I +BGPNUM=0 D

 ...;Exclude if flu immunization contraindication

 ...F BGPZ=15,16,111,125,126,127,128,135 S X=$$FLUCONT(DFN,BGPZ,$$DOB^AUPNPAT(DFN),BGPEDATE) Q:X]""

 ...I X]"" S EXCL=1

 ...;NMI refusal

 ...S G=""

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",15,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",16,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",111,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",125,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",126,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",127,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",128,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",135,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...;Exclude if refused

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",15,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",16,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",111,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",125,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",126,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",127,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",128,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ...I EXCL'=1 S G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$O(^AUTTIMM("C",135,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 ...S:$P(G,U)=1 EXCL=1

 ..D TOTAL(DFN)

 K BGP1,BGP2,BGPDEN,BGPNUM,BGPDT,END,FIRST,IEN,START,VDATE,VIEN,BGPZ,EXCL,BGPX

 K ACNT,BCNT,AENC,BENC,GS

 Q

 ;

FLUCONT(P,C,BD,ED) ;EP

 N X,G,Y,R,D

 ;first check for ICD-9 code documented

 S G=$$LASTDX^BGPMUUT2(P,BD,ED,"BGPMU FLU EGG ALLERGY DX")

 I G Q 1_U_"Egg Allergy Dx"

 S X=0,G="",Y=$O(^AUTTIMM("C",C,0)) I Y F  S X=$O(^BIPC("AC",P,Y,X)) Q:X'=+X!(G)  D

 .S R=$P(^BIPC(X,0),U,3)

 .Q:R=""

 .Q:'$D(^BICONT(R,0))

 .S D=$P(^BIPC(X,0),U,4)

 .Q:D=""

 .Q:$P(^BIPC(X,0),U,4)<BD

 .Q:$P(^BIPC(X,0),U,4)>ED

 .I $P(^BICONT(R,0),U,1)="Egg Allergy" S G=D_U_"Contraindication: Egg Allergy"

 .;I $P(^BICONT(R,0),U,1)="Anaphylaxis" S G=D_U_"Contraindication: Anaphylaxis"  REMOVED per Dr. Advani

 K X,Y,R,D

 Q G

 ;

FLU(DFN) ;Find if pt has a visit during the flu season (Sept-Feb)

 N NUM,FLUCNT,FDATE

 S FLUCNT=0

 S NUM=0 F  S NUM=$O(VIEN(NUM)) Q:NUM=""!(FLUCNT>1)  D

 .S FDATE=$P(VIEN(NUM),U,2)

 .I (FDATE>FBDATE)&(FDATE<FEDATE) D

 ..S FLUCNT=FLUCNT+1

 ..S STRING="EN:"_$$DATE^BGPMUUTL(FDATE)

 ..;I $G(STRING2)="" S STRING2="FLU:"_FDATE

 ..;E  S STRING2=STRING2_",FLU:"_FDATE

 Q FLUCNT

 ;

FLUDATES ; Calculate dates of the most recent flu season

 S FEDATE=$S(+$E(BGPEDATE,4,5)>0&(+$E(BGPEDATE,4,5)<3):($E(BGPEDATE,1,3)-1)_"0301",1:$E(BGPEDATE,1,3)_"0301")

 S FBDATE=($E(FEDATE,1,3)-1)_"0831"

 Q

 ;S FBDATE=$S(+$E(BGPBDATE,4,5)>0&(+$E(BGPBDATE,4,5)<3):$E(BGPBDATE,1,3)_"0101",1:$E(BGPBDATE,1,3)_"0901")

 ;I $E(BGPBDATE,1,3)'=$E(BGPEDATE,1,3)  D

 ;.S FEDATE=$S(+$E(BGPEDATE,4,5)>0&(+$E(BGPEDATE,4,5)<3):$E(BGPEDATE,1,3)_"0301",1:$E(BGPEDATE,1,3)_"1231")

 ;E  S FEDATE=$S(+$E(BGPEDATE,4,5)>0&(+$E(BGPEDATE,4,5)<3):$E(BGPEDATE,1,3)_"0301",1:$E(BGPEDATE,1,3)+1_"0101")

 ;Q

TOTAL(DFN) ;See where this patient ends up

 N PTCNT,EXCCT,DENCT,NUMCT,TOTALS

 S TOTALS=+$G(^TMP("BGPMU0041",$J,BGPMUTF,"TOT"))

 S EXCCT=+$G(^TMP("BGPMU0041",$J,BGPMUTF,"EXC"))

 S DENCT=+$G(^TMP("BGPMU0041",$J,BGPMUTF,"DEN"))

 S NUMCT=+$G(^TMP("BGPMU0041",$J,BGPMUTF,"NUM"))

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 I +EXCL D

 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0041",$J,BGPMUTF,"EXC")=EXCCT

 .I BGPMUTF="C" S ^TMP("BGPMU0041",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_STRING_U_"Excluded"

 E  D

 .S:+BGPDEN DENCT=DENCT+1 S ^TMP("BGPMU0041",$J,BGPMUTF,"DEN")=DENCT

 .I +BGPNUM D

 ..S NUMCT=NUMCT+1 S ^TMP("BGPMU0041",$J,BGPMUTF,"NUM")=NUMCT

 ..I BGPMUTF="C" S ^TMP("BGPMU0041",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_STRING_U_STRING2

 .E  I BGPMUTF="C" S ^TMP("BGPMU0041",$J,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_STRING_U_STRING2

 S ^TMP("BGPMU0041",$J,BGPMUTF,"TOT")=PTCNT

 ;Setup iCare array for patient

 S BGPICARE("MU.EP.0041.1",BGPMUTF)=(+BGPDEN&'EXCL)_U_+BGPNUM_U_+EXCL_U_STRING_";"_STRING2_U_$P(EXCL,U,2)

 K PTCNT,EXCCT,DENCT,NUMCT,TOTALS

 Q

 ;

TEST ; debug target

 ;S U="^"

 ;S DT=$$DT^XLFDT()

 ;S DFN=184            ;  DFN      = patient code from VA PATIENT file

 ;S BGPBDATE=3110101   ;  BGPBDATE = begin date of report

 ;S BGPEDATE=3110301   ;  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

BGPMUC01  ; IHS/MSC/MGH - MI measure NQF0041 ;02-Mar-2011 11:25;DU

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 +2       ;Code to collect meaningful use report for adult influenza immunization 0041

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        NEW BGP1,BGP2,BGPDEN,BGPNUM,BGPDT,END,FIRST,IEN,START,VDATE,VIEN,BGPZ,EXCL,BGPX

 +8        NEW VCNT,ACNT,BCNT,AENC,BENC,G,CENC,DENC,EENC,FENC,GENC,STRING,STRING2,IMMC,FBDATE,FEDATE

 +9        SET (ACNT,BCNT,VCNT)=0

 +10       SET (BGPDEN,BGPNUM,EXCL)=0

 +11      ;Pts must be 50 years and older

 +12       IF BGPAGEB<50

               QUIT 

 +13       DO FLUDATES

 +14      ;the START date will be the beginning of the previous flu season and the loop below will make appropriate report period checks

 +15       SET START=9999999-FBDATE

           SET END=9999999-BGPEDATE

 +16      ;look for 2 visits with E&M codes (outpatient encounters)

 +17      ;    OR   1 visit with E&M codes  (preventive medicine encounter)

 +18       SET (BGP1,BGP2)=0

 +19       SET (STRING,STRING2)=""

 +20       SET FIRST=END-0.1

           FOR 

               SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))

               IF FIRST=""!($PIECE(FIRST,".",1)>START)

                   QUIT 

               Begin DoDot:1

 +21               SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))

                       IF '+IEN

                           QUIT 

                       Begin DoDot:2

 +22      ;Check provider, determine if there are visits with E&M codes where at least 2 are needed

 +23                       IF $$PRV^BGPMUUT1(IEN,BGPPROV)

                               Begin DoDot:3

 +24      ;check and see if an appropriate CPT code exists

 +25                               SET AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU ENCOUNTER EM")

 +26                               SET BENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU PREV 40 ENCOUNT EM")

 +27                               SET CENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU GRP ENCOUNT EM")

 +28                               SET DENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU IND ENCOUNT EM")

 +29                               SET EENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU PREV OTH ENCOUNT EM")

 +30                               SET FENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU NURS FAC ENCOUNT EM")

 +31                               SET GENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU FLU NURS DC ENCOUNT EM")

 +32      ;Need 2 or more of BGPMU FLU ENCOUNT EM OR 1 or more of the others

 +33                               IF (+AENC=1)

                                       Begin DoDot:4

 +34                                       SET VDATE=$PIECE($PIECE($GET(^AUPNVSIT(IEN,0)),U,1),".",1)

 +35                                       SET VCNT=VCNT+1

 +36                                       SET VIEN(VCNT)=IEN_U_VDATE

 +37      ;check to see if encounter is within report period

 +38                                       IF (VDATE>=BGPBDATE)&(VDATE<=BGPEDATE)

                                               Begin DoDot:5

 +39                                               SET ACNT=ACNT+1

 +40                                               SET STRING="EN:"_$$DATE^BGPMUUTL(VDATE)

                                               End DoDot:5

                                       End DoDot:4

 +41                               IF (+BENC=1)!(+CENC=1)!(+DENC=1)!(+EENC=1)!(+FENC=1)!(+GENC=1)

                                       Begin DoDot:4

 +42                                       SET VDATE=$PIECE($PIECE($GET(^AUPNVSIT(IEN,0)),U,1),".",1)

 +43                                       SET VCNT=VCNT+1

 +44                                       SET VIEN(VCNT)=IEN_U_VDATE

 +45      ;check to see if encounter is within report period

 +46                                       IF (VDATE>=BGPBDATE)&(VDATE<=BGPEDATE)

                                               Begin DoDot:5

 +47                                               SET BCNT=BCNT+1

 +48                                               IF STRING=""

                                                       SET STRING="EN:"_$$DATE^BGPMUUTL(VDATE)

 +49                                              IF '$TEST

                                                       SET STRING=STRING_";EN:"_$$DATE^BGPMUUTL(VDATE)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +50       IF (ACNT>1)!(BCNT>0)

               Begin DoDot:1

 +51      ;count for denominator if encounter falls between Sept-Feb

 +52               SET BGPFLU=$$FLU(DFN)

 +53               IF +BGPFLU

                       Begin DoDot:2

 +54                       SET BGPDEN=1

 +55      ;Setup numerator

 +56      ;get all immunizations

 +57                       SET C="15^16^111^125^126^127^128^135"

 +58                       SET CPTS="90656^90658^90660^90661^90662^90663^90664^90666^90667^90668"

 +59                       KILL BGPX

                           DO GETIMMS^BGPMUUT2(DFN,BGPEDATE,C,.BGPX,CPTS)

 +60                       IF $DATA(BGPX)

                               Begin DoDot:3

 +61                               SET IMMC=""

 +62                               FOR 

                                       SET IMMC=$ORDER(BGPX(IMMC))

                                       IF IMMC=""

                                           QUIT 

                                       Begin DoDot:4

 +63                                       SET IMMD=BGPX(IMMC)

 +64                                       SET IMMV=$PIECE(IMMD,U,2)

 +65                                       SET IMMDATE=$PIECE($GET(^AUPNVSIT(IMMV,0)),U,1)

 +66                                       IF (IMMDATE>FBDATE)&(IMMDATE<FEDATE)

                                               Begin DoDot:5

 +67                                               SET BGPNUM=1

 +68                                               SET STRING2=$SELECT($PIECE(IMMD,U,3):$PIECE(IMMD,U,1),1:$PIECE($GET(^AUTTIMM($PIECE(IMMD,U,1),0)),U,3))_" "_$$DATE^BGPMUUTL($PIECE(IMMDATE,".",1))

 +69                                               QUIT 

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

 +70                       IF +BGPNUM=0

                               Begin DoDot:3

 +71      ;Exclude if flu immunization contraindication

 +72                               FOR BGPZ=15,16,111,125,126,127,128,135

                                       SET X=$$FLUCONT(DFN,BGPZ,$$DOB^AUPNPAT(DFN),BGPEDATE)

                                       IF X]""

                                           QUIT 

 +73                               IF X]""

                                       SET EXCL=1

 +74      ;NMI refusal

 +75                               SET G=""

 +76                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",15,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +77                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +78                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",16,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +79                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +80                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",111,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +81                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +82                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",125,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +83                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +84                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",126,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +85                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +86                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",127,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +87                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +88                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",128,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +89                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +90                               IF EXCL'=1

                                       SET G=$$NMIREF^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",135,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +91                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +92      ;Exclude if refused

 +93                               IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",15,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +94                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +95                               IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",16,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +96                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +97                               IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",111,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +98                               IF $PIECE(G,U)=1

                                       SET EXCL=1

 +99                               IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",125,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +100                              IF $PIECE(G,U)=1

                                       SET EXCL=1

 +101                              IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",126,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +102                              IF $PIECE(G,U)=1

                                       SET EXCL=1

 +103                              IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",127,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +104                              IF $PIECE(G,U)=1

                                       SET EXCL=1

 +105                              IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",128,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +106                              IF $PIECE(G,U)=1

                                       SET EXCL=1

 +107                              IF EXCL'=1

                                       SET G=$$REFUSAL^BGPMUUT2(DFN,9999999.14,$ORDER(^AUTTIMM("C",135,0)),$$DOB^AUPNPAT(DFN),BGPEDATE)

 +108                              IF $PIECE(G,U)=1

                                       SET EXCL=1

                               End DoDot:3

 +109                      DO TOTAL(DFN)

                       End DoDot:2

               End DoDot:1

 +110      KILL BGP1,BGP2,BGPDEN,BGPNUM,BGPDT,END,FIRST,IEN,START,VDATE,VIEN,BGPZ,EXCL,BGPX

 +111      KILL ACNT,BCNT,AENC,BENC,GS

 +112      QUIT 

 +113     ;

FLUCONT(P,C,BD,ED) ;EP

 +1        NEW X,G,Y,R,D

 +2       ;first check for ICD-9 code documented

 +3        SET G=$$LASTDX^BGPMUUT2(P,BD,ED,"BGPMU FLU EGG ALLERGY DX")

 +4        IF G

               QUIT 1_U_"Egg Allergy Dx"

 +5        SET X=0

           SET G=""

           SET Y=$ORDER(^AUTTIMM("C",C,0))

           IF Y

               FOR 

                   SET X=$ORDER(^BIPC("AC",P,Y,X))

                   IF X'=+X!(G)

                       QUIT 

                   Begin DoDot:1

 +6                    SET R=$PIECE(^BIPC(X,0),U,3)

 +7                    IF R=""

                           QUIT 

 +8                    IF '$DATA(^BICONT(R,0))

                           QUIT 

 +9                    SET D=$PIECE(^BIPC(X,0),U,4)

 +10                   IF D=""

                           QUIT 

 +11                   IF $PIECE(^BIPC(X,0),U,4)<BD

                           QUIT 

 +12                   IF $PIECE(^BIPC(X,0),U,4)>ED

                           QUIT 

 +13                   IF $PIECE(^BICONT(R,0),U,1)="Egg Allergy"

                           SET G=D_U_"Contraindication: Egg Allergy"

 +14      ;I $P(^BICONT(R,0),U,1)="Anaphylaxis" S G=D_U_"Contraindication: Anaphylaxis"  REMOVED per Dr. Advani

                   End DoDot:1

 +15       KILL X,Y,R,D

 +16       QUIT G

 +17      ;

FLU(DFN)  ;Find if pt has a visit during the flu season (Sept-Feb)

 +1        NEW NUM,FLUCNT,FDATE

 +2        SET FLUCNT=0

 +3        SET NUM=0

           FOR 

               SET NUM=$ORDER(VIEN(NUM))

               IF NUM=""!(FLUCNT>1)

                   QUIT 

               Begin DoDot:1

 +4                SET FDATE=$PIECE(VIEN(NUM),U,2)

 +5                IF (FDATE>FBDATE)&(FDATE<FEDATE)

                       Begin DoDot:2

 +6                        SET FLUCNT=FLUCNT+1

 +7                        SET STRING="EN:"_$$DATE^BGPMUUTL(FDATE)

 +8       ;I $G(STRING2)="" S STRING2="FLU:"_FDATE

 +9       ;E  S STRING2=STRING2_",FLU:"_FDATE

                       End DoDot:2

               End DoDot:1

 +10       QUIT FLUCNT

 +11      ;

FLUDATES  ; Calculate dates of the most recent flu season

 +1        SET FEDATE=$SELECT(+$EXTRACT(BGPEDATE,4,5)>0&(+$EXTRACT(BGPEDATE,4,5)<3):($EXTRACT(BGPEDATE,1,3)-1)_"0301",1:$EXTRACT(BGPEDATE,1,3)_"0301")

 +2        SET FBDATE=($EXTRACT(FEDATE,1,3)-1)_"0831"

 +3        QUIT 

 +4       ;S FBDATE=$S(+$E(BGPBDATE,4,5)>0&(+$E(BGPBDATE,4,5)<3):$E(BGPBDATE,1,3)_"0101",1:$E(BGPBDATE,1,3)_"0901")

 +5       ;I $E(BGPBDATE,1,3)'=$E(BGPEDATE,1,3)  D

 +6       ;.S FEDATE=$S(+$E(BGPEDATE,4,5)>0&(+$E(BGPEDATE,4,5)<3):$E(BGPEDATE,1,3)_"0301",1:$E(BGPEDATE,1,3)_"1231")

 +7       ;E  S FEDATE=$S(+$E(BGPEDATE,4,5)>0&(+$E(BGPEDATE,4,5)<3):$E(BGPEDATE,1,3)_"0301",1:$E(BGPEDATE,1,3)+1_"0101")

 +8       ;Q

TOTAL(DFN) ;See where this patient ends up

 +1        NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS

 +2        SET TOTALS=+$GET(^TMP("BGPMU0041",$JOB,BGPMUTF,"TOT"))

 +3        SET EXCCT=+$GET(^TMP("BGPMU0041",$JOB,BGPMUTF,"EXC"))

 +4        SET DENCT=+$GET(^TMP("BGPMU0041",$JOB,BGPMUTF,"DEN"))

 +5        SET NUMCT=+$GET(^TMP("BGPMU0041",$JOB,BGPMUTF,"NUM"))

 +6        SET PTCNT=TOTALS

 +7        SET PTCNT=PTCNT+1

 +8        IF +EXCL

               Begin DoDot:1

 +9                SET EXCCT=EXCCT+1

                   SET ^TMP("BGPMU0041",$JOB,BGPMUTF,"EXC")=EXCCT

 +10               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0041",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_STRING_U_"Excluded"

               End DoDot:1

 +11      IF '$TEST

               Begin DoDot:1

 +12               IF +BGPDEN

                       SET DENCT=DENCT+1

                   SET ^TMP("BGPMU0041",$JOB,BGPMUTF,"DEN")=DENCT

 +13               IF +BGPNUM

                       Begin DoDot:2

 +14                       SET NUMCT=NUMCT+1

                           SET ^TMP("BGPMU0041",$JOB,BGPMUTF,"NUM")=NUMCT

 +15                       IF BGPMUTF="C"

                               SET ^TMP("BGPMU0041",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_STRING_U_STRING2

                       End DoDot:2

 +16              IF '$TEST

                       IF BGPMUTF="C"

                           SET ^TMP("BGPMU0041",$JOB,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_STRING_U_STRING2

               End DoDot:1

 +17       SET ^TMP("BGPMU0041",$JOB,BGPMUTF,"TOT")=PTCNT

 +18      ;Setup iCare array for patient

 +19       SET BGPICARE("MU.EP.0041.1",BGPMUTF)=(+BGPDEN&'EXCL)_U_+BGPNUM_U_+EXCL_U_STRING_";"_STRING2_U_$PIECE(EXCL,U,2)

 +20       KILL PTCNT,EXCCT,DENCT,NUMCT,TOTALS

 +21       QUIT 

 +22      ;

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=3110101   ;  BGPBDATE = begin date of report

 +5       ;S BGPEDATE=3110301   ;  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        QUIT