BKMVQCRA ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 13 Jun 2005 3:41 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
; Quality of Care Audit Report
PRINT ; EP - Print report.
N TOTPTS,EXDT,INST,HEEXT,PAGE,CONFS,CONFE,HDRST,BKMRTN
S CONFS="**** CONFIDENTIAL PATIENT INFORMATION ****"
S CONFE="**** END CONFIDENTIAL PATIENT INFORMATION ****"
U IO
D NOW^%DTC
S EXDT=$$FMTE^XLFDT(X)
S INST=$$GET1^DIQ(4,$G(DUZ(2)),.01,"E")
S HEEXT=$P($$FMTE^XLFDT(EDATE),"@",1)
S PAGE=1
I IOST["C-" W @IOF
D HDR
S TOTPTS=+$G(^TMP("BKMVQCR",$J,"HIVTOT1"))
I TOTPTS=0 W !!,"No Data to Report",!! G PRINT1
W ?1,"Total Patients Reviewed: "_TOTPTS,!!
W ?50,"#",?60,"%",!!
W ?1,"Gender: Male" D WC("MALE")
W ?1," Female" D WC("FEMALE")
I ^TMP("BKMVQCR",$J,"UNSPEC") W " Unspecified" D WC("UNSPEC")
W !
W ?1,"Age <15 yrs" D WC("AGE1")
W ?1," 15-44 yrs" D WC("AGE2")
W ?1," 45-64 yrs" D WC("AGE3")
W ?1," >64 yrs" D WC("AGE4")
W !
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF D HDR
W ?1,"LABORATORY EXAMS",!
W ?1,"# w/ CD4 count in last six months" D WP("CD4T","TOTAL")
W ?1," most recent<50" D WP("CD4T","LT50")
W ?1," most recent 50-199" D WP("CD4T","BET50/200")
W ?1," most recent=>200" D WP("CD4T","GTE200")
W ?1," Undetermined" D WP("CD4T","UND")
W !
W ?1,"# w/ Viral Load in last six months" D WP("VRLT","TOTAL")
W ?1," <100,000 copies/ml" D WP("VRLT","LT100K")
W ?1," =>100,000 copies/ml" D WP("VRLT","GTE100K")
W !
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF D HDR
W ?1,"# w/ RPR (Syphilis Test) in the last 12 months" D WP("RPRT","TOTAL")
W ?1," Reactive" D WP("RPRT","REAC")
W ?1," Non-Reactive" D WP("RPRT","NONREAC")
W ?1," Refused" D WP("RPRT","REF")
W ?1," NMI" D WP("RPRT","REFNMI")
W ?1," Undetermined" D WP("RPRT","UND")
W !
W ?1,"# w/ Chlamydia Screen in the last 12 months" D WP("CHLAMT","TOTAL")
W ?1," Positive" D WP("CHLAMT","POS")
W ?1," Negative" D WP("CHLAMT","NEG")
W ?1," Refused" D WP("CHLAMT","REF")
W ?1," NMI" D WP("CHLAMT","REFNMI")
W ?1," Undetermined" D WP("CHLAMT","UND")
W !
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF D HDR
W ?1,"# w/ Gonorrhea Screen in the last 12 months" D WP("GONT","TOTAL")
W ?1," Positive" D WP("GONT","POS")
W ?1," Negative" D WP("GONT","NEG")
W ?1," Refused" D WP("GONT","REF")
W ?1," NMI" D WP("GONT","REFNMI")
W ?1," Undetermined" D WP("GONT","UND")
;PRXM/HC/BHS - 05/10/2006 - only add blank line to terminal
I IOST["C-" W !
I IOST'["C-" W @IOF D HDR
W ?1,"# w/ Tuberculosis test needed" D WP("TUBT","NEEDPPD")
W ?1," PPD Received" D WP("TUBT","PY")
W ?1," PPD+" D WP("TUBT","POSPY")
W ?1," w/ Treatment Given" D WP("TUBT","MED")
W ?1," PPD-" D WP("TUBT","NEGPY")
W ?1," PPD Refused" D WP("TUBT","REF")
W ?1," PPD Status Unknown" D WP("TUBT","UND")
W !
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF D HDR
W ?1,"VACCINATION",!
W ?1,"# w/ Pneumovax in last 5 years (or 2 ever)" D WP("PNEUMOT","TOTAL")
W ?1,"# w/ Tetanus in past 10 years" D WP("TETT","TOTAL")
W !
W ?1,"EXAMS - Yearly",!
W ?1,"Dilated Eye Exam" D WP("EYET","TOTAL")
W ?1,"Dental Exam" D WP("DENTT","TOTAL")
W ?1,"Pap Smear" D WP("PAPT","TOTAL")
W !
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF D HDR
W ?1,"TREATMENT (past 6 months)",!
W ?1,"ARV Therapy given" D WP("ARVT","TOTAL")
W ?1," HAART" D WP("ARVT","HAART")
W ?1," Mono Therapy" D WP("ARVT","MONO")
W ?1," Other Combination" D WP("ARVT","OTHER")
W !
W ?1,"PCP Prophylaxis given if ANY CD4 =>50 and <200 in last six months",!
D WP("PCPT","TOTAL")
W ?1,"MAC Prophylaxis given if ANY CD4 <50 in last six months",!
D WP("MACT","TOTAL")
W !
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF D HDR
W ?1,"RISK FACTORS",!
W ?1,"Tobacco Use Screening" D WP("TOBT","SCREEN")
W ?1," Current Tobacco User" D WP("TOBT","USER")
W ?1," If Yes, Counseled" D WP("TOBT","ED")
W ?1," Not a Current User" D WP("TOBT","NON")
W ?1," Not Documented" D WP("TOBT","UNK")
W !
W ?1,"Substance Abuse Screening" D WP("SUBST","TOTAL")
W ?1," Current User" D WP("SUBST","CURRENT")
;"IV" and "NOT" cannot be calculated so they are displayed as "Unavailable".
W ?1," I/V - Yes"
W ?49,"Unavailable",! ;D WP("SUBST","IV") if IV can be calculated
W " Not a Current User" ;If D WP is reinstated add ?1, before the quote
W ?49,"Unavailable",! ;D WP("SUBST","NOT") if NOT can be calculated
W " Not Documented" D WP("SUBST","UNK") ;If D WP is reinstated add ?1, before the quote
W !
;PRXM/HC/BHS - 04/19/2006 - Added report logic description as last page(s)
I IOST["C-",$$PAUSE^BKMIXX3 Q
W @IOF D HDR ;Force a form feed
;I IOST["C-" W @IOF D HDR
W !
D HDR^BKMIMRP1("HMS Quality of Care Report","")
W !
W ?1,"This report includes all patients who meet the following criteria:"
W !!
W ?5,"* Register Status = Active"
W !
W ?5,"* Current Diagnosis =",$S($P(DENPOP,":",2)=" All":" HIV and AIDS",1:$P(DENPOP,":",2))
W !
W ?5,"* First (oldest) Diagnosis Date is at least 182 days (6 months) prior to"
W !
W ?5," Report End Date"
W !!
;PRXM/HC/BHS - 06/28/2006 - Force page break following report logic removed per IHS
;PRXM/HC/BHS - 06/13/2006 - Force page break following report logic
;I IOST["C-",$$PAUSE^BKMIXX3 Q
;W @IOF D HDR
W ?1,"Total Patients Reviewed: "_TOTPTS,!!
W ?1,"The following patients are included in this report: "
W !!
;PRXM/HC/BHS - 06/13/2006 - Patient list column header
;PRXM/HC/BHS - 06/28/2006 - Check for sufficient space before displaying patient list header
S BKMRTN=""
I IOSL-$Y<6 D Q:BKMRTN="^"
. I IOST["C-",$$PAUSE^BKMIXX3 S BKMRTN="^" Q
. W @IOF D HDR
D PATHDR
;PRXM/HC/BHS - 05/10/2006 - Force page break before patient list
;I IOST["C-" W @IOF D HDR,PATHDR
;W @IOF D HDR,PATHDR
; Loop through patient list
S BKMDFN=""
F S BKMDFN=$O(^TMP("BKMVQCR",$J,"HIVCHK",BKMDFN)) Q:BKMDFN=""!('+BKMDFN) D
. S BKMPATN=$$GET1^DIQ(2,BKMDFN,".01","E")
. I BKMPATN="" S BKMPATN="{MISSING NAME}"
. S ^TMP("BKMVQCR",$J,"HIVCHK","SORTED BY NAME",BKMPATN,BKMDFN)=""
; Loop through patient list sorted by name
S BKMPATN="",BKMRTN=""
F S BKMPATN=$O(^TMP("BKMVQCR",$J,"HIVCHK","SORTED BY NAME",BKMPATN)) Q:BKMPATN="" D Q:BKMRTN="^"
. S BKMDFN="",BKMRTN=""
. F S BKMDFN=$O(^TMP("BKMVQCR",$J,"HIVCHK","SORTED BY NAME",BKMPATN,BKMDFN)) Q:BKMDFN=""!('+BKMDFN) D Q:BKMRTN="^"
. . I IOSL-$Y<6 D Q:BKMRTN="^"
. . . I IOST["C-",$$PAUSE^BKMIXX3 S BKMRTN="^" Q
. . . W @IOF D HDR,PATHDR
. . D PAT(BKMPATN,BKMDFN)
W !
D HDR^BKMIMRP1(CONFE,"")
W !
PRINT1 ;
I IOST["C-",$$PAUSE^BKMIXX3 Q
I IOST["C-" W @IOF
Q
WC(TYPE) ;
N VAL
I TYPE="" Q
S VAL=+$G(^TMP("BKMVQCR",$J,TYPE))
W ?47,$J(VAL,3)
W ?55,$J(VAL/TOTPTS*100,5,1),"%",!
Q
WP(CAT,TYPE) ;
N VAL,PERC
I TYPE="" Q
S VAL=+$G(^TMP("BKMVQCR",$J,CAT,TYPE,"CNT"))
W ?47,$J(VAL,3)
S PERC=$G(^TMP("BKMVQCR",$J,CAT,TYPE,"PERC"))
W ?55,$J(PERC,5,1),"%",!
Q
PAT(BKMPATN,BKMDFN) ;
N BKMIEN,BKMREG
Q:$G(BKMPATN)=""!($G(BKMDFN)="")
;W ?1,$$GET1^DIQ(2,BKMDFN,".01","E")
W ?1,$G(BKMPATN)
W ?32,$$HRN^BKMVA1(BKMDFN)
W ?39,$$GET1^DIQ(2,BKMDFN,".033","E")
W ?43,$$GET1^DIQ(2,BKMDFN,".02","I")
S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
Q:BKMIEN=""
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
Q:BKMREG=""
W ?47,$$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",","2.3","E")
W ?52,$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",","5","I"),"5Z")
W ?64,$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",","5.5","I"),"5Z")
W !
Q
PATHDR ;
N BKMHDR
S $P(BKMHDR,"-",79)=""
W ?1,"Patient Name"
W ?32,"HRN"
W ?39,"Age"
W ?43,"Sex"
W ?47,"Dx"
W ?52,"Init HIV Dx"
W ?64,"Init AIDS Dx"
W !
W ?1,$E(BKMHDR,1,30)
W ?32,$E(BKMHDR,1,6)
W ?39,$E(BKMHDR,1,3)
W ?43,$E(BKMHDR,1,3)
W ?47,$E(BKMHDR,1,4)
W ?52,$E(BKMHDR,1,11)
W ?64,$E(BKMHDR,1,12)
W !
;D HDR3^BKMIMRP1
Q
HDR ;
S HDRST=$$PAD^BKMIXX4($$GET1^DIQ(200,DUZ_",","1","E"),">"," ",35)_$$PAD^BKMIXX4(EXDT,">"," ",35)_"Page: "_PAGE
D HDR^BKMIMRP1(HDRST,"")
D HDR^BKMIMRP1(INST,"")
D HDR^BKMIMRP1("*** HMS CUMULATIVE AUDIT REPORT -- HIV QUALITY OF CARE ***","")
D HDR^BKMIMRP1("Denominator Population - "_DENPOP,"")
D HDR^BKMIMRP1("Period Ending: "_HEEXT,"")
I IOST'["C-",PAGE=1 D DISP
E D HDR^BKMIMRP1(CONFS,"")
D HDR3^BKMIMRP1
S PAGE=PAGE+1
Q
;
DISP ;
W !!,?30,"***WARNING***",!
W ?21,"***RESTRICTED INFORMATION***",!
W ?1,"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *",!
W ?1,"* All information in this system is protected by the Privacy Act of *",!
W ?1,"* 1974. If you elect to proceed, you will be required to prove you have *",!
W ?1,"* a need to know. Access of data in this system is tracked, and your *",!
W ?1,"* station Security Officer may contact you for your justification. *",!
W ?1,"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *",!
Q
BKMVQCRA ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 13 Jun 2005 3:41 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Quality of Care Audit Report
PRINT ; EP - Print report.
+1 NEW TOTPTS,EXDT,INST,HEEXT,PAGE,CONFS,CONFE,HDRST,BKMRTN
+2 SET CONFS="**** CONFIDENTIAL PATIENT INFORMATION ****"
+3 SET CONFE="**** END CONFIDENTIAL PATIENT INFORMATION ****"
+4 USE IO
+5 DO NOW^%DTC
+6 SET EXDT=$$FMTE^XLFDT(X)
+7 SET INST=$$GET1^DIQ(4,$GET(DUZ(2)),.01,"E")
+8 SET HEEXT=$PIECE($$FMTE^XLFDT(EDATE),"@",1)
+9 SET PAGE=1
+10 IF IOST["C-"
WRITE @IOF
+11 DO HDR
+12 SET TOTPTS=+$GET(^TMP("BKMVQCR",$JOB,"HIVTOT1"))
+13 IF TOTPTS=0
WRITE !!,"No Data to Report",!!
GOTO PRINT1
+14 WRITE ?1,"Total Patients Reviewed: "_TOTPTS,!!
+15 WRITE ?50,"#",?60,"%",!!
+16 WRITE ?1,"Gender: Male"
DO WC("MALE")
+17 WRITE ?1," Female"
DO WC("FEMALE")
+18 IF ^TMP("BKMVQCR",$JOB,"UNSPEC")
WRITE " Unspecified"
DO WC("UNSPEC")
+19 WRITE !
+20 WRITE ?1,"Age <15 yrs"
DO WC("AGE1")
+21 WRITE ?1," 15-44 yrs"
DO WC("AGE2")
+22 WRITE ?1," 45-64 yrs"
DO WC("AGE3")
+23 WRITE ?1," >64 yrs"
DO WC("AGE4")
+24 WRITE !
+25 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+26 IF IOST["C-"
WRITE @IOF
DO HDR
+27 WRITE ?1,"LABORATORY EXAMS",!
+28 WRITE ?1,"# w/ CD4 count in last six months"
DO WP("CD4T","TOTAL")
+29 WRITE ?1," most recent<50"
DO WP("CD4T","LT50")
+30 WRITE ?1," most recent 50-199"
DO WP("CD4T","BET50/200")
+31 WRITE ?1," most recent=>200"
DO WP("CD4T","GTE200")
+32 WRITE ?1," Undetermined"
DO WP("CD4T","UND")
+33 WRITE !
+34 WRITE ?1,"# w/ Viral Load in last six months"
DO WP("VRLT","TOTAL")
+35 WRITE ?1," <100,000 copies/ml"
DO WP("VRLT","LT100K")
+36 WRITE ?1," =>100,000 copies/ml"
DO WP("VRLT","GTE100K")
+37 WRITE !
+38 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+39 IF IOST["C-"
WRITE @IOF
DO HDR
+40 WRITE ?1,"# w/ RPR (Syphilis Test) in the last 12 months"
DO WP("RPRT","TOTAL")
+41 WRITE ?1," Reactive"
DO WP("RPRT","REAC")
+42 WRITE ?1," Non-Reactive"
DO WP("RPRT","NONREAC")
+43 WRITE ?1," Refused"
DO WP("RPRT","REF")
+44 WRITE ?1," NMI"
DO WP("RPRT","REFNMI")
+45 WRITE ?1," Undetermined"
DO WP("RPRT","UND")
+46 WRITE !
+47 WRITE ?1,"# w/ Chlamydia Screen in the last 12 months"
DO WP("CHLAMT","TOTAL")
+48 WRITE ?1," Positive"
DO WP("CHLAMT","POS")
+49 WRITE ?1," Negative"
DO WP("CHLAMT","NEG")
+50 WRITE ?1," Refused"
DO WP("CHLAMT","REF")
+51 WRITE ?1," NMI"
DO WP("CHLAMT","REFNMI")
+52 WRITE ?1," Undetermined"
DO WP("CHLAMT","UND")
+53 WRITE !
+54 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+55 IF IOST["C-"
WRITE @IOF
DO HDR
+56 WRITE ?1,"# w/ Gonorrhea Screen in the last 12 months"
DO WP("GONT","TOTAL")
+57 WRITE ?1," Positive"
DO WP("GONT","POS")
+58 WRITE ?1," Negative"
DO WP("GONT","NEG")
+59 WRITE ?1," Refused"
DO WP("GONT","REF")
+60 WRITE ?1," NMI"
DO WP("GONT","REFNMI")
+61 WRITE ?1," Undetermined"
DO WP("GONT","UND")
+62 ;PRXM/HC/BHS - 05/10/2006 - only add blank line to terminal
+63 IF IOST["C-"
WRITE !
+64 IF IOST'["C-"
WRITE @IOF
DO HDR
+65 WRITE ?1,"# w/ Tuberculosis test needed"
DO WP("TUBT","NEEDPPD")
+66 WRITE ?1," PPD Received"
DO WP("TUBT","PY")
+67 WRITE ?1," PPD+"
DO WP("TUBT","POSPY")
+68 WRITE ?1," w/ Treatment Given"
DO WP("TUBT","MED")
+69 WRITE ?1," PPD-"
DO WP("TUBT","NEGPY")
+70 WRITE ?1," PPD Refused"
DO WP("TUBT","REF")
+71 WRITE ?1," PPD Status Unknown"
DO WP("TUBT","UND")
+72 WRITE !
+73 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+74 IF IOST["C-"
WRITE @IOF
DO HDR
+75 WRITE ?1,"VACCINATION",!
+76 WRITE ?1,"# w/ Pneumovax in last 5 years (or 2 ever)"
DO WP("PNEUMOT","TOTAL")
+77 WRITE ?1,"# w/ Tetanus in past 10 years"
DO WP("TETT","TOTAL")
+78 WRITE !
+79 WRITE ?1,"EXAMS - Yearly",!
+80 WRITE ?1,"Dilated Eye Exam"
DO WP("EYET","TOTAL")
+81 WRITE ?1,"Dental Exam"
DO WP("DENTT","TOTAL")
+82 WRITE ?1,"Pap Smear"
DO WP("PAPT","TOTAL")
+83 WRITE !
+84 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+85 IF IOST["C-"
WRITE @IOF
DO HDR
+86 WRITE ?1,"TREATMENT (past 6 months)",!
+87 WRITE ?1,"ARV Therapy given"
DO WP("ARVT","TOTAL")
+88 WRITE ?1," HAART"
DO WP("ARVT","HAART")
+89 WRITE ?1," Mono Therapy"
DO WP("ARVT","MONO")
+90 WRITE ?1," Other Combination"
DO WP("ARVT","OTHER")
+91 WRITE !
+92 WRITE ?1,"PCP Prophylaxis given if ANY CD4 =>50 and <200 in last six months",!
+93 DO WP("PCPT","TOTAL")
+94 WRITE ?1,"MAC Prophylaxis given if ANY CD4 <50 in last six months",!
+95 DO WP("MACT","TOTAL")
+96 WRITE !
+97 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+98 IF IOST["C-"
WRITE @IOF
DO HDR
+99 WRITE ?1,"RISK FACTORS",!
+100 WRITE ?1,"Tobacco Use Screening"
DO WP("TOBT","SCREEN")
+101 WRITE ?1," Current Tobacco User"
DO WP("TOBT","USER")
+102 WRITE ?1," If Yes, Counseled"
DO WP("TOBT","ED")
+103 WRITE ?1," Not a Current User"
DO WP("TOBT","NON")
+104 WRITE ?1," Not Documented"
DO WP("TOBT","UNK")
+105 WRITE !
+106 WRITE ?1,"Substance Abuse Screening"
DO WP("SUBST","TOTAL")
+107 WRITE ?1," Current User"
DO WP("SUBST","CURRENT")
+108 ;"IV" and "NOT" cannot be calculated so they are displayed as "Unavailable".
+109 WRITE ?1," I/V - Yes"
+110 ;D WP("SUBST","IV") if IV can be calculated
WRITE ?49,"Unavailable",!
+111 ;If D WP is reinstated add ?1, before the quote
WRITE " Not a Current User"
+112 ;D WP("SUBST","NOT") if NOT can be calculated
WRITE ?49,"Unavailable",!
+113 ;If D WP is reinstated add ?1, before the quote
WRITE " Not Documented"
DO WP("SUBST","UNK")
+114 WRITE !
+115 ;PRXM/HC/BHS - 04/19/2006 - Added report logic description as last page(s)
+116 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+117 ;Force a form feed
WRITE @IOF
DO HDR
+118 ;I IOST["C-" W @IOF D HDR
+119 WRITE !
+120 DO HDR^BKMIMRP1("HMS Quality of Care Report","")
+121 WRITE !
+122 WRITE ?1,"This report includes all patients who meet the following criteria:"
+123 WRITE !!
+124 WRITE ?5,"* Register Status = Active"
+125 WRITE !
+126 WRITE ?5,"* Current Diagnosis =",$SELECT($PIECE(DENPOP,":",2)=" All":" HIV and AIDS",1:$PIECE(DENPOP,":",2))
+127 WRITE !
+128 WRITE ?5,"* First (oldest) Diagnosis Date is at least 182 days (6 months) prior to"
+129 WRITE !
+130 WRITE ?5," Report End Date"
+131 WRITE !!
+132 ;PRXM/HC/BHS - 06/28/2006 - Force page break following report logic removed per IHS
+133 ;PRXM/HC/BHS - 06/13/2006 - Force page break following report logic
+134 ;I IOST["C-",$$PAUSE^BKMIXX3 Q
+135 ;W @IOF D HDR
+136 WRITE ?1,"Total Patients Reviewed: "_TOTPTS,!!
+137 WRITE ?1,"The following patients are included in this report: "
+138 WRITE !!
+139 ;PRXM/HC/BHS - 06/13/2006 - Patient list column header
+140 ;PRXM/HC/BHS - 06/28/2006 - Check for sufficient space before displaying patient list header
+141 SET BKMRTN=""
+142 IF IOSL-$Y<6
Begin DoDot:1
+143 IF IOST["C-"
IF $$PAUSE^BKMIXX3
SET BKMRTN="^"
QUIT
+144 WRITE @IOF
DO HDR
End DoDot:1
IF BKMRTN="^"
QUIT
+145 DO PATHDR
+146 ;PRXM/HC/BHS - 05/10/2006 - Force page break before patient list
+147 ;I IOST["C-" W @IOF D HDR,PATHDR
+148 ;W @IOF D HDR,PATHDR
+149 ; Loop through patient list
+150 SET BKMDFN=""
+151 FOR
SET BKMDFN=$ORDER(^TMP("BKMVQCR",$JOB,"HIVCHK",BKMDFN))
IF BKMDFN=""!('+BKMDFN)
QUIT
Begin DoDot:1
+152 SET BKMPATN=$$GET1^DIQ(2,BKMDFN,".01","E")
+153 IF BKMPATN=""
SET BKMPATN="{MISSING NAME}"
+154 SET ^TMP("BKMVQCR",$JOB,"HIVCHK","SORTED BY NAME",BKMPATN,BKMDFN)=""
End DoDot:1
+155 ; Loop through patient list sorted by name
+156 SET BKMPATN=""
SET BKMRTN=""
+157 FOR
SET BKMPATN=$ORDER(^TMP("BKMVQCR",$JOB,"HIVCHK","SORTED BY NAME",BKMPATN))
IF BKMPATN=""
QUIT
Begin DoDot:1
+158 SET BKMDFN=""
SET BKMRTN=""
+159 FOR
SET BKMDFN=$ORDER(^TMP("BKMVQCR",$JOB,"HIVCHK","SORTED BY NAME",BKMPATN,BKMDFN))
IF BKMDFN=""!('+BKMDFN)
QUIT
Begin DoDot:2
+160 IF IOSL-$Y<6
Begin DoDot:3
+161 IF IOST["C-"
IF $$PAUSE^BKMIXX3
SET BKMRTN="^"
QUIT
+162 WRITE @IOF
DO HDR
DO PATHDR
End DoDot:3
IF BKMRTN="^"
QUIT
+163 DO PAT(BKMPATN,BKMDFN)
End DoDot:2
IF BKMRTN="^"
QUIT
End DoDot:1
IF BKMRTN="^"
QUIT
+164 WRITE !
+165 DO HDR^BKMIMRP1(CONFE,"")
+166 WRITE !
PRINT1 ;
+1 IF IOST["C-"
IF $$PAUSE^BKMIXX3
QUIT
+2 IF IOST["C-"
WRITE @IOF
+3 QUIT
WC(TYPE) ;
+1 NEW VAL
+2 IF TYPE=""
QUIT
+3 SET VAL=+$GET(^TMP("BKMVQCR",$JOB,TYPE))
+4 WRITE ?47,$JUSTIFY(VAL,3)
+5 WRITE ?55,$JUSTIFY(VAL/TOTPTS*100,5,1),"%",!
+6 QUIT
WP(CAT,TYPE) ;
+1 NEW VAL,PERC
+2 IF TYPE=""
QUIT
+3 SET VAL=+$GET(^TMP("BKMVQCR",$JOB,CAT,TYPE,"CNT"))
+4 WRITE ?47,$JUSTIFY(VAL,3)
+5 SET PERC=$GET(^TMP("BKMVQCR",$JOB,CAT,TYPE,"PERC"))
+6 WRITE ?55,$JUSTIFY(PERC,5,1),"%",!
+7 QUIT
PAT(BKMPATN,BKMDFN) ;
+1 NEW BKMIEN,BKMREG
+2 IF $GET(BKMPATN)=""!($GET(BKMDFN)="")
QUIT
+3 ;W ?1,$$GET1^DIQ(2,BKMDFN,".01","E")
+4 WRITE ?1,$GET(BKMPATN)
+5 WRITE ?32,$$HRN^BKMVA1(BKMDFN)
+6 WRITE ?39,$$GET1^DIQ(2,BKMDFN,".033","E")
+7 WRITE ?43,$$GET1^DIQ(2,BKMDFN,".02","I")
+8 SET BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
+9 IF BKMIEN=""
QUIT
+10 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+11 IF BKMREG=""
QUIT
+12 WRITE ?47,$$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",","2.3","E")
+13 WRITE ?52,$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",","5","I"),"5Z")
+14 WRITE ?64,$$FMTE^XLFDT($$GET1^DIQ(90451.01,BKMREG_","_BKMIEN_",","5.5","I"),"5Z")
+15 WRITE !
+16 QUIT
PATHDR ;
+1 NEW BKMHDR
+2 SET $PIECE(BKMHDR,"-",79)=""
+3 WRITE ?1,"Patient Name"
+4 WRITE ?32,"HRN"
+5 WRITE ?39,"Age"
+6 WRITE ?43,"Sex"
+7 WRITE ?47,"Dx"
+8 WRITE ?52,"Init HIV Dx"
+9 WRITE ?64,"Init AIDS Dx"
+10 WRITE !
+11 WRITE ?1,$EXTRACT(BKMHDR,1,30)
+12 WRITE ?32,$EXTRACT(BKMHDR,1,6)
+13 WRITE ?39,$EXTRACT(BKMHDR,1,3)
+14 WRITE ?43,$EXTRACT(BKMHDR,1,3)
+15 WRITE ?47,$EXTRACT(BKMHDR,1,4)
+16 WRITE ?52,$EXTRACT(BKMHDR,1,11)
+17 WRITE ?64,$EXTRACT(BKMHDR,1,12)
+18 WRITE !
+19 ;D HDR3^BKMIMRP1
+20 QUIT
HDR ;
+1 SET HDRST=$$PAD^BKMIXX4($$GET1^DIQ(200,DUZ_",","1","E"),">"," ",35)_$$PAD^BKMIXX4(EXDT,">"," ",35)_"Page: "_PAGE
+2 DO HDR^BKMIMRP1(HDRST,"")
+3 DO HDR^BKMIMRP1(INST,"")
+4 DO HDR^BKMIMRP1("*** HMS CUMULATIVE AUDIT REPORT -- HIV QUALITY OF CARE ***","")
+5 DO HDR^BKMIMRP1("Denominator Population - "_DENPOP,"")
+6 DO HDR^BKMIMRP1("Period Ending: "_HEEXT,"")
+7 IF IOST'["C-"
IF PAGE=1
DO DISP
+8 IF '$TEST
DO HDR^BKMIMRP1(CONFS,"")
+9 DO HDR3^BKMIMRP1
+10 SET PAGE=PAGE+1
+11 QUIT
+12 ;
DISP ;
+1 WRITE !!,?30,"***WARNING***",!
+2 WRITE ?21,"***RESTRICTED INFORMATION***",!
+3 WRITE ?1,"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *",!
+4 WRITE ?1,"* All information in this system is protected by the Privacy Act of *",!
+5 WRITE ?1,"* 1974. If you elect to proceed, you will be required to prove you have *",!
+6 WRITE ?1,"* a need to know. Access of data in this system is tracked, and your *",!
+7 WRITE ?1,"* station Security Officer may contact you for your justification. *",!
+8 WRITE ?1,"* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *",!
+9 QUIT
