BKMQQCRU ;VNGT/HS/ALA-QOC Utility Program ; 22 Mar 2010 9:28 AM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
ACTWRK ; Active from HMS Register Search
N ENDDT,GLOBX,REGDFN,VSTDT,HIVDT,AIDDT
N EXEC,IENS,BKMPATN,OK,DXCAT,STAT
N TREF,TAX,TRIEN,DXOK,TIEN,IEN,VISIT,VSDTM
;
S ENDDT=$$FMADD^XLFDT(EDATE,-183)
S GLOBX=$NA(^TMP("BKMQQCRX",UID))
K @GLOBX
;
; Denominator:
; Patients with Proposed or Accepted tag status
; with an HMS register status of active or blank (not in register)
;S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S TREF="BQITAX"
S TAX="BGP HIV/AIDS DXS"
D BLD^BQITUTL(TAX,TREF)
;
S REGDFN=0
F S REGDFN=$O(@GLOB@("HIVCHK",REGDFN)) Q:REGDFN="" D
. ;
. S IENS=$$HMSIENS^BKMQUTL(REGDFN)
. ;
. ; Selected active HMS Register patients
. I $G(BKMRPOP)="R" S OK=1 D Q:'OK
.. I IENS="" S OK=0 Q
.. S STAT=$$GET1^DIQ(90451.01,IENS,.5,"I") I STAT'="A",STAT'="T" S OK=0 Q
.. S DXCAT=$$GET1^DIQ(90451.01,IENS,2.3,"I")
.. ; Diagnosis category of "A", "H" or blank (At Risk is excluded)
.. I DXCAT="A"!(DXCAT="H")!(DXCAT="") Q
.. ;I "AH"[DXCAT Q
.. S OK=0 Q
. ;
. ; Selected active HIV/AIDS tag option.
. ; Check if current status matches selected status.
. I $G(BKMRPOP)="D",'$$ACT^BKMQUTL(REGDFN,HMSIEN,BKMTAG) Q
. ;
. ; Exclude if initial diagnosis was within 6 months of end date
. ; find latest date of fields 5 and 5.5
. S VSTDT=""
. S HIVDT=$$GET1^DIQ(90451.01,IENS,5.5,"I")
. I HIVDT'="",HIVDT<VSTDT!(VSTDT="") S VSTDT=HIVDT
. S AIDDT=$$GET1^DIQ(90451.01,IENS,5,"I")
. I AIDDT'="",AIDDT<VSTDT!(VSTDT="") S VSTDT=AIDDT
. ;
. ; If initial HIV or AIDS dx date check fails look for HIV/AIDS POV or Active Problem List
. I VSTDT>ENDDT!(VSTDT="") S DXOK=0 D I 'DXOK S BKMPATN=$$GET1^DIQ(2,REGDFN,".01","E"),NDA(BKMPATN,REGDFN)="",NDA=$G(NDA)+1 Q
.. ;
.. ; At least 1 HIV/AIDS POV or active problem list 6 months or more prior to report end date
.. ;
.. S TRIEN=0,DXOK=0
.. F S TRIEN=$O(@TREF@(TRIEN)) Q:'TRIEN I $$PRB(REGDFN,ENDDT) S DXOK=1 Q
.. Q:DXOK
.. ;
.. N TIEN,VDATA,PDATA
.. S IEN=""
.. F S IEN=$O(^AUPNVPOV("AC",REGDFN,IEN),-1) Q:IEN="" D Q:DXOK
... S PDATA=$G(^AUPNVPOV(IEN,0)) I PDATA="" Q
... ;S TIEN=$$GET1^DIQ(9000010.07,IEN,.01,"I") I TIEN="" Q
... S TIEN=$P(PDATA,U,1) I TIEN="" Q
... I '$D(@TREF@(TIEN)) Q
... S VISIT=$P(PDATA,U,3) I VISIT="" Q
... S VDATA=$G(^AUPNVSIT(VISIT,0)) I VDATA="" Q
... ;S VISIT=$$GET1^DIQ(9000010.07,IEN,.03,"I") I VISIT="" Q
... I $P(VDATA,U,11)=1 Q
... ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
... S VSDTM=$P(VDATA,U,1)\1 I VSDTM=0 Q
... ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
... I VSDTM<ENDDT S DXOK=1 Q
. S @GLOBX@("HIVCHK",REGDFN)=""
K @GLOB@("HIVCHK")
M @GLOB@("HIVCHK")=@GLOBX@("HIVCHK")
K @GLOBX@("HIVCHK"),@TREF
Q
;
PRB(DFN,DATE) ;EP - Check Problem File for instance of a patient
NEW PROB,PVIEN,VSDTM,OK,PBDATA
S PROB=0,OK=0
S PVIEN=""
F S PVIEN=$O(^AUPNPROB("AC",DFN,PVIEN),-1) Q:'PVIEN D Q:OK
. S PBDATA=$G(^AUPNPROB(PVIEN,0)) I PBDATA="" Q
. S TIEN=$P(PBDATA,U,1) I TIEN="" Q
. ;S TIEN=$$GET1^DIQ(9000011,PVIEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. ; Check class - if Family ignore
. I $P(PBDATA,U,4)="F" Q
. I $P(PBDATA,U,12)'="A" Q
. ;I $$GET1^DIQ(9000011,PVIEN,.04,"I")="F" Q
. ;I $$GET1^DIQ(9000011,PVIEN,.12,"I")'="A" Q
. S VSDTM=$$PROB^BQIUL1(PVIEN)\1 I VSDTM=0 Q
. I VSDTM<DATE S OK=1 Q
Q OK
;
ASTAT(BKMDFN,RPTDT,STAT,REG) ;EP -- ARV Status and Regimen
; Input
; BKMDFN - Patient IEN
; RPTDT - Report Date
; STAT - ARV Status
; REG - ARV Regimen
; Description
; Returns a result if the patient has the ARV status in the Report Period
NEW QFL,STDT,IEN,RESULT,BKMIEN,BKMREG,REVPER
S REVPER=$$FMADD^XLFDT(RPTDT,-365),STAT=$G(STAT,""),REG=$G(REG,"")
S STDT=RPTDT+.005
S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN) I BKMIEN="" Q 0
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
S RESULT=0,QFL=0
F S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1) Q:STDT=""!(STDT<REVPER) D Q:QFL
. S IEN=""
. F S IEN=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1) Q:IEN="" D Q:QFL
.. I $G(STAT)'="",$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)'=STAT Q
.. I $G(REG)'="",$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,3)'=REG Q
.. S RESULT=1_U_STDT_U_STAT_U_REG,QFL=1
Q RESULT
;
LAB(BKMDFN,SDATE,ALL) ;
K ALL
;S ENDATE=$$FMADD^XLFDT(SDATE,-56)
S ENDATE=SDATE
S BEGDATE=$$FMADD^XLFDT(SDATE,56)
S HREV=$$FMTH^XLFDT(BEGDATE,1),HEND=$$FMTH^XLFDT(ENDATE,1)
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S CD4="BKMCD4" K @CD4
F TAX="BKM CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES" D BLD^BQITUTL(TAX,CD4)
M @TREF=@CD4
;
S VIRAL="BKMVIR" K @VIRAL
F TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,VIRAL)
M @TREF=@VIRAL
;
S IEN=""
F S IEN=$O(^AUPNVLAB("AC",BKMDFN,IEN),-1) Q:IEN="" D
. S PDATA=$G(^AUPNVLAB(IEN,0)) I PDATA="" Q
. S TIEN=$P(PDATA,U,1) I TIEN="" Q
. I '$D(@TREF@(TIEN)) 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 RESULT=$P(PDATA,U,4)
. S HSDTM=$$FMTH^XLFDT(VSDTM,1)
. I HSDTM>HREV!(HSDTM<HEND) Q
. I $D(@CD4@(TIEN)) S ALL("ZLAB","CD4",VSDTM,IEN)=RESULT
. I $D(@VIRAL@(TIEN)) S ALL("ZLAB","VIRAL",VSDTM,IEN)=RESULT
Q
;
LB(ALL) ;
NEW COLDTM
I $G(UID)="" S UID=$J
S REVPER=$$FMADD^XLFDT(RPTDT,-365)
S P1B=$$FMADD^XLFDT(RPTDT,-120),P1E=RPTDT
S P2B=$$FMADD^XLFDT(RPTDT,-121),P2E=$$FMADD^XLFDT(RPTDT,-240)
S P3B=$$FMADD^XLFDT(RPTDT,-241),P3E=REVPER
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S CD4="BKMCD4" K @CD4
F TAX="BKM CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES" D BLD^BQITUTL(TAX,CD4)
S TIEN=""
F S TIEN=$O(@CD4@(TIEN)) Q:TIEN="" D
. S IEN=""
. F S IEN=$O(^AUPNVLAB("B",TIEN,IEN)) Q:IEN="" D
.. S DFN=$P($G(^AUPNVLAB(IEN,0)),U,2) I DFN="" Q
.. S VISIT=$P($G(^AUPNVLAB(IEN,0)),U,3) I VISIT="" Q
.. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I +VSDTM=0 Q
.. S COLDTM=$P($G(^AUPNVLAB(IEN,12)),U,1)\1
.. I COLDTM'=0 S VSDTM=COLDTM
.. S RESULT=$P(^AUPNVLAB(IEN,0),U,4) I RESULT="" Q
.. I RESULT?.AP Q
.. I VSDTM<REVPER!(VSDTM>RPTDT) Q
.. ;S ALL("ZLAB","CD4",DFN,VSDTM,IEN)=RESULT
.. I VSDTM'<P1B,VSDTM'>P1E S ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P1"
.. I VSDTM'>P2B,VSDTM'<P2E S ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P2"
.. I VSDTM'>P3B,VSDTM'<P3E S ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P3"
K @CD4
;
S VIRAL="BKMVIR" K @VIRAL
F TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,VIRAL)
S TIEN=""
F S TIEN=$O(@VIRAL@(TIEN)) Q:TIEN="" D
. S IEN=""
. F S IEN=$O(^AUPNVLAB("B",TIEN,IEN)) Q:IEN="" D
.. S DFN=$P($G(^AUPNVLAB(IEN,0)),U,2) I DFN="" Q
.. S VISIT=$P($G(^AUPNVLAB(IEN,0)),U,3) I VISIT="" Q
.. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I +VSDTM=0 Q
.. S COLDTM=$P($G(^AUPNVLAB(IEN,12)),U,1)\1
.. I COLDTM'=0 S VSDTM=COLDTM
.. S RESULT=$P(^AUPNVLAB(IEN,0),U,4) I RESULT="" Q
.. I RESULT?.AP Q
.. I VSDTM<REVPER!(VSDTM>RPTDT) Q
.. ;S ALL("ZLAB","VIRAL",DFN,VSDTM,IEN)=RESULT
.. I VSDTM'<P1B,VSDTM'>P1E S ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P1"
.. I VSDTM'>P2B,VSDTM'<P2E S ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P2"
.. I VSDTM'>P3B,VSDTM'<P3E S ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P3"
K @VIRAL
Q
;
DTR(RPTDT) ;EP - Get all date ranges from a report end date
S REVPER=$$FMADD^XLFDT(RPTDT,-365)
;S P1B=$$FMADD^XLFDT(RPTDT,-120),P1E=RPTDT
S P1B=RPTDT,P1E=$$FMADD^XLFDT(RPTDT,-120)
S HP1B=$$FMTH^XLFDT(P1B,1),HP1E=$$FMTH^XLFDT(P1E,1)
S P2B=$$FMADD^XLFDT(RPTDT,-121),P2E=$$FMADD^XLFDT(RPTDT,-240)
S HP2B=$$FMTH^XLFDT(P2B,1),HP2E=$$FMTH^XLFDT(P2E,1)
S P3B=$$FMADD^XLFDT(RPTDT,-241),P3E=REVPER
S HP3B=$$FMTH^XLFDT(P3B,1),HP3E=$$FMTH^XLFDT(P3E,1)
;S P61B=$$FMADD^XLFDT(RPTDT,-181),P61E=RPTDT
S P61B=RPTDT,P61E=$$FMADD^XLFDT(RPTDT,-181)
S HP61B=$$FMTH^XLFDT(P61B,1),HP61E=$$FMTH^XLFDT(P61E,1)
S P62B=$$FMADD^XLFDT(RPTDT,-182),P62E=REVPER
S HP62B=$$FMTH^XLFDT(P62B,1),HP62E=$$FMTH^XLFDT(P62E,1)
Q
BKMQQCRU ;VNGT/HS/ALA-QOC Utility Program ; 22 Mar 2010 9:28 AM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
ACTWRK ; Active from HMS Register Search
+1 NEW ENDDT,GLOBX,REGDFN,VSTDT,HIVDT,AIDDT
+2 NEW EXEC,IENS,BKMPATN,OK,DXCAT,STAT
+3 NEW TREF,TAX,TRIEN,DXOK,TIEN,IEN,VISIT,VSDTM
+4 ;
+5 SET ENDDT=$$FMADD^XLFDT(EDATE,-183)
+6 SET GLOBX=$NAME(^TMP("BKMQQCRX",UID))
+7 KILL @GLOBX
+8 ;
+9 ; Denominator:
+10 ; Patients with Proposed or Accepted tag status
+11 ; with an HMS register status of active or blank (not in register)
+12 ;S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
+13 SET TREF="BQITAX"
+14 SET TAX="BGP HIV/AIDS DXS"
+15 DO BLD^BQITUTL(TAX,TREF)
+16 ;
+17 SET REGDFN=0
+18 FOR
SET REGDFN=$ORDER(@GLOB@("HIVCHK",REGDFN))
IF REGDFN=""
QUIT
Begin DoDot:1
+19 ;
+20 SET IENS=$$HMSIENS^BKMQUTL(REGDFN)
+21 ;
+22 ; Selected active HMS Register patients
+23 IF $GET(BKMRPOP)="R"
SET OK=1
Begin DoDot:2
+24 IF IENS=""
SET OK=0
QUIT
+25 SET STAT=$$GET1^DIQ(90451.01,IENS,.5,"I")
IF STAT'="A"
IF STAT'="T"
SET OK=0
QUIT
+26 SET DXCAT=$$GET1^DIQ(90451.01,IENS,2.3,"I")
+27 ; Diagnosis category of "A", "H" or blank (At Risk is excluded)
+28 IF DXCAT="A"!(DXCAT="H")!(DXCAT="")
QUIT
+29 ;I "AH"[DXCAT Q
+30 SET OK=0
QUIT
End DoDot:2
IF 'OK
QUIT
+31 ;
+32 ; Selected active HIV/AIDS tag option.
+33 ; Check if current status matches selected status.
+34 IF $GET(BKMRPOP)="D"
IF '$$ACT^BKMQUTL(REGDFN,HMSIEN,BKMTAG)
QUIT
+35 ;
+36 ; Exclude if initial diagnosis was within 6 months of end date
+37 ; find latest date of fields 5 and 5.5
+38 SET VSTDT=""
+39 SET HIVDT=$$GET1^DIQ(90451.01,IENS,5.5,"I")
+40 IF HIVDT'=""
IF HIVDT<VSTDT!(VSTDT="")
SET VSTDT=HIVDT
+41 SET AIDDT=$$GET1^DIQ(90451.01,IENS,5,"I")
+42 IF AIDDT'=""
IF AIDDT<VSTDT!(VSTDT="")
SET VSTDT=AIDDT
+43 ;
+44 ; If initial HIV or AIDS dx date check fails look for HIV/AIDS POV or Active Problem List
+45 IF VSTDT>ENDDT!(VSTDT="")
SET DXOK=0
Begin DoDot:2
+46 ;
+47 ; At least 1 HIV/AIDS POV or active problem list 6 months or more prior to report end date
+48 ;
+49 SET TRIEN=0
SET DXOK=0
+50 FOR
SET TRIEN=$ORDER(@TREF@(TRIEN))
IF 'TRIEN
QUIT
IF $$PRB(REGDFN,ENDDT)
SET DXOK=1
QUIT
+51 IF DXOK
QUIT
+52 ;
+53 NEW TIEN,VDATA,PDATA
+54 SET IEN=""
+55 FOR
SET IEN=$ORDER(^AUPNVPOV("AC",REGDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+56 SET PDATA=$GET(^AUPNVPOV(IEN,0))
IF PDATA=""
QUIT
+57 ;S TIEN=$$GET1^DIQ(9000010.07,IEN,.01,"I") I TIEN="" Q
+58 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+59 IF '$DATA(@TREF@(TIEN))
QUIT
+60 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+61 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+62 ;S VISIT=$$GET1^DIQ(9000010.07,IEN,.03,"I") I VISIT="" Q
+63 IF $PIECE(VDATA,U,11)=1
QUIT
+64 ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
+65 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+66 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
+67 IF VSDTM<ENDDT
SET DXOK=1
QUIT
End DoDot:3
IF DXOK
QUIT
End DoDot:2
IF 'DXOK
SET BKMPATN=$$GET1^DIQ(2,REGDFN,".01","E")
SET NDA(BKMPATN,REGDFN)=""
SET NDA=$GET(NDA)+1
QUIT
+68 SET @GLOBX@("HIVCHK",REGDFN)=""
End DoDot:1
+69 KILL @GLOB@("HIVCHK")
+70 MERGE @GLOB@("HIVCHK")=@GLOBX@("HIVCHK")
+71 KILL @GLOBX@("HIVCHK"),@TREF
+72 QUIT
+73 ;
PRB(DFN,DATE) ;EP - Check Problem File for instance of a patient
+1 NEW PROB,PVIEN,VSDTM,OK,PBDATA
+2 SET PROB=0
SET OK=0
+3 SET PVIEN=""
+4 FOR
SET PVIEN=$ORDER(^AUPNPROB("AC",DFN,PVIEN),-1)
IF 'PVIEN
QUIT
Begin DoDot:1
+5 SET PBDATA=$GET(^AUPNPROB(PVIEN,0))
IF PBDATA=""
QUIT
+6 SET TIEN=$PIECE(PBDATA,U,1)
IF TIEN=""
QUIT
+7 ;S TIEN=$$GET1^DIQ(9000011,PVIEN,.01,"I") I TIEN="" Q
+8 IF '$DATA(@TREF@(TIEN))
QUIT
+9 ; Check class - if Family ignore
+10 IF $PIECE(PBDATA,U,4)="F"
QUIT
+11 IF $PIECE(PBDATA,U,12)'="A"
QUIT
+12 ;I $$GET1^DIQ(9000011,PVIEN,.04,"I")="F" Q
+13 ;I $$GET1^DIQ(9000011,PVIEN,.12,"I")'="A" Q
+14 SET VSDTM=$$PROB^BQIUL1(PVIEN)\1
IF VSDTM=0
QUIT
+15 IF VSDTM<DATE
SET OK=1
QUIT
End DoDot:1
IF OK
QUIT
+16 QUIT OK
+17 ;
ASTAT(BKMDFN,RPTDT,STAT,REG) ;EP -- ARV Status and Regimen
+1 ; Input
+2 ; BKMDFN - Patient IEN
+3 ; RPTDT - Report Date
+4 ; STAT - ARV Status
+5 ; REG - ARV Regimen
+6 ; Description
+7 ; Returns a result if the patient has the ARV status in the Report Period
+8 NEW QFL,STDT,IEN,RESULT,BKMIEN,BKMREG,REVPER
+9 SET REVPER=$$FMADD^XLFDT(RPTDT,-365)
SET STAT=$GET(STAT,"")
SET REG=$GET(REG,"")
+10 SET STDT=RPTDT+.005
+11 SET BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
IF BKMIEN=""
QUIT 0
+12 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+13 SET RESULT=0
SET QFL=0
+14 FOR
SET STDT=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1)
IF STDT=""!(STDT<REVPER)
QUIT
Begin DoDot:1
+15 SET IEN=""
+16 FOR
SET IEN=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+17 IF $GET(STAT)'=""
IF $PIECE(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)'=STAT
QUIT
+18 IF $GET(REG)'=""
IF $PIECE(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,3)'=REG
QUIT
+19 SET RESULT=1_U_STDT_U_STAT_U_REG
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+20 QUIT RESULT
+21 ;
LAB(BKMDFN,SDATE,ALL) ;
+1 KILL ALL
+2 ;S ENDATE=$$FMADD^XLFDT(SDATE,-56)
+3 SET ENDATE=SDATE
+4 SET BEGDATE=$$FMADD^XLFDT(SDATE,56)
+5 SET HREV=$$FMTH^XLFDT(BEGDATE,1)
SET HEND=$$FMTH^XLFDT(ENDATE,1)
+6 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+7 SET CD4="BKMCD4"
KILL @CD4
+8 FOR TAX="BKM CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES"
DO BLD^BQITUTL(TAX,CD4)
+9 MERGE @TREF=@CD4
+10 ;
+11 SET VIRAL="BKMVIR"
KILL @VIRAL
+12 FOR TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES"
DO BLD^BQITUTL(TAX,VIRAL)
+13 MERGE @TREF=@VIRAL
+14 ;
+15 SET IEN=""
+16 FOR
SET IEN=$ORDER(^AUPNVLAB("AC",BKMDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+17 SET PDATA=$GET(^AUPNVLAB(IEN,0))
IF PDATA=""
QUIT
+18 SET TIEN=$PIECE(PDATA,U,1)
IF TIEN=""
QUIT
+19 IF '$DATA(@TREF@(TIEN))
QUIT
+20 SET VISIT=$PIECE(PDATA,U,3)
IF VISIT=""
QUIT
+21 SET VDATA=$GET(^AUPNVSIT(VISIT,0))
IF VDATA=""
QUIT
+22 IF $PIECE(VDATA,U,11)=1
QUIT
+23 SET VSDTM=$PIECE(VDATA,U,1)\1
IF VSDTM=0
QUIT
+24 ; Get collection date/time
+25 SET COLDTM=$PIECE($GET(^AUPNVLAB(IEN,12)),U,1)\1
+26 IF COLDTM'=0
SET VSDTM=COLDTM
+27 SET RESULT=$PIECE(PDATA,U,4)
+28 SET HSDTM=$$FMTH^XLFDT(VSDTM,1)
+29 IF HSDTM>HREV!(HSDTM<HEND)
QUIT
+30 IF $DATA(@CD4@(TIEN))
SET ALL("ZLAB","CD4",VSDTM,IEN)=RESULT
+31 IF $DATA(@VIRAL@(TIEN))
SET ALL("ZLAB","VIRAL",VSDTM,IEN)=RESULT
End DoDot:1
+32 QUIT
+33 ;
LB(ALL) ;
+1 NEW COLDTM
+2 IF $GET(UID)=""
SET UID=$JOB
+3 SET REVPER=$$FMADD^XLFDT(RPTDT,-365)
+4 SET P1B=$$FMADD^XLFDT(RPTDT,-120)
SET P1E=RPTDT
+5 SET P2B=$$FMADD^XLFDT(RPTDT,-121)
SET P2E=$$FMADD^XLFDT(RPTDT,-240)
+6 SET P3B=$$FMADD^XLFDT(RPTDT,-241)
SET P3E=REVPER
+7 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+8 SET CD4="BKMCD4"
KILL @CD4
+9 FOR TAX="BKM CD4 ABS TESTS TAX","BKMV CD4 ABS LOINC CODES"
DO BLD^BQITUTL(TAX,CD4)
+10 SET TIEN=""
+11 FOR
SET TIEN=$ORDER(@CD4@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(^AUPNVLAB("B",TIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+14 SET DFN=$PIECE($GET(^AUPNVLAB(IEN,0)),U,2)
IF DFN=""
QUIT
+15 SET VISIT=$PIECE($GET(^AUPNVLAB(IEN,0)),U,3)
IF VISIT=""
QUIT
+16 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1
IF +VSDTM=0
QUIT
+17 SET COLDTM=$PIECE($GET(^AUPNVLAB(IEN,12)),U,1)\1
+18 IF COLDTM'=0
SET VSDTM=COLDTM
+19 SET RESULT=$PIECE(^AUPNVLAB(IEN,0),U,4)
IF RESULT=""
QUIT
+20 IF RESULT?.AP
QUIT
+21 IF VSDTM<REVPER!(VSDTM>RPTDT)
QUIT
+22 ;S ALL("ZLAB","CD4",DFN,VSDTM,IEN)=RESULT
+23 IF VSDTM'<P1B
IF VSDTM'>P1E
SET ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P1"
+24 IF VSDTM'>P2B
IF VSDTM'<P2E
SET ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P2"
+25 IF VSDTM'>P3B
IF VSDTM'<P3E
SET ALL("CD4",DFN,VSDTM,IEN)=RESULT_U_"P3"
End DoDot:2
End DoDot:1
+26 KILL @CD4
+27 ;
+28 SET VIRAL="BKMVIR"
KILL @VIRAL
+29 FOR TAX="BGP HIV VIRAL LOAD TAX","BGP VIRAL LOAD LOINC CODES"
DO BLD^BQITUTL(TAX,VIRAL)
+30 SET TIEN=""
+31 FOR
SET TIEN=$ORDER(@VIRAL@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+32 SET IEN=""
+33 FOR
SET IEN=$ORDER(^AUPNVLAB("B",TIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+34 SET DFN=$PIECE($GET(^AUPNVLAB(IEN,0)),U,2)
IF DFN=""
QUIT
+35 SET VISIT=$PIECE($GET(^AUPNVLAB(IEN,0)),U,3)
IF VISIT=""
QUIT
+36 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1
IF +VSDTM=0
QUIT
+37 SET COLDTM=$PIECE($GET(^AUPNVLAB(IEN,12)),U,1)\1
+38 IF COLDTM'=0
SET VSDTM=COLDTM
+39 SET RESULT=$PIECE(^AUPNVLAB(IEN,0),U,4)
IF RESULT=""
QUIT
+40 IF RESULT?.AP
QUIT
+41 IF VSDTM<REVPER!(VSDTM>RPTDT)
QUIT
+42 ;S ALL("ZLAB","VIRAL",DFN,VSDTM,IEN)=RESULT
+43 IF VSDTM'<P1B
IF VSDTM'>P1E
SET ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P1"
+44 IF VSDTM'>P2B
IF VSDTM'<P2E
SET ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P2"
+45 IF VSDTM'>P3B
IF VSDTM'<P3E
SET ALL("VIRAL",DFN,VSDTM,IEN)=RESULT_U_"P3"
End DoDot:2
End DoDot:1
+46 KILL @VIRAL
+47 QUIT
+48 ;
DTR(RPTDT) ;EP - Get all date ranges from a report end date
+1 SET REVPER=$$FMADD^XLFDT(RPTDT,-365)
+2 ;S P1B=$$FMADD^XLFDT(RPTDT,-120),P1E=RPTDT
+3 SET P1B=RPTDT
SET P1E=$$FMADD^XLFDT(RPTDT,-120)
+4 SET HP1B=$$FMTH^XLFDT(P1B,1)
SET HP1E=$$FMTH^XLFDT(P1E,1)
+5 SET P2B=$$FMADD^XLFDT(RPTDT,-121)
SET P2E=$$FMADD^XLFDT(RPTDT,-240)
+6 SET HP2B=$$FMTH^XLFDT(P2B,1)
SET HP2E=$$FMTH^XLFDT(P2E,1)
+7 SET P3B=$$FMADD^XLFDT(RPTDT,-241)
SET P3E=REVPER
+8 SET HP3B=$$FMTH^XLFDT(P3B,1)
SET HP3E=$$FMTH^XLFDT(P3E,1)
+9 ;S P61B=$$FMADD^XLFDT(RPTDT,-181),P61E=RPTDT
+10 SET P61B=RPTDT
SET P61E=$$FMADD^XLFDT(RPTDT,-181)
+11 SET HP61B=$$FMTH^XLFDT(P61B,1)
SET HP61E=$$FMTH^XLFDT(P61E,1)
+12 SET P62B=$$FMADD^XLFDT(RPTDT,-182)
SET P62E=REVPER
+13 SET HP62B=$$FMTH^XLFDT(P62B,1)
SET HP62E=$$FMTH^XLFDT(P62E,1)
+14 QUIT
