BKMRMIM ;PRXM/HC/ALA-HMS Immunization Reminders ; 13 Nov 2007 4:05 PM
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
IZ01(GUI) ;EP - REM.IZ.01
; Pneumovax Due
; Due date = Today, if no Pneumovax vaccine (IZ.6) ever documented. OR
; Due date = Date of most recent Pneumovax vaccine + 1825 days or 5 years or 60 months).
; If "Now," then text = "Pneumovax immunization may be due now; last documented [date]."
NEW LAST,DUE,LAST1,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,LAST1)=""
D CVXTAX^BKMIXX1(DFN,"BKM PNEUMO IZ CVX CODES","","","",.LAST)
D ICDTAX^BKMIXX1(DFN,"BQI PNEUMO IZ DXS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D CPTTAX^BKMIXX(DFN,"BGP PNEUMO IZ CPTS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D PRCTAX^BKMIXX1(DFN,"BQI PNEUMO IZ PROCEDURES","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
I LAST'="" S DUE=+$$SCH^XLFDT("60M",LAST)
I LAST="" S DUE=DT
D ADDLINE^BKMVF32("25 REM.IZ.01",.LIST,"Pneumovax IZ",LAST,DUE)
D WRITE("25 REM.IZ.01",GUI)
Q
;
IZ02(GUI) ;EP - REM.IZ.02
; Influenza IZ Due
; Due date = Today, if no Influenza vaccine (IZ.5) ever documented. OR
; Due date = Date of most recent Influenza vaccine + 365 days (or 12 months)
; If "Now," then text = "Influenza immunization may be due now; last documented [date]."
NEW LAST,DUE,LAST1,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,LAST1)=""
D CVXTAX^BKMIXX1(DFN,"BGP FLU IZ CVX CODES","","","",.LAST)
D ICDTAX^BKMIXX1(DFN,"BQI FLU IZ DXS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D CPTTAX^BKMIXX(DFN,"BGP CPT FLU","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D PRCTAX^BKMIXX1(DFN,"BQI FLU IZ PROCEDURES","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
I LAST'="" S DUE=+$$SCH^XLFDT("12M",LAST)
I LAST="" S DUE=DT
D ADDLINE^BKMVF32("26 REM.IZ.02",.LIST,"Influenza IZ",LAST,DUE)
D WRITE("26 REM.IZ.02",GUI)
Q
;
IZ03(GUI) ;EP - REM.IZ.03
; Hepatitis A IZ Due
; Due date = Today, if no Hepatitis A diagnosis (DX.5) POV or Problem list ever documented. OR
; Due date = Today, if no Hepatitis A immunization (IZ.3) ever documented.
; If "Now," then text = "Hepatitis A immunization may be due now. This patient has no documentation of either immunization for or diagnosis of Hepatitis A, and is considered at risk."
NEW LASTTXT,LAST,DUE,LAST1,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,LAST1,LASTTXT)=""
D CVXTAX^BKMIXX1(DFN,"BKM HEP A IZ CVX CODES","","","",.LAST)
D CPTTAX^BKMIXX(DFN,"BKM HEP A IZ CPTS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D ICDTAX^BKMIXX1(DFN,"BKM HEP A DXS","","","",.LAST1)
I LAST1>LAST S LASTTXT=" (dx)"
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D PRBTAX^BKMIXX(DFN,"BKM HEP A DXS","","","",.LAST1)
I LAST1>LAST S LASTTXT=" (dx)"
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
I LAST="" S DUE=DT
D ADDLINE^BKMVF32("24 REM.IZ.03",.LIST,"Hep A IZ",LAST,DUE,LASTTXT)
D WRITE("24 REM.IZ.03",GUI)
Q
;
IZ04(GUI) ;EP - REM.IZ.04
; Hepatitis B IZ Due
; Due date = Today, if no Hepatitis B diagnosis (DX.15) POV or Problem list ever documented.
; Due date = Today, if no Hepatitis B immunization (IZ.4) ever documented.
; If "Now," then text = "Hepatitis B immunization may be due now. This patient has no documentation of either immunization for or diagnosis of Hepatitis B and is considered at risk."
NEW LAST,DUE,LAST1,LASTTXT,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,LAST1,LASTTXT)=""
D CVXTAX^BKMIXX1(DFN,"BKM HEP B IZ CVX CODES","","","",.LAST)
D CPTTAX^BKMIXX(DFN,"BKM HEP B IZ CPTS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D ICDTAX^BKMIXX1(DFN,"BKM HEP B DXS","","","",.LAST1)
I LAST1>LAST S LASTTXT=" (dx)"
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D PRBTAX^BKMIXX(DFN,"BKM HEP B DXS","","","",.LAST1)
I LAST1>LAST S LASTTXT=" (dx)"
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
I LAST="" S DUE=DT
D ADDLINE^BKMVF32("23 REM.IZ.04",.LIST,"Hep B IZ",LAST,DUE,LASTTXT)
D WRITE("23 REM.IZ.04",GUI)
Q
;
IZ05(GUI) ;EP - REM.IZ.05
; Tetanus IZ Due
; Due date = Today, if no Tetanus immunization (IZ.7) ever documented.
; Due date = Date of most recent Tetanus immunization + 3650 days or 10 years or 120 months).
; If "Now," then text = "Tetanus immunization may be due now; last documented [date]."
NEW LAST,DUE,LAST1,LIST
S GUI=$G(GUI,0)
S (LAST,DUE,LAST1)=""
D CVXTAX^BKMIXX1(DFN,"BKM TETANUS IZ CVX CODES","","","",.LAST)
D ICDTAX^BKMIXX1(DFN,"BKM TETANUS IZ DXS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D CPTTAX^BKMIXX(DFN,"BKM TETANUS IZ CPTS","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
D PRCTAX^BKMIXX1(DFN,"BKM TETANUS IZ PROCEDURES","","","",.LAST1)
S LAST=$S(LAST>LAST1:LAST,1:LAST1)
; $$SCH function won't accept values greater than 99, but we need to add 120.
I LAST'="" S DUE=+$$SCH^XLFDT("60M",LAST),DUE=+$$SCH^XLFDT("60M",DUE)
I LAST="" S DUE=DT
D ADDLINE^BKMVF32("27 REM.IZ.05",.LIST,"Tetanus IZ",LAST,DUE)
D WRITE("27 REM.IZ.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 $G(APCHNEXT)'="",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
I $G(BKMSUP) M REMLIST=LIST
K APCHLAST,APCHNEXT,APCHSTEX,LIST
Q
BKMRMIM ;PRXM/HC/ALA-HMS Immunization Reminders ; 13 Nov 2007 4:05 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
IZ01(GUI) ;EP - REM.IZ.01
+1 ; Pneumovax Due
+2 ; Due date = Today, if no Pneumovax vaccine (IZ.6) ever documented. OR
+3 ; Due date = Date of most recent Pneumovax vaccine + 1825 days or 5 years or 60 months).
+4 ; If "Now," then text = "Pneumovax immunization 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 CVXTAX^BKMIXX1(DFN,"BKM PNEUMO IZ CVX CODES","","","",.LAST)
+9 DO ICDTAX^BKMIXX1(DFN,"BQI PNEUMO IZ DXS","","","",.LAST1)
+10 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+11 DO CPTTAX^BKMIXX(DFN,"BGP PNEUMO IZ CPTS","","","",.LAST1)
+12 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+13 DO PRCTAX^BKMIXX1(DFN,"BQI PNEUMO IZ PROCEDURES","","","",.LAST1)
+14 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+15 IF LAST'=""
SET DUE=+$$SCH^XLFDT("60M",LAST)
+16 IF LAST=""
SET DUE=DT
+17 DO ADDLINE^BKMVF32("25 REM.IZ.01",.LIST,"Pneumovax IZ",LAST,DUE)
+18 DO WRITE("25 REM.IZ.01",GUI)
+19 QUIT
+20 ;
IZ02(GUI) ;EP - REM.IZ.02
+1 ; Influenza IZ Due
+2 ; Due date = Today, if no Influenza vaccine (IZ.5) ever documented. OR
+3 ; Due date = Date of most recent Influenza vaccine + 365 days (or 12 months)
+4 ; If "Now," then text = "Influenza immunization 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 CVXTAX^BKMIXX1(DFN,"BGP FLU IZ CVX CODES","","","",.LAST)
+9 DO ICDTAX^BKMIXX1(DFN,"BQI FLU IZ DXS","","","",.LAST1)
+10 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+11 DO CPTTAX^BKMIXX(DFN,"BGP CPT FLU","","","",.LAST1)
+12 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+13 DO PRCTAX^BKMIXX1(DFN,"BQI FLU IZ PROCEDURES","","","",.LAST1)
+14 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+15 IF LAST'=""
SET DUE=+$$SCH^XLFDT("12M",LAST)
+16 IF LAST=""
SET DUE=DT
+17 DO ADDLINE^BKMVF32("26 REM.IZ.02",.LIST,"Influenza IZ",LAST,DUE)
+18 DO WRITE("26 REM.IZ.02",GUI)
+19 QUIT
+20 ;
IZ03(GUI) ;EP - REM.IZ.03
+1 ; Hepatitis A IZ Due
+2 ; Due date = Today, if no Hepatitis A diagnosis (DX.5) POV or Problem list ever documented. OR
+3 ; Due date = Today, if no Hepatitis A immunization (IZ.3) ever documented.
+4 ; If "Now," then text = "Hepatitis A immunization may be due now. This patient has no documentation of either immunization for or diagnosis of Hepatitis A, and is considered at risk."
+5 NEW LASTTXT,LAST,DUE,LAST1,LIST
+6 SET GUI=$GET(GUI,0)
+7 SET (LAST,DUE,LAST1,LASTTXT)=""
+8 DO CVXTAX^BKMIXX1(DFN,"BKM HEP A IZ CVX CODES","","","",.LAST)
+9 DO CPTTAX^BKMIXX(DFN,"BKM HEP A IZ CPTS","","","",.LAST1)
+10 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+11 DO ICDTAX^BKMIXX1(DFN,"BKM HEP A DXS","","","",.LAST1)
+12 IF LAST1>LAST
SET LASTTXT=" (dx)"
+13 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+14 DO PRBTAX^BKMIXX(DFN,"BKM HEP A DXS","","","",.LAST1)
+15 IF LAST1>LAST
SET LASTTXT=" (dx)"
+16 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+17 IF LAST=""
SET DUE=DT
+18 DO ADDLINE^BKMVF32("24 REM.IZ.03",.LIST,"Hep A IZ",LAST,DUE,LASTTXT)
+19 DO WRITE("24 REM.IZ.03",GUI)
+20 QUIT
+21 ;
IZ04(GUI) ;EP - REM.IZ.04
+1 ; Hepatitis B IZ Due
+2 ; Due date = Today, if no Hepatitis B diagnosis (DX.15) POV or Problem list ever documented.
+3 ; Due date = Today, if no Hepatitis B immunization (IZ.4) ever documented.
+4 ; If "Now," then text = "Hepatitis B immunization may be due now. This patient has no documentation of either immunization for or diagnosis of Hepatitis B and is considered at risk."
+5 NEW LAST,DUE,LAST1,LASTTXT,LIST
+6 SET GUI=$GET(GUI,0)
+7 SET (LAST,DUE,LAST1,LASTTXT)=""
+8 DO CVXTAX^BKMIXX1(DFN,"BKM HEP B IZ CVX CODES","","","",.LAST)
+9 DO CPTTAX^BKMIXX(DFN,"BKM HEP B IZ CPTS","","","",.LAST1)
+10 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+11 DO ICDTAX^BKMIXX1(DFN,"BKM HEP B DXS","","","",.LAST1)
+12 IF LAST1>LAST
SET LASTTXT=" (dx)"
+13 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+14 DO PRBTAX^BKMIXX(DFN,"BKM HEP B DXS","","","",.LAST1)
+15 IF LAST1>LAST
SET LASTTXT=" (dx)"
+16 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+17 IF LAST=""
SET DUE=DT
+18 DO ADDLINE^BKMVF32("23 REM.IZ.04",.LIST,"Hep B IZ",LAST,DUE,LASTTXT)
+19 DO WRITE("23 REM.IZ.04",GUI)
+20 QUIT
+21 ;
IZ05(GUI) ;EP - REM.IZ.05
+1 ; Tetanus IZ Due
+2 ; Due date = Today, if no Tetanus immunization (IZ.7) ever documented.
+3 ; Due date = Date of most recent Tetanus immunization + 3650 days or 10 years or 120 months).
+4 ; If "Now," then text = "Tetanus immunization 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 CVXTAX^BKMIXX1(DFN,"BKM TETANUS IZ CVX CODES","","","",.LAST)
+9 DO ICDTAX^BKMIXX1(DFN,"BKM TETANUS IZ DXS","","","",.LAST1)
+10 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+11 DO CPTTAX^BKMIXX(DFN,"BKM TETANUS IZ CPTS","","","",.LAST1)
+12 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+13 DO PRCTAX^BKMIXX1(DFN,"BKM TETANUS IZ PROCEDURES","","","",.LAST1)
+14 SET LAST=$SELECT(LAST>LAST1:LAST,1:LAST1)
+15 ; $$SCH function won't accept values greater than 99, but we need to add 120.
+16 IF LAST'=""
SET DUE=+$$SCH^XLFDT("60M",LAST)
SET DUE=+$$SCH^XLFDT("60M",DUE)
+17 IF LAST=""
SET DUE=DT
+18 DO ADDLINE^BKMVF32("27 REM.IZ.05",.LIST,"Tetanus IZ",LAST,DUE)
+19 DO WRITE("27 REM.IZ.05",GUI)
+20 QUIT
+21 ;
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 $GET(APCHNEXT)'=""
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 IF $GET(BKMSUP)
MERGE REMLIST=LIST
+9 KILL APCHLAST,APCHNEXT,APCHSTEX,LIST
+10 QUIT
