BQITRCTB ;GDHD/HS/ALA-CVD Tobacco ; 16 Jun 2016 3:16 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
ASSES(BQDFN) ;EP - Assessed Tobacco
NEW MEET,DESC,X,TAX,TREF
S MEET=1,DESC="No Tobacco Assessment in past year"
S X=$$TOB^BQIRGASU(BQDFN)
I X D
. S $P(X,U,2)=$$DATE^BQIUL1($P(X,U,2))
. S MEET=0,DESC="Last Tobacco HF was "_$$FMTMDY^BQIUL1($P(X,U,2))
I X="" D
. ;Patient Education Code
. S BQTDATE=$$DATE^BQIUL1("T-12M"),RESULT=1
. I $$FED^BQITREDU(BQTDATE,BQDFN,"TO-") S MEET=0,DESC="Patient met education code 'TO-'"
. I $$FED^BQITREDU(BQTDATE,BQDFN,"-TO") S MEET=0,DESC="Patient met education code '-TO'"
. I $$FED^BQITREDU(BQTDATE,BQDFN,"-SHS") S MEET=0,DESC="Patient met education code '-SHS'"
. S SN=$O(^BGPSNOMM("B","TOBACCO SCREEN PATIENT ED",0))
. I SN'="" D
.. S CD=0 F S CD=$O(^BGPSNOMM(SN,11,CD)) Q:'CD D
... S SNOM=^BGPSNOMM(SN,11,CD,0)
... I $$FED^BQITREDU(BQTDATE,BQDFN,SNOM) S MEET=0,DESC="Patient met SNOMED subset TOBACCO SCREEN PATIENT ED" Q
. ;
. S TAX="BGP TOBACCO DXS",TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. D BLD^BQITUTL(TAX,.TREF)
. S N="" F S N=$O(@TREF@(N)) Q:N="" S DXC=$P(@TREF@(N),"^",1) D
.. I $$FED^BQITREDU(BQTDATE,BQDFN,DXC) S MEET=0,DESC="Patient met taxonomy BGP TOBACCO DXS" Q
. ;
. S TAX="BGP TOBACCO SCREEN CPTS",TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. D BLD^BQITUTL(TAX,.TREF)
. S N="" F S N=$O(@TREF@(N)) Q:N="" S CPT=$P(@TREF@(N),"^",1) D
.. I $$FED^BQITREDU(BQTDATE,BQDFN,CPT) S MEET=0,DESC="Patient met education BGP TOBACCO SCREEN CPTS" Q
. ;
. S N="" F S N=$O(@TREF@(N)) Q:N="" S CPT=$P(@TREF@(N),"^",1) D
.. I $$TAX^BQITRUTL("T-12M","",1,BQDFN,9000010.18,"",,.TREF,"","") S MEET=0,DESC="Patient met CPT BGP TOBACCO SCREEN CPTS" Q
;
Q MEET_U_DESC
;
EDUC ;EP - Education
S MEET=1,DESC="No Tobacco Intervention"
I $$FED^BQITREDU(BQTDATE,BQDFN,"TO-") S MEET=0,DESC="Patient met education code 'TO-'"
I $$FED^BQITREDU(BQTDATE,BQDFN,"-TO") S MEET=0,DESC="Patient met education code '-TO'"
I $$FED^BQITREDU(BQTDATE,BQDFN,"-SHS") S MEET=0,DESC="Patient met education code '-SHS'"
S SN=$O(^BGPSNOMM("B","TOBACCO SCREEN PATIENT ED",0))
I SN'="" D
. S CD=0 F S CD=$O(^BGPSNOMM(SN,11,CD)) Q:'CD D
.. S SNOM=^BGPSNOMM(SN,11,CD,0)
.. I $$FED^BQITREDU(BQTDATE,BQDFN,SNOM) S MEET=0,DESC="Patient met SNOMED subset TOBACCO SCREEN PATIENT ED" Q
;
S TAX="BGP TOBACCO DXS",TREF=$NA(^TMP("BQITAX",UID)) K @TREF
D BLD^BQITUTL(TAX,.TREF)
S N="" F S N=$O(@TREF@(N)) Q:N="" S DXC=$P(@TREF@(N),"^",1) D
. I $$FED^BQITREDU(BQTDATE,BQDFN,DXC) S MEET=0,DESC="Patient met taxonomy BGP TOBACCO DXS" Q
;
S TAX="BGP TOBACCO SCREEN CPTS",TREF=$NA(^TMP("BQITAX",UID)) K @TREF
D BLD^BQITUTL(TAX,.TREF)
S N="" F S N=$O(@TREF@(N)) Q:N="" S CPT=$P(@TREF@(N),"^",1) D
. I $$FED^BQITREDU(BQTDATE,BQDFN,CPT) S MEET=0,DESC="Patient met education BGP TOBACCO SCREEN CPTS" Q
Q
;
SMOK(BQDFN) ; EP - Find smoking for a patient
; Input
; BQDFN - Patient internal entry number
;
NEW BQIARRAY,BA,LBA,NP,VIEN,VDATE,BQDEF,BQEXEC,BQGLB,BQIRY,ENDT
NEW EXDT,PLFLG,RESULT,TMREF,TOB,TPIEN,MTYP,DNC,BQTDATE,QFL,TAX
NEW TCC,VISIT
S UID=$G(UID,$J),RESULT=""
S TMREF=$NA(^TMP("BQITOBAC",UID)) K @TMREF
; if patient current tobacco user
S TOB=$$PAT^BQITD12("Tobacco Users (Smokers)","BQIARRAY",BQDFN)
I TOB D
. S BA="BQIARRAY" F S BA=$Q(@BA) Q:BA="" S LBA=BA
. S NP=$L(LBA,",")
. I $F(LBA,",""P"",") S TPIEN=$P($P(LBA,",",NP),")",1) S BQTDATE=$$PROB^BQIUL1(TPIEN)
. I $F(LBA,",""V"",") S VIEN=$P($P(LBA,",",NP-1),")",1) S BQTDATE=$P($G(^AUPNVSIT(VIEN,0)),U,1)\1
. M @TMREF=BQIARRAY
. S RESULT="Patient tagged as current tobacco user"
;
I 'TOB D
. ; Check for new CPT taxonomy
. S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
. D BLD^BQITUTL("BGP TOBACCO USER CPTS",TREF)
. S IEN=""
. F S IEN=$O(^AUPNVCPT("AC",BQDFN,IEN),-1) Q:IEN="" D
.. S TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I") I TIEN="" Q
.. I '$D(@TREF@(TIEN)) Q
.. S VIEN=$$GET1^DIQ(9000010.18,IEN,.03,"I") Q:VIEN=""
.. I $$GET1^DIQ(9000010,VIEN,.11,"I")=1 Q
.. S VDATE=$$GET1^DIQ(9000010,VIEN,.01,"I")\1 Q:'VDATE
.. S @TMREF@(VDATE,IEN)=VIEN,TOB=1,RESULT="Patient had a CPT from BGP TOBACCO USER CPTS"
;
; If not current tobacco user, quit
I 'TOB Q 0_"^Patient not a current tobacco user"
;
I $G(BQTDATE)="" S BQTDATE=$O(@TMREF@(""),-1)
;
; if current tobacco user, check for tobacco intervention
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
D BLD^BQITUTL("BGP TOBACCO INTERVENTION CPTS",TREF)
S IEN="",QFL=0
F S IEN=$O(^AUPNVCPT("AC",BQDFN,IEN),-1) Q:IEN="" D Q:QFL
. S TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. S VIEN=$$GET1^DIQ(9000010.18,IEN,.03,"I") Q:VIEN=""
. I $$GET1^DIQ(9000010,VIEN,.11,"I")=1 Q
. S VDATE=$$GET1^DIQ(9000010,VIEN,.01,"I")\1 Q:'VDATE
. I VDATE'>BQTDATE Q
. S QFL=1
I QFL Q 0_"^Patient had tobacco intervention CPT from BGP TOBACCO INTERVENTION CPTS"
;
; If intervention has been documented after most recent tobacco use
D EDUC I 'MEET Q "0^"_DESC
;Dental Code
S DNC=$$FIND1^DIC(9999999.31,"","X",1320,"B","","ERROR")
S QFL=0
I DNC'="" D
. S IEN=""
. F S IEN=$O(^AUPNVDEN("B",DNC,IEN)) Q:IEN="" D Q:QFL
.. I $$GET1^DIQ(9000010.05,IEN,.02,"I")'=BQDFN Q
.. S VISIT=$$GET1^DIQ(9000010.05,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VDATE
.. I VDATE<BQTDATE Q
.. S QFL=1
I QFL Q 0_"^Patient met Dental Code 1320"
;
;Clinic Code 94
S TCC=$$FIND1^DIC(40.7,"","X",94,"C","","ERROR")
S VISIT="",QFL=0
F S VISIT=$O(^AUPNVSIT("AC",BQDFN,VISIT)) Q:VISIT="" D Q:QFL
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. S VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VDATE
. I VDATE<BQTDATE Q
. I $$GET1^DIQ(9000010,VISIT,.08,"I")'=TCC Q
. S QFL=1
I QFL Q 0_"^Patient had a visit in TOBACCO CESSATION CLINIC"
;
;Medication with Name containing
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP CMS SMOKING CESSATION MEDS","BGP CMS SMOKING CESSATION NDC" D BLD^BQITUTL("BGP TOBACCO USER CPTS",TREF)
F MTYP="NICOTINE PATCH","NICOTINE POLACRILEX","NICOTINE INHALER","NICOTINE NASAL SPRAY" D MED^BQITRUTL(TREF,MTYP)
S TIEN="",QFL=0
F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVMED("B",TIEN,IEN)) Q:IEN="" D Q:QFL
.. I $$GET1^DIQ(9000010.14,IEN,.02,"I")'=BQDFN Q
.. S VISIT=$$GET1^DIQ(9000010.14,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VDATE
.. I VDATE<BQTDATE Q
.. S QFL=1
I QFL Q 0_"^Patient had smoking cessation medication"
;
Q 1_"^Patient current smoker but no smoking cessation intervention"
BQITRCTB ;GDHD/HS/ALA-CVD Tobacco ; 16 Jun 2016 3:16 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
ASSES(BQDFN) ;EP - Assessed Tobacco
+1 NEW MEET,DESC,X,TAX,TREF
+2 SET MEET=1
SET DESC="No Tobacco Assessment in past year"
+3 SET X=$$TOB^BQIRGASU(BQDFN)
+4 IF X
Begin DoDot:1
+5 SET $PIECE(X,U,2)=$$DATE^BQIUL1($PIECE(X,U,2))
+6 SET MEET=0
SET DESC="Last Tobacco HF was "_$$FMTMDY^BQIUL1($PIECE(X,U,2))
End DoDot:1
+7 IF X=""
Begin DoDot:1
+8 ;Patient Education Code
+9 SET BQTDATE=$$DATE^BQIUL1("T-12M")
SET RESULT=1
+10 IF $$FED^BQITREDU(BQTDATE,BQDFN,"TO-")
SET MEET=0
SET DESC="Patient met education code 'TO-'"
+11 IF $$FED^BQITREDU(BQTDATE,BQDFN,"-TO")
SET MEET=0
SET DESC="Patient met education code '-TO'"
+12 IF $$FED^BQITREDU(BQTDATE,BQDFN,"-SHS")
SET MEET=0
SET DESC="Patient met education code '-SHS'"
+13 SET SN=$ORDER(^BGPSNOMM("B","TOBACCO SCREEN PATIENT ED",0))
+14 IF SN'=""
Begin DoDot:2
+15 SET CD=0
FOR
SET CD=$ORDER(^BGPSNOMM(SN,11,CD))
IF 'CD
QUIT
Begin DoDot:3
+16 SET SNOM=^BGPSNOMM(SN,11,CD,0)
+17 IF $$FED^BQITREDU(BQTDATE,BQDFN,SNOM)
SET MEET=0
SET DESC="Patient met SNOMED subset TOBACCO SCREEN PATIENT ED"
QUIT
End DoDot:3
End DoDot:2
+18 ;
+19 SET TAX="BGP TOBACCO DXS"
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+20 DO BLD^BQITUTL(TAX,.TREF)
+21 SET N=""
FOR
SET N=$ORDER(@TREF@(N))
IF N=""
QUIT
SET DXC=$PIECE(@TREF@(N),"^",1)
Begin DoDot:2
+22 IF $$FED^BQITREDU(BQTDATE,BQDFN,DXC)
SET MEET=0
SET DESC="Patient met taxonomy BGP TOBACCO DXS"
QUIT
End DoDot:2
+23 ;
+24 SET TAX="BGP TOBACCO SCREEN CPTS"
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+25 DO BLD^BQITUTL(TAX,.TREF)
+26 SET N=""
FOR
SET N=$ORDER(@TREF@(N))
IF N=""
QUIT
SET CPT=$PIECE(@TREF@(N),"^",1)
Begin DoDot:2
+27 IF $$FED^BQITREDU(BQTDATE,BQDFN,CPT)
SET MEET=0
SET DESC="Patient met education BGP TOBACCO SCREEN CPTS"
QUIT
End DoDot:2
+28 ;
+29 SET N=""
FOR
SET N=$ORDER(@TREF@(N))
IF N=""
QUIT
SET CPT=$PIECE(@TREF@(N),"^",1)
Begin DoDot:2
+30 IF $$TAX^BQITRUTL("T-12M","",1,BQDFN,9000010.18,"",,.TREF,"","")
SET MEET=0
SET DESC="Patient met CPT BGP TOBACCO SCREEN CPTS"
QUIT
End DoDot:2
End DoDot:1
+31 ;
+32 QUIT MEET_U_DESC
+33 ;
EDUC ;EP - Education
+1 SET MEET=1
SET DESC="No Tobacco Intervention"
+2 IF $$FED^BQITREDU(BQTDATE,BQDFN,"TO-")
SET MEET=0
SET DESC="Patient met education code 'TO-'"
+3 IF $$FED^BQITREDU(BQTDATE,BQDFN,"-TO")
SET MEET=0
SET DESC="Patient met education code '-TO'"
+4 IF $$FED^BQITREDU(BQTDATE,BQDFN,"-SHS")
SET MEET=0
SET DESC="Patient met education code '-SHS'"
+5 SET SN=$ORDER(^BGPSNOMM("B","TOBACCO SCREEN PATIENT ED",0))
+6 IF SN'=""
Begin DoDot:1
+7 SET CD=0
FOR
SET CD=$ORDER(^BGPSNOMM(SN,11,CD))
IF 'CD
QUIT
Begin DoDot:2
+8 SET SNOM=^BGPSNOMM(SN,11,CD,0)
+9 IF $$FED^BQITREDU(BQTDATE,BQDFN,SNOM)
SET MEET=0
SET DESC="Patient met SNOMED subset TOBACCO SCREEN PATIENT ED"
QUIT
End DoDot:2
End DoDot:1
+10 ;
+11 SET TAX="BGP TOBACCO DXS"
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+12 DO BLD^BQITUTL(TAX,.TREF)
+13 SET N=""
FOR
SET N=$ORDER(@TREF@(N))
IF N=""
QUIT
SET DXC=$PIECE(@TREF@(N),"^",1)
Begin DoDot:1
+14 IF $$FED^BQITREDU(BQTDATE,BQDFN,DXC)
SET MEET=0
SET DESC="Patient met taxonomy BGP TOBACCO DXS"
QUIT
End DoDot:1
+15 ;
+16 SET TAX="BGP TOBACCO SCREEN CPTS"
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+17 DO BLD^BQITUTL(TAX,.TREF)
+18 SET N=""
FOR
SET N=$ORDER(@TREF@(N))
IF N=""
QUIT
SET CPT=$PIECE(@TREF@(N),"^",1)
Begin DoDot:1
+19 IF $$FED^BQITREDU(BQTDATE,BQDFN,CPT)
SET MEET=0
SET DESC="Patient met education BGP TOBACCO SCREEN CPTS"
QUIT
End DoDot:1
+20 QUIT
+21 ;
SMOK(BQDFN) ; EP - Find smoking for a patient
+1 ; Input
+2 ; BQDFN - Patient internal entry number
+3 ;
+4 NEW BQIARRAY,BA,LBA,NP,VIEN,VDATE,BQDEF,BQEXEC,BQGLB,BQIRY,ENDT
+5 NEW EXDT,PLFLG,RESULT,TMREF,TOB,TPIEN,MTYP,DNC,BQTDATE,QFL,TAX
+6 NEW TCC,VISIT
+7 SET UID=$GET(UID,$JOB)
SET RESULT=""
+8 SET TMREF=$NAME(^TMP("BQITOBAC",UID))
KILL @TMREF
+9 ; if patient current tobacco user
+10 SET TOB=$$PAT^BQITD12("Tobacco Users (Smokers)","BQIARRAY",BQDFN)
+11 IF TOB
Begin DoDot:1
+12 SET BA="BQIARRAY"
FOR
SET BA=$QUERY(@BA)
IF BA=""
QUIT
SET LBA=BA
+13 SET NP=$LENGTH(LBA,",")
+14 IF $FIND(LBA,",""P"",")
SET TPIEN=$PIECE($PIECE(LBA,",",NP),")",1)
SET BQTDATE=$$PROB^BQIUL1(TPIEN)
+15 IF $FIND(LBA,",""V"",")
SET VIEN=$PIECE($PIECE(LBA,",",NP-1),")",1)
SET BQTDATE=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)\1
+16 MERGE @TMREF=BQIARRAY
+17 SET RESULT="Patient tagged as current tobacco user"
End DoDot:1
+18 ;
+19 IF 'TOB
Begin DoDot:1
+20 ; Check for new CPT taxonomy
+21 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+22 DO BLD^BQITUTL("BGP TOBACCO USER CPTS",TREF)
+23 SET IEN=""
+24 FOR
SET IEN=$ORDER(^AUPNVCPT("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+25 SET TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I")
IF TIEN=""
QUIT
+26 IF '$DATA(@TREF@(TIEN))
QUIT
+27 SET VIEN=$$GET1^DIQ(9000010.18,IEN,.03,"I")
IF VIEN=""
QUIT
+28 IF $$GET1^DIQ(9000010,VIEN,.11,"I")=1
QUIT
+29 SET VDATE=$$GET1^DIQ(9000010,VIEN,.01,"I")\1
IF 'VDATE
QUIT
+30 SET @TMREF@(VDATE,IEN)=VIEN
SET TOB=1
SET RESULT="Patient had a CPT from BGP TOBACCO USER CPTS"
End DoDot:2
End DoDot:1
+31 ;
+32 ; If not current tobacco user, quit
+33 IF 'TOB
QUIT 0_"^Patient not a current tobacco user"
+34 ;
+35 IF $GET(BQTDATE)=""
SET BQTDATE=$ORDER(@TMREF@(""),-1)
+36 ;
+37 ; if current tobacco user, check for tobacco intervention
+38 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+39 DO BLD^BQITUTL("BGP TOBACCO INTERVENTION CPTS",TREF)
+40 SET IEN=""
SET QFL=0
+41 FOR
SET IEN=$ORDER(^AUPNVCPT("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+42 SET TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I")
IF TIEN=""
QUIT
+43 IF '$DATA(@TREF@(TIEN))
QUIT
+44 SET VIEN=$$GET1^DIQ(9000010.18,IEN,.03,"I")
IF VIEN=""
QUIT
+45 IF $$GET1^DIQ(9000010,VIEN,.11,"I")=1
QUIT
+46 SET VDATE=$$GET1^DIQ(9000010,VIEN,.01,"I")\1
IF 'VDATE
QUIT
+47 IF VDATE'>BQTDATE
QUIT
+48 SET QFL=1
End DoDot:1
IF QFL
QUIT
+49 IF QFL
QUIT 0_"^Patient had tobacco intervention CPT from BGP TOBACCO INTERVENTION CPTS"
+50 ;
+51 ; If intervention has been documented after most recent tobacco use
+52 DO EDUC
IF 'MEET
QUIT "0^"_DESC
+53 ;Dental Code
+54 SET DNC=$$FIND1^DIC(9999999.31,"","X",1320,"B","","ERROR")
+55 SET QFL=0
+56 IF DNC'=""
Begin DoDot:1
+57 SET IEN=""
+58 FOR
SET IEN=$ORDER(^AUPNVDEN("B",DNC,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+59 IF $$GET1^DIQ(9000010.05,IEN,.02,"I")'=BQDFN
QUIT
+60 SET VISIT=$$GET1^DIQ(9000010.05,IEN,.03,"I")
IF VISIT=""
QUIT
+61 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+62 SET VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VDATE
QUIT
+63 IF VDATE<BQTDATE
QUIT
+64 SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+65 IF QFL
QUIT 0_"^Patient met Dental Code 1320"
+66 ;
+67 ;Clinic Code 94
+68 SET TCC=$$FIND1^DIC(40.7,"","X",94,"C","","ERROR")
+69 SET VISIT=""
SET QFL=0
+70 FOR
SET VISIT=$ORDER(^AUPNVSIT("AC",BQDFN,VISIT))
IF VISIT=""
QUIT
Begin DoDot:1
+71 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+72 SET VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VDATE
QUIT
+73 IF VDATE<BQTDATE
QUIT
+74 IF $$GET1^DIQ(9000010,VISIT,.08,"I")'=TCC
QUIT
+75 SET QFL=1
End DoDot:1
IF QFL
QUIT
+76 IF QFL
QUIT 0_"^Patient had a visit in TOBACCO CESSATION CLINIC"
+77 ;
+78 ;Medication with Name containing
+79 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+80 FOR TAX="BGP CMS SMOKING CESSATION MEDS","BGP CMS SMOKING CESSATION NDC"
DO BLD^BQITUTL("BGP TOBACCO USER CPTS",TREF)
+81 FOR MTYP="NICOTINE PATCH","NICOTINE POLACRILEX","NICOTINE INHALER","NICOTINE NASAL SPRAY"
DO MED^BQITRUTL(TREF,MTYP)
+82 SET TIEN=""
SET QFL=0
+83 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+84 SET IEN=""
+85 FOR
SET IEN=$ORDER(^AUPNVMED("B",TIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+86 IF $$GET1^DIQ(9000010.14,IEN,.02,"I")'=BQDFN
QUIT
+87 SET VISIT=$$GET1^DIQ(9000010.14,IEN,.03,"I")
IF VISIT=""
QUIT
+88 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+89 SET VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VDATE
QUIT
+90 IF VDATE<BQTDATE
QUIT
+91 SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+92 IF QFL
QUIT 0_"^Patient had smoking cessation medication"
+93 ;
+94 QUIT 1_"^Patient current smoker but no smoking cessation intervention"
