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
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 ;
SNS(GLB,TREF,REVPER) ;EP - Look by SNOMED concept ID
+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,BQCID
+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 VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+9 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+10 IF $PIECE(VDATA,U,11)=1
QUIT
+11 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+12 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+13 SET BQCID=$PIECE($GET(^AUPNVPOV(IEN,11)),U,1)
IF '$DATA(@TREF@(BQCID))
QUIT
+14 SET TYP=@TREF@(TIEN)
+15 SET @GLB=$GET(@GLB)+1
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
CPT(GLB,TREF) ;EP
+1 SET BKMDFN=0
+2 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+3 NEW TIEN,VDATA,PDATA,VISIT,VSDTM
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(^AUPNVCPT("AC",BKMDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+6 SET PDATA=$GET(^AUPNVCPT(IEN,0))
IF PDATA=""
QUIT
+7 ;S TIEN=$$GET1^DIQ(9000010.18,IEN,.01,"I") I TIEN="" Q
+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 ;S VISIT=$$GET1^DIQ(9000010.18,IEN,.03,"I") I VISIT="" Q
+13 IF $PIECE(VDATA,U,11)=1
QUIT
+14 ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
+15 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+16 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
+17 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+18 SET @GLB=$GET(@GLB)+1
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
EDUC(GLB,TREF) ;EP Education
+1 SET BKMDFN=0
+2 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+3 NEW TIEN,VDATA,PDATA,VISIT,VSDTM
+4 SET BDT=(9999999-EDATE)-.001
SET EDT=9999999-REVPER
+5 FOR
SET BDT=$ORDER(^AUPNVPED("AA",BKMDFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:2
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^AUPNVPED("AA",BKMDFN,BDT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+8 SET PDATA=$GET(^AUPNVPED(IEN,0))
IF PDATA=""
QUIT
+9 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+10 IF '$DATA(@TREF@(TIEN))
QUIT
+11 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+12 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+13 IF $PIECE(VDATA,U,11)=1
QUIT
+14 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+15 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+16 SET TYP=@TREF@(TIEN)
+17 SET @GLB=$GET(@GLB)+1
End DoDot:3
End DoDot:2
+18 ; Refusals
+19 NEW RFT,FIL,BDT,EDT,TIEN,IEN,TYP
+20 SET RFT=$ORDER(^AUTTREFT("B","EDUCATION TOPICS",""))
IF RFT=""
QUIT
+21 SET FIL=$PIECE(^AUTTREFT(RFT,0),U,2)
+22 SET BDT=(9999999-EDATE)-.001
SET EDT=9999999-REVPER
+23 SET TIEN=""
+24 FOR
SET TIEN=$ORDER(^AUPNPREF("AA",BKMDFN,FIL,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+25 IF '$DATA(@TREF@(TIEN))
QUIT
+26 FOR
SET BDT=$ORDER(^AUPNPREF("AA",BKMDFN,FIL,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+27 SET IEN=""
+28 FOR
SET IEN=$ORDER(^AUPNPREF("AA",BKMDFN,FIL,TIEN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+29 SET TYP=@TREF@(TIEN)
+30 SET @GLB=$GET(@GLB)+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
EXM(GLB,TREF) ;EP
+1 SET BKMDFN=0
+2 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+3 NEW TIEN,VDATA,PDATA,VISIT,VSDTM
+4 SET IEN=""
+5 FOR
SET IEN=$ORDER(^AUPNVXAM("AC",BKMDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+6 SET PDATA=$GET(^AUPNVXAM(IEN,0))
IF PDATA=""
QUIT
+7 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+8 IF '$DATA(@TREF@(TIEN))
QUIT
+9 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+10 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+11 IF $PIECE(VDATA,U,11)=1
QUIT
+12 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+13 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+14 SET TYP=@TREF@(TIEN)
+15 SET @GLB=$GET(@GLB)+1
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
AMH ;EP
+1 NEW TREF,VC,VCIEN,REVPER,RIEN
+2 SET REVPER=$$FMADD^XLFDT(EDATE,-365)
+3 SET TREF="AMH"
KILL @TREF
+4 FOR VC=14,14.1,15
SET VCIEN=$ORDER(^AMHPROB("B",VC,""))
IF VCIEN=""
QUIT
SET @TREF@(VCIEN)="MHDEP"
+5 FOR VC=43,43.1,43.2,43.3,43.4
SET VCIEN=$ORDER(^AMHPROB("B",VC,""))
IF VCIEN=""
QUIT
SET @TREF@(VCIEN)="MHDV"
+6 FOR VC=44,44.1,44.2,44.3,44.4
SET VCIEN=$ORDER(^AMHPROB("B",VC,""))
IF VCIEN=""
QUIT
SET @TREF@(VCIEN)="MHDV"
+7 ;
+8 SET DATE=REVPER-.005
+9 FOR
SET DATE=$ORDER(^AMHREC("B",DATE))
IF DATE=""!(DATE\1>EDATE)
QUIT
Begin DoDot:1
+10 SET RIEN=""
+11 FOR
SET RIEN=$ORDER(^AMHREC("B",DATE,RIEN))
IF RIEN=""
QUIT
Begin DoDot:2
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(^AMHRPRO("AD",RIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+14 SET VCIEN=$PIECE(^AMHRPRO(IEN,0),U,1)
+15 IF '$DATA(VCODE(VCIEN))
QUIT
+16 SET DFN=$PIECE(^AMHRPRO(IEN,0),U,2)
IF DFN=""
QUIT
+17 IF '$DATA(@GLOB@("HIVCHK",DFN))
QUIT
+18 SET TYP=VCODE(VCIEN)
+19 SET @GLB=$GET(@GLB)+1
End DoDot:3
End DoDot:2
End DoDot:1
+20 KILL VCODE
+21 QUIT
