BQITREDU ;PRXM/HC/ALA-Find Education ; 21 May 2007 3:15 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
;
FED(DATE,BQDFN,CODE) ;EP - Find education
; Input
; DATE - Date to search from
; BQDFN - Patient internal entry number
; CODE - Education code to search for
;
;Build the topic data
NEW TREF,RES,IEN,TIEN,VIEN,VSDTM
S TREF=$NA(^TMP("BQITOPIC",UID)),RES=0_U_"No PED"
S DATE=$G(DATE,"")
K @TREF
D EDTP^BQITRUTL(TREF,CODE)
S IEN=""
F S IEN=$O(^AUPNVPED("AC",BQDFN,IEN)) Q:IEN="" D
. S TIEN=$P($G(^AUPNVPED(IEN,0)),U,1) I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. S VIEN=$P(^AUPNVPED(IEN,0),U,3) I VIEN="" Q
. S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),U,1)\1 I VSDTM=0 Q
. I DATE'="",VSDTM<DATE Q
. S RES=1_U_VSDTM_U_U_VIEN_U_IEN
K @TREF
Q RES
;
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 $D(@TMREF)<1 Q 0
;
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
;
;Patient Education Code CVD.ED.3
I $$FED(BQTDATE,BQDFN,"TO-") Q 0_"^Patient met education code 'TO-'"
I $$FED(BQTDATE,BQDFN,"-TO") Q 0_"^Patient met education code '-TO'"
I $$FED(BQTDATE,BQDFN,"-SHS") Q 0_"^Patient met education code '-SHS'"
I $$FED(BQTDATE,BQDFN,"305.1") Q 0_"^Patient met education dx 305.1"
I $$FED(BQTDATE,BQDFN,"649.00") Q 0_"^Patient met education dx 649.00"
I $$FED(BQTDATE,BQDFN,"649.01") Q 0_"^Patient met education dx 649.01"
I $$FED(BQTDATE,BQDFN,"649.02") Q 0_"^Patient met education dx 649.02"
I $$FED(BQTDATE,BQDFN,"649.03") Q 0_"^Patient met education dx 649.03"
I $$FED(BQTDATE,BQDFN,"649.04") Q 0_"^Patient met education dx 649.04"
;
;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"
BQITREDU ;PRXM/HC/ALA-Find Education ; 21 May 2007 3:15 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**1**;Apr 18, 2012;Build 43
+2 ;
FED(DATE,BQDFN,CODE) ;EP - Find education
+1 ; Input
+2 ; DATE - Date to search from
+3 ; BQDFN - Patient internal entry number
+4 ; CODE - Education code to search for
+5 ;
+6 ;Build the topic data
+7 NEW TREF,RES,IEN,TIEN,VIEN,VSDTM
+8 SET TREF=$NAME(^TMP("BQITOPIC",UID))
SET RES=0_U_"No PED"
+9 SET DATE=$GET(DATE,"")
+10 KILL @TREF
+11 DO EDTP^BQITRUTL(TREF,CODE)
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(^AUPNVPED("AC",BQDFN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+14 SET TIEN=$PIECE($GET(^AUPNVPED(IEN,0)),U,1)
IF TIEN=""
QUIT
+15 IF '$DATA(@TREF@(TIEN))
QUIT
+16 SET VIEN=$PIECE(^AUPNVPED(IEN,0),U,3)
IF VIEN=""
QUIT
+17 SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)\1
IF VSDTM=0
QUIT
+18 IF DATE'=""
IF VSDTM<DATE
QUIT
+19 SET RES=1_U_VSDTM_U_U_VIEN_U_IEN
End DoDot:1
+20 KILL @TREF
+21 QUIT RES
+22 ;
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 ;I $D(@TMREF)<1 Q 0
+35 ;
+36 IF $GET(BQTDATE)=""
SET BQTDATE=$ORDER(@TMREF@(""),-1)
+37 ;
+38 ; if current tobacco user, check for tobacco intervention
+39 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+40 DO BLD^BQITUTL("BGP TOBACCO INTERVENTION CPTS",TREF)
+41 SET IEN=""
SET QFL=0
+42 FOR
SET IEN=$ORDER(^AUPNVCPT("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+43 SET TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I")
IF TIEN=""
QUIT
+44 IF '$DATA(@TREF@(TIEN))
QUIT
+45 SET VIEN=$$GET1^DIQ(9000010.18,IEN,.03,"I")
IF VIEN=""
QUIT
+46 IF $$GET1^DIQ(9000010,VIEN,.11,"I")=1
QUIT
+47 SET VDATE=$$GET1^DIQ(9000010,VIEN,.01,"I")\1
IF 'VDATE
QUIT
+48 IF VDATE'>BQTDATE
QUIT
+49 SET QFL=1
End DoDot:1
IF QFL
QUIT
+50 IF QFL
QUIT 0_"^Patient had tobacco intervention CPT from BGP TOBACCO INTERVENTION CPTS"
+51 ;
+52 ; If intervention has been documented after most recent tobacco use
+53 ;
+54 ;Patient Education Code CVD.ED.3
+55 IF $$FED(BQTDATE,BQDFN,"TO-")
QUIT 0_"^Patient met education code 'TO-'"
+56 IF $$FED(BQTDATE,BQDFN,"-TO")
QUIT 0_"^Patient met education code '-TO'"
+57 IF $$FED(BQTDATE,BQDFN,"-SHS")
QUIT 0_"^Patient met education code '-SHS'"
+58 IF $$FED(BQTDATE,BQDFN,"305.1")
QUIT 0_"^Patient met education dx 305.1"
+59 IF $$FED(BQTDATE,BQDFN,"649.00")
QUIT 0_"^Patient met education dx 649.00"
+60 IF $$FED(BQTDATE,BQDFN,"649.01")
QUIT 0_"^Patient met education dx 649.01"
+61 IF $$FED(BQTDATE,BQDFN,"649.02")
QUIT 0_"^Patient met education dx 649.02"
+62 IF $$FED(BQTDATE,BQDFN,"649.03")
QUIT 0_"^Patient met education dx 649.03"
+63 IF $$FED(BQTDATE,BQDFN,"649.04")
QUIT 0_"^Patient met education dx 649.04"
+64 ;
+65 ;Dental Code
+66 SET DNC=$$FIND1^DIC(9999999.31,"","X",1320,"B","","ERROR")
+67 SET QFL=0
+68 IF DNC'=""
Begin DoDot:1
+69 SET IEN=""
+70 FOR
SET IEN=$ORDER(^AUPNVDEN("B",DNC,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+71 IF $$GET1^DIQ(9000010.05,IEN,.02,"I")'=BQDFN
QUIT
+72 SET VISIT=$$GET1^DIQ(9000010.05,IEN,.03,"I")
IF VISIT=""
QUIT
+73 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+74 SET VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VDATE
QUIT
+75 IF VDATE<BQTDATE
QUIT
+76 SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+77 IF QFL
QUIT 0_"^Patient met Dental Code 1320"
+78 ;
+79 ;Clinic Code 94
+80 SET TCC=$$FIND1^DIC(40.7,"","X",94,"C","","ERROR")
+81 SET VISIT=""
SET QFL=0
+82 FOR
SET VISIT=$ORDER(^AUPNVSIT("AC",BQDFN,VISIT))
IF VISIT=""
QUIT
Begin DoDot:1
+83 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+84 SET VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VDATE
QUIT
+85 IF VDATE<BQTDATE
QUIT
+86 IF $$GET1^DIQ(9000010,VISIT,.08,"I")'=TCC
QUIT
+87 SET QFL=1
End DoDot:1
IF QFL
QUIT
+88 IF QFL
QUIT 0_"^Patient had a visit in TOBACCO CESSATION CLINIC"
+89 ;
+90 ;Medication with Name containing
+91 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+92 FOR TAX="BGP CMS SMOKING CESSATION MEDS","BGP CMS SMOKING CESSATION NDC"
DO BLD^BQITUTL("BGP TOBACCO USER CPTS",TREF)
+93 FOR MTYP="NICOTINE PATCH","NICOTINE POLACRILEX","NICOTINE INHALER","NICOTINE NASAL SPRAY"
DO MED^BQITRUTL(TREF,MTYP)
+94 SET TIEN=""
SET QFL=0
+95 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+96 SET IEN=""
+97 FOR
SET IEN=$ORDER(^AUPNVMED("B",TIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+98 IF $$GET1^DIQ(9000010.14,IEN,.02,"I")'=BQDFN
QUIT
+99 SET VISIT=$$GET1^DIQ(9000010.14,IEN,.03,"I")
IF VISIT=""
QUIT
+100 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+101 SET VDATE=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VDATE
QUIT
+102 IF VDATE<BQTDATE
QUIT
+103 SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+104 IF QFL
QUIT 0_"^Patient had smoking cessation medication"
+105 ;
+106 QUIT 1_"^Patient current smoker but no smoking cessation intervention"
