Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMRMDR

BKMRMDR.m

Go to the documentation of this file. 
  1. BKMRMDR ;VNGT/HS/ALA-HIV STI Reminders ; 28 Feb 2007  11:07 AM
  1.  ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
  1.  ;
  1.  ;
  1. EN(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY,VALUE) ; PEP
  1.  ; Return STI (Sexually Transmitted Infections) incidences
  1.  ; Can specify a particular one or get all or key
  1.  ;
  1.  ;Input
  1.  ;  BKDFN - Patient ien
  1.  ;  BKBDT - Beginning Date Range
  1.  ;  BKEDT - Ending Date Range
  1.  ;  BKTYP - Type of reminder
  1.  ;
  1.  S BKTYP=$G(BKTYP,""),BKBDT=$G(BKBDT,""),BKEDT=$G(BKEDT,DT)
  1.  K ARRAY
  1.  I BKTYP="" D ALL G DONE
  1.  I BKTYP="KEY" D KEY G DONE
  1.  I BKTYP="OTHER" D OTH G DONE
  1.  I BKTYP="CHN"!(BKTYP="Chancroid") D CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
  1.  I BKTYP="CHL"!(BKTYP="Chlamydia") D CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
  1.  I BKTYP="GENH"!(BKTYP="Genital Herpes") D GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
  1.  I BKTYP="GENW"!(BKTYP="Genital Warts") D GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
  1.  I BKTYP="GC"!(BKTYP="Gonorrhea") D GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
  1.  I BKTYP="HEPB"!(BKTYP="Hepatitis B") D HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
  1.  I BKTYP="HEPC"!(BKTYP="Hepatitis C") D HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
  1.  I BKTYP="HIV"!(BKTYP="HIV/AIDS") D HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
  1.  I BKTYP="HPV"!(BKTYP="Human Papilloma Virus") D HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
  1.  I BKTYP="LGV"!(BKTYP="Lymphogranuloma Venereum") D LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
  1.  I BKTYP="SYP"!(BKTYP="Syphilis") D SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
  1.  I BKTYP="TRIC"!(BKTYP="Trichomonas") D TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
  1.  ;
  1. DONE ;
  1.  NEW TYP,TOTAL,DX,DAT,RETURN,DTDIF
  1.  ;
  1.  S TYP=""
  1.  F  S TYP=$O(ARRAY(TYP)) Q:TYP=""  D
  1.  . S TOTAL=0,DAT="",IDXDT=$O(ARRAY(TYP,"")),RETURN=""
  1.  . S TOTAL=0,DAT="",RETURN=""
  1.  . F  S DAT=$O(ARRAY(TYP,DAT)) Q:'DAT  D
  1.  .. S TOTAL=TOTAL+1
  1.  .. S VALUE(TYP,"DEN",DAT)=ARRAY(TYP,DAT)
  1.  .. S RETURN=RETURN_$$FMTE^XLFDT(DAT,"2Z")_" "_ARRAY(TYP,DAT)_"; "
  1.  . S VALUE(TYP,"DEN")=TOTAL_U_RETURN
  1.  Q
  1.  ;
  1. CHN(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Chancroid
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM CHANCROID DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. CHL(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Chlamydia
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM CHLAMYDIA DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. GENH(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Genital Herpes
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM GENITAL HERPES DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. GENW(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Genital Warts
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM GENITAL WARTS DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. GON(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Gonorrhea
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM GONORRHEA DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. HEPB(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ;  Hepatitis B
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM HEP B DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. HEPC(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ;  Hepatitis C
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM HEP C DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. HIV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ;  HIV/AIDS
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. HPV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Human Papilloma Virus
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM HPV DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. LGV(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Lymphogranuloma Venereum
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM LGV DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. SYP(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Syphilis
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM SYPHILIS DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. TRIC(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; Trichomonas
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BKM TRICHOMONIASIS DXS","^TMP(""BKMARRAY"",$J)")
  1.  D FND(.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . D FND1(.TIEN,.BKDFN,.BKBDT,.BKEDT,.BKTYP,.ARRAY)
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q
  1.  ;
  1. HIVE(BKDFN,BKIDT,BKMEDT) ;EP - HIV/AIDs ever
  1.  NEW TIEN,BKMBDT,QFL,IEN,VISIT,VSDT,LDATE,LV
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
  1.  ;
  1.  NEW BKMBDT,IEN
  1.  S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
  1.  S BKMEDT=(9999999-BKMEDT)
  1.  F  S BKMBDT=$O(^AUPNVPOV("AA",BKDFN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT)  D  Q:QFL
  1.  . S IEN="",QFL=0
  1.  . F  S IEN=$O(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  .. S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q
  1.  .. I '$D(^TMP("BKMARRAY",$J,TIEN)) Q
  1.  .. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
  1.  .. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
  1.  .. S QFL=1,LDATE=VSDT,LV=IEN
  1.  .. S VALUE(BKTY,"NUM",BKNMTY,VSDT)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" POV: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]"
  1.  .. S HVDFL=1
  1.  ;
  1.  ;Check CPT
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMARRAY"",$J)")
  1.  S TIEN="",QFL=0
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D  Q:QFL
  1.  . S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
  1.  . F  S BKMBDT=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT)  D  Q:QFL
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  ... S VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I") Q:VISIT=""
  1.  ... S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
  1.  ... S QFL=1,LDATE=VSDT,LV=IEN
  1.  ... S VALUE(BKTY,"NUM",BKNMTY,VSDT)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" CPT: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]"
  1.  ... S HVDFL=1
  1.  Q
  1.  ; using new future cross-reference
  1.  S TIEN=""
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D
  1.  . S BKMBDT=""
  1.  . F  S BKMBDT=$O(^AUPNVPOV("AF",TIEN,BKMBDT)) Q:BKMBDT=""!(BKMBDT\1>BKMEDT)  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVPOV("AF",TIEN,BKMBDT,BKDFN,IEN)) Q:IEN=""  D  Q:QFL
  1.  .. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
  1.  .. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
  1.  .. S QFL=1,LDATE=VSDT,LV=IEN
  1.  .. S VALUE(BKTY,"NUM",BKNMTY)=1_U_$$FMTE^XLFDT((LDATE\1),"2Z")_" [HIV "_^TMP("BKMARRAY",$J,TIEN)_"]"
  1.  .. S HVDFL=1
  1.  Q
  1.  ;
  1. ALL ; Get all STDs
  1.  D CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
  1.  D CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
  1.  D GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
  1.  D GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
  1.  D GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
  1.  D HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
  1.  D HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
  1.  D HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
  1.  D HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
  1.  D LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
  1.  D SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
  1.  D TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
  1.  Q
  1.  ;
  1. KEY ; Get all Key STDs
  1.  D CHL(.BKDFN,.BKBDT,.BKEDT,"CHL",.ARRAY)
  1.  D GON(.BKDFN,.BKBDT,.BKEDT,"GC",.ARRAY)
  1.  D HIV(.BKDFN,.BKBDT,.BKEDT,"HIV",.ARRAY)
  1.  D SYP(.BKDFN,.BKBDT,.BKEDT,"SYP",.ARRAY)
  1.  Q
  1.  ;
  1. OTH ; Other than the Key STIs
  1.  D CHN(.BKDFN,.BKBDT,.BKEDT,"CHN",.ARRAY)
  1.  D GENH(.BKDFN,.BKBDT,.BKEDT,"GENH",.ARRAY)
  1.  D GENW(.BKDFN,.BKBDT,.BKEDT,"GENW",.ARRAY)
  1.  D HEPB(.BKDFN,.BKBDT,.BKEDT,"HEPB",.ARRAY)
  1.  D HEPC(.BKDFN,.BKBDT,.BKEDT,"HEPC",.ARRAY)
  1.  D HPV(.BKDFN,.BKBDT,.BKEDT,"HPV",.ARRAY)
  1.  D LGV(.BKDFN,.BKBDT,.BKEDT,"LGV",.ARRAY)
  1.  D TRIC(.BKDFN,.BKBDT,.BKEDT,"TRIC",.ARRAY)
  1.  Q
  1.  ;
  1. FND(BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ;  Find an entry
  1.  NEW BKMBDT,IEN
  1.  S BKMBDT=BKBDT,BKMEDT=(9999999-BKEDT)
  1.  ;
  1.  S BKMBDT=(9999999-BKBDT)+.0001
  1.  F  S BKMBDT=$O(^AUPNVPOV("AA",BKDFN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT)  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN)) Q:IEN=""  D
  1.  .. S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q
  1.  .. I '$D(^TMP("BKMARRAY",$J,TIEN)) Q
  1.  .. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
  1.  .. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
  1.  .. S ARRAY(BKTYP,VSDT)="POV: "_BKTYP_" "_^TMP("BKMARRAY",$J,TIEN)
  1.  .. S ZARRAY("ZD",VSDT,BKTYP)="",ZARRAY("ZD",VSDT)=$G(ZARRAY("ZD",VSDT))+1
  1.  Q
  1.  ;
  1. FND1(TIEN,BKDFN,BKBDT,BKEDT,BKTYP,ARRAY) ; using new future cross-reference
  1.  NEW DXC
  1.  F  S BKMBDT=$O(^AUPNVPOV("AF",TIEN,BKMBDT)) Q:BKMBDT=""!(BKMBDT\1<BKEDT)  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVPOV("AF",TIEN,BKMBDT,BKDFN,IEN)) Q:IEN=""  D
  1.  .. S DXC=^TMP("BKMARRAY",$J,TIEN),VSDT=BKMBDT\1
  1.  .. S ARRAY(BKTYP,VSDT)="POV: "_BKTYP_" "_DXC
  1.  ;
  1.  Q
  1.  ;
  1. HIVS(BKDFN,BKIDT,BKMEDT) ;EP - HIV/AIDs between date range
  1.  NEW TIEN
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BGP HIV/AIDS DXS","^TMP(""BKMARRAY"",$J)")
  1.  ;
  1.  S FLAG=0
  1.  NEW BKMBDT,IEN
  1.  S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
  1.  S BKMEDT=(9999999-BKMEDT)
  1.  F  S BKMBDT=$O(^AUPNVPOV("AA",BKDFN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT)  D  Q:QFL
  1.  . S IEN="",QFL=0
  1.  . F  S IEN=$O(^AUPNVPOV("AA",BKDFN,BKMBDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  .. S TIEN=$$GET1^DIQ(9000010.07,IEN_",",.01,"I") I TIEN="" Q
  1.  .. I '$D(^TMP("BKMARRAY",$J,TIEN)) Q
  1.  .. S VISIT=$$GET1^DIQ(9000010.07,IEN_",",.03,"I") Q:VISIT=""
  1.  .. S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
  1.  .. S FLAG=1_U_$$FMTE^XLFDT(VSDT,"2Z")_" POV: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]",QFL=1
  1.  K ^TMP("BKMARRAY",$J)
  1.  D BLDTAX^BKMIXX5("BGP CPT HIV TESTS","^TMP(""BKMARRAY"",$J)")
  1.  S TIEN="",QFL=0
  1.  F  S TIEN=$O(^TMP("BKMARRAY",$J,TIEN)) Q:TIEN=""  D  Q:QFL
  1.  . S BKMBDT=$S(BKIDT'="":(9999999-BKIDT)+.0001,1:"")
  1.  . F  S BKMBDT=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT),-1) Q:BKMBDT=""!(BKMBDT\1<BKMEDT)  D  Q:QFL
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^AUPNVCPT("AA",BKDFN,TIEN,BKMBDT,IEN)) Q:IEN=""  D  Q:QFL
  1.  ... S VISIT=$$GET1^DIQ(9000010.18,IEN_",",.03,"I") Q:VISIT=""
  1.  ... S VSDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 Q:VSDT=0
  1.  ... S FLAG=1_U_$$FMTE^XLFDT(VSDT,"2Z")_" CPT: HIV ["_^TMP("BKMARRAY",$J,TIEN)_"]"_U_VSDT,QFL=1
  1.  K ^TMP("BKMARRAY",$J)
  1.  Q FLAG