- 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
