BKMRMLB ;PRXM/HC/ALA-HMS Lab Reminders ; 13 Nov 2007 4:04 PM
;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
CD4(GUI) ;EP - REM.T.01
; CD4 Due
; Due date = Today, if no CD4 test (T.2) documented ever.
; Due date = Date of most recent CD4 test + 120 days (or 4 months).
; If "Now," then text = "CD4 laboratory test may be due now; last documented [date]."
NEW LAST,DUE,LAST1,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,LAST1)=""
D LABCODES^BKMVF32(DFN,"BGP CD4 TAX","BGP CD4 LOINC CODES","BGP CD4 CPTS","","",.LAST)
D LABCODES^BKMVF32(DFN,"BKMV CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES","BKMV CD4 ABS CPTS","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
I LAST'="" S DUE=+$$SCH^XLFDT("4M",LAST)
I LAST="" S DUE=DT
D ADDLINE^BKMVF32("1 REM.T.01",.LIST,"CD4",LAST,DUE)
D WRITE("1 REM.T.01",GUI)
Q
;
CHL(GUI) ;EP - REM.T.07
; Chlamydia Test Due
; Numerator: All patients 18 years of age and older
; Due date = Today, if no Chlamydia test (T.3) ever documented OR
; Due date = Today, if most recent test results for any of the following are positive
; since the most recent Chlamydia test and =<365 days from today:
; Gonorrhea (T.10); Syphilis (T.22) or (T.9). OR
; Due date = Today, if patient has any of the following POV diagnoses
; since the most recent Chlamydia test and =<365 days from today:
; Gonorrhea (DX.4), Syphilis (DX.11), Trichomoniasis (DX.13) or other STD (DX.9) OR
; Due date = Date of most recent positive Chlamydia test + 56 days (for retest after cure) OR
; Due date = Date of most recent Chlamydia test + 365 days (or 12 months).
; If "Now," then text = "Chlamydia test may be due now. Please review your patient's recent and past history and consider ordering this test; last documented test was [date].
; *** What happens if a Chlamydia test is done on Monday and a Gonorrhea (etc.) is found positive on Tuesday? When should the next Chlamydia be scheduled?
NEW LAST,DUE,PDATE,LAST1,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,PDATE,LAST1)=""
I APCHSAGE'<18 D
. D LABCODES^BKMVF32(DFN,"BGP CHLAMYDIA TESTS TAX","BGP CHLAMYDIA LOINC CODES","BTPW CHLAMYDIA CPTS","BGP CHLAMYDIA TEST PROCEDURES","",.LAST,"","",.PDATE)
. I LAST'="" D
.. S DUE=+$$SCH^XLFDT("12M",LAST)
.. I PDATE'="" D
... I PDATE'<LAST S DUE=$$FMADD^XLFDT(PDATE,56)
.. ; If any STD tests (except Chlamydia) are positive since the last Chlamydia test (or diagnoses found)
.. I $$STDS^BKMVF32(DFN,"CHLAMYDIA",LAST) S DUE=DT
. I LAST="" S DUE=DT
D ADDLINE^BKMVF32("20 REM.T.07",.LIST,"Chlamydia Test",LAST,DUE)
D WRITE("20 REM.T.07",GUI)
Q
;
SYPF(GUI) ;EP - REM.T.04
; FTA-ABS (Syphilis) Due
; Numerator: Patients with a positive RPR laboratory value (T.22) (defined as positive,
; reactive, indeterminate or any number values) and no FTA-ABS (T.9) documented
; after the date of the positive RPR
; Due date = Date of the most recent positive RPR laboratory test + 14 days.
; If "Now," then text = "An FTA-ABS Syphilis test is strongly recommended at this time because your patient had a positive RPR test documented on [date]."
NEW LAST,DUE,PDATE,ODATE,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,PDATE,ODATE)=""
D LABCODES^BKMVF32(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","","","","","",.PDATE,.PR,"","",.ODATE,.OR,"$$UP^XLFSTR(RESULT)[""INDETERMINATE""!(RESULT?0.N0.1"".""1.N&(RESULT'=0))")
S PDATE=$S(PDATE>ODATE:PDATE,1:ODATE)
I PDATE'="" D
. D LABCODES^BKMVF32(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","",PDATE,"",.LAST)
. I LAST="" S DUE=$$FMADD^XLFDT(PDATE,14)
D ADDLINE^BKMVF32("13 REM.T.04",.LIST,"FTA/ABS Syphilis Test",LAST,DUE)
D WRITE("13 REM.T.04",GUI)
Q
;
GON(GUI) ;EP - REM.T.08
; Gonorrhea Test Due
; Numerator: All patients 18 years of age and older.
; Due date = Today, if no Gonorrhea test (T.10) ever documented. OR
; Due date = Today, if most recent test results for any of the following are positive
; since the most recent Gonorrhea test and =<365 days from today:
; Chlamydia (T.3); Syphilis (T.22) or (T.9). OR
; Due date = Today, if patient has any of the following POV diagnoses
; since the most recent Gonorrhea test and =<365 days from today:
; Chlamydia (DX.2), Syphilis (DX.11), Trichomoniasis (DX.13) or other STD (DX.9) OR
; Due date = Date of most recent Gonorrhea test + 365 days (or 12 months).
; If "Now," then text = "Gonorrhea test may be due now. Please review your patient's recent and past history and consider ordering this test; last documented test was [date]."
NEW LAST,DUE,BDATE
S (LAST,DUE)=""
I $G(BDATE)="" S BDATE=DT
I APCHSAGE'<18 D
. D LABCODES^BKMVF32(DFN,"BKM GONORRHEA TEST TAX","BKM GONORRHEA LOINC CODES","BKM GONORRHEA TESTS CPTS","","",.LAST)
. I LAST'="" D
. . S DUE=+$$SCH^XLFDT("12M",LAST)
. . ; If any STD tests (except Gonorrhea) are positive since the last Gonorrhea test (or diagnoses found)
. . I $$STDS^BKMVF32(DFN,"GONORRHEA",LAST) S DUE=BDATE
. I LAST="" S DUE=BDATE
D ADDLINE^BKMVF32("21 REM.T.08",.LIST,"Gonorrhea Test",LAST,DUE)
D WRITE("21 REM.T.08",GUI)
Q
;
HEPBR(GUI) ;EP - REM.T.13
; Hepatitis B Retest Due
; Numerator: All patients with 3 documented Hepatitis B immunizations (IZ.4) and no
; Hepatitis B test (T.27) documented after the final immunization
; Due date = Today
; If "Now," then text = "Hepatitis B retest may be indicated at this time to ensure adequate coverage since this patient has completed all 3 Hepatitis B immunizations; last documented immunization was given on [date]."
NEW LAST,DUE,LAST1,VISIT,CNT,BDATE
S (LAST,DUE,LAST1,VISIT)="",CNT=0 K TEMP
I $G(BDATE)="" S BDATE=DT
D CVXTAX^BKMIXX1(DFN,"BKM HEP B IZ CVX CODES","","","TEMP(VISIT)",.LAST)
D CPTTAX^BKMIXX(DFN,"BKM HEP B IZ CPTS","","","TEMP(VISIT)",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
F S VISIT=$O(TEMP(VISIT)) Q:'VISIT S CNT=CNT+1
I CNT<3 S LAST=""
I CNT'<3 D
. S LAST1=""
. D LABCODES^BKMVF32(DFN,"BKM HEP B TAX","BKM HEP B LOINC CODES","BKM HEP B TESTS CPTS","",LAST,.LAST1)
. I LAST1'="" S LAST="" Q
. S DUE=BDATE,LAST=LAST1
D ADDLINE^BKMVF32("17 REM.T.13",.LIST,"Hep B Retest",LAST,DUE)
D WRITE("17 REM.T.13",GUI)
Q
;
HEPB(GUI) ;EP - REM.T.12
; Hepatitis B Test Due
; Numerator: Any patient with no Hepatitis B (DX.15) diagnosis (POV or problem list) ever AND
; no Hepatitis B test results (T.27) ever documented.
; Due date = Today
; If "Now," then text = "This patient may benefit from a Hepatitis B Test."
NEW LAST,DUE,BDATE
S (LAST,DUE)=""
I $G(BDATE)="" S BDATE=DT
D
. D ICDTAX^BKMIXX1(DFN,"BKM HEP B DXS","","","",.LAST)
. I LAST'="" Q
. D PRBTAX^BKMIXX(DFN,"BKM HEP B DXS","","","",.LAST)
. I LAST'="" Q
. D LABCODES^BKMVF32(DFN,"BKM HEP B TAX","BKM HEP B LOINC CODES","BKM HEP B TESTS CPTS","","",.LAST)
. I LAST'="" Q
. S DUE=BDATE
D ADDLINE^BKMVF32("16 REM.T.12",.LIST,"Hep B Test",LAST,DUE)
D WRITE("16 REM.T.12",GUI)
Q
;
HEPCE(GUI) ;EP - REM.T.09
; Hepatitis C EIA Test Due
; Numerator: Any patient with no Hepatitis C (DX.16) diagnosis (POV or problem list) ever documented.
; Due date = Today, if no Hepatitis C EIA (T.13) or Hepatitis C RIBA (T.14) ever documented OR
; Due date = if no documented Hepatitis C EIA (T.13) test but a Hepatitis C confirmation test (T.14) is documented, date of most recent confirmation test + 365 days (1 year) OR
; Due date = if most recent EIA test is not positive, date of most recent, not positive Hepatitis C EIA test + 365 days (or 12 months) OR
; Due date = if most recent EIA test is positive followed by a negative Hepatitis C RIBA test, date of EIA test +365 days (or 12 months).
; If most recent EIA test is positive AND is not followed by documented Hep C confirmation test, then go to REM.T.14
; If "Now," then text = "This patient may be due for a Hepatitis C testing; last documented [date]."
NEW SKIP,LAST,DUE,LAST1,EPDATE,ENDATE,RLAST,RNDATE,BDATE
; If set to 1, skip this reminder and continue with REM.T.14
S SKIP=""
S (LAST,DUE,LAST1,EPDATE,ENDATE,RLAST,RNDATE)=""
I $G(BDATE)="" S BDATE=DT
D
. D ICDTAX^BKMIXX1(DFN,"BKM HEP C DXS","","","",.LAST1)
. I LAST1'="" Q
. D PRBTAX^BKMIXX(DFN,"BKM HEP C DXS","","","",.LAST1)
. I LAST1'="" Q
. ; Check for T.13
. D LABCODES^BKMVF32(DFN,"BKM HEP C SCREENING TAX","BKM HEP C SCREEN LOINC CODES","BKM HEP C SCREEN TESTS CPTS","","","",.LAST,"",.EPDATE,"",.ENDATE)
. ; Check for T.14
. D LABCODES^BKMVF32(DFN,"BKM HEP C CONFIRMATORY TAX","BKM HEP C CONFIRM LOINC CODES","BKM HEP C CONFIRM TESTS CPTS","","","",.RLAST,"","","",.RNDATE)
. ; If no test found for either HEP C EIA or HEP C RIBA
. I LAST="",RLAST="" S DUE=BDATE Q
. I LAST="",RLAST]"" S DUE=+$$SCH^XLFDT("12M",RLAST) Q
. I ENDATE'="",EPDATE'=LAST S DUE=+$$SCH^XLFDT("12M",LAST) Q
. ;I ENDATE'="",EPDATE'=LAST S DUE=+$$SCH^XLFDT("12M",ENDATE) Q
. I EPDATE'="",EPDATE=LAST,RNDATE'="",RNDATE>EPDATE S DUE=+$$SCH^XLFDT("12M",EPDATE)
. I EPDATE'="",EPDATE=LAST,RNDATE'>EPDATE S SKIP=1
;. I LAST="",RLAST="" S DUE=BDATE
;. ELSE D
;. . I ENDATE'="",ENDATE=LAST S DUE=+$$SCH^XLFDT("12M",ENDATE) Q
;. . I EPDATE'="",EPDATE=LAST,RNDATE'="",RNDATE>EPDATE S DUE=+$$SCH^XLFDT("12M",EPDATE)
I 'SKIP D ADDLINE^BKMVF32("14 REM.T.09",.LIST,"Hep C EIA Test",LAST,DUE)
D WRITE("14 REM.T.09",GUI)
Q
;
HEPCR(GUI) ;EP - REM.T.14
; Hepatitis C RIBA Test Due
; Numerator: Patients with no Hepatitis C (DX.16) diagnosis (POV or problem list) and positive
; Hepatitis C EIA test (T.13) and no documented Hepatitis C RIBA test (T.14)
; occurring after EIA test date.
; Due date = Today
; If "Now," then text = "A Hepatitis C RIBA test is indicated because your patient had a positive Hepatitis C EIA test result documented on [date]."
NEW LAST,DUE,EPDATE,LAST1,BDATE
S (LAST,DUE,EPDATE,LAST1)=""
I $G(BDATE)="" S BDATE=DT
D
. D ICDTAX^BKMIXX1(DFN,"BKM HEP C DXS","","","",.LAST1)
. I LAST1'="" Q
. D PRBTAX^BKMIXX(DFN,"BKM HEP C DXS","","","",.LAST1)
. I LAST1'="" Q
. ; Check for T.13
. D LABCODES^BKMVF32(DFN,"BKM HEP C SCREENING TAX","BKM HEP C SCREEN LOINC CODES","BKM HEP C SCREEN TESTS CPTS","","","","","",.EPDATE)
. I EPDATE="" Q
. ; Check for T.14
. D LABCODES^BKMVF32(DFN,"BKM HEP C CONFIRMATORY TAX","BKM HEP C CONFIRM LOINC CODES","BKM HEP C CONFIRM TESTS CPTS","",EPDATE,.LAST1)
. I LAST1'="" Q
. S DUE=BDATE
D ADDLINE^BKMVF32("15 REM.T.14",.LIST,"Hep C Confirm",LAST,DUE)
D WRITE("15 REM.T.14",GUI)
Q
;
PPD(GUI) ;EP - REM.T.05
; PPD Due
; Numerator: Patients with:
; 1) No TB DX (DX.14) ever
; 2) No positive PPD results (T.21) ever (positive result or no result but PPD reading >=5 mm)
; 3) No TB treatment (M.08) ever
; Due date = Today, if PPD (T.21) never documented OR
; Due date = Date of most recent PPD + 365 days (or 12 months)
; If "Now," then text = "PPD skin test may be due now; last documented [date]."
NEW LAST,DUE,LAST1,LRESULT,PR,OR,BDATE
S (LAST,DUE,LAST1,LRESULT,PR,OR)=""
I $G(BDATE)="" S BDATE=DT
D
. D ICDTAX^BKMIXX1(DFN,"DM AUDIT PROBLEM TB DXS","","","",.LAST1)
. I LAST1'="" Q ; Exclude patient with a TB DX
. D NDCTAX^BKMIXX1(DFN,"BKM TB MED NDCS","","","",.LAST1)
. I LAST1'="" Q ; Exclude patient with TB treatment
. D MEDTAX^BKMIXX(DFN,"BKM TB MEDS","","","",.LAST1)
. I LAST1'="" Q ; Exclude patient with TB treatment
. D LABCODES^BKMVF32(DFN,"BKM PPD TAX","BKM PPD LOINC CODES","BKM PPD CPTS","BKM PPD ICDS","","",.LAST,.LRESULT,"",.PR,"","","",.OR,"RESULT'<5")
. I PR'=""!(OR'="") S LAST="" Q ; Positive Result or PPD >= 5 mm
. ; If patient had no PPD T.21 in Labs, also check Skin Tests and Immunizations.
. K PPDTEST
. S TARGET="PPDTEST(""SKN"",VSTDT,TEST)"
. D SKNTAX^BKMIXX1(DFN,"21","","",TARGET,.LAST1)
. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
. S TARGET="PPDTEST(""CVX"",VSTDT,TEST)"
. D CVXTAX^BKMIXX1(DFN,"BKM PPD CVX CODES","","",TARGET,.LAST1)
. S LAST=$S(LAST>LAST1:LAST,1:LAST1)
. I LAST="" S DUE=BDATE Q ;If never had PPD T.21
. N PPDPOS
. S PPD="PPDTEST",PPDPOS=""
. F S PPD=$Q(@PPD) Q:PPD="" D Q:PPDPOS
.. ; For Skin test use result (2nd piece) if present, if not use reading (1st piece)
.. I $P(PPD,",")="PPDTEST(""SKN""" D Q
... I $P(@PPD,U,2)]"" S PPDPOS=$$POSITIVE^BKMVF32($P(@PPD,U,2)) Q
... I +@PPD'<5 S PPDPOS=1 Q
.. I $$POSITIVE^BKMVF32(@PPD)!(@PPD'<5) S PPDPOS=1 Q
. I PPDPOS S LAST="" Q ; PPD is positive or >= 5 mm
. S DUE=+$$SCH^XLFDT("12M",LAST)
D ADDLINE^BKMVF32("11 REM.T.05",.LIST,"PPD Skin Test",LAST,DUE)
D WRITE("11 REM.T.05",GUI)
Q
;
WRITE(REM,GUI) ; Write out the reminder
S APCHLAST=$G(LIST(REM,1,"LAST"))
I APCHLAST="" S APCHSTEX(1)="MAY BE DUE NOW"
S APCHNEXT=$G(LIST(REM,1,"DUE"))
I APCHNEXT>DT S APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)
I APCHNEXT'>DT S APCHSTEX(1)="MAY BE DUE NOW (WAS DUE "_$$DATE^APCHSMU(APCHNEXT)_")"
I 'GUI D WRITE^APCHSMU
I GUI S REMLAST=APCHLAST,REMNEXT=$G(APCHSTEX(1)),REMDUE=APCHNEXT
K APCHLAST,APCHNEXT,APCHSTEX,LIST
Q
BKMRMLB ;PRXM/HC/ALA-HMS Lab Reminders ; 13 Nov 2007 4:04 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
CD4(GUI) ;EP - REM.T.01
+1 ; CD4 Due
+2 ; Due date = Today, if no CD4 test (T.2) documented ever.
+3 ; Due date = Date of most recent CD4 test + 120 days (or 4 months).
+4 ; If "Now," then text = "CD4 laboratory test may be due now; last documented [date]."
+5 NEW LAST,DUE,LAST1,LIST
+6 SET GUI=$GET(GUI,0)
+7 SET (LAST,DUE,LAST1)=""
+8 DO LABCODES^BKMVF32(DFN,"BGP CD4 TAX","BGP CD4 LOINC CODES","BGP CD4 CPTS","","",.LAST)
+9 DO LABCODES^BKMVF32(DFN,"BKMV CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES","BKMV CD4 ABS CPTS","","",.LAST1)
+10 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+11 IF LAST'=""
SET DUE=+$$SCH^XLFDT("4M",LAST)
+12 IF LAST=""
SET DUE=DT
+13 DO ADDLINE^BKMVF32("1 REM.T.01",.LIST,"CD4",LAST,DUE)
+14 DO WRITE("1 REM.T.01",GUI)
+15 QUIT
+16 ;
CHL(GUI) ;EP - REM.T.07
+1 ; Chlamydia Test Due
+2 ; Numerator: All patients 18 years of age and older
+3 ; Due date = Today, if no Chlamydia test (T.3) ever documented OR
+4 ; Due date = Today, if most recent test results for any of the following are positive
+5 ; since the most recent Chlamydia test and =<365 days from today:
+6 ; Gonorrhea (T.10); Syphilis (T.22) or (T.9). OR
+7 ; Due date = Today, if patient has any of the following POV diagnoses
+8 ; since the most recent Chlamydia test and =<365 days from today:
+9 ; Gonorrhea (DX.4), Syphilis (DX.11), Trichomoniasis (DX.13) or other STD (DX.9) OR
+10 ; Due date = Date of most recent positive Chlamydia test + 56 days (for retest after cure) OR
+11 ; Due date = Date of most recent Chlamydia test + 365 days (or 12 months).
+12 ; If "Now," then text = "Chlamydia test may be due now. Please review your patient's recent and past history and consider ordering this test; last documented test was [date].
+13 ; *** What happens if a Chlamydia test is done on Monday and a Gonorrhea (etc.) is found positive on Tuesday? When should the next Chlamydia be scheduled?
+14 NEW LAST,DUE,PDATE,LAST1,LIST
+15 SET GUI=$GET(GUI,0)
+16 SET (LAST,DUE,PDATE,LAST1)=""
+17 IF APCHSAGE'<18
Begin DoDot:1
+18 DO LABCODES^BKMVF32(DFN,"BGP CHLAMYDIA TESTS TAX","BGP CHLAMYDIA LOINC CODES","BTPW CHLAMYDIA CPTS","BGP CHLAMYDIA TEST PROCEDURES","",.LAST,"","",.PDATE)
+19 IF LAST'=""
Begin DoDot:2
+20 SET DUE=+$$SCH^XLFDT("12M",LAST)
+21 IF PDATE'=""
Begin DoDot:3
+22 IF PDATE'<LAST
SET DUE=$$FMADD^XLFDT(PDATE,56)
End DoDot:3
+23 ; If any STD tests (except Chlamydia) are positive since the last Chlamydia test (or diagnoses found)
+24 IF $$STDS^BKMVF32(DFN,"CHLAMYDIA",LAST)
SET DUE=DT
End DoDot:2
+25 IF LAST=""
SET DUE=DT
End DoDot:1
+26 DO ADDLINE^BKMVF32("20 REM.T.07",.LIST,"Chlamydia Test",LAST,DUE)
+27 DO WRITE("20 REM.T.07",GUI)
+28 QUIT
+29 ;
SYPF(GUI) ;EP - REM.T.04
+1 ; FTA-ABS (Syphilis) Due
+2 ; Numerator: Patients with a positive RPR laboratory value (T.22) (defined as positive,
+3 ; reactive, indeterminate or any number values) and no FTA-ABS (T.9) documented
+4 ; after the date of the positive RPR
+5 ; Due date = Date of the most recent positive RPR laboratory test + 14 days.
+6 ; If "Now," then text = "An FTA-ABS Syphilis test is strongly recommended at this time because your patient had a positive RPR test documented on [date]."
+7 NEW LAST,DUE,PDATE,ODATE,LIST
+8 SET GUI=$GET(GUI,0)
+9 SET (LAST,DUE,PDATE,ODATE)=""
+10 DO LABCODES^BKMVF32(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","","","","","",.PDATE,.PR,"","",.ODATE,.OR,"$$UP^XLFSTR(RESULT)[""INDETERMINATE""!(RESULT?0.N0.1"".""1.N&(RESULT'=0))")
+11 SET PDATE=$SELECT(PDATE>ODATE:PDATE,1:ODATE)
+12 IF PDATE'=""
Begin DoDot:1
+13 DO LABCODES^BKMVF32(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","",PDATE,"",.LAST)
+14 IF LAST=""
SET DUE=$$FMADD^XLFDT(PDATE,14)
End DoDot:1
+15 DO ADDLINE^BKMVF32("13 REM.T.04",.LIST,"FTA/ABS Syphilis Test",LAST,DUE)
+16 DO WRITE("13 REM.T.04",GUI)
+17 QUIT
+18 ;
GON(GUI) ;EP - REM.T.08
+1 ; Gonorrhea Test Due
+2 ; Numerator: All patients 18 years of age and older.
+3 ; Due date = Today, if no Gonorrhea test (T.10) ever documented. OR
+4 ; Due date = Today, if most recent test results for any of the following are positive
+5 ; since the most recent Gonorrhea test and =<365 days from today:
+6 ; Chlamydia (T.3); Syphilis (T.22) or (T.9). OR
+7 ; Due date = Today, if patient has any of the following POV diagnoses
+8 ; since the most recent Gonorrhea test and =<365 days from today:
+9 ; Chlamydia (DX.2), Syphilis (DX.11), Trichomoniasis (DX.13) or other STD (DX.9) OR
+10 ; Due date = Date of most recent Gonorrhea test + 365 days (or 12 months).
+11 ; If "Now," then text = "Gonorrhea test may be due now. Please review your patient's recent and past history and consider ordering this test; last documented test was [date]."
+12 NEW LAST,DUE,BDATE
+13 SET (LAST,DUE)=""
+14 IF $GET(BDATE)=""
SET BDATE=DT
+15 IF APCHSAGE'<18
Begin DoDot:1
+16 DO LABCODES^BKMVF32(DFN,"BKM GONORRHEA TEST TAX","BKM GONORRHEA LOINC CODES","BKM GONORRHEA TESTS CPTS","","",.LAST)
+17 IF LAST'=""
Begin DoDot:2
+18 SET DUE=+$$SCH^XLFDT("12M",LAST)
+19 ; If any STD tests (except Gonorrhea) are positive since the last Gonorrhea test (or diagnoses found)
+20 IF $$STDS^BKMVF32(DFN,"GONORRHEA",LAST)
SET DUE=BDATE
End DoDot:2
+21 IF LAST=""
SET DUE=BDATE
End DoDot:1
+22 DO ADDLINE^BKMVF32("21 REM.T.08",.LIST,"Gonorrhea Test",LAST,DUE)
+23 DO WRITE("21 REM.T.08",GUI)
+24 QUIT
+25 ;
HEPBR(GUI) ;EP - REM.T.13
+1 ; Hepatitis B Retest Due
+2 ; Numerator: All patients with 3 documented Hepatitis B immunizations (IZ.4) and no
+3 ; Hepatitis B test (T.27) documented after the final immunization
+4 ; Due date = Today
+5 ; If "Now," then text = "Hepatitis B retest may be indicated at this time to ensure adequate coverage since this patient has completed all 3 Hepatitis B immunizations; last documented immunization was given on [date]."
+6 NEW LAST,DUE,LAST1,VISIT,CNT,BDATE
+7 SET (LAST,DUE,LAST1,VISIT)=""
SET CNT=0
KILL TEMP
+8 IF $GET(BDATE)=""
SET BDATE=DT
+9 DO CVXTAX^BKMIXX1(DFN,"BKM HEP B IZ CVX CODES","","","TEMP(VISIT)",.LAST)
+10 DO CPTTAX^BKMIXX(DFN,"BKM HEP B IZ CPTS","","","TEMP(VISIT)",.LAST1)
+11 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+12 FOR
SET VISIT=$ORDER(TEMP(VISIT))
IF 'VISIT
QUIT
SET CNT=CNT+1
+13 IF CNT<3
SET LAST=""
+14 IF CNT'<3
Begin DoDot:1
+15 SET LAST1=""
+16 DO LABCODES^BKMVF32(DFN,"BKM HEP B TAX","BKM HEP B LOINC CODES","BKM HEP B TESTS CPTS","",LAST,.LAST1)
+17 IF LAST1'=""
SET LAST=""
QUIT
+18 SET DUE=BDATE
SET LAST=LAST1
End DoDot:1
+19 DO ADDLINE^BKMVF32("17 REM.T.13",.LIST,"Hep B Retest",LAST,DUE)
+20 DO WRITE("17 REM.T.13",GUI)
+21 QUIT
+22 ;
HEPB(GUI) ;EP - REM.T.12
+1 ; Hepatitis B Test Due
+2 ; Numerator: Any patient with no Hepatitis B (DX.15) diagnosis (POV or problem list) ever AND
+3 ; no Hepatitis B test results (T.27) ever documented.
+4 ; Due date = Today
+5 ; If "Now," then text = "This patient may benefit from a Hepatitis B Test."
+6 NEW LAST,DUE,BDATE
+7 SET (LAST,DUE)=""
+8 IF $GET(BDATE)=""
SET BDATE=DT
+9 Begin DoDot:1
+10 DO ICDTAX^BKMIXX1(DFN,"BKM HEP B DXS","","","",.LAST)
+11 IF LAST'=""
QUIT
+12 DO PRBTAX^BKMIXX(DFN,"BKM HEP B DXS","","","",.LAST)
+13 IF LAST'=""
QUIT
+14 DO LABCODES^BKMVF32(DFN,"BKM HEP B TAX","BKM HEP B LOINC CODES","BKM HEP B TESTS CPTS","","",.LAST)
+15 IF LAST'=""
QUIT
+16 SET DUE=BDATE
End DoDot:1
+17 DO ADDLINE^BKMVF32("16 REM.T.12",.LIST,"Hep B Test",LAST,DUE)
+18 DO WRITE("16 REM.T.12",GUI)
+19 QUIT
+20 ;
HEPCE(GUI) ;EP - REM.T.09
+1 ; Hepatitis C EIA Test Due
+2 ; Numerator: Any patient with no Hepatitis C (DX.16) diagnosis (POV or problem list) ever documented.
+3 ; Due date = Today, if no Hepatitis C EIA (T.13) or Hepatitis C RIBA (T.14) ever documented OR
+4 ; Due date = if no documented Hepatitis C EIA (T.13) test but a Hepatitis C confirmation test (T.14) is documented, date of most recent confirmation test + 365 days (1 year) OR
+5 ; Due date = if most recent EIA test is not positive, date of most recent, not positive Hepatitis C EIA test + 365 days (or 12 months) OR
+6 ; Due date = if most recent EIA test is positive followed by a negative Hepatitis C RIBA test, date of EIA test +365 days (or 12 months).
+7 ; If most recent EIA test is positive AND is not followed by documented Hep C confirmation test, then go to REM.T.14
+8 ; If "Now," then text = "This patient may be due for a Hepatitis C testing; last documented [date]."
+9 NEW SKIP,LAST,DUE,LAST1,EPDATE,ENDATE,RLAST,RNDATE,BDATE
+10 ; If set to 1, skip this reminder and continue with REM.T.14
+11 SET SKIP=""
+12 SET (LAST,DUE,LAST1,EPDATE,ENDATE,RLAST,RNDATE)=""
+13 IF $GET(BDATE)=""
SET BDATE=DT
+14 Begin DoDot:1
+15 DO ICDTAX^BKMIXX1(DFN,"BKM HEP C DXS","","","",.LAST1)
+16 IF LAST1'=""
QUIT
+17 DO PRBTAX^BKMIXX(DFN,"BKM HEP C DXS","","","",.LAST1)
+18 IF LAST1'=""
QUIT
+19 ; Check for T.13
+20 DO LABCODES^BKMVF32(DFN,"BKM HEP C SCREENING TAX","BKM HEP C SCREEN LOINC CODES","BKM HEP C SCREEN TESTS CPTS","","","",.LAST,"",.EPDATE,"",.ENDATE)
+21 ; Check for T.14
+22 DO LABCODES^BKMVF32(DFN,"BKM HEP C CONFIRMATORY TAX","BKM HEP C CONFIRM LOINC CODES","BKM HEP C CONFIRM TESTS CPTS","","","",.RLAST,"","","",.RNDATE)
+23 ; If no test found for either HEP C EIA or HEP C RIBA
+24 IF LAST=""
IF RLAST=""
SET DUE=BDATE
QUIT
+25 IF LAST=""
IF RLAST]""
SET DUE=+$$SCH^XLFDT("12M",RLAST)
QUIT
+26 IF ENDATE'=""
IF EPDATE'=LAST
SET DUE=+$$SCH^XLFDT("12M",LAST)
QUIT
+27 ;I ENDATE'="",EPDATE'=LAST S DUE=+$$SCH^XLFDT("12M",ENDATE) Q
+28 IF EPDATE'=""
IF EPDATE=LAST
IF RNDATE'=""
IF RNDATE>EPDATE
SET DUE=+$$SCH^XLFDT("12M",EPDATE)
+29 IF EPDATE'=""
IF EPDATE=LAST
IF RNDATE'>EPDATE
SET SKIP=1
End DoDot:1
+30 ;. I LAST="",RLAST="" S DUE=BDATE
+31 ;. ELSE D
+32 ;. . I ENDATE'="",ENDATE=LAST S DUE=+$$SCH^XLFDT("12M",ENDATE) Q
+33 ;. . I EPDATE'="",EPDATE=LAST,RNDATE'="",RNDATE>EPDATE S DUE=+$$SCH^XLFDT("12M",EPDATE)
+34 IF 'SKIP
DO ADDLINE^BKMVF32("14 REM.T.09",.LIST,"Hep C EIA Test",LAST,DUE)
+35 DO WRITE("14 REM.T.09",GUI)
+36 QUIT
+37 ;
HEPCR(GUI) ;EP - REM.T.14
+1 ; Hepatitis C RIBA Test Due
+2 ; Numerator: Patients with no Hepatitis C (DX.16) diagnosis (POV or problem list) and positive
+3 ; Hepatitis C EIA test (T.13) and no documented Hepatitis C RIBA test (T.14)
+4 ; occurring after EIA test date.
+5 ; Due date = Today
+6 ; If "Now," then text = "A Hepatitis C RIBA test is indicated because your patient had a positive Hepatitis C EIA test result documented on [date]."
+7 NEW LAST,DUE,EPDATE,LAST1,BDATE
+8 SET (LAST,DUE,EPDATE,LAST1)=""
+9 IF $GET(BDATE)=""
SET BDATE=DT
+10 Begin DoDot:1
+11 DO ICDTAX^BKMIXX1(DFN,"BKM HEP C DXS","","","",.LAST1)
+12 IF LAST1'=""
QUIT
+13 DO PRBTAX^BKMIXX(DFN,"BKM HEP C DXS","","","",.LAST1)
+14 IF LAST1'=""
QUIT
+15 ; Check for T.13
+16 DO LABCODES^BKMVF32(DFN,"BKM HEP C SCREENING TAX","BKM HEP C SCREEN LOINC CODES","BKM HEP C SCREEN TESTS CPTS","","","","","",.EPDATE)
+17 IF EPDATE=""
QUIT
+18 ; Check for T.14
+19 DO LABCODES^BKMVF32(DFN,"BKM HEP C CONFIRMATORY TAX","BKM HEP C CONFIRM LOINC CODES","BKM HEP C CONFIRM TESTS CPTS","",EPDATE,.LAST1)
+20 IF LAST1'=""
QUIT
+21 SET DUE=BDATE
End DoDot:1
+22 DO ADDLINE^BKMVF32("15 REM.T.14",.LIST,"Hep C Confirm",LAST,DUE)
+23 DO WRITE("15 REM.T.14",GUI)
+24 QUIT
+25 ;
PPD(GUI) ;EP - REM.T.05
+1 ; PPD Due
+2 ; Numerator: Patients with:
+3 ; 1) No TB DX (DX.14) ever
+4 ; 2) No positive PPD results (T.21) ever (positive result or no result but PPD reading >=5 mm)
+5 ; 3) No TB treatment (M.08) ever
+6 ; Due date = Today, if PPD (T.21) never documented OR
+7 ; Due date = Date of most recent PPD + 365 days (or 12 months)
+8 ; If "Now," then text = "PPD skin test may be due now; last documented [date]."
+9 NEW LAST,DUE,LAST1,LRESULT,PR,OR,BDATE
+10 SET (LAST,DUE,LAST1,LRESULT,PR,OR)=""
+11 IF $GET(BDATE)=""
SET BDATE=DT
+12 Begin DoDot:1
+13 DO ICDTAX^BKMIXX1(DFN,"DM AUDIT PROBLEM TB DXS","","","",.LAST1)
+14 ; Exclude patient with a TB DX
IF LAST1'=""
QUIT
+15 DO NDCTAX^BKMIXX1(DFN,"BKM TB MED NDCS","","","",.LAST1)
+16 ; Exclude patient with TB treatment
IF LAST1'=""
QUIT
+17 DO MEDTAX^BKMIXX(DFN,"BKM TB MEDS","","","",.LAST1)
+18 ; Exclude patient with TB treatment
IF LAST1'=""
QUIT
+19 DO LABCODES^BKMVF32(DFN,"BKM PPD TAX","BKM PPD LOINC CODES","BKM PPD CPTS","BKM PPD ICDS","","",.LAST,.LRESULT,"",.PR,"","","",.OR,"RESULT'<5")
+20 ; Positive Result or PPD >= 5 mm
IF PR'=""!(OR'="")
SET LAST=""
QUIT
+21 ; If patient had no PPD T.21 in Labs, also check Skin Tests and Immunizations.
+22 KILL PPDTEST
+23 SET TARGET="PPDTEST(""SKN"",VSTDT,TEST)"
+24 DO SKNTAX^BKMIXX1(DFN,"21","","",TARGET,.LAST1)
+25 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+26 SET TARGET="PPDTEST(""CVX"",VSTDT,TEST)"
+27 DO CVXTAX^BKMIXX1(DFN,"BKM PPD CVX CODES","","",TARGET,.LAST1)
+28 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+29 ;If never had PPD T.21
IF LAST=""
SET DUE=BDATE
QUIT
+30 NEW PPDPOS
+31 SET PPD="PPDTEST"
SET PPDPOS=""
+32 FOR
SET PPD=$QUERY(@PPD)
IF PPD=""
QUIT
Begin DoDot:2
+33 ; For Skin test use result (2nd piece) if present, if not use reading (1st piece)
+34 IF $PIECE(PPD,",")="PPDTEST(""SKN"""
Begin DoDot:3
+35 IF $PIECE(@PPD,U,2)]""
SET PPDPOS=$$POSITIVE^BKMVF32($PIECE(@PPD,U,2))
QUIT
+36 IF +@PPD'<5
SET PPDPOS=1
QUIT
End DoDot:3
QUIT
+37 IF $$POSITIVE^BKMVF32(@PPD)!(@PPD'<5)
SET PPDPOS=1
QUIT
End DoDot:2
IF PPDPOS
QUIT
+38 ; PPD is positive or >= 5 mm
IF PPDPOS
SET LAST=""
QUIT
+39 SET DUE=+$$SCH^XLFDT("12M",LAST)
End DoDot:1
+40 DO ADDLINE^BKMVF32("11 REM.T.05",.LIST,"PPD Skin Test",LAST,DUE)
+41 DO WRITE("11 REM.T.05",GUI)
+42 QUIT
+43 ;
WRITE(REM,GUI) ; Write out the reminder
+1 SET APCHLAST=$GET(LIST(REM,1,"LAST"))
+2 IF APCHLAST=""
SET APCHSTEX(1)="MAY BE DUE NOW"
+3 SET APCHNEXT=$GET(LIST(REM,1,"DUE"))
+4 IF APCHNEXT>DT
SET APCHSTEX(1)=$$DATE^APCHSMU(APCHNEXT)
+5 IF APCHNEXT'>DT
SET APCHSTEX(1)="MAY BE DUE NOW (WAS DUE "_$$DATE^APCHSMU(APCHNEXT)_")"
+6 IF 'GUI
DO WRITE^APCHSMU
+7 IF GUI
SET REMLAST=APCHLAST
SET REMNEXT=$GET(APCHSTEX(1))
SET REMDUE=APCHNEXT
+8 KILL APCHLAST,APCHNEXT,APCHSTEX,LIST
+9 QUIT
