BKMQQCRB ;VNGT/HS/ALA - Updates to HIVQual Report ; 10 Mar 2010 6:06 PM
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
;
EN ;
D VIS,LAB
Q
;
VIS ; Visit breakdown by every 4 and 6 months
NEW TREF,TAX,TOTPTS,TOTPTS1,BKMDFN,IEN,TOTVIS,TOTVIS1,RVRSE,RVRSB,PR,LBDT
NEW TOTCD4,TOTCD41,TOTVIR,TOTVIR1,TOTBTH,TOTBTH1,GLOBNO,TOTLCD,TOTLVR
NEW REVPER,P1B,P1E,HP1B,HP1E,P2B,P2E,HP2B,HP2E,P3B,P3E,HP3B,HP3E,VIS
NEW P61B,P61E,HP61B,HP61E,P62B,P62E,HP62B,HP62E,HVSDTM,VLBC4,VLBVR,VCPC4,VCPVR
NEW P1,P2,P3,P61,P62,LC1,LV1,LC2,LV2,LC3,LV3,LB1,LB2,LB3,LBC1,LBV1,LBC2,LBV2,LBB1,LBB2
;
S TREF="BQITAX" K @TREF
S TAX="BGP HIV/AIDS DXS"
D BLD^BQITUTL(TAX,TREF)
D DTR^BKMQQCRU(EDATE)
S RVRSE=9999999-EDATE,RVRSB=9999999-REVPER
;
; Total patients who had visit every 4 months
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""V4MPTCNT"")"
; Total patients who had visit every 6 months
S TOTPTS1=$P(GLOB,")")_",""HIVCHK"",""V6MPTCNT"")"
; Total number of visits for the patients who had a visit every 4 months
S TOTVIS=$P(GLOB,")")_",""HIVCHK"",""V4MVSCNT"")"
; Total number of visits for the patients who had a visit every 6 months
S TOTVIS1=$P(GLOB,")")_",""HIVCHK"",""V6MVSCNT"")"
S @TOTPTS=0,@TOTPTS1=0,@TOTVIS=0,@TOTVIS1=0
;
S TOTCD4=$P(GLOB,")")_",""HIVCHK"",""CD4MPTCNT"")"
S TOTCD41=$P(GLOB,")")_",""HIVCHK"",""CD6MPTCNT"")"
S TOTVIR=$P(GLOB,")")_",""HIVCHK"",""VR4MPTCNT"")"
S TOTVIR1=$P(GLOB,")")_",""HIVCHK"",""VR6MPTCNT"")"
S TOTBTH=$P(GLOB,")")_",""HIVCHK"",""BTH4MPTCNT"")"
S TOTBTH1=$P(GLOB,")")_",""HIVCHK"",""BTH6MPTCNT"")"
S TOTLVR=$P(GLOB,")")_",""HIVCHK"",""LVR4MPTCNT"")"
S TOTLCD=$P(GLOB,")")_",""HIVCHK"",""LCD4MPTCNT"")"
S (@TOTCD4,@TOTCD41,@TOTVIR,@TOTVIR1,@TOTBTH,@TOTBTH1,@TOTLVR,@TOTLCD)=0
;
; Build taxonomy list of items
D TAX
;
S BKMDFN=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
. S GLOBNO=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""NOVIRAL"")",@GLOBNO=0
. NEW TIEN,VDATA,PDATA,VISIT,VSDTM,XX,XVIR,XCD4
. S IEN=""
. S (P1,P2,P3,P61,P62,LC1,LV1,LC2,LV2,LC3,LV3,LB1,LB2,LB3,LBC1,LBV1,LBC2,LBV2,LBB1,LBB2)=0
. S LBDT=RVRSE-.001
. F S LBDT=$O(^AUPNVSIT("AA",BKMDFN,LBDT)) Q:LBDT=""!(LBDT\1>RVRSB) D
.. S IEN=""
.. F S IEN=$O(^AUPNVSIT("AA",BKMDFN,LBDT,IEN),-1) Q:IEN="" D
... S VISIT=IEN
... 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 HVSDTM=$$FMTH^XLFDT(VSDTM,1)
... ; Check for most recent quarterly period or Period 1
... I HVSDTM'>HP1B,HVSDTM'<HP1E D
.... D LBVS(VISIT)
.... I VLBC4'=0!(VCPC4'=0) S XX("P1","C")=$G(XX("P1","C"))+1,@TOTLCD=@TOTLCD+1
.... I VLBVR'=0!(VCPVR'=0) S XX("P1","V")=$G(XX("P1","V"))+1,@TOTLVR=@TOTLVR+1
.... ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LB1=LB1+1
.... I VIS'=0 S P1=$G(P1)+1
... ; Check for middle quarterly period or Period 2
... I HVSDTM'>HP2B,HVSDTM'<HP2E D
.... D LBVS(VISIT)
.... I VLBC4'=0!(VCPC4'=0) S XX("P2","C")=$G(XX("P2","C"))+1
.... I VLBVR'=0!(VCPVR'=0) S XX("P2","V")=$G(XX("P2","V"))+1
.... ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LB2=LB2+1
.... I VIS'=0 S P2=$G(P2)+1
... ; Check for last quarterly period or Period 3
... I HVSDTM'>HP3B,HVSDTM'<HP3E D
.... D LBVS(VISIT)
.... I VLBC4'=0!(VCPC4'=0) S XX("P3","C")=$G(XX("P3","C"))+1
.... I VLBVR'=0!(VCPVR'=0) S XX("P3","V")=$G(XX("P3","V"))+1
.... ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LB3=LB3+1
.... I VIS'=0 S P3=$G(P3)+1
... ; Check for most recent six month period
... I HVSDTM'>HP61B,HVSDTM'<HP61E D
.... D LBVS(VISIT)
.... I VLBC4'=0!(VCPC4'=0) S XX("P61","C")=$G(XX("P61","C"))+1
.... I VLBVR'=0!(VCPVR'=0) S XX("P61","V")=$G(XX("P61","V"))+1,@GLOBNO=@GLOBNO+1
.... ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LBB1=LBB1+1
.... ;I VLBVR=0,VCPVR=0 S @GLOBNO=@GLOBNO+1
.... I VIS'=0 S P61=$G(P61)+1
... ; Check for previous six month period
... I HVSDTM'>HP62B,HVSDTM'<HP62E D
.... D LBVS(VISIT)
.... I VLBC4'=0!(VCPC4'=0) S XX("P62","C")=$G(XX("P62","C"))+1
.... I VLBVR'=0!(VCPVR'=0) S XX("P62","V")=$G(XX("P62","V"))+1
.... ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LBB2=LBB2+1
.... I VIS'=0 S P62=$G(P62)+1
. I P1'=0,P2'=0,P3'=0 D
.. NEW XCD4,XVIR
.. S @TOTPTS=@TOTPTS+1
.. S XCD4=0 F PR="P1","P2","P3" I +$G(XX(PR,"C"))'=0 S XCD4=XCD4+1
.. S XVIR=0 F PR="P1","P2","P3" I +$G(XX(PR,"V"))'=0 S XVIR=XVIR+1
.. I XCD4>2,XVIR=0 S @TOTCD4=@TOTCD4+1
.. I XCD4=0,XVIR>2 S @TOTVIR=@TOTVIR+1
.. I XCD4'=0,XVIR'=0,XCD4'<3,XVIR'<3 S @TOTBTH=@TOTBTH+1
. I P61'=0,P62'=0 D
.. S @TOTPTS1=@TOTPTS1+1
.. S XCD4=0 F PR="P61","P62" I +$G(XX(PR,"C"))'=0 S XCD4=XCD4+1
.. S XVIR=0 F PR="P61","P62" I +$G(XX(PR,"V"))'=0 S XVIR=XVIR+1
.. I XCD4>1,XVIR=0 S @TOTCD41=@TOTCD41+1
.. I XCD4=0,XVIR>1 S @TOTVIR1=@TOTVIR1+1
.. I XCD4'=0,XVIR'=0,XCD4'<2,XVIR'<2 S @TOTBTH1=@TOTBTH1+1
. K XX
K BQITAX
Q
;
LAB ; CD4 and Viral Load break down by every 4 and 6 months
NEW REVPER,P1B,P1E,HP1B,HP1E,P2B,P2E,HP2B,HP2E,P3B,P3E,HP3B,HP3E
NEW TAX,IEN,CD4,VIRAL,RVRSE,RVRSB,LBDT,QFL,RESULT,CCPT,CD4,VCPT,VIRAL
NEW P61B,P61E,HP61B,HP61E,P62B,P62E,HP62B,HP62E,HVSDTM,GLOBVN,GLOBVS
NEW CCPT,VCPT,GLOBAL,GLOBAL1,PTGLOB,PTGLOB1,PTGLOB2,GLOBC1,GLOBC2,GLOBC3,GLOBC4
NEW PC1,PC2,PC3,PC61,PC62,PTGLOB3,PTGLOB4,PTLAB1,PTLAB2,PV1,PV2,PV3,PV61,PV62
NEW PTLABC,PTLABV
;
; Build taxonomy list of items
D TAX
;
; Get Dates of performance
D DTR^BKMQQCRU(EDATE\1)
S RVRSE=9999999-(EDATE\1),RVRSB=9999999-(REVPER\1)
;
; CD4RES1 = CD4 Result 0-199
; CD4RES2 = CD4 Result 200-349
; CD4RES3 = CD4 Result 350-499
; CD4RES4 = CD4 Result >500
S GLOBC1=$P(GLOB,")")_",""HIVCHK"",""CD4RES1"")"
S PTGLOB1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES1"")"
S GLOBC2=$P(GLOB,")")_",""HIVCHK"",""CD4RES2"")"
S PTGLOB2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES2"")"
S GLOBC3=$P(GLOB,")")_",""HIVCHK"",""CD4RES3"")"
S PTGLOB3=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES3"")"
S GLOBC4=$P(GLOB,")")_",""HIVCHK"",""CD4RES4"")"
S PTGLOB4=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES4"")"
;S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRALCNT"")"
;S PTGLOB2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRAL"")"
S PTLAB1=$P(GLOB,")")_",""ZLAB"",BKMDFN,""VIRAL"",VSDTM)"
S PTLABV=$P(GLOB,")")_",""ZLAB"",BKMDFN,""VIRAL"")"
S PTLAB2=$P(GLOB,")")_",""ZLAB"",BKMDFN,""CD4"",VSDTM)"
S PTLABC=$P(GLOB,")")_",""ZLAB"",BKMDFN,""CD4"")"
S GLOBVS=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRALSUP"")"
S GLOBVN=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRALNSU"")"
S (@GLOBC1,@GLOBC2,@GLOBC3,@GLOBC4)=0
;
S BKMDFN=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
. NEW TIEN,VDATA,PDATA,VISIT,VSDTM,COLDTM
. S LBDT=RVRSE-.001
. F S LBDT=$O(^AUPNVLAB("AE",BKMDFN,LBDT)) Q:LBDT=""!(LBDT\1>RVRSB) D
.. S TIEN=""
.. F S TIEN=$O(^AUPNVLAB("AE",BKMDFN,LBDT,TIEN)) Q:TIEN="" D
... I '$D(@CD4@(TIEN)),'$D(@VIRAL@(TIEN)) Q
... S IEN="",QFL=0
... F S IEN=$O(^AUPNVLAB("AE",BKMDFN,LBDT,TIEN,IEN),-1) Q:IEN="" D
.... S PDATA=$G(^AUPNVLAB(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
.... ; Get collection date/time
.... S COLDTM=$P($G(^AUPNVLAB(IEN,12)),U,1)\1
.... I COLDTM'=0 S VSDTM=COLDTM
.... S HVSDTM=$$FMTH^XLFDT(VSDTM,1)
.... I VSDTM<REVPER!(VSDTM>EDATE) Q
.... S RESULT=$P(PDATA,U,4)
.... I RESULT'="" D
..... I $D(@CD4@(TIEN)) D
...... S @PTLAB2=RESULT
..... I $D(@VIRAL@(TIEN)) D
...... NEW OPER,VRLRES,RES
...... I RESULT=""!(RESULT?.A) Q
...... S @PTLAB1=RESULT
. ;
. S VSDTM=$O(@PTLABC@(""),-1)
. I VSDTM'="" D
.. S RESULT=@PTLABC@(VSDTM)
.. I RESULT<200 S @PTGLOB1=$G(@PTGLOB1)+1,@GLOBC1=@GLOBC1+1 Q
.. I RESULT>199,RESULT<350 S @PTGLOB2=$G(@PTGLOB2)+1,@GLOBC2=@GLOBC2+1 Q
.. I RESULT>349,RESULT<500 S @PTGLOB3=$G(@PTGLOB3)+1,@GLOBC3=@GLOBC3+1 Q
.. I RESULT>499 S @PTGLOB4=$G(@PTGLOB4)+1,@GLOBC4=@GLOBC4+1 Q
. ;
. S VSDTM=$O(@PTLABV@(""),-1)
. I VSDTM'="" D
.. S RESULT=@PTLABV@(VSDTM)
.. I RESULT="<400" S @GLOBVS=RESULT,QFL=1 Q
.. S OPER=$S($E(RESULT,1)="<":"<",$E(RESULT,1)=">":">",1:"")
.. S VRLRES=$S($E(RESULT,1)?.P:$E(RESULT,2,99),1:RESULT)
.. S RES=400
.. I OPER="" S OPER="<"
.. I @(VRLRES_OPER_RES) S @GLOBVS=RESULT Q
.. S OPER="'<"
.. I @(VRLRES_OPER_RES) S @GLOBVN=RESULT Q
;
K @VCPT,@CD4,@VIRAL,@CCPT
Q
;
TAX ;EP - Build taxonomy item lists
S CD4="BKMCD4" K @CD4
F TAX="BKMV CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES" D BLD^BQITUTL(TAX,CD4)
S CCPT="BKMCCPT" K @CCPT
F TAX="BKMV CD4 ABS CPTS" D BLD^BQITUTL(TAX,CCPT)
S VIRAL="BKMVIR" K @VIRAL
F TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,VIRAL)
S VCPT="BKMVCPT" K @VCPT
F TAX="BGP HIV VIRAL LOAD CPTS" D BLD^BQITUTL(TAX,VCPT)
Q
;
LBVS(VIEN) ;EP - Find labs for a specific visit
NEW IEN,PDATA,TIEN
S VLBC4=0,VLBVR=0,VCPC4=0,VCPVR=0,VIS=0
S IEN=""
F S IEN=$O(^AUPNVLAB("AD",VIEN,IEN)) Q:IEN="" D
. S PDATA=$G(^AUPNVLAB(IEN,0)) I PDATA="" Q
. S TIEN=$P(PDATA,U,1) I TIEN="" Q
. I '$D(@CD4@(TIEN)),'$D(@VIRAL@(TIEN)) Q
. I $D(@CD4@(TIEN)) S VLBC4=VLBC4+1
. I $D(@VIRAL@(TIEN)) S VLBVR=VLBVR+1
;
S IEN=""
F S IEN=$O(^AUPNVCPT("AD",VIEN,IEN)) Q:IEN="" D
. S PDATA=$G(^AUPNVCPT(IEN,0)) I PDATA="" Q
. S TIEN=$P(PDATA,U,1) I TIEN="" Q
. I '$D(@CCPT@(TIEN)),'$D(@VCPT@(TIEN)) Q
. I $D(@CCPT@(TIEN)) S VCPC4=VCPC4+1
. I $D(@VCPT@(TIEN)) S VCPVR=VCPVR+1
;
S IEN=""
F S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) 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 VIS=VIS+1
Q
BKMQQCRB ;VNGT/HS/ALA - Updates to HIVQual Report ; 10 Mar 2010 6:06 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
+2 ;
EN ;
+1 DO VIS
DO LAB
+2 QUIT
+3 ;
VIS ; Visit breakdown by every 4 and 6 months
+1 NEW TREF,TAX,TOTPTS,TOTPTS1,BKMDFN,IEN,TOTVIS,TOTVIS1,RVRSE,RVRSB,PR,LBDT
+2 NEW TOTCD4,TOTCD41,TOTVIR,TOTVIR1,TOTBTH,TOTBTH1,GLOBNO,TOTLCD,TOTLVR
+3 NEW REVPER,P1B,P1E,HP1B,HP1E,P2B,P2E,HP2B,HP2E,P3B,P3E,HP3B,HP3E,VIS
+4 NEW P61B,P61E,HP61B,HP61E,P62B,P62E,HP62B,HP62E,HVSDTM,VLBC4,VLBVR,VCPC4,VCPVR
+5 NEW P1,P2,P3,P61,P62,LC1,LV1,LC2,LV2,LC3,LV3,LB1,LB2,LB3,LBC1,LBV1,LBC2,LBV2,LBB1,LBB2
+6 ;
+7 SET TREF="BQITAX"
KILL @TREF
+8 SET TAX="BGP HIV/AIDS DXS"
+9 DO BLD^BQITUTL(TAX,TREF)
+10 DO DTR^BKMQQCRU(EDATE)
+11 SET RVRSE=9999999-EDATE
SET RVRSB=9999999-REVPER
+12 ;
+13 ; Total patients who had visit every 4 months
+14 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""V4MPTCNT"")"
+15 ; Total patients who had visit every 6 months
+16 SET TOTPTS1=$PIECE(GLOB,")")_",""HIVCHK"",""V6MPTCNT"")"
+17 ; Total number of visits for the patients who had a visit every 4 months
+18 SET TOTVIS=$PIECE(GLOB,")")_",""HIVCHK"",""V4MVSCNT"")"
+19 ; Total number of visits for the patients who had a visit every 6 months
+20 SET TOTVIS1=$PIECE(GLOB,")")_",""HIVCHK"",""V6MVSCNT"")"
+21 SET @TOTPTS=0
SET @TOTPTS1=0
SET @TOTVIS=0
SET @TOTVIS1=0
+22 ;
+23 SET TOTCD4=$PIECE(GLOB,")")_",""HIVCHK"",""CD4MPTCNT"")"
+24 SET TOTCD41=$PIECE(GLOB,")")_",""HIVCHK"",""CD6MPTCNT"")"
+25 SET TOTVIR=$PIECE(GLOB,")")_",""HIVCHK"",""VR4MPTCNT"")"
+26 SET TOTVIR1=$PIECE(GLOB,")")_",""HIVCHK"",""VR6MPTCNT"")"
+27 SET TOTBTH=$PIECE(GLOB,")")_",""HIVCHK"",""BTH4MPTCNT"")"
+28 SET TOTBTH1=$PIECE(GLOB,")")_",""HIVCHK"",""BTH6MPTCNT"")"
+29 SET TOTLVR=$PIECE(GLOB,")")_",""HIVCHK"",""LVR4MPTCNT"")"
+30 SET TOTLCD=$PIECE(GLOB,")")_",""HIVCHK"",""LCD4MPTCNT"")"
+31 SET (@TOTCD4,@TOTCD41,@TOTVIR,@TOTVIR1,@TOTBTH,@TOTBTH1,@TOTLVR,@TOTLCD)=0
+32 ;
+33 ; Build taxonomy list of items
+34 DO TAX
+35 ;
+36 SET BKMDFN=0
+37 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+38 SET GLOBNO=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""NOVIRAL"")"
SET @GLOBNO=0
+39 NEW TIEN,VDATA,PDATA,VISIT,VSDTM,XX,XVIR,XCD4
+40 SET IEN=""
+41 SET (P1,P2,P3,P61,P62,LC1,LV1,LC2,LV2,LC3,LV3,LB1,LB2,LB3,LBC1,LBV1,LBC2,LBV2,LBB1,LBB2)=0
+42 SET LBDT=RVRSE-.001
+43 FOR
SET LBDT=$ORDER(^AUPNVSIT("AA",BKMDFN,LBDT))
IF LBDT=""!(LBDT\1>RVRSB)
QUIT
Begin DoDot:2
+44 SET IEN=""
+45 FOR
SET IEN=$ORDER(^AUPNVSIT("AA",BKMDFN,LBDT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+46 SET VISIT=IEN
+47 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+48 IF $PIECE(VDATA,U,11)=1
QUIT
+49 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+50 ;I VSDTM<REVPER!(VSDTM>EDATE) Q
+51 SET HVSDTM=$$FMTH^XLFDT(VSDTM,1)
+52 ; Check for most recent quarterly period or Period 1
+53 IF HVSDTM'>HP1B
IF HVSDTM'<HP1E
Begin DoDot:4
+54 DO LBVS(VISIT)
+55 IF VLBC4'=0!(VCPC4'=0)
SET XX("P1","C")=$GET(XX("P1","C"))+1
SET @TOTLCD=@TOTLCD+1
+56 IF VLBVR'=0!(VCPVR'=0)
SET XX("P1","V")=$GET(XX("P1","V"))+1
SET @TOTLVR=@TOTLVR+1
+57 ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LB1=LB1+1
+58 IF VIS'=0
SET P1=$GET(P1)+1
End DoDot:4
+59 ; Check for middle quarterly period or Period 2
+60 IF HVSDTM'>HP2B
IF HVSDTM'<HP2E
Begin DoDot:4
+61 DO LBVS(VISIT)
+62 IF VLBC4'=0!(VCPC4'=0)
SET XX("P2","C")=$GET(XX("P2","C"))+1
+63 IF VLBVR'=0!(VCPVR'=0)
SET XX("P2","V")=$GET(XX("P2","V"))+1
+64 ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LB2=LB2+1
+65 IF VIS'=0
SET P2=$GET(P2)+1
End DoDot:4
+66 ; Check for last quarterly period or Period 3
+67 IF HVSDTM'>HP3B
IF HVSDTM'<HP3E
Begin DoDot:4
+68 DO LBVS(VISIT)
+69 IF VLBC4'=0!(VCPC4'=0)
SET XX("P3","C")=$GET(XX("P3","C"))+1
+70 IF VLBVR'=0!(VCPVR'=0)
SET XX("P3","V")=$GET(XX("P3","V"))+1
+71 ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LB3=LB3+1
+72 IF VIS'=0
SET P3=$GET(P3)+1
End DoDot:4
+73 ; Check for most recent six month period
+74 IF HVSDTM'>HP61B
IF HVSDTM'<HP61E
Begin DoDot:4
+75 DO LBVS(VISIT)
+76 IF VLBC4'=0!(VCPC4'=0)
SET XX("P61","C")=$GET(XX("P61","C"))+1
+77 IF VLBVR'=0!(VCPVR'=0)
SET XX("P61","V")=$GET(XX("P61","V"))+1
SET @GLOBNO=@GLOBNO+1
+78 ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LBB1=LBB1+1
+79 ;I VLBVR=0,VCPVR=0 S @GLOBNO=@GLOBNO+1
+80 IF VIS'=0
SET P61=$GET(P61)+1
End DoDot:4
+81 ; Check for previous six month period
+82 IF HVSDTM'>HP62B
IF HVSDTM'<HP62E
Begin DoDot:4
+83 DO LBVS(VISIT)
+84 IF VLBC4'=0!(VCPC4'=0)
SET XX("P62","C")=$GET(XX("P62","C"))+1
+85 IF VLBVR'=0!(VCPVR'=0)
SET XX("P62","V")=$GET(XX("P62","V"))+1
+86 ;I VLBC4'=0!(VCPC4'=0),VLBVR'=0!(VCPVR'=0) S LBB2=LBB2+1
+87 IF VIS'=0
SET P62=$GET(P62)+1
End DoDot:4
End DoDot:3
End DoDot:2
+88 IF P1'=0
IF P2'=0
IF P3'=0
Begin DoDot:2
+89 NEW XCD4,XVIR
+90 SET @TOTPTS=@TOTPTS+1
+91 SET XCD4=0
FOR PR="P1","P2","P3"
IF +$GET(XX(PR,"C"))'=0
SET XCD4=XCD4+1
+92 SET XVIR=0
FOR PR="P1","P2","P3"
IF +$GET(XX(PR,"V"))'=0
SET XVIR=XVIR+1
+93 IF XCD4>2
IF XVIR=0
SET @TOTCD4=@TOTCD4+1
+94 IF XCD4=0
IF XVIR>2
SET @TOTVIR=@TOTVIR+1
+95 IF XCD4'=0
IF XVIR'=0
IF XCD4'<3
IF XVIR'<3
SET @TOTBTH=@TOTBTH+1
End DoDot:2
+96 IF P61'=0
IF P62'=0
Begin DoDot:2
+97 SET @TOTPTS1=@TOTPTS1+1
+98 SET XCD4=0
FOR PR="P61","P62"
IF +$GET(XX(PR,"C"))'=0
SET XCD4=XCD4+1
+99 SET XVIR=0
FOR PR="P61","P62"
IF +$GET(XX(PR,"V"))'=0
SET XVIR=XVIR+1
+100 IF XCD4>1
IF XVIR=0
SET @TOTCD41=@TOTCD41+1
+101 IF XCD4=0
IF XVIR>1
SET @TOTVIR1=@TOTVIR1+1
+102 IF XCD4'=0
IF XVIR'=0
IF XCD4'<2
IF XVIR'<2
SET @TOTBTH1=@TOTBTH1+1
End DoDot:2
+103 KILL XX
End DoDot:1
+104 KILL BQITAX
+105 QUIT
+106 ;
LAB ; CD4 and Viral Load break down by every 4 and 6 months
+1 NEW REVPER,P1B,P1E,HP1B,HP1E,P2B,P2E,HP2B,HP2E,P3B,P3E,HP3B,HP3E
+2 NEW TAX,IEN,CD4,VIRAL,RVRSE,RVRSB,LBDT,QFL,RESULT,CCPT,CD4,VCPT,VIRAL
+3 NEW P61B,P61E,HP61B,HP61E,P62B,P62E,HP62B,HP62E,HVSDTM,GLOBVN,GLOBVS
+4 NEW CCPT,VCPT,GLOBAL,GLOBAL1,PTGLOB,PTGLOB1,PTGLOB2,GLOBC1,GLOBC2,GLOBC3,GLOBC4
+5 NEW PC1,PC2,PC3,PC61,PC62,PTGLOB3,PTGLOB4,PTLAB1,PTLAB2,PV1,PV2,PV3,PV61,PV62
+6 NEW PTLABC,PTLABV
+7 ;
+8 ; Build taxonomy list of items
+9 DO TAX
+10 ;
+11 ; Get Dates of performance
+12 DO DTR^BKMQQCRU(EDATE\1)
+13 SET RVRSE=9999999-(EDATE\1)
SET RVRSB=9999999-(REVPER\1)
+14 ;
+15 ; CD4RES1 = CD4 Result 0-199
+16 ; CD4RES2 = CD4 Result 200-349
+17 ; CD4RES3 = CD4 Result 350-499
+18 ; CD4RES4 = CD4 Result >500
+19 SET GLOBC1=$PIECE(GLOB,")")_",""HIVCHK"",""CD4RES1"")"
+20 SET PTGLOB1=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES1"")"
+21 SET GLOBC2=$PIECE(GLOB,")")_",""HIVCHK"",""CD4RES2"")"
+22 SET PTGLOB2=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES2"")"
+23 SET GLOBC3=$PIECE(GLOB,")")_",""HIVCHK"",""CD4RES3"")"
+24 SET PTGLOB3=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES3"")"
+25 SET GLOBC4=$PIECE(GLOB,")")_",""HIVCHK"",""CD4RES4"")"
+26 SET PTGLOB4=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4RES4"")"
+27 ;S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRALCNT"")"
+28 ;S PTGLOB2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRAL"")"
+29 SET PTLAB1=$PIECE(GLOB,")")_",""ZLAB"",BKMDFN,""VIRAL"",VSDTM)"
+30 SET PTLABV=$PIECE(GLOB,")")_",""ZLAB"",BKMDFN,""VIRAL"")"
+31 SET PTLAB2=$PIECE(GLOB,")")_",""ZLAB"",BKMDFN,""CD4"",VSDTM)"
+32 SET PTLABC=$PIECE(GLOB,")")_",""ZLAB"",BKMDFN,""CD4"")"
+33 SET GLOBVS=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRALSUP"")"
+34 SET GLOBVN=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""VIRALNSU"")"
+35 SET (@GLOBC1,@GLOBC2,@GLOBC3,@GLOBC4)=0
+36 ;
+37 SET BKMDFN=0
+38 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+39 NEW TIEN,VDATA,PDATA,VISIT,VSDTM,COLDTM
+40 SET LBDT=RVRSE-.001
+41 FOR
SET LBDT=$ORDER(^AUPNVLAB("AE",BKMDFN,LBDT))
IF LBDT=""!(LBDT\1>RVRSB)
QUIT
Begin DoDot:2
+42 SET TIEN=""
+43 FOR
SET TIEN=$ORDER(^AUPNVLAB("AE",BKMDFN,LBDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+44 IF '$DATA(@CD4@(TIEN))
IF '$DATA(@VIRAL@(TIEN))
QUIT
+45 SET IEN=""
SET QFL=0
+46 FOR
SET IEN=$ORDER(^AUPNVLAB("AE",BKMDFN,LBDT,TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:4
+47 SET PDATA=$GET(^AUPNVLAB(IEN,0))
IF PDATA=""
QUIT
+48 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+49 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+50 IF $PIECE(VDATA,U,11)=1
QUIT
+51 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+52 ; Get collection date/time
+53 SET COLDTM=$PIECE($GET(^AUPNVLAB(IEN,12)),U,1)\1
+54 IF COLDTM'=0
SET VSDTM=COLDTM
+55 SET HVSDTM=$$FMTH^XLFDT(VSDTM,1)
+56 IF VSDTM<REVPER!(VSDTM>EDATE)
QUIT
+57 SET RESULT=$PIECE(PDATA,U,4)
+58 IF RESULT'=""
Begin DoDot:5
+59 IF $DATA(@CD4@(TIEN))
Begin DoDot:6
+60 SET @PTLAB2=RESULT
End DoDot:6
+61 IF $DATA(@VIRAL@(TIEN))
Begin DoDot:6
+62 NEW OPER,VRLRES,RES
+63 IF RESULT=""!(RESULT?.A)
QUIT
+64 SET @PTLAB1=RESULT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+65 ;
+66 SET VSDTM=$ORDER(@PTLABC@(""),-1)
+67 IF VSDTM'=""
Begin DoDot:2
+68 SET RESULT=@PTLABC@(VSDTM)
+69 IF RESULT<200
SET @PTGLOB1=$GET(@PTGLOB1)+1
SET @GLOBC1=@GLOBC1+1
QUIT
+70 IF RESULT>199
IF RESULT<350
SET @PTGLOB2=$GET(@PTGLOB2)+1
SET @GLOBC2=@GLOBC2+1
QUIT
+71 IF RESULT>349
IF RESULT<500
SET @PTGLOB3=$GET(@PTGLOB3)+1
SET @GLOBC3=@GLOBC3+1
QUIT
+72 IF RESULT>499
SET @PTGLOB4=$GET(@PTGLOB4)+1
SET @GLOBC4=@GLOBC4+1
QUIT
End DoDot:2
+73 ;
+74 SET VSDTM=$ORDER(@PTLABV@(""),-1)
+75 IF VSDTM'=""
Begin DoDot:2
+76 SET RESULT=@PTLABV@(VSDTM)
+77 IF RESULT="<400"
SET @GLOBVS=RESULT
SET QFL=1
QUIT
+78 SET OPER=$SELECT($EXTRACT(RESULT,1)="<":"<",$EXTRACT(RESULT,1)=">":">",1:"")
+79 SET VRLRES=$SELECT($EXTRACT(RESULT,1)?.P:$EXTRACT(RESULT,2,99),1:RESULT)
+80 SET RES=400
+81 IF OPER=""
SET OPER="<"
+82 IF @(VRLRES_OPER_RES)
SET @GLOBVS=RESULT
QUIT
+83 SET OPER="'<"
+84 IF @(VRLRES_OPER_RES)
SET @GLOBVN=RESULT
QUIT
End DoDot:2
End DoDot:1
+85 ;
+86 KILL @VCPT,@CD4,@VIRAL,@CCPT
+87 QUIT
+88 ;
TAX ;EP - Build taxonomy item lists
+1 SET CD4="BKMCD4"
KILL @CD4
+2 FOR TAX="BKMV CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES"
DO BLD^BQITUTL(TAX,CD4)
+3 SET CCPT="BKMCCPT"
KILL @CCPT
+4 FOR TAX="BKMV CD4 ABS CPTS"
DO BLD^BQITUTL(TAX,CCPT)
+5 SET VIRAL="BKMVIR"
KILL @VIRAL
+6 FOR TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES"
DO BLD^BQITUTL(TAX,VIRAL)
+7 SET VCPT="BKMVCPT"
KILL @VCPT
+8 FOR TAX="BGP HIV VIRAL LOAD CPTS"
DO BLD^BQITUTL(TAX,VCPT)
+9 QUIT
+10 ;
LBVS(VIEN) ;EP - Find labs for a specific visit
+1 NEW IEN,PDATA,TIEN
+2 SET VLBC4=0
SET VLBVR=0
SET VCPC4=0
SET VCPVR=0
SET VIS=0
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^AUPNVLAB("AD",VIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+5 SET PDATA=$GET(^AUPNVLAB(IEN,0))
IF PDATA=""
QUIT
+6 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+7 IF '$DATA(@CD4@(TIEN))
IF '$DATA(@VIRAL@(TIEN))
QUIT
+8 IF $DATA(@CD4@(TIEN))
SET VLBC4=VLBC4+1
+9 IF $DATA(@VIRAL@(TIEN))
SET VLBVR=VLBVR+1
End DoDot:1
+10 ;
+11 SET IEN=""
+12 FOR
SET IEN=$ORDER(^AUPNVCPT("AD",VIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+13 SET PDATA=$GET(^AUPNVCPT(IEN,0))
IF PDATA=""
QUIT
+14 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+15 IF '$DATA(@CCPT@(TIEN))
IF '$DATA(@VCPT@(TIEN))
QUIT
+16 IF $DATA(@CCPT@(TIEN))
SET VCPC4=VCPC4+1
+17 IF $DATA(@VCPT@(TIEN))
SET VCPVR=VCPVR+1
End DoDot:1
+18 ;
+19 SET IEN=""
+20 FOR
SET IEN=$ORDER(^AUPNVPOV("AD",VIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+21 SET PDATA=$GET(^AUPNVPOV(IEN,0))
IF PDATA=""
QUIT
+22 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+23 IF '$DATA(@TREF@(TIEN))
QUIT
+24 SET VIS=VIS+1
End DoDot:1
+25 QUIT
