BKMRMDR ;VNGT/HS/ALA-HIV STI Reminders ; 28 Feb 2007 11:07 AM
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
;
;
EN(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY,VALUE) ; PEP
; Return STI (Sexually Transmitted Infections) incidences
; Can specify a particular one or get all or key
;
;Input
; BKDFN - Patient ien
; BKBDT - Beginning Date Range
; BKEDT - Ending Date Range
; BKTYP - Type of reminder
;
S BKTYP=$G(BKTYP,""),BKBDT=$G(BKBDT,""),BKEDT=$G(BKEDT,DT)
K ARRAY
I BKTYP="" D ALL G DONE
I BKTYP="KEY" D KEY G DONE
I BKTYP="OTHER" D OTH G DONE
I BKTYP="CHN"!(BKTYP="Chancroid") D CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
I BKTYP="CHL"!(BKTYP="Chlamydia") D CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
I BKTYP="GENH"!(BKTYP="Genital Herpes") D GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
I BKTYP="GENW"!(BKTYP="Genital Warts") D GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
I BKTYP="GC"!(BKTYP="Gonorrhea") D GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
I BKTYP="HEPB"!(BKTYP="Hepatitis B") D HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
I BKTYP="HEPC"!(BKTYP="Hepatitis C") D HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
I BKTYP="HIV"!(BKTYP="HIV/AIDS") D HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
I BKTYP="HPV"!(BKTYP="Human Papilloma Virus") D HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
I BKTYP="LGV"!(BKTYP="Lymphogranuloma Venereum") D LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
I BKTYP="SYP"!(BKTYP="Syphilis") D SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
I BKTYP="TRIC"!(BKTYP="Trichomonas") D TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
;
DONE ;
NEW TYP,TOTAL,DX,DAT,RETURN,DTDIF
;
S TYP=""
F S TYP=$O(ARRAY(TYP)) Q:TYP="" D
. S TOTAL=0,DAT="",IDXDT=$O(ARRAY(TYP,"")),RETURN=""
. S TOTAL=0,DAT="",RETURN=""
. F S DAT=$O(ARRAY(TYP,DAT)) Q:'DAT D
.. S TOTAL=TOTAL+1
.. S VALUE(TYP,"DEN",DAT)=ARRAY(TYP,DAT)
.. S RETURN=RETURN_$$FMTE^XLFDT(DAT,"2Z")_" "_ARRAY(TYP,DAT)_"; "
. S VALUE(TYP,"DEN")=TOTAL_U_RETURN
Q
;
CHN(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Chancroid
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM CHANCROID DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
CHL(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Chlamydia
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM CHLAMYDIA DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
GENH(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Genital Herpes
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM GENITAL HERPES DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
GENW(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Genital Warts
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM GENITAL WARTS DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
GON(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Gonorrhea
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM GONORRHEA DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
HEPB(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Hepatitis B
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM HEP B DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
HEPC(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Hepatitis C
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM HEP C DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
HIV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; HIV/AIDS
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
HPV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Human Papilloma Virus
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM HPV DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
LGV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Lymphogranuloma Venereum
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM LGV DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
SYP(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Syphilis
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM SYPHILIS DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
TRIC(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Trichomonas
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BKM TRICHOMONIASIS DXS","^TMP(""BKMARRAY"",$J)")
D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
K ^TMP("BKMARRAY",$J)
Q
;
HIVE(BKDFN,BKIDT,BKMEDT) ;EP - HIV/AIDs ever
NEW TIEN,BKMBDT,QFL,IEN,VISIT,VSDT,LDATE,LV
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
;
NEW BKMBDT,IEN
S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
S BKMEDT=(9999999-BKMEDT)
F S BKMBDT=$O(^AUPNVPOV("AA",BKDFN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT) D Q:QFL
. S IEN="",QFL=0
. F S IEN=$O(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN)) Q:IEN="" D Q:QFL
.. S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q
.. I '$D(^TMP("BKMARRAY",$J,TIEN)) Q
.. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
.. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
.. S QFL=1,LDATE=VSDT,LV=IEN
.. S VALUE(BKTY,"NUM",BKNMTY,VSDT)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" POV: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]"
.. S HVDFL=1
;
;Check CPT
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMARRAY"",$J)")
S TIEN="",QFL=0
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D Q:QFL
. S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
. F S BKMBDT=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT) D Q:QFL
.. S IEN=""
.. F S IEN=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT,IEN)) Q:IEN="" D Q:QFL
... S VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I") Q:VISIT=""
... S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
... S QFL=1,LDATE=VSDT,LV=IEN
... S VALUE(BKTY,"NUM",BKNMTY,VSDT)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" CPT: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]"
... S HVDFL=1
Q
; using new future cross-reference
S TIEN=""
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D
. S BKMBDT=""
. F S BKMBDT=$O(^AUPNVPOV("AF",TIEN,BKMBDT)) Q:BKMBDT=""!(BKMBDT\1>BKMEDT) D
. S IEN=""
. F S IEN=$O(^AUPNVPOV("AF",TIEN,BKMBDT,BKDFN,IEN)) Q:IEN="" D Q:QFL
.. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
.. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
.. S QFL=1,LDATE=VSDT,LV=IEN
.. S VALUE(BKTY,"NUM",BKNMTY)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" [HIV "_^TMP("BKMARRAY",$J,TIEN)_"]"
.. S HVDFL=1
Q
;
ALL ; Get all STDs
D CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
D CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
D GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
D GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
D GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
D HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
D HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
D HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
D HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
D LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
D SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
D TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
Q
;
KEY ; Get all Key STDs
D CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
D GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
D HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
D SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
Q
;
OTH ; Other than the Key STIs
D CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
D GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
D GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
D HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
D HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
D HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
D LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
D TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
Q
;
FND(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Find an entry
NEW BKMBDT,IEN
S BKMBDT=BKBDT,BKMEDT=(9999999-BKEDT)
;
S BKMBDT=(9999999-BKBDT)+.0001
F S BKMBDT=$O(^AUPNVPOV("AA",BKDFN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT) D
. S IEN=""
. F S IEN=$O(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN)) Q:IEN="" D
.. S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q
.. I '$D(^TMP("BKMARRAY",$J,TIEN)) Q
.. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
.. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
.. S ARRAY(BKTYP,VSDT)="POV: "_BKTYP_" "_^TMP("BKMARRAY",$J,TIEN)
.. S ZARRAY("ZD",VSDT,BKTYP)="",ZARRAY("ZD",VSDT)=$G(ZARRAY("ZD",VSDT))+1
Q
;
FND1(TIEN,BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; using new future cross-reference
NEW DXC
F S BKMBDT=$O(^AUPNVPOV("AF",TIEN,BKMBDT)) Q:BKMBDT=""!(BKMBDT\1<BKEDT) D
. S IEN=""
. F S IEN=$O(^AUPNVPOV("AF",TIEN,BKMBDT,BKDFN,IEN)) Q:IEN="" D
.. S DXC=^TMP("BKMARRAY",$J,TIEN),VSDT=BKMBDT\1
.. S ARRAY(BKTYP,VSDT)="POV: "_BKTYP_" "_DXC
;
Q
;
HIVS(BKDFN,BKIDT,BKMEDT) ;EP - HIV/AIDs between date range
NEW TIEN
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
;
S FLAG=0
NEW BKMBDT,IEN
S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
S BKMEDT=(9999999-BKMEDT)
F S BKMBDT=$O(^AUPNVPOV("AA",BKDFN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT) D Q:QFL
. S IEN="",QFL=0
. F S IEN=$O(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN)) Q:IEN="" D Q:QFL
.. S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q
.. I '$D(^TMP("BKMARRAY",$J,TIEN)) Q
.. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
.. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
.. S FLAG=1_U_$$FMTE^XLFDT(VSDT,"2Z")_" POV: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]",QFL=1
K ^TMP("BKMARRAY",$J)
D BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMARRAY"",$J)")
S TIEN="",QFL=0
F S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN="" D Q:QFL
. S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
. F S BKMBDT=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT) D Q:QFL
.. S IEN=""
.. F S IEN=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT,IEN)) Q:IEN="" D Q:QFL
... S VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I") Q:VISIT=""
... S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
... S FLAG=1_U_$$FMTE^XLFDT(VSDT,"2Z")_" CPT: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]"_U_VSDT,QFL=1
K ^TMP("BKMARRAY",$J)
Q FLAG
BKMRMDR ;VNGT/HS/ALA-HIV STI Reminders ; 28 Feb 2007 11:07 AM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
+2 ;
+3 ;
EN(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY,VALUE) ; PEP
+1 ; Return STI (Sexually Transmitted Infections) incidences
+2 ; Can specify a particular one or get all or key
+3 ;
+4 ;Input
+5 ; BKDFN - Patient ien
+6 ; BKBDT - Beginning Date Range
+7 ; BKEDT - Ending Date Range
+8 ; BKTYP - Type of reminder
+9 ;
+10 SET BKTYP=$GET(BKTYP,"")
SET BKBDT=$GET(BKBDT,"")
SET BKEDT=$GET(BKEDT,DT)
+11 KILL ARRAY
+12 IF BKTYP=""
DO ALL
GOTO DONE
+13 IF BKTYP="KEY"
DO KEY
GOTO DONE
+14 IF BKTYP="OTHER"
DO OTH
GOTO DONE
+15 IF BKTYP="CHN"!(BKTYP="Chancroid")
DO CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
+16 IF BKTYP="CHL"!(BKTYP="Chlamydia")
DO CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
+17 IF BKTYP="GENH"!(BKTYP="Genital Herpes")
DO GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
+18 IF BKTYP="GENW"!(BKTYP="Genital Warts")
DO GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
+19 IF BKTYP="GC"!(BKTYP="Gonorrhea")
DO GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
+20 IF BKTYP="HEPB"!(BKTYP="Hepatitis B")
DO HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
+21 IF BKTYP="HEPC"!(BKTYP="Hepatitis C")
DO HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
+22 IF BKTYP="HIV"!(BKTYP="HIV/AIDS")
DO HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
+23 IF BKTYP="HPV"!(BKTYP="Human Papilloma Virus")
DO HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
+24 IF BKTYP="LGV"!(BKTYP="Lymphogranuloma Venereum")
DO LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
+25 IF BKTYP="SYP"!(BKTYP="Syphilis")
DO SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
+26 IF BKTYP="TRIC"!(BKTYP="Trichomonas")
DO TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
+27 ;
DONE ;
+1 NEW TYP,TOTAL,DX,DAT,RETURN,DTDIF
+2 ;
+3 SET TYP=""
+4 FOR
SET TYP=$ORDER(ARRAY(TYP))
IF TYP=""
QUIT
Begin DoDot:1
+5 SET TOTAL=0
SET DAT=""
SET IDXDT=$ORDER(ARRAY(TYP,""))
SET RETURN=""
+6 SET TOTAL=0
SET DAT=""
SET RETURN=""
+7 FOR
SET DAT=$ORDER(ARRAY(TYP,DAT))
IF 'DAT
QUIT
Begin DoDot:2
+8 SET TOTAL=TOTAL+1
+9 SET VALUE(TYP,"DEN",DAT)=ARRAY(TYP,DAT)
+10 SET RETURN=RETURN_$$FMTE^XLFDT(DAT,"2Z")_" "_ARRAY(TYP,DAT)_"; "
End DoDot:2
+11 SET VALUE(TYP,"DEN")=TOTAL_U_RETURN
End DoDot:1
+12 QUIT
+13 ;
CHN(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Chancroid
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM CHANCROID DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
CHL(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Chlamydia
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM CHLAMYDIA DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
GENH(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Genital Herpes
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM GENITAL HERPES DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
GENW(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Genital Warts
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM GENITAL WARTS DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
GON(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Gonorrhea
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM GONORRHEA DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
HEPB(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Hepatitis B
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM HEP B DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
HEPC(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Hepatitis C
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM HEP C DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
HIV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; HIV/AIDS
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
HPV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Human Papilloma Virus
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM HPV DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
LGV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Lymphogranuloma Venereum
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM LGV DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
SYP(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Syphilis
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM SYPHILIS DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
TRIC(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Trichomonas
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BKM TRICHOMONIASIS DXS","^TMP(""BKMARRAY"",$J)")
+4 DO FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
+5 KILL ^TMP("BKMARRAY",$JOB)
+6 QUIT
+7 SET TIEN=""
+8 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+9 DO FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
End DoDot:1
+10 KILL ^TMP("BKMARRAY",$JOB)
+11 QUIT
+12 ;
HIVE(BKDFN,BKIDT,BKMEDT) ;EP - HIV/AIDs ever
+1 NEW TIEN,BKMBDT,QFL,IEN,VISIT,VSDT,LDATE,LV
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
+4 ;
+5 NEW BKMBDT,IEN
+6 SET BKMBDT=$SELECT(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
+7 SET BKMEDT=(9999999-BKMEDT)
+8 FOR
SET BKMBDT=$ORDER(^AUPNVPOV("AA",BKDFN,BKMBDT),-1)
IF BKMBDT=""!(BKMBDT\1<BKMEDT)
QUIT
Begin DoDot:1
+9 SET IEN=""
SET QFL=0
+10 FOR
SET IEN=$ORDER(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+11 SET TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I")
IF TIEN=""
QUIT
+12 IF '$DATA(^TMP("BKMARRAY",$JOB,TIEN))
QUIT
+13 SET VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I")
IF VISIT=""
QUIT
+14 SET VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDT=0
QUIT
+15 SET QFL=1
SET LDATE=VSDT
SET LV=IEN
+16 SET VALUE(BKTY,"NUM",BKNMTY,VSDT)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" POV: HIV ["_^TMP("BKMARRAY",$JOB,TIEN)_"]"
+17 SET HVDFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+18 ;
+19 ;Check CPT
+20 KILL ^TMP("BKMARRAY",$JOB)
+21 DO BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMARRAY"",$J)")
+22 SET TIEN=""
SET QFL=0
+23 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+24 SET BKMBDT=$SELECT(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
+25 FOR
SET BKMBDT=$ORDER(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT),-1)
IF BKMBDT=""!(BKMBDT\1<BKMEDT)
QUIT
Begin DoDot:2
+26 SET IEN=""
+27 FOR
SET IEN=$ORDER(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+28 SET VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I")
IF VISIT=""
QUIT
+29 SET VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDT=0
QUIT
+30 SET QFL=1
SET LDATE=VSDT
SET LV=IEN
+31 SET VALUE(BKTY,"NUM",BKNMTY,VSDT)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" CPT: HIV ["_^TMP("BKMARRAY",$JOB,TIEN)_"]"
+32 SET HVDFL=1
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+33 QUIT
+34 ; using new future cross-reference
+35 SET TIEN=""
+36 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+37 SET BKMBDT=""
+38 FOR
SET BKMBDT=$ORDER(^AUPNVPOV("AF",TIEN,BKMBDT))
IF BKMBDT=""!(BKMBDT\1>BKMEDT)
QUIT
Begin DoDot:2
End DoDot:2
+39 SET IEN=""
+40 FOR
SET IEN=$ORDER(^AUPNVPOV("AF",TIEN,BKMBDT,BKDFN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+41 SET VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I")
IF VISIT=""
QUIT
+42 SET VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDT=0
QUIT
+43 SET QFL=1
SET LDATE=VSDT
SET LV=IEN
+44 SET VALUE(BKTY,"NUM",BKNMTY)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" [HIV "_^TMP("BKMARRAY",$JOB,TIEN)_"]"
+45 SET HVDFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+46 QUIT
+47 ;
ALL ; Get all STDs
+1 DO CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
+2 DO CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
+3 DO GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
+4 DO GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
+5 DO GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
+6 DO HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
+7 DO HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
+8 DO HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
+9 DO HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
+10 DO LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
+11 DO SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
+12 DO TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
+13 QUIT
+14 ;
KEY ; Get all Key STDs
+1 DO CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
+2 DO GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
+3 DO HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
+4 DO SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
+5 QUIT
+6 ;
OTH ; Other than the Key STIs
+1 DO CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
+2 DO GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
+3 DO GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
+4 DO HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
+5 DO HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
+6 DO HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
+7 DO LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
+8 DO TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
+9 QUIT
+10 ;
FND(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Find an entry
+1 NEW BKMBDT,IEN
+2 SET BKMBDT=BKBDT
SET BKMEDT=(9999999-BKEDT)
+3 ;
+4 SET BKMBDT=(9999999-BKBDT)+.0001
+5 FOR
SET BKMBDT=$ORDER(^AUPNVPOV("AA",BKDFN,BKMBDT),-1)
IF BKMBDT=""!(BKMBDT\1<BKMEDT)
QUIT
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+8 SET TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I")
IF TIEN=""
QUIT
+9 IF '$DATA(^TMP("BKMARRAY",$JOB,TIEN))
QUIT
+10 SET VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I")
IF VISIT=""
QUIT
+11 SET VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDT=0
QUIT
+12 SET ARRAY(BKTYP,VSDT)="POV: "_BKTYP_" "_^TMP("BKMARRAY",$JOB,TIEN)
+13 SET ZARRAY("ZD",VSDT,BKTYP)=""
SET ZARRAY("ZD",VSDT)=$GET(ZARRAY("ZD",VSDT))+1
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
FND1(TIEN,BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; using new future cross-reference
+1 NEW DXC
+2 FOR
SET BKMBDT=$ORDER(^AUPNVPOV("AF",TIEN,BKMBDT))
IF BKMBDT=""!(BKMBDT\1<BKEDT)
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^AUPNVPOV("AF",TIEN,BKMBDT,BKDFN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+5 SET DXC=^TMP("BKMARRAY",$JOB,TIEN)
SET VSDT=BKMBDT\1
+6 SET ARRAY(BKTYP,VSDT)="POV: "_BKTYP_" "_DXC
End DoDot:2
End DoDot:1
+7 ;
+8 QUIT
+9 ;
HIVS(BKDFN,BKIDT,BKMEDT) ;EP - HIV/AIDs between date range
+1 NEW TIEN
+2 KILL ^TMP("BKMARRAY",$JOB)
+3 DO BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
+4 ;
+5 SET FLAG=0
+6 NEW BKMBDT,IEN
+7 SET BKMBDT=$SELECT(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
+8 SET BKMEDT=(9999999-BKMEDT)
+9 FOR
SET BKMBDT=$ORDER(^AUPNVPOV("AA",BKDFN,BKMBDT),-1)
IF BKMBDT=""!(BKMBDT\1<BKMEDT)
QUIT
Begin DoDot:1
+10 SET IEN=""
SET QFL=0
+11 FOR
SET IEN=$ORDER(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+12 SET TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I")
IF TIEN=""
QUIT
+13 IF '$DATA(^TMP("BKMARRAY",$JOB,TIEN))
QUIT
+14 SET VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I")
IF VISIT=""
QUIT
+15 SET VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDT=0
QUIT
+16 SET FLAG=1_U_$$FMTE^XLFDT(VSDT,"2Z")_" POV: HIV ["_^TMP("BKMARRAY",$JOB,TIEN)_"]"
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+17 KILL ^TMP("BKMARRAY",$JOB)
+18 DO BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMARRAY"",$J)")
+19 SET TIEN=""
SET QFL=0
+20 FOR
SET TIEN=$ORDER(^TMP("BKMARRAY",$JOB,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+21 SET BKMBDT=$SELECT(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
+22 FOR
SET BKMBDT=$ORDER(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT),-1)
IF BKMBDT=""!(BKMBDT\1<BKMEDT)
QUIT
Begin DoDot:2
+23 SET IEN=""
+24 FOR
SET IEN=$ORDER(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+25 SET VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I")
IF VISIT=""
QUIT
+26 SET VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDT=0
QUIT
+27 SET FLAG=1_U_$$FMTE^XLFDT(VSDT,"2Z")_" CPT: HIV ["_^TMP("BKMARRAY",$JOB,TIEN)_"]"_U_VSDT
SET QFL=1
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+28 KILL ^TMP("BKMARRAY",$JOB)
+29 QUIT FLAG
