BKM100P2 ;PRXM/HC/ALA-BKM 1.00 Patch 2 ; 08 Mar 2007 6:12 PM
;;2.0;HIV MANAGEMENT SYSTEM;;May 29, 2009
;
EN ;
;
; Set up new taxonomies for STI and updates
D ^BKMETX
;
LTAX ; Add Lab Taxonomies to ^ATXLAB
NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX
S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
; Loop through the Taxonomies as stored in routine BKMVTAX4.
D LDLAB(.LTAX)
F BJ=1:1 Q:'$D(LTAX(BJ)) S X=LTAX(BJ) D
. I $D(^ATXLAB("B",X)) Q ; Skip pre-existing Lab taxonomies
. D ^DIC S DA=+Y
. I DA<1 Q
. S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
. S BQTXUP(9002228,DA_",",.05)=DUZ
. S BQTXUP(9002228,DA_",",.06)=DT
. S BQTXUP(9002228,DA_",",.09)=60
. D FILE^DIE("I","BQTXUP")
. S BQTXUP(9002228,DA_",",.08)="B"
. D FILE^DIE("E","BQTXUP")
;
K DA,BJ,BQTXUP
;
; Set up the HMS Reminders as inactive in the standard Health
; Summary Maintenance Items file #9001018 (APCHSURV)
;NEW BKMDATA,BKMI,BKMJ,BKMD,PRGM
;F BKMI=1:1:13 S BKMDATA=$P($T(REM+BKMI),";;",2) D
;. NEW X,DIC,DA,BKMUPD,Y
;. S X=$P(BKMDATA,"|",1)
;. S DIC="^APCHSURV(",DIC(0)="LZ" D ^DIC
;. ; If this is not a new entry, quit
;. I $P(Y,U,3)'=1 Q
;. S DA=+Y
;. S BKMUPD(9001018,DA_",",.03)="INACTIVE (OFF)"
;. S BKMUPD(9001018,DA_",",.05)="HIV"
;. S BKMUPD(9001018,DA_",",.06)="YES"
;. S PRGM=$P(BKMDATA,"|",2),PRGM=$TR(PRGM,"~",";")
;. S BKMUPD(9001018,DA_",",1)=PRGM
;. D FILE^DIE("E","BKMUPD","ERROR")
;. F BKMJ=1:1 S BKMD=$T(@BKMI+BKMJ) Q:BKMD[" Q" S BKWP(BKMJ)=$P(BKMD,";;",2)
;. D WP^DIE(9001018,DA_",",2,"","BKWP","ERROR")
;. K BKWP
;
; Load HMS Supplement in ^APCHSUP
;
;NEW BKMDATA,BKMI,BKMJ,BKMD
;F BKMI=1 S BKMDATA=$P($T(SUP+BKMI),";;",2) D
;. NEW X,DIC,DA,BKMUPD,Y
;. S X=$P(BKMDATA,"|",1)
;. S DIC="^APCHSUP(",DIC(0)="LZ" D ^DIC
;. ; If this is not a new entry, quit
;. I $P(Y,U,3)'=1 Q
;. S DA=+Y
;. S BKMUPD(9001022,DA_",",1100)=$P(BKMDATA,"|",2)
;. D FILE^DIE("E","BKMUPD","ERROR")
;. F BKMJ=1:1 S BKMD=$T(@("S"_BKMI)+BKMJ) Q:BKMD[" Q" S BKWP(BKMJ)=$P(BKMD,";;",2)
;. D WP^DIE(9001022,DA_",",1200,"","BKWP","ERROR")
;. K BKWP
Q
;
PRE ; Preinstall
NEW DA,DIK
S DIK="^BKM(90454,"
S DA=0
F S DA=$O(^BKM(90454,DA)) Q:'DA D ^DIK
Q
;
REM ;
;;SAFE SEX EDUCATION|ED01~BKMVF33
;;FAMILY PLANNING EDUCATION|ED02~BKMVF33
;;HMS PNEUMOVAX|IZ01~BKMVF33
;;HMS INFLUENZA|IZ02~BKMVF33
;;HEPATITIS A|IZ03~BKMVF33
;;HEPATITIS B|IZ04~BKMVF33
;;TETANUS|IZ05~BKMVF33
;;EYE EXAM|EX01~BKMVF33
;;DENTAL EXAM|EX02~BKMVF33
;;HMS MAMMOGRAM|WMH~BKMVF33
;;CD4|TST01~BKMVF33
;;CHLAMYDIA|TST02~BKMVF33
;;SYPHILIS|TST03~BKMVF33
Q
;
1 ;;
;;Numerator: All patients, ages 13 and older.
;; Due date = Today, if patients have not had Safe Sex Education (ED.3)
;;ever documented.
;; OR
;; Due date = Last documented education date + 183 days (or 6 months)
Q
2 ;;
;;Numerator: All patients, ages 13 and older.
;;Due date = Today, if patients have not had Safe Sex Education
;;(ED.3) ever
;;documented.
;;OR
;;Due date = Last documented education date + 183 days (or 6 months)
Q
3 ;;
;;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).
Q
4 ;;
;;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)
Q
5 ;;
;;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.
Q
6 ;;
;;Due date = Today, if no Hepatitis B diagnosis (DX.15) POV or
;;Problem list ever documented.
;;OR
;;Due date = Today, if no Hepatitis B immunization (IZ.4) ever documented.
Q
7 ;;
;;Due date = Today, if no Tetanus immunization (IZ.7) ever documented.
;;OR
;;Due date = Date of most recent Tetanus immunization + 3650 days or 10 years or 120 months).
Q
8 ;;
;;Due date = Today, if no dilated eye exam (P.03) ever documented.
;;Due date = Date of most recent dilated eye exam + 183 days (or 6 months)
;; if any CD4 Absolute laboratory test (T.30) since most recent
;; dilated eye exam is < 50.
;;Due date = Date of most recent dilated eye exam + 365 days (or 12 months).
Q
9 ;;
;;Due date = Today, if no dental exam (P.02) ever documented.
;;Due date = Date of most recent dental exam + 365 days (or 12 months)
Q
10 ;;
;;Numerator: All female patients ages 50-69 without documented bilateral
;;mastectomy (P.01)
;;
;;Due date = Today, if no Mammogram (P.05) ever documented.
;;Due date = Date of most mammogram + 365 days (or 12 months).
Q
11 ;;
;;Due date = Today, if no CD4 test (T.2) documented ever.
;;Due date = Date of most recent CD4 test + 120 days (or 4 months).
Q
12 ;;
;;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).
Q
13 ;;
;;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.
Q
;
SUP ; Load HMS Supplement in ^APCHSUP
;;HMS PATIENT CARE SUPPLEMENT|D EP^BKMVSUP(APCHSPAT)
Q
;
S1 ;;
;;The HMS Supplement has been designed to display information
;;specifically related to HIV. You will be able to see, at a glance, the
;;relevant labs, related diagnoses, medications and reminders.
Q
;
LDLAB(ARRAY) ;EP - Load site-populated Lab tests
NEW I,TEXT
F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT="" S ARRAY(I)=TEXT
Q
;
LAB ;EP - LAB TESTS (SITE-POPULATED)
;;BGP CHLAMYDIA TESTS TAX
;;BGP HIV TEST TAX
;;BKM GONORRHEA TEST TAX
;;BKM HEP B TAX
;;BKM FTA-ABS TEST TAX
;;BKM RPR TAX
;;
BKM100P2 ;PRXM/HC/ALA-BKM 1.00 Patch 2 ; 08 Mar 2007 6:12 PM
+1 ;;2.0;HIV MANAGEMENT SYSTEM;;May 29, 2009
+2 ;
EN ;
+1 ;
+2 ; Set up new taxonomies for STI and updates
+3 DO ^BKMETX
+4 ;
LTAX ; Add Lab Taxonomies to ^ATXLAB
+1 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX
+2 SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DLAYGO=9002228
+3 ; Loop through the Taxonomies as stored in routine BKMVTAX4.
+4 DO LDLAB(.LTAX)
+5 FOR BJ=1:1
IF '$DATA(LTAX(BJ))
QUIT
SET X=LTAX(BJ)
Begin DoDot:1
+6 ; Skip pre-existing Lab taxonomies
IF $DATA(^ATXLAB("B",X))
QUIT
+7 DO ^DIC
SET DA=+Y
+8 IF DA<1
QUIT
+9 SET BQTXUP(9002228,DA_",",.02)=$PIECE(X," ",2,999)
+10 SET BQTXUP(9002228,DA_",",.05)=DUZ
+11 SET BQTXUP(9002228,DA_",",.06)=DT
+12 SET BQTXUP(9002228,DA_",",.09)=60
+13 DO FILE^DIE("I","BQTXUP")
+14 SET BQTXUP(9002228,DA_",",.08)="B"
+15 DO FILE^DIE("E","BQTXUP")
End DoDot:1
+16 ;
+17 KILL DA,BJ,BQTXUP
+18 ;
+19 ; Set up the HMS Reminders as inactive in the standard Health
+20 ; Summary Maintenance Items file #9001018 (APCHSURV)
+21 ;NEW BKMDATA,BKMI,BKMJ,BKMD,PRGM
+22 ;F BKMI=1:1:13 S BKMDATA=$P($T(REM+BKMI),";;",2) D
+23 ;. NEW X,DIC,DA,BKMUPD,Y
+24 ;. S X=$P(BKMDATA,"|",1)
+25 ;. S DIC="^APCHSURV(",DIC(0)="LZ" D ^DIC
+26 ;. ; If this is not a new entry, quit
+27 ;. I $P(Y,U,3)'=1 Q
+28 ;. S DA=+Y
+29 ;. S BKMUPD(9001018,DA_",",.03)="INACTIVE (OFF)"
+30 ;. S BKMUPD(9001018,DA_",",.05)="HIV"
+31 ;. S BKMUPD(9001018,DA_",",.06)="YES"
+32 ;. S PRGM=$P(BKMDATA,"|",2),PRGM=$TR(PRGM,"~",";")
+33 ;. S BKMUPD(9001018,DA_",",1)=PRGM
+34 ;. D FILE^DIE("E","BKMUPD","ERROR")
+35 ;. F BKMJ=1:1 S BKMD=$T(@BKMI+BKMJ) Q:BKMD[" Q" S BKWP(BKMJ)=$P(BKMD,";;",2)
+36 ;. D WP^DIE(9001018,DA_",",2,"","BKWP","ERROR")
+37 ;. K BKWP
+38 ;
+39 ; Load HMS Supplement in ^APCHSUP
+40 ;
+41 ;NEW BKMDATA,BKMI,BKMJ,BKMD
+42 ;F BKMI=1 S BKMDATA=$P($T(SUP+BKMI),";;",2) D
+43 ;. NEW X,DIC,DA,BKMUPD,Y
+44 ;. S X=$P(BKMDATA,"|",1)
+45 ;. S DIC="^APCHSUP(",DIC(0)="LZ" D ^DIC
+46 ;. ; If this is not a new entry, quit
+47 ;. I $P(Y,U,3)'=1 Q
+48 ;. S DA=+Y
+49 ;. S BKMUPD(9001022,DA_",",1100)=$P(BKMDATA,"|",2)
+50 ;. D FILE^DIE("E","BKMUPD","ERROR")
+51 ;. F BKMJ=1:1 S BKMD=$T(@("S"_BKMI)+BKMJ) Q:BKMD[" Q" S BKWP(BKMJ)=$P(BKMD,";;",2)
+52 ;. D WP^DIE(9001022,DA_",",1200,"","BKWP","ERROR")
+53 ;. K BKWP
+54 QUIT
+55 ;
PRE ; Preinstall
+1 NEW DA,DIK
+2 SET DIK="^BKM(90454,"
+3 SET DA=0
+4 FOR
SET DA=$ORDER(^BKM(90454,DA))
IF 'DA
QUIT
DO ^DIK
+5 QUIT
+6 ;
REM ;
+1 ;;SAFE SEX EDUCATION|ED01~BKMVF33
+2 ;;FAMILY PLANNING EDUCATION|ED02~BKMVF33
+3 ;;HMS PNEUMOVAX|IZ01~BKMVF33
+4 ;;HMS INFLUENZA|IZ02~BKMVF33
+5 ;;HEPATITIS A|IZ03~BKMVF33
+6 ;;HEPATITIS B|IZ04~BKMVF33
+7 ;;TETANUS|IZ05~BKMVF33
+8 ;;EYE EXAM|EX01~BKMVF33
+9 ;;DENTAL EXAM|EX02~BKMVF33
+10 ;;HMS MAMMOGRAM|WMH~BKMVF33
+11 ;;CD4|TST01~BKMVF33
+12 ;;CHLAMYDIA|TST02~BKMVF33
+13 ;;SYPHILIS|TST03~BKMVF33
+14 QUIT
+15 ;
1 ;;
+1 ;;Numerator: All patients, ages 13 and older.
+2 ;; Due date = Today, if patients have not had Safe Sex Education (ED.3)
+3 ;;ever documented.
+4 ;; OR
+5 ;; Due date = Last documented education date + 183 days (or 6 months)
+6 QUIT
2 ;;
+1 ;;Numerator: All patients, ages 13 and older.
+2 ;;Due date = Today, if patients have not had Safe Sex Education
+3 ;;(ED.3) ever
+4 ;;documented.
+5 ;;OR
+6 ;;Due date = Last documented education date + 183 days (or 6 months)
+7 QUIT
3 ;;
+1 ;;Due date = Today, if no Pneumovax vaccine (IZ.6) ever
+2 ;;documented.
+3 ;;OR
+4 ;;Due date = Date of most recent Pneumovax vaccine + 1825 days
+5 ;;or 5 years
+6 ;;or 60 months).
+7 QUIT
4 ;;
+1 ;;Due date = Today, if no Influenza vaccine (IZ.5) ever documented.
+2 ;;OR
+3 ;;Due date = Date of most recent Influenza vaccine + 365 days (or
+4 ;;12 months)
+5 QUIT
5 ;;
+1 ;;Due date = Today, if no Hepatitis A diagnosis (DX.5) POV or
+2 ;;Problem list ever documented.
+3 ;;OR
+4 ;;Due date = Today, if no Hepatitis A immunization (IZ.3) ever documented.
+5 QUIT
6 ;;
+1 ;;Due date = Today, if no Hepatitis B diagnosis (DX.15) POV or
+2 ;;Problem list ever documented.
+3 ;;OR
+4 ;;Due date = Today, if no Hepatitis B immunization (IZ.4) ever documented.
+5 QUIT
7 ;;
+1 ;;Due date = Today, if no Tetanus immunization (IZ.7) ever documented.
+2 ;;OR
+3 ;;Due date = Date of most recent Tetanus immunization + 3650 days or 10 years or 120 months).
+4 QUIT
8 ;;
+1 ;;Due date = Today, if no dilated eye exam (P.03) ever documented.
+2 ;;Due date = Date of most recent dilated eye exam + 183 days (or 6 months)
+3 ;; if any CD4 Absolute laboratory test (T.30) since most recent
+4 ;; dilated eye exam is < 50.
+5 ;;Due date = Date of most recent dilated eye exam + 365 days (or 12 months).
+6 QUIT
9 ;;
+1 ;;Due date = Today, if no dental exam (P.02) ever documented.
+2 ;;Due date = Date of most recent dental exam + 365 days (or 12 months)
+3 QUIT
10 ;;
+1 ;;Numerator: All female patients ages 50-69 without documented bilateral
+2 ;;mastectomy (P.01)
+3 ;;
+4 ;;Due date = Today, if no Mammogram (P.05) ever documented.
+5 ;;Due date = Date of most mammogram + 365 days (or 12 months).
+6 QUIT
11 ;;
+1 ;;Due date = Today, if no CD4 test (T.2) documented ever.
+2 ;;Due date = Date of most recent CD4 test + 120 days (or 4 months).
+3 QUIT
12 ;;
+1 ;;Numerator: All patients 18 years of age and older
+2 ;;Due date = Today, if no Chlamydia test (T.3) ever documented
+3 ;;OR
+4 ;;Due date = Today, if most recent test results for any of the following
+5 ;;are positive
+6 ;; since the most recent Chlamydia test and =<365 days from today:
+7 ;; Gonorrhea (T.10); Syphilis (T.22) or (T.9).
+8 ;;OR
+9 ;;Due date = Today, if patient has any of the following POV diagnoses
+10 ;; since the most recent Chlamydia test and =<365 days from today:
+11 ;; Gonorrhea (DX.4), Syphilis (DX.11), Trichomoniasis (DX.13) or other
+12 ;;STD (DX.9)
+13 ;;OR
+14 ;;Due date = Date of most recent positive Chlamydia test + 56 days (for
+15 ;;retest after cure)
+16 ;;OR
+17 ;;Due date = Date of most recent Chlamydia test + 365 days (or 12 months).
+18 QUIT
13 ;;
+1 ;;Numerator: Patients with a positive RPR laboratory value (T.22) (defined
+2 ;;as positive, reactive, indeterminate or any number values) and no FTA-ABS
+3 ;;(T.9) documented after the date of the positive RPR
+4 ;;
+5 ;;Due date = Date of the most recent positive RPR laboratory test + 14 days.
+6 QUIT
+7 ;
SUP ; Load HMS Supplement in ^APCHSUP
+1 ;;HMS PATIENT CARE SUPPLEMENT|D EP^BKMVSUP(APCHSPAT)
+2 QUIT
+3 ;
S1 ;;
+1 ;;The HMS Supplement has been designed to display information
+2 ;;specifically related to HIV. You will be able to see, at a glance, the
+3 ;;relevant labs, related diagnoses, medications and reminders.
+4 QUIT
+5 ;
LDLAB(ARRAY) ;EP - Load site-populated Lab tests
+1 NEW I,TEXT
+2 FOR I=1:1
SET TEXT=$PIECE($TEXT(LAB+I),";;",2)
IF TEXT=""
QUIT
SET ARRAY(I)=TEXT
+3 QUIT
+4 ;
LAB ;EP - LAB TESTS (SITE-POPULATED)
+1 ;;BGP CHLAMYDIA TESTS TAX
+2 ;;BGP HIV TEST TAX
+3 ;;BKM GONORRHEA TEST TAX
+4 ;;BKM HEP B TAX
+5 ;;BKM FTA-ABS TEST TAX
+6 ;;BKM RPR TAX
+7 ;;
