BQITD08 ;PRXM/HC/ALA-HIV/AIDS ; 02 Mar 2006 1:17 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
Q
;
POP(BQARY,TGLOB) ; EP -- By population
;
;Description
; Finds all patients who meet the criteria for HIV/AIDS
;Input
; BQARY - Array of taxonomies and other information
; TGLOB - Global where data is to be stored and passed back
; to calling routine
; Structure:
; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
;Variables
; TAX - Taxonomy name
; NIT - Number of iterations
; TMFRAME - Time frame of check
; FREF - File Number reference
; PLFLG - Problem File flag
; GREF - Global reference
; TREF - Taxonomy temp reference
;
; Clean up all current entries
NEW DXNN,TDFN,DA,DIK,RGIEN
NEW PRIM,SERV,VSERV,OPRM
;
N TAX,FREF,GREF,TMFRAME,EXDT,DTDIF,ENDT,TIEN,IEN,TDFN,VISIT
;One diagnosis on Active Problem List (for POP)
S TMFRAME="",EXDT="",DTDIF="",ENDT=""
S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
K @TREF,@TMREF
S TAX="BGP HIV/AIDS DXS"
S PRIM=1,SERV="A;H"
D BLD^BQITUTL(TAX,TREF)
; For each entry in the taxonomy reference check problem file
S TIEN=0
F S TIEN=$O(@TREF@(TIEN)) Q:'TIEN D PRB^BQITDGN(TIEN,.TGLOB)
;
; At least 2 POVs ever at least 60 days apart (for POP)
; Note: BGP HIV/AIDS DX taxonomy data already loaded in TREF
D GETVST ; Get related visit data and set up criteria in temporary file
S TDFN=""
F S TDFN=$O(@TMREF@(TDFN)) Q:TDFN="" D
. Q:$D(@TGLOB@(TDFN)) ; Patient already identified
. D POV^BQITD081(TDFN,TGLOB,TMREF)
;
; At least 2 CD4/Viral Load lab tests in the past two years
; at least 60 days apart (for POP)
N N
K BQITRY,@TMREF
S BQITRY(1)="BGP CD4 TAX^9000010.09^^T-24M"
S BQITRY(2)="BGP CD4 CPTS^9000010.18^^T-24M"
S BQITRY(3)="BGP CD4 LOINC CODES^9000010.09^^T-24M"
S BQITRY(4)="BGP HIV VIRAL LOAD TAX^9000010.09^^T-24M"
S BQITRY(5)="BGP HIV VIRAL LOAD CPTS^9000010.18^^T-24M"
S BQITRY(6)="BGP VIRAL LOAD LOINC CODES^9000010.09^^T-24M"
S N=0
F S N=$O(BQITRY(N)) Q:'N D
. K @TREF
. S TAX=$P(BQITRY(N),U,1),FREF=$P(BQITRY(N),U,2),GREF=$$ROOT^DILFD(FREF,"",1)
. S TMFRAME=$P(BQITRY(N),U,4),ENDT=""
. D BLD^BQITUTL(TAX,TREF)
. D GETVST ; Get related visit data and set up criteria in temporary file
S TDFN=""
F S TDFN=$O(@TMREF@(TDFN)) Q:TDFN="" D
. Q:$D(@TGLOB@(TDFN)) ; Patient already identified
. D CDVL^BQITD081(TDFN,TGLOB,TMREF)
K @TMREF
;
; Positive HIV Screening (for POP)
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
K @TREF
S TAX="BGP HIV TEST TAX" D BLD^BQITUTL(TAX,TREF)
S TIEN=0
F S TIEN=$O(@TREF@(TIEN)) Q:'TIEN D
. S IEN=""
. F S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN="" D
.. I $G(@GREF@(IEN,0))="" Q
.. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
.. I $D(@TGLOB@(DFN)) Q ; Patient already identified
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. ; If service categories, check the visit for the service category
.. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
.. I $G(SERV)'="",SERV'[VSERV Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I $$POSITIVE^BKMVF32(RESULT) D STOR(DFN,"Positive HIV Screening",VISIT,IEN,TGLOB) Q
K @TREF
Q
;
;
PAT(DEF,BTGLOB,BDFN) ;EP -- By patient
NEW DXOK ;,BQDXN,BQREF
NEW PRIM,SERV,VSERV,OPRM
S DXOK=0
;
N TAX,FREF,GREF,TMFRAME,EXDT,DTDIF,ENDT,TRIEN,IEN,TDFN,VISIT
;One diagnosis on Active Problem List (for PAT)
S TMFRAME="",EXDT="",DTDIF="",ENDT=""
S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
K @TREF
S TAX="BGP HIV/AIDS DXS"
S PRIM=1,SERV="A;H"
S TPRGL=$NA(^TMP("TPRBLM",UID)) K @TPRGL
NEW TPGLOB
S TPGLOB=BTGLOB
D BLD^BQITUTL(TAX,TREF)
D PPRB^BQITDGN(BDFN,TPRGL)
I $D(@TPRGL@(BDFN))>0,'$D(@BTGLOB@(BDFN)) M @BTGLOB@(BDFN)=@TPRGL@(BDFN) Q 1
; For each entry in the taxonomy reference
;S TRIEN=0
;F S TRIEN=$O(@TREF@(TRIEN)) Q:'TRIEN D I $D(@BTGLOB@(BDFN)) Q
;. D PPRB^BQITDGN(BDFN,.BTGLOB)
;I $D(@BTGLOB@(BDFN)) Q 1 ; Patient already identified
;
; At least 2 POVs ever at least 60 days apart (for PAT)
S TMREF=$NA(^TMP("BQITMPD",UID))
K @TMREF
N TIEN
S IEN=""
F S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN="" D
. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
.. I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. ; If service categories, check the visit for the service category
. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
. I $G(SERV)'="",SERV'[VSERV Q
. I $D(@TMREF@(BDFN,VSDTM)) Q
. ;
. S @TMREF@(BDFN)=$G(@TMREF@(BDFN))+1
. S @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
;
I $D(@TMREF@(BDFN)) D POV^BQITD081(BDFN,BTGLOB,TMREF,.DXOK)
K @TREF,@TMREF
I DXOK Q DXOK
;
; At least 2 CD4/Viral Load lab tests in the past two years
; at least 60 days apart (for PAT)
N N
S TMREF=$NA(^TMP("BQITMPD",UID))
K @TMREF,BQITRY
S BQITRY(1)="BGP CD4 TAX^9000010.09^^T-24M"
S BQITRY(2)="BGP CD4 CPTS^9000010.18^^T-24M"
S BQITRY(3)="BGP CD4 LOINC CODES^9000010.09^^T-24M"
S BQITRY(4)="BGP HIV VIRAL LOAD TAX^9000010.09^^T-24M"
S BQITRY(5)="BGP HIV VIRAL LOAD CPTS^9000010.18^^T-24M"
S BQITRY(6)="BGP VIRAL LOAD LOINC CODES^9000010.09^^T-24M"
S N=0
F S N=$O(BQITRY(N)) Q:'N D
. K @TREF
. S TAX=$P(BQITRY(N),U,1),FREF=$P(BQITRY(N),U,2)
. S GREF=$$ROOT^DILFD(FREF,"",1),PLFLG=+$P(BQITRY(N),U,6)
. S TMFRAME=$P(BQITRY(N),U,4),ENDT=""
. D BLD^BQITUTL(TAX,TREF)
. S IEN=""
. F S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN="" D
.. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
.. I '$D(@TREF@(TIEN)) Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. ; If service categories, check the visit for the service category
.. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
.. I $G(SERV)'="",SERV'[VSERV Q
.. I $D(@TMREF@(BDFN,VSDTM)) Q
.. ;
.. S @TMREF@(BDFN)=$G(@TMREF@(BDFN))+1
.. S @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
;
I $D(@TMREF@(BDFN)) D CDVL^BQITD081(BDFN,BTGLOB,TMREF,.DXOK)
K @TREF,@TMREF
I DXOK Q DXOK
;
;Positive HIV Screening (for PAT)
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
S TAX="BGP HIV TEST TAX" D
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
. S IEN=""
. F S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN="" D Q:DXOK
.. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""
.. I '$D(@TREF@(TIEN)) Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. ; If service categories, check the visit for the service category
.. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
.. I $G(SERV)'="",SERV'[VSERV Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I $$POSITIVE^BKMVF32(RESULT) D
... D STOR(BDFN,"Positive HIV Screening",VISIT,IEN,BTGLOB)
... S DXOK=1
Q DXOK
;
STOR(SDFN,CRIT,VIENS,IENS,GLOB) ; Store the patient's met criteria
NEW VST,I,VSDTM,IIEN
I $G(@GLOB@(SDFN))>3 Q
I $D(@GLOB@(SDFN,"CRITERIA",CRIT))>0 Q
S @GLOB@(SDFN)=$G(@GLOB@(SDFN))+1
S @GLOB@(SDFN,"CRITERIA",CRIT)=""
I $G(VIENS)["," D Q
. F I=1:1 S VST=$P(VIENS,",",I) Q:VST="" D
.. S IIEN=$P(IENS,",",I)
.. S VSDTM=$$GET1^DIQ(9000010,VST_",",.01,"I") Q:'VSDTM
.. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
.. S @GLOB@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN)=VSDTM_U_U_IIEN_U_FREF
.. I EXDT'="" S $P(@GLOB@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN),U,2)=EXDT
I $G(VIENS)'="" D
. S VSDTM=$$GET1^DIQ(9000010,VIENS_",",.01,"I") Q:'VSDTM
. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
. S @GLOB@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS)=VSDTM_U_U_IENS_U_FREF
. I EXDT'="" S $P(@GLOB@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS),U,2)=EXDT
Q
;
GETVST ; EP - Get visit related data
S TIEN="",PRIM=1
F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
. S IEN=""
. F S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN="" D
.. S TDFN=$$GET1^DIQ(FREF,IEN,.02,"I") I TDFN="" Q
.. I $D(@TGLOB@(TDFN)) Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. ; If service categories, check the visit for the service category
.. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
.. I $G(SERV)'="",SERV'[VSERV Q
.. ;
.. I $D(@TMREF@(TDFN,VSDTM)) Q
.. S @TMREF@(TDFN)=$G(@TMREF@(TDFN))+1
.. S @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
Q
BQITD08 ;PRXM/HC/ALA-HIV/AIDS ; 02 Mar 2006 1:17 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 QUIT
+3 ;
POP(BQARY,TGLOB) ; EP -- By population
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria for HIV/AIDS
+4 ;Input
+5 ; BQARY - Array of taxonomies and other information
+6 ; TGLOB - Global where data is to be stored and passed back
+7 ; to calling routine
+8 ; Structure:
+9 ; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+10 ;Variables
+11 ; TAX - Taxonomy name
+12 ; NIT - Number of iterations
+13 ; TMFRAME - Time frame of check
+14 ; FREF - File Number reference
+15 ; PLFLG - Problem File flag
+16 ; GREF - Global reference
+17 ; TREF - Taxonomy temp reference
+18 ;
+19 ; Clean up all current entries
+20 NEW DXNN,TDFN,DA,DIK,RGIEN
+21 NEW PRIM,SERV,VSERV,OPRM
+22 ;
+23 NEW TAX,FREF,GREF,TMFRAME,EXDT,DTDIF,ENDT,TIEN,IEN,TDFN,VISIT
+24 ;One diagnosis on Active Problem List (for POP)
+25 SET TMFRAME=""
SET EXDT=""
SET DTDIF=""
SET ENDT=""
+26 SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+27 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+28 KILL @TREF,@TMREF
+29 SET TAX="BGP HIV/AIDS DXS"
+30 SET PRIM=1
SET SERV="A;H"
+31 DO BLD^BQITUTL(TAX,TREF)
+32 ; For each entry in the taxonomy reference check problem file
+33 SET TIEN=0
+34 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
DO PRB^BQITDGN(TIEN,.TGLOB)
+35 ;
+36 ; At least 2 POVs ever at least 60 days apart (for POP)
+37 ; Note: BGP HIV/AIDS DX taxonomy data already loaded in TREF
+38 ; Get related visit data and set up criteria in temporary file
DO GETVST
+39 SET TDFN=""
+40 FOR
SET TDFN=$ORDER(@TMREF@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+41 ; Patient already identified
IF $DATA(@TGLOB@(TDFN))
QUIT
+42 DO POV^BQITD081(TDFN,TGLOB,TMREF)
End DoDot:1
+43 ;
+44 ; At least 2 CD4/Viral Load lab tests in the past two years
+45 ; at least 60 days apart (for POP)
+46 NEW N
+47 KILL BQITRY,@TMREF
+48 SET BQITRY(1)="BGP CD4 TAX^9000010.09^^T-24M"
+49 SET BQITRY(2)="BGP CD4 CPTS^9000010.18^^T-24M"
+50 SET BQITRY(3)="BGP CD4 LOINC CODES^9000010.09^^T-24M"
+51 SET BQITRY(4)="BGP HIV VIRAL LOAD TAX^9000010.09^^T-24M"
+52 SET BQITRY(5)="BGP HIV VIRAL LOAD CPTS^9000010.18^^T-24M"
+53 SET BQITRY(6)="BGP VIRAL LOAD LOINC CODES^9000010.09^^T-24M"
+54 SET N=0
+55 FOR
SET N=$ORDER(BQITRY(N))
IF 'N
QUIT
Begin DoDot:1
+56 KILL @TREF
+57 SET TAX=$PIECE(BQITRY(N),U,1)
SET FREF=$PIECE(BQITRY(N),U,2)
SET GREF=$$ROOT^DILFD(FREF,"",1)
+58 SET TMFRAME=$PIECE(BQITRY(N),U,4)
SET ENDT=""
+59 DO BLD^BQITUTL(TAX,TREF)
+60 ; Get related visit data and set up criteria in temporary file
DO GETVST
End DoDot:1
+61 SET TDFN=""
+62 FOR
SET TDFN=$ORDER(@TMREF@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+63 ; Patient already identified
IF $DATA(@TGLOB@(TDFN))
QUIT
+64 DO CDVL^BQITD081(TDFN,TGLOB,TMREF)
End DoDot:1
+65 KILL @TMREF
+66 ;
+67 ; Positive HIV Screening (for POP)
+68 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+69 KILL @TREF
+70 SET TAX="BGP HIV TEST TAX"
DO BLD^BQITUTL(TAX,TREF)
+71 SET TIEN=0
+72 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+73 SET IEN=""
+74 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+75 IF $GET(@GREF@(IEN,0))=""
QUIT
+76 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+77 ; Patient already identified
IF $DATA(@TGLOB@(DFN))
QUIT
+78 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+79 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+80 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:3
+81 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+82 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+83 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+84 ; If service categories, check the visit for the service category
+85 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+86 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+87 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+88 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+89 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+90 IF $$POSITIVE^BKMVF32(RESULT)
DO STOR(DFN,"Positive HIV Screening",VISIT,IEN,TGLOB)
QUIT
End DoDot:2
End DoDot:1
+91 KILL @TREF
+92 QUIT
+93 ;
+94 ;
PAT(DEF,BTGLOB,BDFN) ;EP -- By patient
+1 ;,BQDXN,BQREF
NEW DXOK
+2 NEW PRIM,SERV,VSERV,OPRM
+3 SET DXOK=0
+4 ;
+5 NEW TAX,FREF,GREF,TMFRAME,EXDT,DTDIF,ENDT,TRIEN,IEN,TDFN,VISIT
+6 ;One diagnosis on Active Problem List (for PAT)
+7 SET TMFRAME=""
SET EXDT=""
SET DTDIF=""
SET ENDT=""
+8 SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+9 KILL @TREF
+10 SET TAX="BGP HIV/AIDS DXS"
+11 SET PRIM=1
SET SERV="A;H"
+12 SET TPRGL=$NAME(^TMP("TPRBLM",UID))
KILL @TPRGL
+13 NEW TPGLOB
+14 SET TPGLOB=BTGLOB
+15 DO BLD^BQITUTL(TAX,TREF)
+16 DO PPRB^BQITDGN(BDFN,TPRGL)
+17 IF $DATA(@TPRGL@(BDFN))>0
IF '$DATA(@BTGLOB@(BDFN))
MERGE @BTGLOB@(BDFN)=@TPRGL@(BDFN)
QUIT 1
+18 ; For each entry in the taxonomy reference
+19 ;S TRIEN=0
+20 ;F S TRIEN=$O(@TREF@(TRIEN)) Q:'TRIEN D I $D(@BTGLOB@(BDFN)) Q
+21 ;. D PPRB^BQITDGN(BDFN,.BTGLOB)
+22 ;I $D(@BTGLOB@(BDFN)) Q 1 ; Patient already identified
+23 ;
+24 ; At least 2 POVs ever at least 60 days apart (for PAT)
+25 SET TMREF=$NAME(^TMP("BQITMPD",UID))
+26 KILL @TMREF
+27 NEW TIEN
+28 SET IEN=""
+29 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+30 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+31 IF '$DATA(@TREF@(TIEN))
QUIT
+32 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+33 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+34 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:2
+35 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:2
IF 'OPRM
QUIT
+36 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+37 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+38 ; If service categories, check the visit for the service category
+39 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+40 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+41 IF $DATA(@TMREF@(BDFN,VSDTM))
QUIT
+42 ;
+43 SET @TMREF@(BDFN)=$GET(@TMREF@(BDFN))+1
+44 SET @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:1
+45 ;
+46 IF $DATA(@TMREF@(BDFN))
DO POV^BQITD081(BDFN,BTGLOB,TMREF,.DXOK)
+47 KILL @TREF,@TMREF
+48 IF DXOK
QUIT DXOK
+49 ;
+50 ; At least 2 CD4/Viral Load lab tests in the past two years
+51 ; at least 60 days apart (for PAT)
+52 NEW N
+53 SET TMREF=$NAME(^TMP("BQITMPD",UID))
+54 KILL @TMREF,BQITRY
+55 SET BQITRY(1)="BGP CD4 TAX^9000010.09^^T-24M"
+56 SET BQITRY(2)="BGP CD4 CPTS^9000010.18^^T-24M"
+57 SET BQITRY(3)="BGP CD4 LOINC CODES^9000010.09^^T-24M"
+58 SET BQITRY(4)="BGP HIV VIRAL LOAD TAX^9000010.09^^T-24M"
+59 SET BQITRY(5)="BGP HIV VIRAL LOAD CPTS^9000010.18^^T-24M"
+60 SET BQITRY(6)="BGP VIRAL LOAD LOINC CODES^9000010.09^^T-24M"
+61 SET N=0
+62 FOR
SET N=$ORDER(BQITRY(N))
IF 'N
QUIT
Begin DoDot:1
+63 KILL @TREF
+64 SET TAX=$PIECE(BQITRY(N),U,1)
SET FREF=$PIECE(BQITRY(N),U,2)
+65 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET PLFLG=+$PIECE(BQITRY(N),U,6)
+66 SET TMFRAME=$PIECE(BQITRY(N),U,4)
SET ENDT=""
+67 DO BLD^BQITUTL(TAX,TREF)
+68 SET IEN=""
+69 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+70 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+71 IF '$DATA(@TREF@(TIEN))
QUIT
+72 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+73 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+74 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:3
+75 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+76 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+77 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+78 ; If service categories, check the visit for the service category
+79 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+80 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+81 IF $DATA(@TMREF@(BDFN,VSDTM))
QUIT
+82 ;
+83 SET @TMREF@(BDFN)=$GET(@TMREF@(BDFN))+1
+84 SET @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:2
End DoDot:1
+85 ;
+86 IF $DATA(@TMREF@(BDFN))
DO CDVL^BQITD081(BDFN,BTGLOB,TMREF,.DXOK)
+87 KILL @TREF,@TMREF
+88 IF DXOK
QUIT DXOK
+89 ;
+90 ;Positive HIV Screening (for PAT)
+91 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+92 SET TAX="BGP HIV TEST TAX"
Begin DoDot:1
+93 KILL @TREF
+94 DO BLD^BQITUTL(TAX,TREF)
+95 SET IEN=""
+96 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+97 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+98 IF '$DATA(@TREF@(TIEN))
QUIT
+99 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+100 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+101 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:3
+102 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+103 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+104 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+105 ; If service categories, check the visit for the service category
+106 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+107 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+108 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+109 IF $$POSITIVE^BKMVF32(RESULT)
Begin DoDot:3
+110 DO STOR(BDFN,"Positive HIV Screening",VISIT,IEN,BTGLOB)
+111 SET DXOK=1
End DoDot:3
End DoDot:2
IF DXOK
QUIT
End DoDot:1
+112 QUIT DXOK
+113 ;
STOR(SDFN,CRIT,VIENS,IENS,GLOB) ; Store the patient's met criteria
+1 NEW VST,I,VSDTM,IIEN
+2 IF $GET(@GLOB@(SDFN))>3
QUIT
+3 IF $DATA(@GLOB@(SDFN,"CRITERIA",CRIT))>0
QUIT
+4 SET @GLOB@(SDFN)=$GET(@GLOB@(SDFN))+1
+5 SET @GLOB@(SDFN,"CRITERIA",CRIT)=""
+6 IF $GET(VIENS)[","
Begin DoDot:1
+7 FOR I=1:1
SET VST=$PIECE(VIENS,",",I)
IF VST=""
QUIT
Begin DoDot:2
+8 SET IIEN=$PIECE(IENS,",",I)
+9 SET VSDTM=$$GET1^DIQ(9000010,VST_",",.01,"I")
IF 'VSDTM
QUIT
+10 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+11 SET @GLOB@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN)=VSDTM_U_U_IIEN_U_FREF
+12 IF EXDT'=""
SET $PIECE(@GLOB@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN),U,2)=EXDT
End DoDot:2
End DoDot:1
QUIT
+13 IF $GET(VIENS)'=""
Begin DoDot:1
+14 SET VSDTM=$$GET1^DIQ(9000010,VIENS_",",.01,"I")
IF 'VSDTM
QUIT
+15 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+16 SET @GLOB@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS)=VSDTM_U_U_IENS_U_FREF
+17 IF EXDT'=""
SET $PIECE(@GLOB@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS),U,2)=EXDT
End DoDot:1
+18 QUIT
+19 ;
GETVST ; EP - Get visit related data
+1 SET TIEN=""
SET PRIM=1
+2 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+5 SET TDFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF TDFN=""
QUIT
+6 IF $DATA(@TGLOB@(TDFN))
QUIT
+7 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+8 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+9 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:3
+10 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+11 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+12 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+13 ; If service categories, check the visit for the service category
+14 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+15 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+16 ;
+17 IF $DATA(@TMREF@(TDFN,VSDTM))
QUIT
+18 SET @TMREF@(TDFN)=$GET(@TMREF@(TDFN))+1
+19 SET @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:2
End DoDot:1
+20 QUIT
