BKMQQCR5 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
; Quality of Care Audit Report
Q
TOBACCO ; EP - Tobacco Use
N TOBDT,ICDTAX,ADATAX,HFTAX,HFTAX1,HFTAX2,PTEDTAX,BKMSVTX
N CLINIC,GL,GL2,GLOBAL,GLOBAL1,GLOBAL2,GLOBAL3,TOTPTS,BKMDFN,TOB
S TOBDT=$$FMADD^XLFDT(EDATE,-365)
;DX.12 Tobacco Users
S CPTTAX="BGP TOBACCO USER CPTS"
S ICDTAX="BGP SMOKER ONLY DXS"
S HFTAX1="BGP TOBACCO USER HLTH FACTORS"
;S.4 Tobacco Use Screen
S CPTTAX1="BGP SMOKING CPTS"
S ICDTAX1="BGP GPRA SMOKING DXS"
S HFTAX="BGP TOBACCO SCREEN HLTH FACTOR"
S ADATAX="BGP TOBACCO CESS DENTAL CODE"
S PTEDTAX="TO-,-TO,-SHS" ; Tobacco
S CLINIC=94
;ED.5 Tobacco Cessation Counseling (includes ADATAX, PTEDTAX, and CLINIC above)
S CPTTAX2="BGP TOBACCO CESS CPTS"
;DX.7 Non Tobacco Users
S HFTAX2="BQI NON TOBACCO USER FACTORS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TOB"",VSTDT,TEST)" ; S.4 Tobacco Use Screen
S GL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TOB"")"
S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBUSER"",VSTDT,TEST)" ; DX.12 Tobacco Users
S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBED"",VSTDT,TEST)" ; ED.5 Tobacco Cessation Counseling
S GL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBED"")"
S GLOBAL3=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBNONUSER"",VSTDT,TEST)" ; DX.7 Non Tobacco Users
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""TOBTOT"")"
S @TOTPTS=0,BKMDFN=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.;S.4 and DX.12 and ED.5
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,TOBDT,GLOBAL)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,TOBDT,GLOBAL)
.N CPT,EDT,TDT,GBL
.S CPT=CPTTAX1_$C(29)_CPTTAX_$C(29)_CPTTAX2
.S EDT=EDATE_$C(29)_EDATE_$C(29)_EDATE
.;S TDT=TDT_$C(29)_TDT_$C(29)_TDT
.S TDT=TOBDT_$C(29)_TOBDT_$C(29)_TOBDT
.S GBL=GLOBAL_$C(29)_GLOBAL1_$C(29)_GLOBAL2
.D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,TDT,GBL)
.K CPT,EDT,TDT,GBL
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TOBDT,GLOBAL1)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TOBDT,GLOBAL1)
.;ED.5
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX2,EDATE,TOBDT,GLOBAL2)
.; DX.12 only. Include problem list.
.D PRBTAX^BKMIXX(BKMDFN,ICDTAX,EDATE,TOBDT,GLOBAL1)
.;S.4 and ED.5
.D ADATAX^BKMIXX(BKMDFN,ADATAX,EDATE,TOBDT,GLOBAL)
.;D ADATAX^BKMIXX(BKMDFN,ADATAX,EDATE,TOBDT,GLOBAL2)
.M @GL2=@GL
.;S.4 and ED.5
.D PTEDTAX^BKMIXX(BKMDFN,PTEDTAX,EDATE,TOBDT,GLOBAL,"","","",.BKMSVTX)
.;D PTEDTAX^BKMIXX(BKMDFN,PTEDTAX,EDATE,TOBDT,GLOBAL2)
.M @GL2=@GL
.;S.4 and ED.5
.D CLNTAX^BKMIXX2(BKMDFN,CLINIC,EDATE,TOBDT,GLOBAL)
.D CLNTAX^BKMIXX2(BKMDFN,CLINIC,EDATE,TOBDT,GLOBAL2)
.;S.4
.D HFTAX^BKMIXX(BKMDFN,HFTAX,EDATE,TOBDT,GLOBAL)
.;DX.12
.D HFTAX^BKMIXX(BKMDFN,HFTAX1,EDATE,TOBDT,GLOBAL1)
.;DX.7
.D HFTAX^BKMIXX(BKMDFN,HFTAX2,EDATE,TOBDT,GLOBAL3)
.I $D(@GLOB@("HIVCHK",BKMDFN,"TOB")) S @TOTPTS=@TOTPTS+1
Q
SUBS01 ; EP - Substance Abuse
N SUBS01DT,ICDTAX,ICDTAX2,ICDTAX3,HFTAX,PTEDTAX,GLOBAL,GLOBAL1,TOTPTS,BKMDFN,BKMSVTX
N CD,BHP,BHPRB,MSR
S SUBS01DT=$$FMADD^XLFDT(EDATE,-365)
;S.1
S CPTTAX="BGP ALCOHOL SCREENING CPTS"
S ICDTAX="BQI ALCOHOL SCREEN DXS"
S ICDTAX2="BGP ALCOHOL DXS"
S PRCTAX="BQI ALCOHOL PROCEDURES"
S HFTAX="BGP ALCOHOL HLTH FACTOR"
S PTEDTAX="CD-,-CD,AOD-,-AOD"
;S.3
S ICDTAX3="BKM OTHER SUBSTANCE ABUSE DXS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""SUBS01"",VSTDT,TEST)"
; IHS does not want Substance Abuse sub-totals originally requested
; S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""SUBS01CURR"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""SUBS01TOT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.;S.1
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,SUBS01DT,GLOBAL)
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX2,EDATE,SUBS01DT,GLOBAL)
.; D ICDTAX^BKMIXX1(BKMDFN,ICDTAX2,EDATE,SUBS01DT,GLOBAL1)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,SUBS01DT,GLOBAL)
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,SUBS01DT,GLOBAL)
.D HFTAX^BKMIXX(BKMDFN,HFTAX,EDATE,SUBS01DT,GLOBAL)
.D PTEDTAX^BKMIXX(BKMDFN,PTEDTAX,EDATE,SUBS01DT,GLOBAL,"","","",.BKMSVTX)
.D EXAMTAX^BKMIXX1(BKMDFN,"35",EDATE,SUBS01DT,GLOBAL)
.F CD=10,27,29 S BHP(CD)=""
.D BHPTAX^BKMIXX2(BKMDFN,.BHP,EDATE,SUBS01DT,GLOBAL)
.F CD=29.1 S BHPRB(CD)=""
.D BHPRBTAX^BKMIXX2(BKMDFN,.BHPRB,EDATE,SUBS01DT,GLOBAL)
.F CD="AUDT","AUDC","CRFT" S MSR(CD)=""
.D MSRTAX^BKMIXX2(BKMDFN,.MSR,EDATE,SUBS01DT,GLOBAL)
.;S.3
.;D ICDTAX^BKMIXX1(BKMDFN,ICDTAX3,EDATE,SUBS01DT,GLOBAL1)
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX3,EDATE,SUBS01DT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"SUBS01"))!$D(@GLOB@("HIVCHK",BKMDFN,"SUBS01CURR")) S @TOTPTS=@TOTPTS+1
Q
BKMQQCR5 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
+2 ; Quality of Care Audit Report
+3 QUIT
TOBACCO ; EP - Tobacco Use
+1 NEW TOBDT,ICDTAX,ADATAX,HFTAX,HFTAX1,HFTAX2,PTEDTAX,BKMSVTX
+2 NEW CLINIC,GL,GL2,GLOBAL,GLOBAL1,GLOBAL2,GLOBAL3,TOTPTS,BKMDFN,TOB
+3 SET TOBDT=$$FMADD^XLFDT(EDATE,-365)
+4 ;DX.12 Tobacco Users
+5 SET CPTTAX="BGP TOBACCO USER CPTS"
+6 SET ICDTAX="BGP SMOKER ONLY DXS"
+7 SET HFTAX1="BGP TOBACCO USER HLTH FACTORS"
+8 ;S.4 Tobacco Use Screen
+9 SET CPTTAX1="BGP SMOKING CPTS"
+10 SET ICDTAX1="BGP GPRA SMOKING DXS"
+11 SET HFTAX="BGP TOBACCO SCREEN HLTH FACTOR"
+12 SET ADATAX="BGP TOBACCO CESS DENTAL CODE"
+13 ; Tobacco
SET PTEDTAX="TO-,-TO,-SHS"
+14 SET CLINIC=94
+15 ;ED.5 Tobacco Cessation Counseling (includes ADATAX, PTEDTAX, and CLINIC above)
+16 SET CPTTAX2="BGP TOBACCO CESS CPTS"
+17 ;DX.7 Non Tobacco Users
+18 SET HFTAX2="BQI NON TOBACCO USER FACTORS"
+19 ; S.4 Tobacco Use Screen
SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TOB"",VSTDT,TEST)"
+20 SET GL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TOB"")"
+21 ; DX.12 Tobacco Users
SET GLOBAL1=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBUSER"",VSTDT,TEST)"
+22 ; ED.5 Tobacco Cessation Counseling
SET GLOBAL2=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBED"",VSTDT,TEST)"
+23 SET GL2=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBED"")"
+24 ; DX.7 Non Tobacco Users
SET GLOBAL3=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TOBNONUSER"",VSTDT,TEST)"
+25 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""TOBTOT"")"
+26 SET @TOTPTS=0
SET BKMDFN=0
+27 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+28 ;S.4 and DX.12 and ED.5
+29 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,TOBDT,GLOBAL)
+30 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,TOBDT,GLOBAL)
+31 NEW CPT,EDT,TDT,GBL
+32 SET CPT=CPTTAX1_$CHAR(29)_CPTTAX_$CHAR(29)_CPTTAX2
+33 SET EDT=EDATE_$CHAR(29)_EDATE_$CHAR(29)_EDATE
+34 ;S TDT=TDT_$C(29)_TDT_$C(29)_TDT
+35 SET TDT=TOBDT_$CHAR(29)_TOBDT_$CHAR(29)_TOBDT
+36 SET GBL=GLOBAL_$CHAR(29)_GLOBAL1_$CHAR(29)_GLOBAL2
+37 DO CPTTAX^BKMIXX(BKMDFN,CPT,EDT,TDT,GBL)
+38 KILL CPT,EDT,TDT,GBL
+39 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TOBDT,GLOBAL1)
+40 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TOBDT,GLOBAL1)
+41 ;ED.5
+42 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX2,EDATE,TOBDT,GLOBAL2)
+43 ; DX.12 only. Include problem list.
+44 DO PRBTAX^BKMIXX(BKMDFN,ICDTAX,EDATE,TOBDT,GLOBAL1)
+45 ;S.4 and ED.5
+46 DO ADATAX^BKMIXX(BKMDFN,ADATAX,EDATE,TOBDT,GLOBAL)
+47 ;D ADATAX^BKMIXX(BKMDFN,ADATAX,EDATE,TOBDT,GLOBAL2)
+48 MERGE @GL2=@GL
+49 ;S.4 and ED.5
+50 DO PTEDTAX^BKMIXX(BKMDFN,PTEDTAX,EDATE,TOBDT,GLOBAL,"","","",.BKMSVTX)
+51 ;D PTEDTAX^BKMIXX(BKMDFN,PTEDTAX,EDATE,TOBDT,GLOBAL2)
+52 MERGE @GL2=@GL
+53 ;S.4 and ED.5
+54 DO CLNTAX^BKMIXX2(BKMDFN,CLINIC,EDATE,TOBDT,GLOBAL)
+55 DO CLNTAX^BKMIXX2(BKMDFN,CLINIC,EDATE,TOBDT,GLOBAL2)
+56 ;S.4
+57 DO HFTAX^BKMIXX(BKMDFN,HFTAX,EDATE,TOBDT,GLOBAL)
+58 ;DX.12
+59 DO HFTAX^BKMIXX(BKMDFN,HFTAX1,EDATE,TOBDT,GLOBAL1)
+60 ;DX.7
+61 DO HFTAX^BKMIXX(BKMDFN,HFTAX2,EDATE,TOBDT,GLOBAL3)
+62 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"TOB"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+63 QUIT
SUBS01 ; EP - Substance Abuse
+1 NEW SUBS01DT,ICDTAX,ICDTAX2,ICDTAX3,HFTAX,PTEDTAX,GLOBAL,GLOBAL1,TOTPTS,BKMDFN,BKMSVTX
+2 NEW CD,BHP,BHPRB,MSR
+3 SET SUBS01DT=$$FMADD^XLFDT(EDATE,-365)
+4 ;S.1
+5 SET CPTTAX="BGP ALCOHOL SCREENING CPTS"
+6 SET ICDTAX="BQI ALCOHOL SCREEN DXS"
+7 SET ICDTAX2="BGP ALCOHOL DXS"
+8 SET PRCTAX="BQI ALCOHOL PROCEDURES"
+9 SET HFTAX="BGP ALCOHOL HLTH FACTOR"
+10 SET PTEDTAX="CD-,-CD,AOD-,-AOD"
+11 ;S.3
+12 SET ICDTAX3="BKM OTHER SUBSTANCE ABUSE DXS"
+13 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""SUBS01"",VSTDT,TEST)"
+14 ; IHS does not want Substance Abuse sub-totals originally requested
+15 ; S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""SUBS01CURR"",VSTDT,TEST)"
+16 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""SUBS01TOT"")"
+17 SET BKMDFN=0
SET @TOTPTS=0
+18 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+19 ;S.1
+20 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,SUBS01DT,GLOBAL)
+21 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX2,EDATE,SUBS01DT,GLOBAL)
+22 ; D ICDTAX^BKMIXX1(BKMDFN,ICDTAX2,EDATE,SUBS01DT,GLOBAL1)
+23 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,SUBS01DT,GLOBAL)
+24 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,SUBS01DT,GLOBAL)
+25 DO HFTAX^BKMIXX(BKMDFN,HFTAX,EDATE,SUBS01DT,GLOBAL)
+26 DO PTEDTAX^BKMIXX(BKMDFN,PTEDTAX,EDATE,SUBS01DT,GLOBAL,"","","",.BKMSVTX)
+27 DO EXAMTAX^BKMIXX1(BKMDFN,"35",EDATE,SUBS01DT,GLOBAL)
+28 FOR CD=10,27,29
SET BHP(CD)=""
+29 DO BHPTAX^BKMIXX2(BKMDFN,.BHP,EDATE,SUBS01DT,GLOBAL)
+30 FOR CD=29.1
SET BHPRB(CD)=""
+31 DO BHPRBTAX^BKMIXX2(BKMDFN,.BHPRB,EDATE,SUBS01DT,GLOBAL)
+32 FOR CD="AUDT","AUDC","CRFT"
SET MSR(CD)=""
+33 DO MSRTAX^BKMIXX2(BKMDFN,.MSR,EDATE,SUBS01DT,GLOBAL)
+34 ;S.3
+35 ;D ICDTAX^BKMIXX1(BKMDFN,ICDTAX3,EDATE,SUBS01DT,GLOBAL1)
+36 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX3,EDATE,SUBS01DT,GLOBAL)
+37 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"SUBS01"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"SUBS01CURR"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+38 QUIT
