BKMQQCR ;VNGT/HS/ALA - BKMV Quality of Care Report
;;2.1;HIV MANAGEMENT SYSTEM;**1**;FEB 7, 2011;Build 30
Q
; Check taxonomies - added per bugzilla #1497
;D FLTRMSG^BKMIMRP1 ; will be replaced by RPC call to BQITAXX
;
RUN(DATA,BKMRPOP,EDATE,OWNR,PLIEN,BKMTAG,DFN,GUI) ; EP - Run Quality of Care Report
;
; Input:
; DFN - Either set to a single Patient Internal ID or
; in an array in the following format:
; DFN(IX)=DFN_$C(28)
; GUI - Running from GUI is 0, running from RPMS is 1
; EDATE - Ending date for report
; OWNR - Owner Internal Entry Number if running report by panel
; PLIEN - Panel Internal Entry Number if running report by panel
; BKMRPOP - Report Population:
; - R = Active on HMS Register
; - D = Active HIV/AIDS Diagnostic Tag
; - P = By selected patients
; BKMTAG - If BKMRPOP is by Diagnostic Tag, identifies the status:
; - Proposed
; - Accepted
; - Proposed or Accepted
;
N BQII,GLOB,HMSIEN,LIST,II,PT,CNT,DENPOP,NDA
;
S BQII=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BKMQQCR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
NEW BN,PLNM,LIST,UID,PER1,PERSIX,AMH,BDT,BEGDATE,BKMCCPT,BKMCD4,BKMDFN,BKMIEN,BKMPATN
NEW BKMREG,BKMVCPT,BKMVIR,CCPT,CD4,COLDTM,CPT,CPTTAXX,CPTTAXX1,CPTTAXX2,DATE,EDT,ENDATE
NEW GLOBAL3,HEND,HP1B,HP1E,HP2B,HP2E,HP3B,HP3E,HP61B,HP61E,HP62B,HP62E,HREV,HSDTM,ICDTAX1,IEN
NEW NUMB,P1B,P1E,P2B,P2E,P3B,P3E,P61B,P61E,P62B,P62E,PDATA,PRCTAX,PTOTAL,QFL,REG,REGIEN,RESULT
NEW REVPER,SITETAX,STAT,TAX,TIEN,TOTPTS,TREF,TXN,TYP,VCPT,VDATA,VSDTM,VIRAL,VISTOT,VSTDT,Y
NEW VISIT,RGST,TAGST
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S GLOB=$NA(^TMP("BKMQQCRA",UID))
K @GLOB
S HMSIEN=$O(^BQI(90506.2,"B","HIV/AIDS",""))
I HMSIEN="" S BMXSEC="HMS Register missing from file definition." Q
S EDATE=$$DATE^BQIUL1($G(EDATE))
S REVPER=$$FMADD^XLFDT(EDATE,-365),PER1=$$FMADD^XLFDT(EDATE,-121)
S PERSIX=$$FMADD^XLFDT(EDATE,-183)
I EDATE'[".24" S EDATE=EDATE_".24" ; Report should include info through midnight on the end date.
S DFN=$G(DFN,""),OWNR=$G(OWNR),PLIEN=$G(PLIEN),PLNM="",GUI=$G(GUI,0)
;
I OWNR="",PLIEN="",GUI D
. I BKMRPOP="P" Q
. I BKMRPOP="D" S RIEN="" D
.. F S RIEN=$O(^BQIREG("B",3,RIEN)) Q:RIEN="" D
... S TAGST=$P(^BQIREG(RIEN,0),U,3),PT=$P(^BQIREG(RIEN,0),U,2)
... I BKMTAG="B",TAGST="A"!(TAGST="P") S @GLOB@("HIVCHK",PT)="" Q
... I TAGST=BKMTAG S @GLOB@("HIVCHK",PT)=""
. I BKMRPOP="R" D
.. S RIEN=0
.. F S RIEN=$O(^BKM(90451,RIEN)) Q:'RIEN D
... S RGST=$P($G(^BKM(90451,RIEN,1,1,0)),U,7),PT=$P(^BKM(90451,RIEN,0),U,1)
... I RGST="A" S @GLOB@("HIVCHK",PT)=""
;
I OWNR'="",PLIEN'="" D
. N IENS,DA
. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
. S PLNM=$$GET1^DIQ(90505.01,IENS,.01,"I")
. I BKMRPOP="P" Q
. S PT=0
. F S PT=$O(^BQICARE(OWNR,1,PLIEN,40,PT)) Q:'PT S @GLOB@("HIVCHK",PT)=""
;
I BKMRPOP="P" D
. I GUI D Q
.. S PT="" F S PT=$O(DFN(PT)) Q:PT="" S @GLOB@("HIVCHK",PT)=""
. S LIST=DFN
. I DFN="" D
.. S LIST="",BN=""
.. F S BN=$O(DFN(BN)) Q:BN="" S LIST=LIST_DFN(BN)
.. K DFN
. F II=1:1 S PT=$P(LIST,$C(28),II) Q:PT="" S @GLOB@("HIVCHK",PT)=""
;
S DENPOP=$S(BKMRPOP="R":"Active HMS Register Patients",BKMRPOP="P":"User Selected",1:"HIV/AIDS Diagnostic Tag: "_$S(BKMTAG="A":"Accepted",BKMTAG="P":"Proposed",1:"Proposed and Accepted"))
D ACTWRK^BKMQQCRU
I '$D(@GLOB@("HIVCHK")) S BMXSEC="RPC Call Failed: This report cannot be run. None of the patients selected for this report meet the criteria."
G XIT:$G(BMXSEC)'=""
;
S BKMDFN=0
F CNT=0:1 S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) I 'BKMDFN Q
S @GLOB@("HIVTOT1")=CNT
; compile totals by Gender and Age
D GENDER,AGE
NEW DA,DLAYGO,DIC,X,LOGN,BKMUPD
I $G(^BKM(90450,1,60,0))="" S ^BKM(90450,1,60,0)="^90450.11D^^"
S DA(1)=1,DLAYGO=90450.11,DIC="^BKM(90450,"_DA(1)_",60,",DIC(0)="L"
S X=$$NOW^XLFDT() K DO,DD D FILE^DICN S LOGN=+Y
; run CD4, Viral load, rapid plasma reagin algorithms
S BKMUPD(90450.11,LOGN_",1,",.02)=$$NOW^XLFDT()
D CD4CHK^BKMQQCR1
S BKMUPD(90450.11,LOGN_",1,",.03)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.04)=$$NOW^XLFDT()
D VRLLD^BKMQQCR1
S BKMUPD(90450.11,LOGN_",1,",.05)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.06)=$$NOW^XLFDT()
D RPR^BKMQQCR1
S BKMUPD(90450.11,LOGN_",1,",.07)=$$NOW^XLFDT()
; run chlamydia, gonorrhea, tuberculosis, and pneumo algorithms
S BKMUPD(90450.11,LOGN_",1,",.08)=$$NOW^XLFDT()
D CHLAM^BKMQQCR2
S BKMUPD(90450.11,LOGN_",1,",.09)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1)=$$NOW^XLFDT()
D GON^BKMQQCR2
S BKMUPD(90450.11,LOGN_",1,",.11)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.12)=$$NOW^XLFDT()
D TBT21^BKMQQCR2
S BKMUPD(90450.11,LOGN_",1,",.13)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.14)=$$NOW^XLFDT()
D PNEUMO^BKMQQCR2
S BKMUPD(90450.11,LOGN_",1,",.15)=$$NOW^XLFDT()
; run tetanus, eye, dental, and pap algorithms
S BKMUPD(90450.11,LOGN_",1,",.16)=$$NOW^XLFDT()
D TETSTAT^BKMQQCR3
S BKMUPD(90450.11,LOGN_",1,",.17)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.18)=$$NOW^XLFDT()
D EYEEXAM^BKMQQCR3
S BKMUPD(90450.11,LOGN_",1,",.19)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.2)=$$NOW^XLFDT()
D DENTEXAM^BKMQQCR3
S BKMUPD(90450.11,LOGN_",1,",.21)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.22)=$$NOW^XLFDT()
D PAP^BKMQQCR3
S BKMUPD(90450.11,LOGN_",1,",.23)=$$NOW^XLFDT()
; run ARV and MAC algorithms
S BKMUPD(90450.11,LOGN_",1,",.24)=$$NOW^XLFDT()
D ARVM03^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.25)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.26)=$$NOW^XLFDT()
D ARVM02^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.27)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.28)=$$NOW^XLFDT()
D ARVM05^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.29)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.101)=$$NOW^XLFDT()
D ARVM09^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.102)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.103)=$$NOW^XLFDT()
D ARVM10^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.104)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.105)=$$NOW^XLFDT()
D ARVM11^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.106)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.107)=$$NOW^XLFDT()
D ARVM12^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.108)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.109)=$$NOW^XLFDT()
D ARVM13^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.1011)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1012)=$$NOW^XLFDT()
D PCP^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.1013)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1014)=$$NOW^XLFDT()
D MAC^BKMQQCR4
S BKMUPD(90450.11,LOGN_",1,",.1015)=$$NOW^XLFDT()
; run tobacco, substance abuse algorithms
S BKMUPD(90450.11,LOGN_",1,",.1016)=$$NOW^XLFDT()
D TOBACCO^BKMQQCR5
S BKMUPD(90450.11,LOGN_",1,",.1017)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1018)=$$NOW^XLFDT()
D SUBS01^BKMQQCR5
S BKMUPD(90450.11,LOGN_",1,",.1019)=$$NOW^XLFDT()
; run Lipids,HEP C Screen and CRC
S BKMUPD(90450.11,LOGN_",1,",.1021)=$$NOW^XLFDT()
D LIPIDS^BKMQQCR2
S BKMUPD(90450.11,LOGN_",1,",.1022)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1023)=$$NOW^XLFDT()
D HEPC^BKMQQCR1
S BKMUPD(90450.11,LOGN_",1,",.1024)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1025)=$$NOW^XLFDT()
D CRC^BKMQQCR1
S BKMUPD(90450.11,LOGN_",1,",.1026)=$$NOW^XLFDT()
;
; New updates for HIVQual
S BKMUPD(90450.11,LOGN_",1,",.1027)=$$NOW^XLFDT()
D ^BKMQQCRB
S BKMUPD(90450.11,LOGN_",1,",.1028)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1029)=$$NOW^XLFDT()
D ^BKMQQCRC
S BKMUPD(90450.11,LOGN_",1,",.1031)=$$NOW^XLFDT()
S BKMUPD(90450.11,LOGN_",1,",.1032)=$$NOW^XLFDT()
D ^BKMQQCRD
S BKMUPD(90450.11,LOGN_",1,",.1033)=$$NOW^XLFDT()
;K ^ARLIS1 M ^ARLIS1=^TMP("BKMQQCRA",UID)
EN2 ; do mathematical calculations
D CD4CALC^BKMQQCR6,VRLLDC^BKMQQCR6,RPRCALC^BKMQQCR6
D CHLAMC^BKMQQCR7,GONCALC^BKMQQCR7,TBCALC^BKMQQCR7
D PNEUMOC^BKMQQCR8,TETCALC^BKMQQCR8,EYECALC^BKMQQCR8,DENTCALC^BKMQQCR8,PAPCALC^BKMQQCR8
D ARVCALC^BKMQQCR9,PCP^BKMQQCR9,MAC^BKMQQCR9,TOBCALC^BKMQQCR9,SUBCALC^BKMQQCR9
D LIPCALC^BKMQQCR8,HEPCCALC^BKMQQCR8,CRCCALC^BKMQQCR8
D VISCALC^BKMQQCR9,LABCALC^BKMQQCR9,MHCHK^BKMQQCR9,EDCHK^BKMQQCR9
D APHCALC^BKMQQCR9
;
EN3 ; print the report
D PRINT^BKMQQCRA
I 'GUI D CLEAN,XIT
D FILE^DIE("","BKMUPD","ERROR")
Q
;
GENDER ; gender totals compilation
N DFN,TOTM,TOTF,TOTU,SEX
S (DFN,TOTM,TOTF,TOTU)=0
F S DFN=$O(@GLOB@("HIVCHK",DFN)) Q:'DFN D
.S SEX=$$GET1^DIQ(2,DFN_",",".02","I")
.I SEX="F" S TOTF=TOTF+1 Q
.I SEX="M" S TOTM=TOTM+1 Q
.S TOTU=TOTU+1
S @GLOB@("FEMALE")=TOTF
S @GLOB@("MALE")=TOTM
S @GLOB@("UNSPEC")=TOTU
Q
;
AGE ; age totals compilation
N DFN,AGE,CNT1,CNT2,CNT3,CNT4
S DFN=0,(CNT1,CNT2,CNT3,CNT4)=0
F S DFN=$O(@GLOB@("HIVCHK",DFN)) Q:'DFN D
. S AGE=$$AGE^BKMIMRP1(DFN)
. ; AGE could return days, weeks or months for patients under 3 years
. I AGE'?1.N S CNT1=CNT1+1 Q
. ; AGE<15 is a single category
. I AGE<15 S CNT1=CNT1+1 Q
. I AGE'>44 S CNT2=CNT2+1 Q
. I AGE'>64 S CNT3=CNT3+1 Q
. ; AGE>64
. S CNT4=CNT4+1
S @GLOB@("AGE1")=CNT1
S @GLOB@("AGE2")=CNT2
S @GLOB@("AGE3")=CNT3
S @GLOB@("AGE4")=CNT4
Q
;
CLEAN ;clean up variables
K @GLOB
Q
;
XIT ;
Q
;
ERR ;
D ^%ZTER
N Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
Q
BKMQQCR ;VNGT/HS/ALA - BKMV Quality of Care Report
+1 ;;2.1;HIV MANAGEMENT SYSTEM;**1**;FEB 7, 2011;Build 30
+2 QUIT
+3 ; Check taxonomies - added per bugzilla #1497
+4 ;D FLTRMSG^BKMIMRP1 ; will be replaced by RPC call to BQITAXX
+5 ;
RUN(DATA,BKMRPOP,EDATE,OWNR,PLIEN,BKMTAG,DFN,GUI) ; EP - Run Quality of Care Report
+1 ;
+2 ; Input:
+3 ; DFN - Either set to a single Patient Internal ID or
+4 ; in an array in the following format:
+5 ; DFN(IX)=DFN_$C(28)
+6 ; GUI - Running from GUI is 0, running from RPMS is 1
+7 ; EDATE - Ending date for report
+8 ; OWNR - Owner Internal Entry Number if running report by panel
+9 ; PLIEN - Panel Internal Entry Number if running report by panel
+10 ; BKMRPOP - Report Population:
+11 ; - R = Active on HMS Register
+12 ; - D = Active HIV/AIDS Diagnostic Tag
+13 ; - P = By selected patients
+14 ; BKMTAG - If BKMRPOP is by Diagnostic Tag, identifies the status:
+15 ; - Proposed
+16 ; - Accepted
+17 ; - Proposed or Accepted
+18 ;
+19 NEW BQII,GLOB,HMSIEN,LIST,II,PT,CNT,DENPOP,NDA
+20 ;
+21 SET BQII=0
+22 ;
+23 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BKMQQCR D UNWIND^%ZTER"
+24 NEW BN,PLNM,LIST,UID,PER1,PERSIX,AMH,BDT,BEGDATE,BKMCCPT,BKMCD4,BKMDFN,BKMIEN,BKMPATN
+25 NEW BKMREG,BKMVCPT,BKMVIR,CCPT,CD4,COLDTM,CPT,CPTTAXX,CPTTAXX1,CPTTAXX2,DATE,EDT,ENDATE
+26 NEW GLOBAL3,HEND,HP1B,HP1E,HP2B,HP2E,HP3B,HP3E,HP61B,HP61E,HP62B,HP62E,HREV,HSDTM,ICDTAX1,IEN
+27 NEW NUMB,P1B,P1E,P2B,P2E,P3B,P3E,P61B,P61E,P62B,P62E,PDATA,PRCTAX,PTOTAL,QFL,REG,REGIEN,RESULT
+28 NEW REVPER,SITETAX,STAT,TAX,TIEN,TOTPTS,TREF,TXN,TYP,VCPT,VDATA,VSDTM,VIRAL,VISTOT,VSTDT,Y
+29 NEW VISIT,RGST,TAGST
+30 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+31 SET GLOB=$NAME(^TMP("BKMQQCRA",UID))
+32 KILL @GLOB
+33 SET HMSIEN=$ORDER(^BQI(90506.2,"B","HIV/AIDS",""))
+34 IF HMSIEN=""
SET BMXSEC="HMS Register missing from file definition."
QUIT
+35 SET EDATE=$$DATE^BQIUL1($GET(EDATE))
+36 SET REVPER=$$FMADD^XLFDT(EDATE,-365)
SET PER1=$$FMADD^XLFDT(EDATE,-121)
+37 SET PERSIX=$$FMADD^XLFDT(EDATE,-183)
+38 ; Report should include info through midnight on the end date.
IF EDATE'[".24"
SET EDATE=EDATE_".24"
+39 SET DFN=$GET(DFN,"")
SET OWNR=$GET(OWNR)
SET PLIEN=$GET(PLIEN)
SET PLNM=""
SET GUI=$GET(GUI,0)
+40 ;
+41 IF OWNR=""
IF PLIEN=""
IF GUI
Begin DoDot:1
+42 IF BKMRPOP="P"
QUIT
+43 IF BKMRPOP="D"
SET RIEN=""
Begin DoDot:2
+44 FOR
SET RIEN=$ORDER(^BQIREG("B",3,RIEN))
IF RIEN=""
QUIT
Begin DoDot:3
+45 SET TAGST=$PIECE(^BQIREG(RIEN,0),U,3)
SET PT=$PIECE(^BQIREG(RIEN,0),U,2)
+46 IF BKMTAG="B"
IF TAGST="A"!(TAGST="P")
SET @GLOB@("HIVCHK",PT)=""
QUIT
+47 IF TAGST=BKMTAG
SET @GLOB@("HIVCHK",PT)=""
End DoDot:3
End DoDot:2
+48 IF BKMRPOP="R"
Begin DoDot:2
+49 SET RIEN=0
+50 FOR
SET RIEN=$ORDER(^BKM(90451,RIEN))
IF 'RIEN
QUIT
Begin DoDot:3
+51 SET RGST=$PIECE($GET(^BKM(90451,RIEN,1,1,0)),U,7)
SET PT=$PIECE(^BKM(90451,RIEN,0),U,1)
+52 IF RGST="A"
SET @GLOB@("HIVCHK",PT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;
+54 IF OWNR'=""
IF PLIEN'=""
Begin DoDot:1
+55 NEW IENS,DA
+56 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+57 SET PLNM=$$GET1^DIQ(90505.01,IENS,.01,"I")
+58 IF BKMRPOP="P"
QUIT
+59 SET PT=0
+60 FOR
SET PT=$ORDER(^BQICARE(OWNR,1,PLIEN,40,PT))
IF 'PT
QUIT
SET @GLOB@("HIVCHK",PT)=""
End DoDot:1
+61 ;
+62 IF BKMRPOP="P"
Begin DoDot:1
+63 IF GUI
Begin DoDot:2
+64 SET PT=""
FOR
SET PT=$ORDER(DFN(PT))
IF PT=""
QUIT
SET @GLOB@("HIVCHK",PT)=""
End DoDot:2
QUIT
+65 SET LIST=DFN
+66 IF DFN=""
Begin DoDot:2
+67 SET LIST=""
SET BN=""
+68 FOR
SET BN=$ORDER(DFN(BN))
IF BN=""
QUIT
SET LIST=LIST_DFN(BN)
+69 KILL DFN
End DoDot:2
+70 FOR II=1:1
SET PT=$PIECE(LIST,$CHAR(28),II)
IF PT=""
QUIT
SET @GLOB@("HIVCHK",PT)=""
End DoDot:1
+71 ;
+72 SET DENPOP=$SELECT(BKMRPOP="R":"Active HMS Register Patients",BKMRPOP="P":"User Selected",1:"HIV/AIDS Diagnostic Tag: "_$SELECT(BKMTAG="A":"Accepted",BKMTAG="P":"Proposed",1:"Proposed and Accepted"))
+73 DO ACTWRK^BKMQQCRU
+74 IF '$DATA(@GLOB@("HIVCHK"))
SET BMXSEC="RPC Call Failed: This report cannot be run. None of the patients selected for this report meet the criteria."
+75 IF $GET(BMXSEC)'=""
GOTO XIT
+76 ;
+77 SET BKMDFN=0
+78 FOR CNT=0:1
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
+79 SET @GLOB@("HIVTOT1")=CNT
+80 ; compile totals by Gender and Age
+81 DO GENDER
DO AGE
+82 NEW DA,DLAYGO,DIC,X,LOGN,BKMUPD
+83 IF $GET(^BKM(90450,1,60,0))=""
SET ^BKM(90450,1,60,0)="^90450.11D^^"
+84 SET DA(1)=1
SET DLAYGO=90450.11
SET DIC="^BKM(90450,"_DA(1)_",60,"
SET DIC(0)="L"
+85 SET X=$$NOW^XLFDT()
KILL DO,DD
DO FILE^DICN
SET LOGN=+Y
+86 ; run CD4, Viral load, rapid plasma reagin algorithms
+87 SET BKMUPD(90450.11,LOGN_",1,",.02)=$$NOW^XLFDT()
+88 DO CD4CHK^BKMQQCR1
+89 SET BKMUPD(90450.11,LOGN_",1,",.03)=$$NOW^XLFDT()
+90 SET BKMUPD(90450.11,LOGN_",1,",.04)=$$NOW^XLFDT()
+91 DO VRLLD^BKMQQCR1
+92 SET BKMUPD(90450.11,LOGN_",1,",.05)=$$NOW^XLFDT()
+93 SET BKMUPD(90450.11,LOGN_",1,",.06)=$$NOW^XLFDT()
+94 DO RPR^BKMQQCR1
+95 SET BKMUPD(90450.11,LOGN_",1,",.07)=$$NOW^XLFDT()
+96 ; run chlamydia, gonorrhea, tuberculosis, and pneumo algorithms
+97 SET BKMUPD(90450.11,LOGN_",1,",.08)=$$NOW^XLFDT()
+98 DO CHLAM^BKMQQCR2
+99 SET BKMUPD(90450.11,LOGN_",1,",.09)=$$NOW^XLFDT()
+100 SET BKMUPD(90450.11,LOGN_",1,",.1)=$$NOW^XLFDT()
+101 DO GON^BKMQQCR2
+102 SET BKMUPD(90450.11,LOGN_",1,",.11)=$$NOW^XLFDT()
+103 SET BKMUPD(90450.11,LOGN_",1,",.12)=$$NOW^XLFDT()
+104 DO TBT21^BKMQQCR2
+105 SET BKMUPD(90450.11,LOGN_",1,",.13)=$$NOW^XLFDT()
+106 SET BKMUPD(90450.11,LOGN_",1,",.14)=$$NOW^XLFDT()
+107 DO PNEUMO^BKMQQCR2
+108 SET BKMUPD(90450.11,LOGN_",1,",.15)=$$NOW^XLFDT()
+109 ; run tetanus, eye, dental, and pap algorithms
+110 SET BKMUPD(90450.11,LOGN_",1,",.16)=$$NOW^XLFDT()
+111 DO TETSTAT^BKMQQCR3
+112 SET BKMUPD(90450.11,LOGN_",1,",.17)=$$NOW^XLFDT()
+113 SET BKMUPD(90450.11,LOGN_",1,",.18)=$$NOW^XLFDT()
+114 DO EYEEXAM^BKMQQCR3
+115 SET BKMUPD(90450.11,LOGN_",1,",.19)=$$NOW^XLFDT()
+116 SET BKMUPD(90450.11,LOGN_",1,",.2)=$$NOW^XLFDT()
+117 DO DENTEXAM^BKMQQCR3
+118 SET BKMUPD(90450.11,LOGN_",1,",.21)=$$NOW^XLFDT()
+119 SET BKMUPD(90450.11,LOGN_",1,",.22)=$$NOW^XLFDT()
+120 DO PAP^BKMQQCR3
+121 SET BKMUPD(90450.11,LOGN_",1,",.23)=$$NOW^XLFDT()
+122 ; run ARV and MAC algorithms
+123 SET BKMUPD(90450.11,LOGN_",1,",.24)=$$NOW^XLFDT()
+124 DO ARVM03^BKMQQCR4
+125 SET BKMUPD(90450.11,LOGN_",1,",.25)=$$NOW^XLFDT()
+126 SET BKMUPD(90450.11,LOGN_",1,",.26)=$$NOW^XLFDT()
+127 DO ARVM02^BKMQQCR4
+128 SET BKMUPD(90450.11,LOGN_",1,",.27)=$$NOW^XLFDT()
+129 SET BKMUPD(90450.11,LOGN_",1,",.28)=$$NOW^XLFDT()
+130 DO ARVM05^BKMQQCR4
+131 SET BKMUPD(90450.11,LOGN_",1,",.29)=$$NOW^XLFDT()
+132 SET BKMUPD(90450.11,LOGN_",1,",.101)=$$NOW^XLFDT()
+133 DO ARVM09^BKMQQCR4
+134 SET BKMUPD(90450.11,LOGN_",1,",.102)=$$NOW^XLFDT()
+135 SET BKMUPD(90450.11,LOGN_",1,",.103)=$$NOW^XLFDT()
+136 DO ARVM10^BKMQQCR4
+137 SET BKMUPD(90450.11,LOGN_",1,",.104)=$$NOW^XLFDT()
+138 SET BKMUPD(90450.11,LOGN_",1,",.105)=$$NOW^XLFDT()
+139 DO ARVM11^BKMQQCR4
+140 SET BKMUPD(90450.11,LOGN_",1,",.106)=$$NOW^XLFDT()
+141 SET BKMUPD(90450.11,LOGN_",1,",.107)=$$NOW^XLFDT()
+142 DO ARVM12^BKMQQCR4
+143 SET BKMUPD(90450.11,LOGN_",1,",.108)=$$NOW^XLFDT()
+144 SET BKMUPD(90450.11,LOGN_",1,",.109)=$$NOW^XLFDT()
+145 DO ARVM13^BKMQQCR4
+146 SET BKMUPD(90450.11,LOGN_",1,",.1011)=$$NOW^XLFDT()
+147 SET BKMUPD(90450.11,LOGN_",1,",.1012)=$$NOW^XLFDT()
+148 DO PCP^BKMQQCR4
+149 SET BKMUPD(90450.11,LOGN_",1,",.1013)=$$NOW^XLFDT()
+150 SET BKMUPD(90450.11,LOGN_",1,",.1014)=$$NOW^XLFDT()
+151 DO MAC^BKMQQCR4
+152 SET BKMUPD(90450.11,LOGN_",1,",.1015)=$$NOW^XLFDT()
+153 ; run tobacco, substance abuse algorithms
+154 SET BKMUPD(90450.11,LOGN_",1,",.1016)=$$NOW^XLFDT()
+155 DO TOBACCO^BKMQQCR5
+156 SET BKMUPD(90450.11,LOGN_",1,",.1017)=$$NOW^XLFDT()
+157 SET BKMUPD(90450.11,LOGN_",1,",.1018)=$$NOW^XLFDT()
+158 DO SUBS01^BKMQQCR5
+159 SET BKMUPD(90450.11,LOGN_",1,",.1019)=$$NOW^XLFDT()
+160 ; run Lipids,HEP C Screen and CRC
+161 SET BKMUPD(90450.11,LOGN_",1,",.1021)=$$NOW^XLFDT()
+162 DO LIPIDS^BKMQQCR2
+163 SET BKMUPD(90450.11,LOGN_",1,",.1022)=$$NOW^XLFDT()
+164 SET BKMUPD(90450.11,LOGN_",1,",.1023)=$$NOW^XLFDT()
+165 DO HEPC^BKMQQCR1
+166 SET BKMUPD(90450.11,LOGN_",1,",.1024)=$$NOW^XLFDT()
+167 SET BKMUPD(90450.11,LOGN_",1,",.1025)=$$NOW^XLFDT()
+168 DO CRC^BKMQQCR1
+169 SET BKMUPD(90450.11,LOGN_",1,",.1026)=$$NOW^XLFDT()
+170 ;
+171 ; New updates for HIVQual
+172 SET BKMUPD(90450.11,LOGN_",1,",.1027)=$$NOW^XLFDT()
+173 DO ^BKMQQCRB
+174 SET BKMUPD(90450.11,LOGN_",1,",.1028)=$$NOW^XLFDT()
+175 SET BKMUPD(90450.11,LOGN_",1,",.1029)=$$NOW^XLFDT()
+176 DO ^BKMQQCRC
+177 SET BKMUPD(90450.11,LOGN_",1,",.1031)=$$NOW^XLFDT()
+178 SET BKMUPD(90450.11,LOGN_",1,",.1032)=$$NOW^XLFDT()
+179 DO ^BKMQQCRD
+180 SET BKMUPD(90450.11,LOGN_",1,",.1033)=$$NOW^XLFDT()
+181 ;K ^ARLIS1 M ^ARLIS1=^TMP("BKMQQCRA",UID)
EN2 ; do mathematical calculations
+1 DO CD4CALC^BKMQQCR6
DO VRLLDC^BKMQQCR6
DO RPRCALC^BKMQQCR6
+2 DO CHLAMC^BKMQQCR7
DO GONCALC^BKMQQCR7
DO TBCALC^BKMQQCR7
+3 DO PNEUMOC^BKMQQCR8
DO TETCALC^BKMQQCR8
DO EYECALC^BKMQQCR8
DO DENTCALC^BKMQQCR8
DO PAPCALC^BKMQQCR8
+4 DO ARVCALC^BKMQQCR9
DO PCP^BKMQQCR9
DO MAC^BKMQQCR9
DO TOBCALC^BKMQQCR9
DO SUBCALC^BKMQQCR9
+5 DO LIPCALC^BKMQQCR8
DO HEPCCALC^BKMQQCR8
DO CRCCALC^BKMQQCR8
+6 DO VISCALC^BKMQQCR9
DO LABCALC^BKMQQCR9
DO MHCHK^BKMQQCR9
DO EDCHK^BKMQQCR9
+7 DO APHCALC^BKMQQCR9
+8 ;
EN3 ; print the report
+1 DO PRINT^BKMQQCRA
+2 IF 'GUI
DO CLEAN
DO XIT
+3 DO FILE^DIE("","BKMUPD","ERROR")
+4 QUIT
+5 ;
GENDER ; gender totals compilation
+1 NEW DFN,TOTM,TOTF,TOTU,SEX
+2 SET (DFN,TOTM,TOTF,TOTU)=0
+3 FOR
SET DFN=$ORDER(@GLOB@("HIVCHK",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+4 SET SEX=$$GET1^DIQ(2,DFN_",",".02","I")
+5 IF SEX="F"
SET TOTF=TOTF+1
QUIT
+6 IF SEX="M"
SET TOTM=TOTM+1
QUIT
+7 SET TOTU=TOTU+1
End DoDot:1
+8 SET @GLOB@("FEMALE")=TOTF
+9 SET @GLOB@("MALE")=TOTM
+10 SET @GLOB@("UNSPEC")=TOTU
+11 QUIT
+12 ;
AGE ; age totals compilation
+1 NEW DFN,AGE,CNT1,CNT2,CNT3,CNT4
+2 SET DFN=0
SET (CNT1,CNT2,CNT3,CNT4)=0
+3 FOR
SET DFN=$ORDER(@GLOB@("HIVCHK",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+4 SET AGE=$$AGE^BKMIMRP1(DFN)
+5 ; AGE could return days, weeks or months for patients under 3 years
+6 IF AGE'?1.N
SET CNT1=CNT1+1
QUIT
+7 ; AGE<15 is a single category
+8 IF AGE<15
SET CNT1=CNT1+1
QUIT
+9 IF AGE'>44
SET CNT2=CNT2+1
QUIT
+10 IF AGE'>64
SET CNT3=CNT3+1
QUIT
+11 ; AGE>64
+12 SET CNT4=CNT4+1
End DoDot:1
+13 SET @GLOB@("AGE1")=CNT1
+14 SET @GLOB@("AGE2")=CNT2
+15 SET @GLOB@("AGE3")=CNT3
+16 SET @GLOB@("AGE4")=CNT4
+17 QUIT
+18 ;
CLEAN ;clean up variables
+1 KILL @GLOB
+2 QUIT
+3 ;
XIT ;
+1 QUIT
+2 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 QUIT
