BGP8D76.m

BGP8D76 ;IHS/CMI/LAB - MEASURE LOGIC; 

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;

 ;

TOBCESSD ;EP = tobacco cessaton, gpra dev v18

 I 'BGPACTUP S BGPSTOP=1 Q  ;must be at least user pop

 S (BGPVALUD,BGPVALUE)=""

 S (BGPD1,BGPD2,BGPN1,BGPN2,BGPN3)=0

 K BGPTOBS,BGPTOBL,BGPTOBE,BGPTOBT

 S (BGPTOBSL,BGPTOBLL,BGPTOBEL,BGPTOBTL)=""  ;for last of each

 S (BGPCTU,BGPSMK,BGPSMKL,BGPSMKE,BGPDNV,BGPNMV,BGPGOT,BGPGOTS,BGPGOTL,BGPL,BGPPTU,BGPTU)=""

 ;get all TOBACCO (SMOKING) during report period

 S BGPL=""

 D ALLHF(DFN,BGPBDATE,BGPEDATE,"TOBACCO (SMOKING)","BGPTOBS")

 S X=0 F  S X=$O(BGPTOBS(X)) Q:X'=+X!(BGPSMK)  D

 .S BGPL=X

 .I BGPTOBS(BGPL)["CESSATION" S BGPCTU=1,BGPSMK=1 Q

 .I BGPTOBS(BGPL)["CURRENT SMOKER" S BGPCTU=1,BGPSMK=1 Q

 .I BGPTOBS(BGPL)["HEAVY TOBACCO SMOKER" S BGPCTU=1,BGPSMK=1 Q

 .I BGPTOBS(BGPL)["LIGHT TOBACCO SMOKER" S BGPCTU=1,BGPSMK=1 Q

 I BGPCTU S BGPDNV="USER: "_$P(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBS(BGPL),U,1))_")",BGPGOT=1

 I BGPSMK S BGPDNV=BGPDNV_"; SMOKER: "_$P(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBS(BGPL),U,1))_")",BGPGOTS=1

SML ;

 S BGPL=""

 D ALLHF(DFN,BGPBDATE,BGPEDATE,"TOBACCO (SMOKELESS - CHEWING/DIP)","BGPTOBL")

 S X=0 F  S X=$O(BGPTOBL(X)) Q:X'=+X!(BGPSMKL)  D

 .S BGPL=X

 .I BGPTOBL(BGPL)["CESSATION" S BGPCTU=1,BGPSMKL=1 Q

 .I BGPTOBL(BGPL)["CURRENT SMOKE" S BGPCTU=1,BGPSMKL=1 Q

 I BGPCTU,'BGPGOT S BGPDNV="USER: "_$P(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBL(BGPL),U,1))_")",BGPGOT=1

 I BGPSMKL S BGPDNV=BGPDNV_"; SMOKELESS: "_$P(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBL(BGPL),U,1))_")",BGPGOTL=1

ENDS ;

 S BGPL=""

 D ALLHF(DFN,BGPBDATE,BGPEDATE,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)","BGPTOBE")

 S X=0 F  S X=$O(BGPTOBE(X)) Q:X'=+X!(BGPSMKE)  D

 .S BGPL=X

 .I BGPTOBE(BGPL)["CESSATION" S BGPCTU=1,BGPSMKE=1 Q

 .I BGPTOBE(BGPL)["CURRENT" S BGPCTU=1,BGPSMKE=1 Q

 I BGPCTU,'BGPGOT S BGPDNV="USER: "_$P(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBE(BGPL),U,1))_")",BGPGOT=1

 I BGPSMKE S BGPDNV=BGPDNV_"; ENDS: "_$P(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBE(BGPL),U,1))_")"

 ;

PREV ;get last of each before time period.

 S BGPBDX=$$DOB^AUPNPAT(DFN),BGPEDX=$$FMADD^XLFDT(BGPBDATE,-1)

 ;

PSMK I 'BGPSMK D   ;IF NOT A SMOKER GET LAST IN PREVIOUS TIME PERIOD

 .K BGPTOBS

 .S C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKING)",BGPBDX,BGPEDX)

 .I C]"" S BGPTOBS(1)=$P(C,U,3)_"^"_$P(C,U,1)

 .;now recheck all

 .S BGPL=1 I $D(BGPTOBS(1)) D

 ..I BGPTOBS(BGPL)["CESSATION" S BGPPTU=1,BGPSMK=1 Q

 ..I BGPTOBS(BGPL)["CURRENT SMOKER" S BGPPTU=1,BGPSMK=1 Q

 ..I BGPTOBS(BGPL)["HEAVY TOBACCO SMOKER" S BGPPTU=1,BGPSMK=1 Q

 ..I BGPTOBS(BGPL)["LIGHT TOBACCO SMOKER" S BGPPTU=1,BGPSMK=1 Q

 .Q:'BGPSMK

 .I 'BGPCTU,BGPPTU S BGPDNV="USER: "_$P(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBS(BGPL),U,1))_")",BGPGOT=1

 .S BGPDNV=BGPDNV_"; SMOKER: "_$P(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBS(BGPL),U,1))_")",BGPGOTS=1

PSML ;

 I 'BGPSMKL D

 .K BGPTOBL

 .S C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",BGPBDX,BGPEDX)

 .I C]"" S BGPTOBL(1)=$P(C,U,3)_"^"_$P(C,U,1)

 .S BGPL=1 I $D(BGPTOBL(1)) D

 ..I BGPTOBL(BGPL)["CESSATION" S BGPPTU=1,BGPSMKL=1 Q

 ..I BGPTOBL(BGPL)["CURRENT SMOKE" S BGPPTU=1,BGPSMKL=1 Q

 .Q:'BGPSMKL

 .I BGPPTU,'BGPCTU S BGPDNV="USER: "_$P(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBL(BGPL),U,1))_")",BGPGOT=1

 .S BGPDNV=BGPDNV_"; SMOKELESS: "_$P(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBL(BGPL),U,1))_")",BGPGOTL=1

PREVENDS ;

 I 'BGPSMKE D

 .K BGPTOBE

 .S C=$$LASTHF^BGP8D7(DFN,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",BGPBDX,BGPEDX)

 .I C]"" S BGPTOBE(1)=$P(C,U,3)_"^"_$P(C,U,1)

 .S BGPL=1 I $D(BGPTOBE(1)) D

 ..I BGPTOBE(BGPL)["CESSATION" S BGPTU=1,BGPSMKE=1 Q

 ..I BGPTOBE(BGPL)["CURRENT" S BGPTU=1,BGPSMKE=1 Q

 .Q:'BGPSMKE

 .I BGPTU,'BGPCTU S BGPDNV="USER: "_$P(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBE(BGPL),U,1))_")",BGPGOT=1

 .S BGPDNV=BGPDNV_"; ENDS: "_$P(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($P(BGPTOBE(BGPL),U,1))_")"

 ;

 ;

SET ;

 I BGPCTU!(BGPPTU) S BGPTU=1

 I 'BGPTU S BGPSTOP=1 D KVARS Q  ;not in this denominator at all

 S BGPD1=1  ;UP

 I BGPACTCL S BGPD2=1

 ;

 ;get numerator stuff

 ;BGPN1=tobacco cessation counseling or prescription

 ;BGPN2=quit

 ;BGPN3 - any of them

 S BGPTC1=$$PED^BGP8D711(DFN,BGPBDATE,BGPEDATE,1)

 I $P(BGPTC1,U)]"" S BGPN1=1,BGPN3=1

 ;did they quit?  check each

 ;SMOKER

 S BGPQ=""

 I BGPSMK S X=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKING)",$$DOB^AUPNPAT(DFN),BGPEDATE) G:$P(X,U,1)'["PREVIOUS" S2 S BGPQ="QUIT SMOKING: "_$P(X,U,2)_" "_$P(X,U,1)

 I BGPSMKL S X=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$$DOB^AUPNPAT(DFN),BGPEDATE) G:$P(X,U,1)'["PREVIOUS" S2 S BGPQ=BGPQ_$S(BGPQ]"":"; ",1:"")_"QUIT SMOKELESS: "_$P(X,U,2)_" "_$P(X,U,1)

 I BGPSMKE S X=$$LASTHF^BGP8D7(DFN,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",$$DOB^AUPNPAT(DFN),BGPEDATE) G:$P(X,U,1)'["PREVIOUS" S2 S BGPQ=BGPQ_$S(BGPQ]"":"; ",1:"")_"QUIT ENDS: "_$P(X,U,2)_" "_$P(X,U,1)

 S BGPN2=1,BGPN3=1

S2 ;SET BGPVALUE

 S BGPVALUD="UP"_$S(BGPD2:",AC",1:"")_" "_BGPDNV

 D

 .S BGPVALUD=BGPVALUD_"|||"_$S($P(BGPTC1,U):"COUNSEL: "_$$DATE^BGP7UTL($P(BGPTC1,U))_" "_$P(BGPTC1,U,2),1:"")

 .I BGPN2 S BGPVALUD=BGPVALUD_"; "_BGPQ ;_" "_$P(BGPQ,U,3)

KVARS ;

 K BGPTOBS,BGPTOBL,BGPTOBE,BGPTOBT,BGPTOBSL,BGPTOBLL,BGPTOBEL,BGPTOBTL,BGPTU,BGPSMK,BGPSMKL,BGPSMKE,BGPGOT,BGPGOTS,BGPGOTL,BGPL,BGPTU,BGPCTU,BGPPTU

 Q

GETLAST ;

 NEW BGPBDX,BGPEDX,S,T,C,E

 S BGPBDX=$$DOB^AUPNPAT(DFN),BGPEDX=$$FMADD^XLFDT(BGPBDATE,-1)

 S C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKING)",BGPBDX,BGPEDX)

 I C]"" S BGPTOBS(1)=$P(C,U,3)_"^"_$P(C,U,1)

 S C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",BGPBDX,BGPEDX)

 I C]"" S BGPTOBL(1)=$P(C,U,3)_"^"_$P(C,U,1)

 S C=$$LASTHF^BGP8D7(DFN,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",BGPBDX,BGPEDX)

 I C]"" S BGPTOBE(1)=$P(C,U,3)_"^"_$P(C,U,1)

 S C=$$LASTHF^BGP8D7(DFN,"TOBACCO",BGPBDX,BGPEDX)

 I C]"" S BGPTOBT(1)=$P(C,U,3)_"^"_$P(C,U,1)

 Q

ALLHF(P,BD,ED,CAT,RETVAL) ;\

 NEW H,D,C

 S (H,D,C)=0

 S CAT=$O(^AUTTHF("B",CAT,0))

 F  S H=$O(^AUTTHF("AC",CAT,H))  Q:'+H  D

 .Q:'$D(^AUPNVHF("AA",DFN,H))

 .S D="" F  S D=$O(^AUPNVHF("AA",DFN,H,D)) Q:D'=+D  D

 ..Q:(9999999-D)>ED  ;after time frame

 ..Q:(9999999-D)<BD  ;before time frame

 ..S C=C+1

 ..S @RETVAL@(C)=(9999999-$P(D,"."))_"^"_$P(^AUTTHF(H,0),U,1)

 .Q

 Q

BGP8D76   ;IHS/CMI/LAB - MEASURE LOGIC; 

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +2       ;

 +3       ;

TOBCESSD  ;EP = tobacco cessaton, gpra dev v18

 +1       ;must be at least user pop

           IF 'BGPACTUP

               SET BGPSTOP=1

               QUIT 

 +2        SET (BGPVALUD,BGPVALUE)=""

 +3        SET (BGPD1,BGPD2,BGPN1,BGPN2,BGPN3)=0

 +4        KILL BGPTOBS,BGPTOBL,BGPTOBE,BGPTOBT

 +5       ;for last of each

           SET (BGPTOBSL,BGPTOBLL,BGPTOBEL,BGPTOBTL)=""

 +6        SET (BGPCTU,BGPSMK,BGPSMKL,BGPSMKE,BGPDNV,BGPNMV,BGPGOT,BGPGOTS,BGPGOTL,BGPL,BGPPTU,BGPTU)=""

 +7       ;get all TOBACCO (SMOKING) during report period

 +8        SET BGPL=""

 +9        DO ALLHF(DFN,BGPBDATE,BGPEDATE,"TOBACCO (SMOKING)","BGPTOBS")

 +10       SET X=0

           FOR 

               SET X=$ORDER(BGPTOBS(X))

               IF X'=+X!(BGPSMK)

                   QUIT 

               Begin DoDot:1

 +11               SET BGPL=X

 +12               IF BGPTOBS(BGPL)["CESSATION"

                       SET BGPCTU=1

                       SET BGPSMK=1

                       QUIT 

 +13               IF BGPTOBS(BGPL)["CURRENT SMOKER"

                       SET BGPCTU=1

                       SET BGPSMK=1

                       QUIT 

 +14               IF BGPTOBS(BGPL)["HEAVY TOBACCO SMOKER"

                       SET BGPCTU=1

                       SET BGPSMK=1

                       QUIT 

 +15               IF BGPTOBS(BGPL)["LIGHT TOBACCO SMOKER"

                       SET BGPCTU=1

                       SET BGPSMK=1

                       QUIT 

               End DoDot:1

 +16       IF BGPCTU

               SET BGPDNV="USER: "_$PIECE(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBS(BGPL),U,1))_")"

               SET BGPGOT=1

 +17       IF BGPSMK

               SET BGPDNV=BGPDNV_"; SMOKER: "_$PIECE(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBS(BGPL),U,1))_")"

               SET BGPGOTS=1

SML       ;

 +1        SET BGPL=""

 +2        DO ALLHF(DFN,BGPBDATE,BGPEDATE,"TOBACCO (SMOKELESS - CHEWING/DIP)","BGPTOBL")

 +3        SET X=0

           FOR 

               SET X=$ORDER(BGPTOBL(X))

               IF X'=+X!(BGPSMKL)

                   QUIT 

               Begin DoDot:1

 +4                SET BGPL=X

 +5                IF BGPTOBL(BGPL)["CESSATION"

                       SET BGPCTU=1

                       SET BGPSMKL=1

                       QUIT 

 +6                IF BGPTOBL(BGPL)["CURRENT SMOKE"

                       SET BGPCTU=1

                       SET BGPSMKL=1

                       QUIT 

               End DoDot:1

 +7        IF BGPCTU

               IF 'BGPGOT

                   SET BGPDNV="USER: "_$PIECE(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBL(BGPL),U,1))_")"

                   SET BGPGOT=1

 +8        IF BGPSMKL

               SET BGPDNV=BGPDNV_"; SMOKELESS: "_$PIECE(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBL(BGPL),U,1))_")"

               SET BGPGOTL=1

ENDS      ;

 +1        SET BGPL=""

 +2        DO ALLHF(DFN,BGPBDATE,BGPEDATE,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)","BGPTOBE")

 +3        SET X=0

           FOR 

               SET X=$ORDER(BGPTOBE(X))

               IF X'=+X!(BGPSMKE)

                   QUIT 

               Begin DoDot:1

 +4                SET BGPL=X

 +5                IF BGPTOBE(BGPL)["CESSATION"

                       SET BGPCTU=1

                       SET BGPSMKE=1

                       QUIT 

 +6                IF BGPTOBE(BGPL)["CURRENT"

                       SET BGPCTU=1

                       SET BGPSMKE=1

                       QUIT 

               End DoDot:1

 +7        IF BGPCTU

               IF 'BGPGOT

                   SET BGPDNV="USER: "_$PIECE(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBE(BGPL),U,1))_")"

                   SET BGPGOT=1

 +8        IF BGPSMKE

               SET BGPDNV=BGPDNV_"; ENDS: "_$PIECE(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBE(BGPL),U,1))_")"

 +9       ;

PREV      ;get last of each before time period.

 +1        SET BGPBDX=$$DOB^AUPNPAT(DFN)

           SET BGPEDX=$$FMADD^XLFDT(BGPBDATE,-1)

 +2       ;

PSMK      ;IF NOT A SMOKER GET LAST IN PREVIOUS TIME PERIOD

           IF 'BGPSMK

               Begin DoDot:1

 +1                KILL BGPTOBS

 +2                SET C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKING)",BGPBDX,BGPEDX)

 +3                IF C]""

                       SET BGPTOBS(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +4       ;now recheck all

 +5                SET BGPL=1

                   IF $DATA(BGPTOBS(1))

                       Begin DoDot:2

 +6                        IF BGPTOBS(BGPL)["CESSATION"

                               SET BGPPTU=1

                               SET BGPSMK=1

                               QUIT 

 +7                        IF BGPTOBS(BGPL)["CURRENT SMOKER"

                               SET BGPPTU=1

                               SET BGPSMK=1

                               QUIT 

 +8                        IF BGPTOBS(BGPL)["HEAVY TOBACCO SMOKER"

                               SET BGPPTU=1

                               SET BGPSMK=1

                               QUIT 

 +9                        IF BGPTOBS(BGPL)["LIGHT TOBACCO SMOKER"

                               SET BGPPTU=1

                               SET BGPSMK=1

                               QUIT 

                       End DoDot:2

 +10               IF 'BGPSMK

                       QUIT 

 +11               IF 'BGPCTU

                       IF BGPPTU

                           SET BGPDNV="USER: "_$PIECE(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBS(BGPL),U,1))_")"

                           SET BGPGOT=1

 +12               SET BGPDNV=BGPDNV_"; SMOKER: "_$PIECE(BGPTOBS(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBS(BGPL),U,1))_")"

                   SET BGPGOTS=1

               End DoDot:1

PSML      ;

 +1        IF 'BGPSMKL

               Begin DoDot:1

 +2                KILL BGPTOBL

 +3                SET C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",BGPBDX,BGPEDX)

 +4                IF C]""

                       SET BGPTOBL(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +5                SET BGPL=1

                   IF $DATA(BGPTOBL(1))

                       Begin DoDot:2

 +6                        IF BGPTOBL(BGPL)["CESSATION"

                               SET BGPPTU=1

                               SET BGPSMKL=1

                               QUIT 

 +7                        IF BGPTOBL(BGPL)["CURRENT SMOKE"

                               SET BGPPTU=1

                               SET BGPSMKL=1

                               QUIT 

                       End DoDot:2

 +8                IF 'BGPSMKL

                       QUIT 

 +9                IF BGPPTU

                       IF 'BGPCTU

                           SET BGPDNV="USER: "_$PIECE(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBL(BGPL),U,1))_")"

                           SET BGPGOT=1

 +10               SET BGPDNV=BGPDNV_"; SMOKELESS: "_$PIECE(BGPTOBL(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBL(BGPL),U,1))_")"

                   SET BGPGOTL=1

               End DoDot:1

PREVENDS  ;

 +1        IF 'BGPSMKE

               Begin DoDot:1

 +2                KILL BGPTOBE

 +3                SET C=$$LASTHF^BGP8D7(DFN,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",BGPBDX,BGPEDX)

 +4                IF C]""

                       SET BGPTOBE(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +5                SET BGPL=1

                   IF $DATA(BGPTOBE(1))

                       Begin DoDot:2

 +6                        IF BGPTOBE(BGPL)["CESSATION"

                               SET BGPTU=1

                               SET BGPSMKE=1

                               QUIT 

 +7                        IF BGPTOBE(BGPL)["CURRENT"

                               SET BGPTU=1

                               SET BGPSMKE=1

                               QUIT 

                       End DoDot:2

 +8                IF 'BGPSMKE

                       QUIT 

 +9                IF BGPTU

                       IF 'BGPCTU

                           SET BGPDNV="USER: "_$PIECE(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBE(BGPL),U,1))_")"

                           SET BGPGOT=1

 +10               SET BGPDNV=BGPDNV_"; ENDS: "_$PIECE(BGPTOBE(BGPL),U,2)_"("_$$DATE^BGP8UTL($PIECE(BGPTOBE(BGPL),U,1))_")"

               End DoDot:1

 +11      ;

 +12      ;

SET       ;

 +1        IF BGPCTU!(BGPPTU)

               SET BGPTU=1

 +2       ;not in this denominator at all

           IF 'BGPTU

               SET BGPSTOP=1

               DO KVARS

               QUIT 

 +3       ;UP

           SET BGPD1=1

 +4        IF BGPACTCL

               SET BGPD2=1

 +5       ;

 +6       ;get numerator stuff

 +7       ;BGPN1=tobacco cessation counseling or prescription

 +8       ;BGPN2=quit

 +9       ;BGPN3 - any of them

 +10       SET BGPTC1=$$PED^BGP8D711(DFN,BGPBDATE,BGPEDATE,1)

 +11       IF $PIECE(BGPTC1,U)]""

               SET BGPN1=1

               SET BGPN3=1

 +12      ;did they quit?  check each

 +13      ;SMOKER

 +14       SET BGPQ=""

 +15       IF BGPSMK

               SET X=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKING)",$$DOB^AUPNPAT(DFN),BGPEDATE)

               IF $PIECE(X,U,1)'["PREVIOUS"

                   GOTO S2

               SET BGPQ="QUIT SMOKING: "_$PIECE(X,U,2)_" "_$PIECE(X,U,1)

 +16       IF BGPSMKL

               SET X=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",$$DOB^AUPNPAT(DFN),BGPEDATE)

               IF $PIECE(X,U,1)'["PREVIOUS"

                   GOTO S2

               SET BGPQ=BGPQ_$SELECT(BGPQ]"":"; ",1:"")_"QUIT SMOKELESS: "_$PIECE(X,U,2)_" "_$PIECE(X,U,1)

 +17       IF BGPSMKE

               SET X=$$LASTHF^BGP8D7(DFN,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",$$DOB^AUPNPAT(DFN),BGPEDATE)

               IF $PIECE(X,U,1)'["PREVIOUS"

                   GOTO S2

               SET BGPQ=BGPQ_$SELECT(BGPQ]"":"; ",1:"")_"QUIT ENDS: "_$PIECE(X,U,2)_" "_$PIECE(X,U,1)

 +18       SET BGPN2=1

           SET BGPN3=1

S2        ;SET BGPVALUE

 +1        SET BGPVALUD="UP"_$SELECT(BGPD2:",AC",1:"")_" "_BGPDNV

 +2        Begin DoDot:1

 +3            SET BGPVALUD=BGPVALUD_"|||"_$SELECT($PIECE(BGPTC1,U):"COUNSEL: "_$$DATE^BGP7UTL($PIECE(BGPTC1,U))_" "_$PIECE(BGPTC1,U,2),1:"")

 +4       ;_" "_$P(BGPQ,U,3)

               IF BGPN2

                   SET BGPVALUD=BGPVALUD_"; "_BGPQ

           End DoDot:1

KVARS     ;

 +1        KILL BGPTOBS,BGPTOBL,BGPTOBE,BGPTOBT,BGPTOBSL,BGPTOBLL,BGPTOBEL,BGPTOBTL,BGPTU,BGPSMK,BGPSMKL,BGPSMKE,BGPGOT,BGPGOTS,BGPGOTL,BGPL,BGPTU,BGPCTU,BGPPTU

 +2        QUIT 

GETLAST   ;

 +1        NEW BGPBDX,BGPEDX,S,T,C,E

 +2        SET BGPBDX=$$DOB^AUPNPAT(DFN)

           SET BGPEDX=$$FMADD^XLFDT(BGPBDATE,-1)

 +3        SET C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKING)",BGPBDX,BGPEDX)

 +4        IF C]""

               SET BGPTOBS(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +5        SET C=$$LASTHF^BGP8D7(DFN,"TOBACCO (SMOKELESS - CHEWING/DIP)",BGPBDX,BGPEDX)

 +6        IF C]""

               SET BGPTOBL(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +7        SET C=$$LASTHF^BGP8D7(DFN,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",BGPBDX,BGPEDX)

 +8        IF C]""

               SET BGPTOBE(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +9        SET C=$$LASTHF^BGP8D7(DFN,"TOBACCO",BGPBDX,BGPEDX)

 +10       IF C]""

               SET BGPTOBT(1)=$PIECE(C,U,3)_"^"_$PIECE(C,U,1)

 +11       QUIT 

ALLHF(P,BD,ED,CAT,RETVAL) ;\

 +1        NEW H,D,C

 +2        SET (H,D,C)=0

 +3        SET CAT=$ORDER(^AUTTHF("B",CAT,0))

 +4        FOR 

               SET H=$ORDER(^AUTTHF("AC",CAT,H))

               IF '+H

                   QUIT 

               Begin DoDot:1

 +5                IF '$DATA(^AUPNVHF("AA",DFN,H))

                       QUIT 

 +6                SET D=""

                   FOR 

                       SET D=$ORDER(^AUPNVHF("AA",DFN,H,D))

                       IF D'=+D

                           QUIT 

                       Begin DoDot:2

 +7       ;after time frame

                           IF (9999999-D)>ED

                               QUIT 

 +8       ;before time frame

                           IF (9999999-D)<BD

                               QUIT 

 +9                        SET C=C+1

 +10                       SET @RETVAL@(C)=(9999999-$PIECE(D,"."))_"^"_$PIECE(^AUTTHF(H,0),U,1)

                       End DoDot:2

 +11               QUIT 

               End DoDot:1

 +12       QUIT