BKMQQCRC.m

BKMQQCRC ;VNGT/HS/ALA-HIV QOC Report continued ; 12 Mar 2010  3:02 PM

 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40

 ;

 ; run mental health

 D EXAM,EDU,DXS,PSYC,AMH,MEAS

 ; MHDV  - Domestic Violence

 ; MHDEP - Depression

 ; MHANX - Anxiety

 ; MHCOG - Cognitive

 ; MHSLEEP - Sleep Disorder

 ; MHAPP - Appetite

 ; MHPTSD - Post Traumatic Stress

 ; MHPSYC - Psychosocial

 ; SSEX  - Safe Sex

 ; FPLN  - Family Planning

 ; HIVED - HIV Education

 ; 

 Q

 ;

EXAM ;EP Exams

 NEW TREF,EXAM

 S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S TREF="BQITAX" K @TREF

 S EXAM=34 D

 . S IEN=$O(^AUTTEXAM("C",EXAM,"")) I IEN="" Q

 . S @TREF@(IEN)="MHDV"

 S EXAM=36 D

 . S IEN=$O(^AUTTEXAM("C",EXAM,"")) I IEN="" Q

 . S @TREF@(IEN)="MHDEP"

 S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 D EXM(.TOTPTS,.TREF)

 K @TREF

 Q

 ;

MEAS ;EP Measurements

 NEW MEAS

 S TREF="BQITAX" K @TREF

 F MEAS="PHQ2","PHQ9" D

 . S IEN=$O(^AUTTMSR("B",MEAS,"")) I IEN="" Q

 . S @TREF@(IEN)="MHDEP"

 S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 D MSR(.TOTPTS,.TREF)

 K @TREF

 Q

 ;

EDU ;EP Education

 NEW TOP,NREF

 S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S TREF="BQITAX" K @TREF

 S NREF="ARRAY" K @NREF

 F TAX="BKM SAFE SEX ED CODES" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="SSEX"

 S NREF="ARRAY" K @NREF

 F TOP="FP-","V25.01-","V25.02-","V25.03-","V25.04-","V25.09-","V26.4-" D EDTP^BQITRUTL(.NREF,TOP)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="FPLN"

 K @NREF

 F TOP="GAD-","-GAD" D EDTP^BQITRUTL(.NREF,TOP)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHANX"

 K @NREF

 F TOP="DV-","-DV" D EDTP^BQITRUTL(.NREF,TOP)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDV"

 K @NREF

 F TOP="HIV-","-HIV" D EDTP^BQITRUTL(.NREF,TOP)

 F TOP="042.-","042.0-","042.1-","042.2-","042.9-","043.0-","043.1-" D EDTP^BQITRUTL(.NREF,TOP)

 F TOP="043.2-","043.3-","043.9-","044.0-","044.9-","795.71-","V08.-" D EDTP^BQITRUTL(.NREF,TOP)

 F TOP="V65.44-" D EDTP^BQITRUTL(.NREF,TOP)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="HIVED"

 K @NREF

 F TOP="DEP-","-DEP","BH-","-BH","SB-","-SB","PDEP-","-PDEP" D EDTP^BQITRUTL(.NREF,TOP)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDEP"

 ;

 S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 D EDUC(.TOTPTS,.TREF)

 K @NREF,@TREF

 Q

 ;

DXS ;EP Diagnoses

 NEW REVPER,TREF,NREF

 S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S TREF=$NA(^TMP("BQITAX",UID)) K @TREF

 S NREF="ARRAY" K @NREF

 F TAX="BKM FAMILY PLANNING POV" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="FPLN"

 S NREF="ARRAY" K @NREF

 F TAX="BKM COGNITIVE DISORDERS DXS","BKM COGNITIVE ASSESS ICDS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHCOG"

 K @NREF

 F TAX="BGP MOOD DISORDERS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDEP"

 K @NREF

 F TAX="BKM ANXIETY DXS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHANX"

 K @NREF

 F TAX="BKM SLEEP DISORDER DXS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHSLEEP"

 K @NREF

 F TAX="BKM APPETITE ASSESS DXS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHAPP"

 K @NREF

 F TAX="BGP DV DXS","BGP IPV/DV COUNSELING ICDS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDV"

 K @NREF

 F TAX="BKM POST TX STRESS DIS DXS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHPTSD"

 K @NREF

 F TAX="BKMV HIV ED DXS" D BLD^BQITUTL(TAX,NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="HIVED"

 K @NREF

 F TAX="BQI DEPRESSION SCREEN DXS" D BLD^BQITUTL(TAX,NREF)

 ;D BLDSV^BQITUTL(80,"V79.0",NREF)

 S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDEP"

 ;

 S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 D POV(.TOTPTS,.TREF)

 K @NREF,@TREF

 ;

 ; Check SNOMED

 ;S NREF="ARRAY" K @NREF

 ;NEW SUB

 ;S SUB="PXRM HIV" D SNOM^BQITUTL(SUB,NREF)

 ;S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDEP"

 ;D SNS(.TOTPTS,.TREF)

 Q

 ;

PSYC ;EP

 NEW REVPER,TREF,TAX

 S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S TREF="BQITAX" K @TREF

 F TAX="BKM PSYCHSOC ASSESS CPTS" D BLD^BQITUTL(TAX,TREF)

 S TYP="MHPSYC"

 S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 D CPT(.TOTPTS,.TREF)

 K @TREF

 Q

 ;

MSR(GLB,TREF,REVPER) ;EP

 S REVPER=$G(REVPER,"") I REVPER="" S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S TIEN=""

 F  S TIEN=$O(@TREF@(TIEN)) Q:TIEN=""  D

 . S IEN=""

 . F  S IEN=$O(^AUPNVMSR("B",TIEN,IEN),-1) Q:IEN=""  D

 .. S PDATA=$G(^AUPNVMSR(IEN,0)) I PDATA="" Q

 .. S BKMDFN=$P(PDATA,U,2)

 .. I '$D(@GLOB@("HIVCHK",BKMDFN)) Q

 .. S VISIT=$P(PDATA,U,3) I VISIT="" Q

 .. I $P($G(^AUPNVMSR(IEN,2)),U,1)=1 Q

 .. S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q

 .. I $P(VDATA,U,11)=1 Q

 .. S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q

 .. I VSDTM<REVPER!(VSDTM>EDATE) Q

 .. S TYP=@TREF@(TIEN)

 .. S @GLB=$G(@GLB)+1

 Q

 ;

POV(GLB,TREF,REVPER) ;EP

 S REVPER=$G(REVPER,"") I REVPER="" S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . NEW TIEN,VDATA,PDATA,VISIT,VSDTM

 . S IEN=""

 . F  S IEN=$O(^AUPNVPOV("AC",BKMDFN,IEN),-1) Q:IEN=""  D

 .. S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q

 .. S TIEN=$P(PDATA,U,1) I TIEN="" Q

 .. I '$D(@TREF@(TIEN)) Q

 .. S VISIT=$P(PDATA,U,3) I VISIT="" Q

 .. S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q

 .. I $P(VDATA,U,11)=1 Q

 .. S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q

 .. I VSDTM<REVPER!(VSDTM>EDATE) Q

 .. S TYP=@TREF@(TIEN)

 .. S @GLB=$G(@GLB)+1

 Q

 ;

SNS(GLB,TREF,REVPER) ;EP - Look by SNOMED concept ID

 S REVPER=$G(REVPER,"") I REVPER="" S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . NEW TIEN,VDATA,PDATA,VISIT,VSDTM,BQCID

 . S IEN=""

 . F  S IEN=$O(^AUPNVPOV("AC",BKMDFN,IEN),-1) Q:IEN=""  D

 .. S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q

 .. S VISIT=$P(PDATA,U,3) I VISIT="" Q

 .. S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q

 .. I $P(VDATA,U,11)=1 Q

 .. S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q

 .. I VSDTM<REVPER!(VSDTM>EDATE) Q

 .. S BQCID=$P($G(^AUPNVPOV(IEN,11)),U,1) I '$D(@TREF@(BQCID)) Q

 .. S TYP=@TREF@(TIEN)

 .. S @GLB=$G(@GLB)+1

 Q

 ;

CPT(GLB,TREF) ;EP

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . NEW TIEN,VDATA,PDATA,VISIT,VSDTM

 . S IEN=""

 . F  S IEN=$O(^AUPNVCPT("AC",BKMDFN,IEN),-1) Q:IEN=""  D

 .. S PDATA=$G(^AUPNVCPT(IEN,0)) I PDATA="" Q

 .. ;S TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I") I TIEN="" Q

 .. S TIEN=$P(PDATA,U,1) I TIEN="" Q

 .. I '$D(@TREF@(TIEN)) Q

 .. S VISIT=$P(PDATA,U,3) I VISIT="" Q

 .. S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q

 .. ;S VISIT=$$GET1^DIQ(9000010.18,IEN,.03,"I") I VISIT="" Q

 .. I $P(VDATA,U,11)=1 Q

 .. ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q

 .. S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q

 .. ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q

 .. I VSDTM<REVPER!(VSDTM>EDATE) Q

 .. S @GLB=$G(@GLB)+1

 Q

 ;

EDUC(GLB,TREF) ;EP Education

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . NEW TIEN,VDATA,PDATA,VISIT,VSDTM

 . S BDT=(9999999-EDATE)-.001,EDT=9999999-REVPER

 . F  S BDT=$O(^AUPNVPED("AA",BKMDFN,BDT)) Q:BDT=""!(BDT>EDT)  D

 .. S IEN=""

 .. F  S IEN=$O(^AUPNVPED("AA",BKMDFN,BDT,IEN),-1) Q:IEN=""  D

 ... S PDATA=$G(^AUPNVPED(IEN,0)) I PDATA="" Q

 ... S TIEN=$P(PDATA,U,1) I TIEN="" Q

 ... I '$D(@TREF@(TIEN)) Q

 ... S VISIT=$P(PDATA,U,3) I VISIT="" Q

 ... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q

 ... I $P(VDATA,U,11)=1 Q

 ... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q

 ... I VSDTM<REVPER!(VSDTM>EDATE) Q

 ... S TYP=@TREF@(TIEN)

 ... S @GLB=$G(@GLB)+1

 . ; Refusals

 . NEW RFT,FIL,BDT,EDT,TIEN,IEN,TYP

 . S RFT=$O(^AUTTREFT("B","EDUCATION TOPICS","")) I RFT="" Q

 . S FIL=$P(^AUTTREFT(RFT,0),U,2)

 . S BDT=(9999999-EDATE)-.001,EDT=9999999-REVPER

 . S TIEN=""

 . F  S TIEN=$O(^AUPNPREF("AA",BKMDFN,FIL,TIEN)) Q:TIEN=""  D

 .. I '$D(@TREF@(TIEN)) Q

 .. F  S BDT=$O(^AUPNPREF("AA",BKMDFN,FIL,TIEN,BDT)) Q:BDT=""!(BDT>EDT)  D

 ... S IEN=""

 ... F  S IEN=$O(^AUPNPREF("AA",BKMDFN,FIL,TIEN,BDT,IEN)) Q:IEN=""  D

 .... S TYP=@TREF@(TIEN)

 .... S @GLB=$G(@GLB)+1

 Q

 ;

EXM(GLB,TREF) ;EP

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . NEW TIEN,VDATA,PDATA,VISIT,VSDTM

 . S IEN=""

 . F  S IEN=$O(^AUPNVXAM("AC",BKMDFN,IEN),-1) Q:IEN=""  D

 .. S PDATA=$G(^AUPNVXAM(IEN,0)) I PDATA="" Q

 .. S TIEN=$P(PDATA,U,1) I TIEN="" Q

 .. I '$D(@TREF@(TIEN)) Q

 .. S VISIT=$P(PDATA,U,3) I VISIT="" Q

 .. S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q

 .. I $P(VDATA,U,11)=1 Q

 .. S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q

 .. I VSDTM<REVPER!(VSDTM>EDATE) Q

 .. S TYP=@TREF@(TIEN)

 .. S @GLB=$G(@GLB)+1

 Q

 ;

AMH ;EP

 NEW TREF,VC,VCIEN,REVPER,RIEN

 S REVPER=$$FMADD^XLFDT(EDATE,-365)

 S TREF="AMH" K @TREF

 F VC=14,14.1,15 S VCIEN=$O(^AMHPROB("B",VC,"")) Q:VCIEN=""  S @TREF@(VCIEN)="MHDEP"

 F VC=43,43.1,43.2,43.3,43.4 S VCIEN=$O(^AMHPROB("B",VC,"")) Q:VCIEN=""  S @TREF@(VCIEN)="MHDV"

 F VC=44,44.1,44.2,44.3,44.4 S VCIEN=$O(^AMHPROB("B",VC,"")) Q:VCIEN=""  S @TREF@(VCIEN)="MHDV"

 ;

 S DATE=REVPER-.005

 F  S DATE=$O(^AMHREC("B",DATE)) Q:DATE=""!(DATE\1>EDATE)  D

 . S RIEN=""

 . F  S RIEN=$O(^AMHREC("B",DATE,RIEN)) Q:RIEN=""  D

 .. S IEN=""

 .. F  S IEN=$O(^AMHRPRO("AD",RIEN,IEN),-1) Q:IEN=""  D

 ... S VCIEN=$P(^AMHRPRO(IEN,0),U,1)

 ... I '$D(VCODE(VCIEN)) Q

 ... S DFN=$P(^AMHRPRO(IEN,0),U,2) I DFN="" Q

 ... I '$D(@GLOB@("HIVCHK",DFN)) Q

 ... S TYP=VCODE(VCIEN)

 ... S @GLB=$G(@GLB)+1

 K VCODE

 Q

BKMQQCRC  ;VNGT/HS/ALA-HIV QOC Report continued ; 12 Mar 2010  3:02 PM

 +1       ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40

 +2       ;

 +3       ; run mental health

 +4        DO EXAM

           DO EDU

           DO DXS

           DO PSYC

           DO AMH

           DO MEAS

 +5       ; MHDV  - Domestic Violence

 +6       ; MHDEP - Depression

 +7       ; MHANX - Anxiety

 +8       ; MHCOG - Cognitive

 +9       ; MHSLEEP - Sleep Disorder

 +10      ; MHAPP - Appetite

 +11      ; MHPTSD - Post Traumatic Stress

 +12      ; MHPSYC - Psychosocial

 +13      ; SSEX  - Safe Sex

 +14      ; FPLN  - Family Planning

 +15      ; HIVED - HIV Education

 +16      ; 

 +17       QUIT 

 +18      ;

EXAM      ;EP Exams

 +1        NEW TREF,EXAM

 +2        SET REVPER=$$FMADD^XLFDT(EDATE,-365)

 +3        SET TREF="BQITAX"

           KILL @TREF

 +4        SET EXAM=34

           Begin DoDot:1

 +5            SET IEN=$ORDER(^AUTTEXAM("C",EXAM,""))

               IF IEN=""

                   QUIT 

 +6            SET @TREF@(IEN)="MHDV"

           End DoDot:1

 +7        SET EXAM=36

           Begin DoDot:1

 +8            SET IEN=$ORDER(^AUTTEXAM("C",EXAM,""))

               IF IEN=""

                   QUIT 

 +9            SET @TREF@(IEN)="MHDEP"

           End DoDot:1

 +10       SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 +11       DO EXM(.TOTPTS,.TREF)

 +12       KILL @TREF

 +13       QUIT 

 +14      ;

MEAS      ;EP Measurements

 +1        NEW MEAS

 +2        SET TREF="BQITAX"

           KILL @TREF

 +3        FOR MEAS="PHQ2","PHQ9"

               Begin DoDot:1

 +4                SET IEN=$ORDER(^AUTTMSR("B",MEAS,""))

                   IF IEN=""

                       QUIT 

 +5                SET @TREF@(IEN)="MHDEP"

               End DoDot:1

 +6        SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 +7        DO MSR(.TOTPTS,.TREF)

 +8        KILL @TREF

 +9        QUIT 

 +10      ;

EDU       ;EP Education

 +1        NEW TOP,NREF

 +2        SET REVPER=$$FMADD^XLFDT(EDATE,-365)

 +3        SET TREF="BQITAX"

           KILL @TREF

 +4        SET NREF="ARRAY"

           KILL @NREF

 +5        FOR TAX="BKM SAFE SEX ED CODES"

               DO BLD^BQITUTL(TAX,NREF)

 +6        SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="SSEX"

 +7        SET NREF="ARRAY"

           KILL @NREF

 +8        FOR TOP="FP-","V25.01-","V25.02-","V25.03-","V25.04-","V25.09-","V26.4-"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +9        SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="FPLN"

 +10       KILL @NREF

 +11       FOR TOP="GAD-","-GAD"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +12       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHANX"

 +13       KILL @NREF

 +14       FOR TOP="DV-","-DV"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +15       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHDV"

 +16       KILL @NREF

 +17       FOR TOP="HIV-","-HIV"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +18       FOR TOP="042.-","042.0-","042.1-","042.2-","042.9-","043.0-","043.1-"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +19       FOR TOP="043.2-","043.3-","043.9-","044.0-","044.9-","795.71-","V08.-"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +20       FOR TOP="V65.44-"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +21       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="HIVED"

 +22       KILL @NREF

 +23       FOR TOP="DEP-","-DEP","BH-","-BH","SB-","-SB","PDEP-","-PDEP"

               DO EDTP^BQITRUTL(.NREF,TOP)

 +24       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHDEP"

 +25      ;

 +26       SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 +27       DO EDUC(.TOTPTS,.TREF)

 +28       KILL @NREF,@TREF

 +29       QUIT 

 +30      ;

DXS       ;EP Diagnoses

 +1        NEW REVPER,TREF,NREF

 +2        SET REVPER=$$FMADD^XLFDT(EDATE,-365)

 +3        SET TREF=$NAME(^TMP("BQITAX",UID))

           KILL @TREF

 +4        SET NREF="ARRAY"

           KILL @NREF

 +5        FOR TAX="BKM FAMILY PLANNING POV"

               DO BLD^BQITUTL(TAX,NREF)

 +6        SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="FPLN"

 +7        SET NREF="ARRAY"

           KILL @NREF

 +8        FOR TAX="BKM COGNITIVE DISORDERS DXS","BKM COGNITIVE ASSESS ICDS"

               DO BLD^BQITUTL(TAX,NREF)

 +9        SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHCOG"

 +10       KILL @NREF

 +11       FOR TAX="BGP MOOD DISORDERS"

               DO BLD^BQITUTL(TAX,NREF)

 +12       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHDEP"

 +13       KILL @NREF

 +14       FOR TAX="BKM ANXIETY DXS"

               DO BLD^BQITUTL(TAX,NREF)

 +15       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHANX"

 +16       KILL @NREF

 +17       FOR TAX="BKM SLEEP DISORDER DXS"

               DO BLD^BQITUTL(TAX,NREF)

 +18       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHSLEEP"

 +19       KILL @NREF

 +20       FOR TAX="BKM APPETITE ASSESS DXS"

               DO BLD^BQITUTL(TAX,NREF)

 +21       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHAPP"

 +22       KILL @NREF

 +23       FOR TAX="BGP DV DXS","BGP IPV/DV COUNSELING ICDS"

               DO BLD^BQITUTL(TAX,NREF)

 +24       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHDV"

 +25       KILL @NREF

 +26       FOR TAX="BKM POST TX STRESS DIS DXS"

               DO BLD^BQITUTL(TAX,NREF)

 +27       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHPTSD"

 +28       KILL @NREF

 +29       FOR TAX="BKMV HIV ED DXS"

               DO BLD^BQITUTL(TAX,NREF)

 +30       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="HIVED"

 +31       KILL @NREF

 +32       FOR TAX="BQI DEPRESSION SCREEN DXS"

               DO BLD^BQITUTL(TAX,NREF)

 +33      ;D BLDSV^BQITUTL(80,"V79.0",NREF)

 +34       SET IEN=""

           FOR 

               SET IEN=$ORDER(@NREF@(IEN))

               IF IEN=""

                   QUIT 

               SET @TREF@(IEN)="MHDEP"

 +35      ;

 +36       SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 +37       DO POV(.TOTPTS,.TREF)

 +38       KILL @NREF,@TREF

 +39      ;

 +40      ; Check SNOMED

 +41      ;S NREF="ARRAY" K @NREF

 +42      ;NEW SUB

 +43      ;S SUB="PXRM HIV" D SNOM^BQITUTL(SUB,NREF)

 +44      ;S IEN="" F  S IEN=$O(@NREF@(IEN)) Q:IEN=""  S @TREF@(IEN)="MHDEP"

 +45      ;D SNS(.TOTPTS,.TREF)

 +46       QUIT 

 +47      ;

PSYC      ;EP

 +1        NEW REVPER,TREF,TAX

 +2        SET REVPER=$$FMADD^XLFDT(EDATE,-365)

 +3        SET TREF="BQITAX"

           KILL @TREF

 +4        FOR TAX="BKM PSYCHSOC ASSESS CPTS"

               DO BLD^BQITUTL(TAX,TREF)

 +5        SET TYP="MHPSYC"

 +6        SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""MH"",BKMDFN,TYP)"

 +7        DO CPT(.TOTPTS,.TREF)

 +8        KILL @TREF

 +9        QUIT 

 +10      ;

MSR(GLB,TREF,REVPER) ;EP

 +1        SET REVPER=$GET(REVPER,"")

           IF REVPER=""

               SET REVPER=$$FMADD^XLFDT(EDATE,-365)

 +2        SET TIEN=""

 +3        FOR 

               SET TIEN=$ORDER(@TREF@(TIEN))

               IF TIEN=""

                   QUIT 

               Begin DoDot:1

 +4                SET IEN=""

 +5                FOR 

                       SET IEN=$ORDER(^AUPNVMSR("B",TIEN,IEN),-1)

                       IF IEN=""

                           QUIT 

                       Begin DoDot:2

 +6                        SET PDATA=$GET(^AUPNVMSR(IEN,0))

                           IF PDATA=""

                               QUIT 

 +7                        SET BKMDFN=$PIECE(PDATA,U,2)

 +8                        IF '$DATA(@GLOB@("HIVCHK",BKMDFN))

                               QUIT 

 +9                        SET VISIT=$PIECE(PDATA,U,3)

                           IF VISIT=""

                               QUIT 

 +10                       IF $PIECE($GET(^AUPNVMSR(IEN,2)),U,1)=1

                               QUIT 

 +11                       SET VDATA=$GET(^AUPNVSIT(VISIT,0))

                           IF VDATA=""

                               QUIT 

 +12                       IF $PIECE(VDATA,U,11)=1

                               QUIT 

 +13                       SET VSDTM=$PIECE(VDATA,U,1)\1

                           IF VSDTM=0

                               QUIT 

 +14                       IF VSDTM<REVPER!(VSDTM>EDATE)

                               QUIT 

 +15                       SET TYP=@TREF@(TIEN)

 +16                       SET @GLB=$GET(@GLB)+1

                       End DoDot:2

               End DoDot:1

 +17       QUIT 

 +18      ;

POV(GLB,TREF,REVPER) ;EP

 +1        SET REVPER=$GET(REVPER,"")

           IF REVPER=""

               SET REVPER=$$FMADD^XLFDT(EDATE,-365)

 +2        SET BKMDFN=0

 +3        FOR 

               SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))

               IF 'BKMDFN

                   QUIT 

               Begin DoDot:1

 +4                NEW TIEN,VDATA,PDATA,VISIT,VSDTM

 +5                SET IEN=""

 +6                FOR 

                       SET IEN=$ORDER(^AUPNVPOV("AC",BKMDFN,IEN),-1)

                       IF IEN=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET PDATA=$GET(^AUPNVPOV(IEN,0))

                           IF PDATA=""

                               QUIT 

 +8                        SET TIEN=$PIECE(PDATA,U,1)

                           IF TIEN=""

                               QUIT 

 +9                        IF '$DATA(@TREF@(TIEN))

                               QUIT 

 +10                       SET VISIT=$PIECE(PDATA,U,3)

                           IF VISIT=""

                               QUIT 

 +11                       SET VDATA=$GET(^AUPNVSIT(VISIT,0))

                           IF VDATA=""

                               QUIT 

 +12                       IF $PIECE(VDATA,U,11)=1