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
