BKMRMLB1 ;PRXM/HC/ALA-HMS Lab Reminders continued ; 13 Nov 2007 4:32 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
TOX(GUI) ;EP - REM.T.11
; Toxoplasmosis
; Numerator: All patients with no history of positive Toxoplasmosis test (T.28)
; Due date = Today, if no Toxoplasmosis test (T.28) ever documented. OR
; Due date = Date of most recent Toxoplasmosis test + 365 days (or 12 months).
; If "Now," then text = "A Toxoplasmosis test may be due now; last documented [date]."
NEW LAST,DUE,PDATE,BDATE
S (LAST,DUE,PDATE)=""
I $G(BDATE)="" S BDATE=DT
D LABCODES^BKMVF32(DFN,"BKM TOXOPLASMOSIS TESTS TAX","BKM TOXOPLASMOSIS LOINC CODES","BKM TOXOPLASMOSIS CPTS","","",.LAST,"","",.PDATE)
I PDATE="" D
. I LAST="" S DUE=BDATE Q
. I LAST'="" S DUE=+$$SCH^XLFDT("12M",LAST)
I PDATE'="" S LAST=""
D ADDLINE^BKMVF32("18 REM.T.11",.LIST,"Toxoplasmosis Test",LAST,DUE)
D WRITE("18 REM.T.11",GUI)
Q
;
VIR(GUI) ; REM.T.02
; Viral Load Due
; Due date = Today, if no Viral Load Test (T.26) ever documented. OR
; Due date = Most recent Viral Load Test + 120 days (or 4 months).
; If "Now," then text = "A Viral Load test may be due now; last documented [date]."
NEW LAST,DUE,BDATE
S (LAST,DUE)=""
I $G(BDATE)="" S BDATE=DT
D LABCODES^BKMVF32(DFN,"BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES","BGP HIV VIRAL LOAD CPTS","","",.LAST)
I LAST="" S DUE=BDATE
I LAST'="" D
. S DUE=+$$SCH^XLFDT("4M",LAST)
D ADDLINE^BKMVF32("10 REM.T.02",.LIST,"Viral Load",LAST,DUE)
D WRITE("10 REM.T.02",GUI)
Q
;
SYPR(GUI) ;EP - REM.T.03
; RPR (Syphilis) Due
; Due date = Today, if no RPR (T.22) or FTA-ABS (T.9) tests ever documented. OR
; Due date = Date of last FTA-ABS (T.9) test + 365 days (or 12 months) if no RPR (T.22) ever documented. OR
; Due date = RPR test date + 90 days (or 3 months)
; if most recent RPR is positive and =<365 days from today. OR
; Due date = Today, if most recent RPR is not positive (negative or undetermined)
; AND if most recent test results for any of the following are positive
; since the most recent RPR test and =<365 days from today:
; Gonorrhea (T.10); Chlamydia (T.3). OR
; Due date = Today, if most recent RPR is not positive (negative or undetermined)
; AND if patient has any of the following POV diagnoses
; since the most recent RPR test and =<365 days from today:
; Gonorrhea (DX.4), Chlamydia (DX.2), Trichomoniasis (DX.13) or other STD (DX.9) OR
; Due date = Date of last RPR + 365 days (or 12 months)
; If "Now," then text = "An RPR Syphilis test may be due. Please review your patient's history; last documented [date]."
NEW LAST,DUE,LAST1,LAST2,MLAST,DIFF,PDATE,BDATE
S (LAST,DUE,LAST1,LAST2,MLAST,DIFF,PDATE)=""
I $G(BDATE)="" S BDATE=DT
D LABCODES^BKMVF32(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","","",.LAST)
D LABCODES^BKMVF32(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","","",.LAST1,"","",.PDATE)
; If no tests found
I LAST="",LAST1="" S DUE=BDATE
; If FTA-ABS tests (but no RPR tests) found
I LAST'="",LAST1="" S DUE=+$$SCH^XLFDT("12M",LAST)
; If RPR tests found
I LAST1'="" D
. ; If last RPR test result was positive and within the year
. I PDATE=LAST1,$$FMDIFF^XLFDT(BDATE,PDATE)'>365 S DUE=+$$SCH^XLFDT("3M",PDATE) Q
. ; If last RPR test result is not positive but if any STD tests (except Syphilis) are positive (or diagnoses found)
. I PDATE<LAST1,$$STDS^BKMVF32(DFN,"SYPHILIS",LAST1) S DUE=BDATE Q
. ; Otherwise, due date is 12 months from last RPR test
. S DUE=+$$SCH^XLFDT("12M",LAST1)
D ADDLINE^BKMVF32("12 REM.T.03",.LIST,"RPR Syphilis Test",LAST1,DUE)
D WRITE("12 REM.T.03",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
BKMRMLB1 ;PRXM/HC/ALA-HMS Lab Reminders continued ; 13 Nov 2007 4:32 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
TOX(GUI) ;EP - REM.T.11
+1 ; Toxoplasmosis
+2 ; Numerator: All patients with no history of positive Toxoplasmosis test (T.28)
+3 ; Due date = Today, if no Toxoplasmosis test (T.28) ever documented. OR
+4 ; Due date = Date of most recent Toxoplasmosis test + 365 days (or 12 months).
+5 ; If "Now," then text = "A Toxoplasmosis test may be due now; last documented [date]."
+6 NEW LAST,DUE,PDATE,BDATE
+7 SET (LAST,DUE,PDATE)=""
+8 IF $GET(BDATE)=""
SET BDATE=DT
+9 DO LABCODES^BKMVF32(DFN,"BKM TOXOPLASMOSIS TESTS TAX","BKM TOXOPLASMOSIS LOINC CODES","BKM TOXOPLASMOSIS CPTS","","",.LAST,"","",.PDATE)
+10 IF PDATE=""
Begin DoDot:1
+11 IF LAST=""
SET DUE=BDATE
QUIT
+12 IF LAST'=""
SET DUE=+$$SCH^XLFDT("12M",LAST)
End DoDot:1
+13 IF PDATE'=""
SET LAST=""
+14 DO ADDLINE^BKMVF32("18 REM.T.11",.LIST,"Toxoplasmosis Test",LAST,DUE)
+15 DO WRITE("18 REM.T.11",GUI)
+16 QUIT
+17 ;
VIR(GUI) ; REM.T.02
+1 ; Viral Load Due
+2 ; Due date = Today, if no Viral Load Test (T.26) ever documented. OR
+3 ; Due date = Most recent Viral Load Test + 120 days (or 4 months).
+4 ; If "Now," then text = "A Viral Load test may be due now; last documented [date]."
+5 NEW LAST,DUE,BDATE
+6 SET (LAST,DUE)=""
+7 IF $GET(BDATE)=""
SET BDATE=DT
+8 DO LABCODES^BKMVF32(DFN,"BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES","BGP HIV VIRAL LOAD CPTS","","",.LAST)
+9 IF LAST=""
SET DUE=BDATE
+10 IF LAST'=""
Begin DoDot:1
+11 SET DUE=+$$SCH^XLFDT("4M",LAST)
End DoDot:1
+12 DO ADDLINE^BKMVF32("10 REM.T.02",.LIST,"Viral Load",LAST,DUE)
+13 DO WRITE("10 REM.T.02",GUI)
+14 QUIT
+15 ;
SYPR(GUI) ;EP - REM.T.03
+1 ; RPR (Syphilis) Due
+2 ; Due date = Today, if no RPR (T.22) or FTA-ABS (T.9) tests ever documented. OR
+3 ; Due date = Date of last FTA-ABS (T.9) test + 365 days (or 12 months) if no RPR (T.22) ever documented. OR
+4 ; Due date = RPR test date + 90 days (or 3 months)
+5 ; if most recent RPR is positive and =<365 days from today. OR
+6 ; Due date = Today, if most recent RPR is not positive (negative or undetermined)
+7 ; AND if most recent test results for any of the following are positive
+8 ; since the most recent RPR test and =<365 days from today:
+9 ; Gonorrhea (T.10); Chlamydia (T.3). OR
+10 ; Due date = Today, if most recent RPR is not positive (negative or undetermined)
+11 ; AND if patient has any of the following POV diagnoses
+12 ; since the most recent RPR test and =<365 days from today:
+13 ; Gonorrhea (DX.4), Chlamydia (DX.2), Trichomoniasis (DX.13) or other STD (DX.9) OR
+14 ; Due date = Date of last RPR + 365 days (or 12 months)
+15 ; If "Now," then text = "An RPR Syphilis test may be due. Please review your patient's history; last documented [date]."
+16 NEW LAST,DUE,LAST1,LAST2,MLAST,DIFF,PDATE,BDATE
+17 SET (LAST,DUE,LAST1,LAST2,MLAST,DIFF,PDATE)=""
+18 IF $GET(BDATE)=""
SET BDATE=DT
+19 DO LABCODES^BKMVF32(DFN,"BKM FTA-ABS TEST TAX","BKM FTA-ABS LOINC CODES","BKM FTA-ABS CPTS","","",.LAST)
+20 DO LABCODES^BKMVF32(DFN,"BKM RPR TAX","BKM RPR LOINC CODES","BKM RPR CPTS","","",.LAST1,"","",.PDATE)
+21 ; If no tests found
+22 IF LAST=""
IF LAST1=""
SET DUE=BDATE
+23 ; If FTA-ABS tests (but no RPR tests) found
+24 IF LAST'=""
IF LAST1=""
SET DUE=+$$SCH^XLFDT("12M",LAST)
+25 ; If RPR tests found
+26 IF LAST1'=""
Begin DoDot:1
+27 ; If last RPR test result was positive and within the year
+28 IF PDATE=LAST1
IF $$FMDIFF^XLFDT(BDATE,PDATE)'>365
SET DUE=+$$SCH^XLFDT("3M",PDATE)
QUIT
+29 ; If last RPR test result is not positive but if any STD tests (except Syphilis) are positive (or diagnoses found)
+30 IF PDATE<LAST1
IF $$STDS^BKMVF32(DFN,"SYPHILIS",LAST1)
SET DUE=BDATE
QUIT
+31 ; Otherwise, due date is 12 months from last RPR test
+32 SET DUE=+$$SCH^XLFDT("12M",LAST1)
End DoDot:1
+33 DO ADDLINE^BKMVF32("12 REM.T.03",.LIST,"RPR Syphilis Test",LAST1,DUE)
+34 DO WRITE("12 REM.T.03",GUI)
+35 QUIT
+36 ;
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
