Routine: BGPMUH08

BGPMUH08 ; IHS/MSC/MGH - MI measure NQF0440-STK-8 ;02-Mar-2011 16:19;DU

 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84

 ;ED meaningful use hospital measured

 ; print output routine is BGPMUHP4

 ; delimited output routine is BGPMUHD3

ENTRY ;PEP  Stroke Measure 8 - stroke education

 N START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS

 ;Start by finding all admissions during the reporting period

 S START=BGPBDATE

 S END=BGPEDATE_".2359"

 F  S START=$O(^DGPM("B",START)) Q:START=""!(START>END)  D

 .S BGPIEN="" F  S BGPIEN=$O(^DGPM("B",START,BGPIEN)) Q:BGPIEN=""  D

 ..Q:$P($G(^DGPM(BGPIEN,0)),U,2)'=1    ;Only include admissions

 ..S DFN=$P($G(^DGPM(BGPIEN,0)),U,3)

 ..Q:DFN=""

 ..S BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)

 ..I 'BGPACTUP,'$G(BGPXPXPX),'$G(BGPIISO) Q

 ..S BGPVST=$P($G(^DGPM(BGPIEN,0)),U,27)  ;Get the visit

 ..Q:BGPVST=""

 ..S BGPADM=$P($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1) ;get admin date

 ..S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)

 ..S BGPDIS=$P($G(^DGPM(BGPIEN,0)),U,17)  ;Don't use if pt is still an inpt

 ..Q:BGPDIS=""

 ..;Check for a diagnosis of stroke (both types for this measure)

 ..S STROKE=0,EXC=0,NUM=0

 ..;S BGPISDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")     ;ZSAT

 ..;S BGPHSDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")  ;ZSAT

 ..S BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")

 ..S BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")

 ..;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")

 ..;S BGPHPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEMORRHAGIC STROKE DX","A")

 ..;Pt must have both a POV of stoke and it must be an active problem

 ..;I +BGPISDX&(+BGPIPROB) S STROKE=1

 ..;I +BGPHSDX&(+BGPHPROB) S STROKE=1

 ..I +BGPISDX S STROKE=1

 ..I +BGPHSDX S STROKE=1

 ..;Next check for exclusions

 ..I +STROKE D

 ...S EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST)

 ...;If no exclusions see if they had the education coded

 ...I EXC="" S NUM=$$NUMER(DFN,BGPVST,BGPIEN,BGPDIS)

 ...;Now add it all up

 ...D TOTAL(BGPIEN)

TOTAL(BGPIEN) ;add up the totals

 N PTCNT,EXCCT,DENCT,NUMCT,TOTALS,DATE,NOTCT

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

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

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

 S NOTCT=+$G(^TMP("BGPMU0440",$J,BGPMUTF,"NOT"))

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

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S DATE=$$DATE^BGPMUUTL($P($G(^DGPM(BGPIEN,0)),U,1))

 S DENCT=DENCT+1 S ^TMP("BGPMU0440",$J,BGPMUTF,"DEN")=DENCT

 I EXC'="" D

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

 .I BGPMUTF="C" S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$P(EXC,U,2)

 I EXC="" D

 .S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_DATE

 .I +NUM=1 D

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

 ..S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)

 .I +NUM=0 D

 ..S NOTCT=NOTCT+1 S ^TMP("BGPMU0440",$J,BGPMUTF,"NOT")=NOTCT

 ..S ^TMP("BGPMU0440",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$P(NUM,U,3)_U_$P(NUM,U,2)

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

 S BGPICARE("MU.STK.0435.1",BGPMUTF,DFN)=1_U_+$G(NUM)_U_+EXC_U_DATE_";"_$P($G(NUM),U,3)_";"_$P(EXC,U,2)

EXCLUDE(DFN,BGPIEN,BGPVST) ;See if there are exclusions

 N REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI

 S REASON=""

 I BGPAGEE<18 S REASON="1^AGE" Q REASON

 ;Check for LOS

 S BGPLOS=$$LOS(BGPIEN,BGPDIS)

 I BGPLOS>120 S REASON="1^LOS" Q REASON

 ;Check for hospice care

 S BGPHOS=$$HOSPICE(DFN,BGPVST)

 I +BGPHOS S REASON=BGPHOS Q REASON

 ;Check for clinical trials

 S BGPCLIN=$$TRIAL(DFN,BGPVST)

 I +BGPCLIN S REASON=BGPCLIN Q REASON

 ;Check for elective carotid intervention procedure

 S BGPECI=$$ELECTIVE(DFN,BGPVST,BGPIEN)

 I +BGPECI S REASON=BGPECI Q REASON

 Q REASON

NUMER(DFN,BGPVST,BGPIEN,BGPDIS) ;Check to see if pt is in the numerator

 N EDU,ETOPIC,D,Y,BDATE,EDATE,LIT,LIT2,%,EIEN,ICD,BGPMU,TNAME

 S BDATE=$P($G(^DGPM(BGPIEN,0)),U,1)

 S EDATE=$P($G(^DGPM(BGPDIS,0)),U,1)

 S (%,ETOPIC,LIT,LIT2)=0

 ;Find all the patient ed topics from admission to discharge

 ;Loop through the array and look for stroke education

 S EIEN="" F  S EIEN=$O(^AUPNVPED("AD",BGPVST,EIEN)) Q:EIEN=""!(%'=0)  D

 .S ETOPIC=$P($G(^AUPNVPED(EIEN,0)),U,1)

 .Q:'ETOPIC

 .Q:'$D(^AUTTEDT(ETOPIC,0))

 .;Quit if you find the specific stroke eduction topic

 .S TNAME=$P($G(^AUTTEDT(ETOPIC,0)),U,1)

 .S TTIME=$P($G(^AUPNVPED(EIEN,12)),U,1)

 .I TNAME="STROK-LITERATURE" S %=1_U_TNAME_U_TTIME Q

 .I $P(TNAME,"-",2)="LITERATURE" D

 ..;Check for diagnoses related literature

 ..S ICD=$P(TNAME,"-",1)

 ..I +ICD S LIT=$$EDLOOP(ICD,"BGPMU ISCHEMIC STROKE DX")

 ..I +LIT S %=LIT_U_TTIME

 ..I +ICD S LIT2=$$EDLOOP(ICD,"BGPMU HEMORRHAGIC STROKE DX")

 ..I +LIT2 S %=LIT2_U_TTIME

 S:+% $P(%,U,3)=EDATE

Q %

EDLOOP(ICD,TAX) ;Find ed code in taxonomy

 N BGPTX,X,%,CODE

 S %=0

 S BGPTX=$O(^ATXAX("B",TAX,0))

 S X=0 F  S X=$O(^ATXAX(BGPTX,21,X)) Q:X=""!(%'=0)  D

 .S CODE=$P($G(^ATXAX(BGPTX,21,X,0)),U,1)

 .I CODE=ICD S %=1_U_CODE_"-LITERATURE"

Q %

LOS(BGPIEN,BGPDIS) ;Return the length of stay

 N DAYS,X1,X2,X

 S DAYS=0

 S X2=$P($G(^DGPM(BGPIEN,0)),U,1)

 S X1=$P($G(^DGPM(BGPDIS,0)),U,1)

 D ^%DTC S DAYS=X

 Q DAYS

HOSPICE(DFN,BGPVST) ;Return if hospice DX/problem was found for this patient

 N COMFORT,BGPTDX,BGPTPROB,BGPTCPT

 S COMFORT=0

 S BGPTDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU TERMINAL")

 I +BGPTDX S COMFORT=BGPTDX

 S BGPTPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU TERMINAL","C")

 I +BGPTPROB S COMFORT=BGPTPROB

 S BGPTCPT=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU PALLIATIVE CARE CPT")

 I +BGPTCPT S COMFORT=BGPTCPT

 Q COMFORT

TRIAL(DFN,BGPVST) ;Return if patient is on a clinical trial

 N CLIN,BGPCDX,BGPCPROB

 S CLIN=0

 S BGPCDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU CLINICAL TRIAL DX")

 I +BGPCDX S CLIN=BGPCDX

 S BGPCPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CLINICAL TRIAL DX","C")

 I +BGPCPROB S CLIN=BGPCPROB

 Q CLIN

ELECTIVE(DFN,BGPVST,BGPIEN) ;Return if pt was admitted for an elective carotic interventions procedures

 N PROC,TYPE,BGPCPT,BGPICD0

 S PROC=0

 S TYPE=$$GET1^DIQ(405,BGPIEN,9999999.05)

 I TYPE="ELECTIVE" D

 .S BGPICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU CAROTID INTER ICD0")

 .I +BGPICD0 S PROC=BGPICD0

 Q PROC

BGPMUH08  ; IHS/MSC/MGH - MI measure NQF0440-STK-8 ;02-Mar-2011 16:19;DU

 +1       ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84

 +2       ;ED meaningful use hospital measured

 +3       ; print output routine is BGPMUHP4

 +4       ; delimited output routine is BGPMUHD3

ENTRY     ;PEP  Stroke Measure 8 - stroke education

 +1        NEW START,END,BGPIEN,DFN,BGPVST,BGPISDX,BGPHSDX,BGPAGEE,BGPIPROB,BGPHPROB,STROKE,EXC,NUM,BGPDIS

 +2       ;Start by finding all admissions during the reporting period

 +3        SET START=BGPBDATE

 +4        SET END=BGPEDATE_".2359"

 +5        FOR

               SET START=$ORDER(^DGPM("B",START))

               IF START=""!(START>END)

                   QUIT

               Begin DoDot:1

 +6                SET BGPIEN=""

FOR

                       SET BGPIEN=$ORDER(^DGPM("B",START,BGPIEN))

                       IF BGPIEN=""

                           QUIT

                       Begin DoDot:2

 +7       ;Only include admissions

                           IF $PIECE($GET(^DGPM(BGPIEN,0)),U,2)'=1

                               QUIT

 +8                        SET DFN=$PIECE($GET(^DGPM(BGPIEN,0)),U,3)

 +9                        IF DFN=""

                               QUIT

 +10                       SET BGPACTUP=$$ACTUPAP^BGPMUEHD(DFN,BGPBDATE,BGPEDATE,BGPBEN)

 +11                       IF 'BGPACTUP

                               IF '$GET(BGPXPXPX)

                                   IF '$GET(BGPIISO)

                                       QUIT

 +12      ;Get the visit

                           SET BGPVST=$PIECE($GET(^DGPM(BGPIEN,0)),U,27)

 +13                       IF BGPVST=""

                               QUIT

 +14      ;get admin date

                           SET BGPADM=$PIECE($$GET1^DIQ(9000010,BGPVST_",",.01,"I"),".",1)

 +15                       SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPADM)

 +16      ;Don't use if pt is still an inpt

                           SET BGPDIS=$PIECE($GET(^DGPM(BGPIEN,0)),U,17)

 +17                       IF BGPDIS=""

                               QUIT

 +18      ;Check for a diagnosis of stroke (both types for this measure)

 +19                       SET STROKE=0

                           SET EXC=0

                           SET NUM=0

 +20      ;S BGPISDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")     ;ZSAT

 +21      ;S BGPHSDX=$$VSTPOV^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")  ;ZSAT

 +22                       SET BGPISDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU ISCHEMIC STROKE DX")

 +23                       SET BGPHSDX=$$VSTPOVA^BGPMUUT3(DFN,BGPVST,"BGPMU HEMORRHAGIC STROKE DX")

 +24      ;S BGPIPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU ISCHEMIC STROKE DX","A")

 +25      ;S BGPHPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU HEMORRHAGIC STROKE DX","A")

 +26      ;Pt must have both a POV of stoke and it must be an active problem

 +27      ;I +BGPISDX&(+BGPIPROB) S STROKE=1

 +28      ;I +BGPHSDX&(+BGPHPROB) S STROKE=1

 +29                       IF +BGPISDX

                               SET STROKE=1

 +30                       IF +BGPHSDX

                               SET STROKE=1

 +31      ;Next check for exclusions

 +32                       IF +STROKE

                               Begin DoDot:3

 +33                               SET EXC=$$EXCLUDE(DFN,BGPIEN,BGPVST)

 +34      ;If no exclusions see if they had the education coded

 +35                               IF EXC=""

                                       SET NUM=$$NUMER(DFN,BGPVST,BGPIEN,BGPDIS)

 +36      ;Now add it all up

 +37                               DO TOTAL(BGPIEN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +38       QUIT

TOTAL(BGPIEN) ;add up the totals

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

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

 +3        SET DENCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"DEN"))

 +4        SET NUMCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"NUM"))

 +5        SET NOTCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"NOT"))

 +6        SET EXCCT=+$GET(^TMP("BGPMU0440",$JOB,BGPMUTF,"EXC"))

 +7        SET PTCNT=TOTALS

 +8        SET PTCNT=PTCNT+1

 +9        SET DATE=$$DATE^BGPMUUTL($PIECE($GET(^DGPM(BGPIEN,0)),U,1))

 +10       SET DENCT=DENCT+1

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

 +11       IF EXC'=""

               Begin DoDot:1

 +12               SET EXCCT=EXCCT+1

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

 +13               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_$PIECE(EXC,U,2)

               End DoDot:1

 +14       IF EXC=""

               Begin DoDot:1

 +15               SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_DATE

 +16               IF +NUM=1

                       Begin DoDot:2

 +17                       SET NUMCT=NUMCT+1

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

 +18                       SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)

                       End DoDot:2

 +19               IF +NUM=0

                       Begin DoDot:2

 +20                       SET NOTCT=NOTCT+1

                           SET ^TMP("BGPMU0440",$JOB,BGPMUTF,"NOT")=NOTCT

 +21                       SET ^TMP("BGPMU0440",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DATE_U_$PIECE(NUM,U,3)_U_$PIECE(NUM,U,2)

                       End DoDot:2

               End DoDot:1

 +22       SET ^TMP("BGPMU0440",$JOB,BGPMUTF,"TOT")=PTCNT

 +23       SET BGPICARE("MU.STK.0435.1",BGPMUTF,DFN)=1_U_+$GET(NUM)_U_+EXC_U_DATE_";"_$PIECE($GET(NUM),U,3)_";"_$PIECE(EXC,U,2)

 +24       QUIT

EXCLUDE(DFN,BGPIEN,BGPVST) ;See if there are exclusions

 +1        NEW REASON,BGPLOS,BGPHOS,BGPCLIN,BGPECI

 +2        SET REASON=""

 +3        IF BGPAGEE<18

               SET REASON="1^AGE"

               QUIT REASON

 +4       ;Check for LOS

 +5        SET BGPLOS=$$LOS(BGPIEN,BGPDIS)

 +6        IF BGPLOS>120

               SET REASON="1^LOS"

               QUIT REASON

 +7       ;Check for hospice care

 +8        SET BGPHOS=$$HOSPICE(DFN,BGPVST)

 +9        IF +BGPHOS

               SET REASON=BGPHOS

               QUIT REASON

 +10      ;Check for clinical trials

 +11       SET BGPCLIN=$$TRIAL(DFN,BGPVST)

 +12       IF +BGPCLIN

               SET REASON=BGPCLIN

               QUIT REASON

 +13      ;Check for elective carotid intervention procedure

 +14       SET BGPECI=$$ELECTIVE(DFN,BGPVST,BGPIEN)

 +15       IF +BGPECI

               SET REASON=BGPECI

               QUIT REASON

 +16       QUIT REASON

NUMER(DFN,BGPVST,BGPIEN,BGPDIS) ;Check to see if pt is in the numerator

 +1        NEW EDU,ETOPIC,D,Y,BDATE,EDATE,LIT,LIT2,%,EIEN,ICD,BGPMU,TNAME

 +2        SET BDATE=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)

 +3        SET EDATE=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)

 +4        SET (%,ETOPIC,LIT,LIT2)=0

 +5       ;Find all the patient ed topics from admission to discharge

 +6       ;Loop through the array and look for stroke education

 +7        SET EIEN=""

FOR

               SET EIEN=$ORDER(^AUPNVPED("AD",BGPVST,EIEN))

               IF EIEN=""!(%'=0)

                   QUIT

               Begin DoDot:1

 +8                SET ETOPIC=$PIECE($GET(^AUPNVPED(EIEN,0)),U,1)

 +9                IF 'ETOPIC

                       QUIT

 +10               IF '$DATA(^AUTTEDT(ETOPIC,0))

                       QUIT

 +11      ;Quit if you find the specific stroke eduction topic

 +12               SET TNAME=$PIECE($GET(^AUTTEDT(ETOPIC,0)),U,1)

 +13               SET TTIME=$PIECE($GET(^AUPNVPED(EIEN,12)),U,1)

 +14               IF TNAME="STROK-LITERATURE"

                       SET %=1_U_TNAME_U_TTIME

                       QUIT

 +15               IF $PIECE(TNAME,"-",2)="LITERATURE"

                       Begin DoDot:2

 +16      ;Check for diagnoses related literature

 +17                       SET ICD=$PIECE(TNAME,"-",1)

 +18                       IF +ICD

                               SET LIT=$$EDLOOP(ICD,"BGPMU ISCHEMIC STROKE DX")

 +19                       IF +LIT

                               SET %=LIT_U_TTIME

 +20                       IF +ICD

                               SET LIT2=$$EDLOOP(ICD,"BGPMU HEMORRHAGIC STROKE DX")

 +21                       IF +LIT2

                               SET %=LIT2_U_TTIME

                       End DoDot:2

               End DoDot:1

 +22       IF +%

               SET $PIECE(%,U,3)=EDATE

 +23       QUIT %

EDLOOP(ICD,TAX) ;Find ed code in taxonomy

 +1        NEW BGPTX,X,%,CODE

 +2        SET %=0

 +3        SET BGPTX=$ORDER(^ATXAX("B",TAX,0))

 +4        SET X=0

FOR

               SET X=$ORDER(^ATXAX(BGPTX,21,X))

               IF X=""!(%'=0)

                   QUIT

               Begin DoDot:1

 +5                SET CODE=$PIECE($GET(^ATXAX(BGPTX,21,X,0)),U,1)

 +6                IF CODE=ICD

                       SET %=1_U_CODE_"-LITERATURE"

               End DoDot:1

 +7        QUIT %

LOS(BGPIEN,BGPDIS) ;Return the length of stay

 +1        NEW DAYS,X1,X2,X

 +2        SET DAYS=0

 +3        SET X2=$PIECE($GET(^DGPM(BGPIEN,0)),U,1)

 +4        SET X1=$PIECE($GET(^DGPM(BGPDIS,0)),U,1)

 +5        DO ^%DTC

           SET DAYS=X

 +6        QUIT DAYS

HOSPICE(DFN,BGPVST) ;Return if hospice DX/problem was found for this patient

 +1        NEW COMFORT,BGPTDX,BGPTPROB,BGPTCPT

 +2        SET COMFORT=0

 +3        SET BGPTDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU TERMINAL")

 +4        IF +BGPTDX

               SET COMFORT=BGPTDX

 +5        SET BGPTPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU TERMINAL","C")

 +6        IF +BGPTPROB

               SET COMFORT=BGPTPROB

 +7        SET BGPTCPT=$$VSTCPT^BGPMUUT1(DFN,BGPVST,"BGPMU PALLIATIVE CARE CPT")

 +8        IF +BGPTCPT

               SET COMFORT=BGPTCPT

 +9        QUIT COMFORT

TRIAL(DFN,BGPVST) ;Return if patient is on a clinical trial

 +1        NEW CLIN,BGPCDX,BGPCPROB

 +2        SET CLIN=0

 +3        SET BGPCDX=$$VSTPOVB^BGPMUUT3(DFN,BGPVST,"BGPMU CLINICAL TRIAL DX")

 +4        IF +BGPCDX

               SET CLIN=BGPCDX

 +5        SET BGPCPROB=$$PLTAX^BGPMUUT1(DFN,"BGPMU CLINICAL TRIAL DX","C")

 +6        IF +BGPCPROB

               SET CLIN=BGPCPROB

 +7        QUIT CLIN

ELECTIVE(DFN,BGPVST,BGPIEN) ;Return if pt was admitted for an elective carotic interventions procedures

 +1        NEW PROC,TYPE,BGPCPT,BGPICD0

 +2        SET PROC=0

 +3        SET TYPE=$$GET1^DIQ(405,BGPIEN,9999999.05)

 +4        IF TYPE="ELECTIVE"

               Begin DoDot:1

 +5                SET BGPICD0=$$VSTICD0^BGPMUUT3(DFN,BGPVST,"BGPMU CAROTID INTER ICD0")

 +6                IF +BGPICD0

                       SET PROC=BGPICD0

               End DoDot:1

 +7        QUIT PROC

BGPMUH08.m