- 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