BQITD03 ;PRXM/HC/ALA-CVD Known Definition ; 19 Jun 2006 5:01 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
POP(BQARY,TGLOB) ; EP
;
;Description
; Finds all patients who meet the criteria for CVD known
;Input
; BQARY - Array of taxonomies and other information
; TGLOB - Global where data is to be stored
; Structure:
; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
;Variables
; TAX - Taxonomy name
; NIT - Number of iterations
; TMFRAME - Timeframe
; PLFLG - Problem check flag (if 1 check problem file)
; VTYP - The type of event; 'V'isit or 'P'roblem
; DXOK - Diag category okay flag (if 1 then it meet the criteria)
; FREF - File number to search
; GREF - Global reference of FREF
; TREF - Taxonomy temporary global
; TMREF - Temporary global reference; global stores the individual
; record from the visit or problem file.
;
NEW DTDIF,ENDT,EXDT,PLFLG,PROB,TMFRAME,VTYP,DXOK,DXNN,TDFN,RGIEN
NEW PRIM,SERV,VSERV,OPRM
;
S DXOK=0
; BQARY contains a list of taxonomies that can be checked by the generic
; program, BQITDGN
I $D(@BQARY) D
. D POP^BQITDGN(.BQARY,.TGLOB)
;
; AMI Diagnosis check
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
S TAX="BGP AMI DXS (HEDIS)",FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S PRIM=1,SERV="A;H"
S TMFRAME="",EXDT="",DTDIF="",ENDT=""
K @TREF,@TMREF
; Build the taxonomy global
D BLD^BQITUTL(TAX,TREF)
S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
. ; Check for active problems
. D PRB(TIEN,TMREF)
; For each entry in the taxonomy, find patients that match
S TIEN="" 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
.. ;
.. ; if the patient has already matched one of the general taxonomies, don't
.. ; continue
.. I $D(@TGLOB@(TDFN)) Q
.. ;
.. ; Get the visit pointer and check if it has been deleted
.. 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
.. ;
.. ; Get the visit date/time and if a timeframe, check for validity
.. 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
.. ; Check if there is one value on the same day
.. D ONE(TDFN,VSDTM)
.. I $D(@TMREF@(TDFN,VSDTM)) Q
.. ;
.. ; If passed all checks, save for further checking
.. S @TMREF@(TDFN)=$G(@TMREF@(TDFN))+1
.. ;S @TMREF@(TDFN,VSDTM)=VISIT
.. S @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
;
; if at least 90 days apart but no more than 2 years between
; first and last diagnosis
S TDFN=""
F S TDFN=$O(@TMREF@(TDFN)) Q:TDFN="" D AMI^BQITD031(TDFN,TGLOB,TMREF)
;
; Ischemic Heart Disease
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
S TAX="BQI IHD DXS",FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S SERV="A;H",OPRM=0
S TMFRAME="",EXDT="",DTDIF="",ENDT=""
K @TREF,@TMREF
; Build the taxonomy global
D BLD^BQITUTL(TAX,TREF)
S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
. ; Check for active problems
. D PRB(TIEN,TMREF)
;
; For each entry in the taxonomy, find patients that match
S TIEN="" 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
.. ;
.. ; if the patient has already matched one of the general taxonomies, don't
.. ; continue
.. I $D(@TGLOB@(TDFN)) Q
.. ;
.. ; Get the visit pointer and check if it has been deleted
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. ; Identify clinical ranking (primary or 1st for visit)
.. S OPRM=0
.. I FREF=9000010.07 D
... I $P(@GREF@(IEN,0),U,12)="P" S OPRM=1 Q
... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
.. ; Get the visit date/time and if a timeframe, check for validity
.. 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
.. ; If passed all checks, save for further checking
.. S @TMREF@(TDFN)=$G(@TMREF@(TDFN))+1
.. S @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX_U_OPRM
;
; Check from temporary global if 3 different diagnoses on same day
S TDFN=""
F S TDFN=$O(@TMREF@(TDFN)) Q:TDFN="" D IHDSM^BQITD031(TDFN,TGLOB,TMREF)
;
; 3 instances of any Ischemic Heart Disease
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
S TAX="BQI IHD DXS",FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S SERV="A;H",OPRM=0
S TMFRAME="",EXDT="",DTDIF="",ENDT=""
K @TREF,@TMREF
D BLD^BQITUTL(TAX,TREF)
S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
. D PRB(TIEN,TMREF)
S TIEN="" 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
.. 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 $P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
.. ;
.. D ONE(TDFN,VSDTM)
.. I $D(@TMREF@(TDFN,VSDTM)) Q
.. ; If passed all checks, save for further checking
.. S @TMREF@(TDFN)=$G(@TMREF@(TDFN))+1
.. S @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
;
S TDFN=""
F S TDFN=$O(@TMREF@(TDFN)) Q:TDFN="" D IHD^BQITD031(TDFN,TGLOB,TMREF)
;
; Multiple Instances of Known CVD
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
K BQITRY,@TMREF
S BQITRY(1)="BQI KNOWN CVD-MULT CPTS^9000010.18"
S BQITRY(2)="BQI KNOWN CVD-MULT DXS^9000010.07^^^^1"
S BQITRY(3)="BQI KNOWN CVD-MULT PROCEDURES^9000010.08"
S SERV="A;H",OPRM=0
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 PLFLG=+$P(BQITRY(N),U,6),TMFRAME=$P(BQITRY(N),U,4),ENDT=""
. D BLD^BQITUTL(TAX,TREF)
. S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. I PLFLG D PRB(TIEN,TMREF)
. S TIEN="" 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
... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 I VSDTM=0 Q
... I $G(TMFRAME)'="",VSDTM<ENDT Q
... I $P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D Q:'OPRM
.... I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1
... ; if service categories, check the visit for the service category
... S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
... I $G(SERV)'="",SERV'[VSERV Q
... ;
... D ONE(TDFN,VSDTM)
... 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
;
; at least 90 days apart but no more than 5 years
; between first and last
S TDFN=""
F S TDFN=$O(@TMREF@(TDFN)) Q:TDFN="" D IHD^BQITD031(TDFN,TGLOB,TMREF)
;
K @TMREF,@TREF,BQITRY,TAX,NIT,FREF,FDX,LDX,VISIT,VSDTM,IEN,DFN
K BQITRY,TIEN,TDFN,TREF,TMREF,VSDT,GREF,CT,N
Q
;
PAT(DEF,BTGLOB,BDFN) ; EP -- By patient
;Description
; Checks if a patient meets the criteria for CVD known
;Input
; BDFN - patient internal entry number
; BTGLOB - Global to store results
; DEF - Diagnosis category definition
;Output
; DXOK - Diag category okay flag (if 1 then patient met the criteria)
NEW DXOK,BQDXN,BQREF,DTDIF,ENDT,EXDT,PLFLG,PROB,TMFRAME,VTYP
NEW PRIM,SERV,VSERV,OPRM
S DXOK=0
S BQDXN=$$GDXN^BQITUTL(DEF)
S BQREF="BQIRY"
D GDF^BQITUTL(BQDXN,BQREF)
I $$PAT^BQITDGN(BQREF,BTGLOB,BDFN) Q 1
;
; AMI Diagnosis check
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
S TAX="BGP AMI DXS (HEDIS)",FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S PRIM=1,SERV="A;H"
S TMFRAME="",ENDT=""
K @TREF,@TMREF
D BLD^BQITUTL(TAX,TREF)
D PPRB(BDFN,TMREF)
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
. Q:'$D(@TREF@(TIEN))
. 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
. D ONE(BDFN,VSDTM)
. 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 AMI^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
K @TMREF,@TREF
I DXOK Q DXOK
;
; Ischemic Heart Disease
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
S TAX="BQI IHD DXS",FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S TMFRAME="",ENDT="",SERV="A;H"
K @TREF,@TMREF
D BLD^BQITUTL(TAX,TREF)
D PPRB(BDFN,TMREF)
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
. ;
. Q:'$D(@TREF@(TIEN))
. ;
. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. S OPRM=0
. I FREF=9000010.07 D
.. I $P(@GREF@(IEN,0),U,12)="P" S OPRM=1 Q
.. 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 visit for the service category
. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
. I $G(SERV)'="",SERV'[VSERV Q
. ;
. S @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX_U_OPRM
. S @TMREF@(BDFN)=$G(@TMREF@(BDFN))+1
;
; If 3 different diagnoses on the same date with at least one a primary
I $D(@TMREF@(BDFN)) D IHDSM^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
K @TMREF,@TREF
I DXOK Q DXOK
;
; 3 instances of any Ischemic Heart Disease
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
S TAX="BQI IHD DXS",FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1)
S TMFRAME="",EXDT="",DTDIF="",ENDT=""
K @TREF,@TMREF
D BLD^BQITUTL(TAX,TREF)
D PPRB(BDFN,TMREF)
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
. Q:'$D(@TREF@(TIEN))
. ;
. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. I FREF=9000010.07 S OPRM=0 D Q:'OPRM
.. I $P(@GREF@(IEN,0),U,12)="P" S OPRM=1 Q
.. 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 visit for service category
. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
. I $G(SERV)'="",SERV'[VSERV Q
. D ONE(BDFN,VSDTM)
. 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 IHD^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
K @TMREF,@TREF
I DXOK Q DXOK
;
; Multiple Instances of Known CVD
S TREF=$NA(^TMP("BQITAX",UID)),TMREF=$NA(^TMP("BQITMPD",UID))
K @TMREF,BQITRY
S BQITRY(1)="BQI KNOWN CVD-MULT CPTS^9000010.18"
S BQITRY(2)="BQI KNOWN CVD-MULT DXS^9000010.07^^^^1"
S BQITRY(3)="BQI KNOWN CVD-MULT PROCEDURES^9000010.08"
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)
. I PLFLG D PPRB(BDFN,TMREF)
. 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 S OPRM=0 D Q:'OPRM
... I $P(@GREF@(IEN,0),U,12)="P" S OPRM=1 Q
... 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
.. D ONE(BDFN,VSDTM)
.. 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
;
; at least 90 days apart but no more than 5 years
; between first and last
I $D(@TMREF@(BDFN)) D IHD^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
K @TREF,@TMREF
Q DXOK
;
PRB(PVIEN,TPGLOB) ; EP - Check Problem File for instance of taxonomy
; Input
; PVIEN - Taxonomy entry
; TPGLOB - Problem file temporary global reference
; Call BQITD031 due to routine size considerations
D PRB^BQITD031
Q
;
PPRB(DFN,TPGLOB) ;EP - Check Problem File for instance of a patient
; Input Parameters
; DFN - Patient record
; TPGLOB - Temporary global
; Call BQITD031 due to routine size considerations
D PPRB^BQITD031
Q
;
ONE(DFN,VSDTM) ; If there was a visit and a problem on the same day, count the visit
I $D(@TMREF@(DFN,VSDTM)),$$TYP^BQITD031(DFN,VSDTM,TMREF)="P" D Q
. K @TMREF@(DFN,VSDTM)
. S @TMREF@(DFN)=$G(@TMREF@(DFN))-1
Q
BQITD03 ;PRXM/HC/ALA-CVD Known Definition ; 19 Jun 2006 5:01 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
POP(BQARY,TGLOB) ; EP
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria for CVD known
+4 ;Input
+5 ; BQARY - Array of taxonomies and other information
+6 ; TGLOB - Global where data is to be stored
+7 ; Structure:
+8 ; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+9 ;Variables
+10 ; TAX - Taxonomy name
+11 ; NIT - Number of iterations
+12 ; TMFRAME - Timeframe
+13 ; PLFLG - Problem check flag (if 1 check problem file)
+14 ; VTYP - The type of event; 'V'isit or 'P'roblem
+15 ; DXOK - Diag category okay flag (if 1 then it meet the criteria)
+16 ; FREF - File number to search
+17 ; GREF - Global reference of FREF
+18 ; TREF - Taxonomy temporary global
+19 ; TMREF - Temporary global reference; global stores the individual
+20 ; record from the visit or problem file.
+21 ;
+22 NEW DTDIF,ENDT,EXDT,PLFLG,PROB,TMFRAME,VTYP,DXOK,DXNN,TDFN,RGIEN
+23 NEW PRIM,SERV,VSERV,OPRM
+24 ;
+25 SET DXOK=0
+26 ; BQARY contains a list of taxonomies that can be checked by the generic
+27 ; program, BQITDGN
+28 IF $DATA(@BQARY)
Begin DoDot:1
+29 DO POP^BQITDGN(.BQARY,.TGLOB)
End DoDot:1
+30 ;
+31 ; AMI Diagnosis check
+32 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+33 SET TAX="BGP AMI DXS (HEDIS)"
SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+34 SET PRIM=1
SET SERV="A;H"
+35 SET TMFRAME=""
SET EXDT=""
SET DTDIF=""
SET ENDT=""
+36 KILL @TREF,@TMREF
+37 ; Build the taxonomy global
+38 DO BLD^BQITUTL(TAX,TREF)
+39 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+40 ; Check for active problems
+41 DO PRB(TIEN,TMREF)
End DoDot:1
+42 ; For each entry in the taxonomy, find patients that match
+43 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+44 SET IEN=""
+45 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+46 SET TDFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF TDFN=""
QUIT
+47 ;
+48 ; if the patient has already matched one of the general taxonomies, don't
+49 ; continue
+50 IF $DATA(@TGLOB@(TDFN))
QUIT
+51 ;
+52 ; Get the visit pointer and check if it has been deleted
+53 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+54 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+55 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:3
+56 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+57 ;
+58 ; Get the visit date/time and if a timeframe, check for validity
+59 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+60 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+61 ; if service categories, check the visit for the service category
+62 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+63 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+64 ; Check if there is one value on the same day
+65 DO ONE(TDFN,VSDTM)
+66 IF $DATA(@TMREF@(TDFN,VSDTM))
QUIT
+67 ;
+68 ; If passed all checks, save for further checking
+69 SET @TMREF@(TDFN)=$GET(@TMREF@(TDFN))+1
+70 ;S @TMREF@(TDFN,VSDTM)=VISIT
+71 SET @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:2
End DoDot:1
+72 ;
+73 ; if at least 90 days apart but no more than 2 years between
+74 ; first and last diagnosis
+75 SET TDFN=""
+76 FOR
SET TDFN=$ORDER(@TMREF@(TDFN))
IF TDFN=""
QUIT
DO AMI^BQITD031(TDFN,TGLOB,TMREF)
+77 ;
+78 ; Ischemic Heart Disease
+79 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+80 SET TAX="BQI IHD DXS"
SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+81 SET SERV="A;H"
SET OPRM=0
+82 SET TMFRAME=""
SET EXDT=""
SET DTDIF=""
SET ENDT=""
+83 KILL @TREF,@TMREF
+84 ; Build the taxonomy global
+85 DO BLD^BQITUTL(TAX,TREF)
+86 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+87 ; Check for active problems
+88 DO PRB(TIEN,TMREF)
End DoDot:1
+89 ;
+90 ; For each entry in the taxonomy, find patients that match
+91 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+92 SET IEN=""
+93 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+94 SET TDFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF TDFN=""
QUIT
+95 ;
+96 ; if the patient has already matched one of the general taxonomies, don't
+97 ; continue
+98 IF $DATA(@TGLOB@(TDFN))
QUIT
+99 ;
+100 ; Get the visit pointer and check if it has been deleted
+101 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+102 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+103 ; Identify clinical ranking (primary or 1st for visit)
+104 SET OPRM=0
+105 IF FREF=9000010.07
Begin DoDot:3
+106 IF $PIECE(@GREF@(IEN,0),U,12)="P"
SET OPRM=1
QUIT
+107 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
+108 ; Get the visit date/time and if a timeframe, check for validity
+109 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+110 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+111 ; if service categories, check the visit for the service category
+112 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+113 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+114 ; If passed all checks, save for further checking
+115 SET @TMREF@(TDFN)=$GET(@TMREF@(TDFN))+1
+116 SET @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX_U_OPRM
End DoDot:2
End DoDot:1
+117 ;
+118 ; Check from temporary global if 3 different diagnoses on same day
+119 SET TDFN=""
+120 FOR
SET TDFN=$ORDER(@TMREF@(TDFN))
IF TDFN=""
QUIT
DO IHDSM^BQITD031(TDFN,TGLOB,TMREF)
+121 ;
+122 ; 3 instances of any Ischemic Heart Disease
+123 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+124 SET TAX="BQI IHD DXS"
SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+125 SET SERV="A;H"
SET OPRM=0
+126 SET TMFRAME=""
SET EXDT=""
SET DTDIF=""
SET ENDT=""
+127 KILL @TREF,@TMREF
+128 DO BLD^BQITUTL(TAX,TREF)
+129 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+130 DO PRB(TIEN,TMREF)
End DoDot:1
+131 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+132 SET IEN=""
+133 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+134 SET TDFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF TDFN=""
QUIT
+135 ;
+136 IF $DATA(@TGLOB@(TDFN))
QUIT
+137 ;
+138 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+139 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+140 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+141 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+142 ; if service categories, check the visit for the service category
+143 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+144 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+145 IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:3
+146 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+147 ;
+148 DO ONE(TDFN,VSDTM)
+149 IF $DATA(@TMREF@(TDFN,VSDTM))
QUIT
+150 ; If passed all checks, save for further checking
+151 SET @TMREF@(TDFN)=$GET(@TMREF@(TDFN))+1
+152 SET @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:2
End DoDot:1
+153 ;
+154 SET TDFN=""
+155 FOR
SET TDFN=$ORDER(@TMREF@(TDFN))
IF TDFN=""
QUIT
DO IHD^BQITD031(TDFN,TGLOB,TMREF)
+156 ;
+157 ; Multiple Instances of Known CVD
+158 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+159 KILL BQITRY,@TMREF
+160 SET BQITRY(1)="BQI KNOWN CVD-MULT CPTS^9000010.18"
+161 SET BQITRY(2)="BQI KNOWN CVD-MULT DXS^9000010.07^^^^1"
+162 SET BQITRY(3)="BQI KNOWN CVD-MULT PROCEDURES^9000010.08"
+163 SET SERV="A;H"
SET OPRM=0
+164 SET N=0
FOR
SET N=$ORDER(BQITRY(N))
IF 'N
QUIT
Begin DoDot:1
+165 KILL @TREF
+166 SET TAX=$PIECE(BQITRY(N),U,1)
SET FREF=$PIECE(BQITRY(N),U,2)
SET GREF=$$ROOT^DILFD(FREF,"",1)
+167 SET PLFLG=+$PIECE(BQITRY(N),U,6)
SET TMFRAME=$PIECE(BQITRY(N),U,4)
SET ENDT=""
+168 DO BLD^BQITUTL(TAX,TREF)
+169 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+170 IF PLFLG
DO PRB(TIEN,TMREF)
End DoDot:2
+171 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+172 SET IEN=""
+173 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+174 SET TDFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF TDFN=""
QUIT
+175 IF $DATA(@TGLOB@(TDFN))
QUIT
+176 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+177 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+178 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+179 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+180 IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:4
+181 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:4
IF 'OPRM
QUIT
+182 ; if service categories, check the visit for the service category
+183 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+184 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+185 ;
+186 DO ONE(TDFN,VSDTM)
+187 IF $DATA(@TMREF@(TDFN,VSDTM))
QUIT
+188 SET @TMREF@(TDFN)=$GET(@TMREF@(TDFN))+1
+189 SET @TMREF@(TDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:3
End DoDot:2
End DoDot:1
+190 ;
+191 ; at least 90 days apart but no more than 5 years
+192 ; between first and last
+193 SET TDFN=""
+194 FOR
SET TDFN=$ORDER(@TMREF@(TDFN))
IF TDFN=""
QUIT
DO IHD^BQITD031(TDFN,TGLOB,TMREF)
+195 ;
+196 KILL @TMREF,@TREF,BQITRY,TAX,NIT,FREF,FDX,LDX,VISIT,VSDTM,IEN,DFN
+197 KILL BQITRY,TIEN,TDFN,TREF,TMREF,VSDT,GREF,CT,N
+198 QUIT
+199 ;
PAT(DEF,BTGLOB,BDFN) ; EP -- By patient
+1 ;Description
+2 ; Checks if a patient meets the criteria for CVD known
+3 ;Input
+4 ; BDFN - patient internal entry number
+5 ; BTGLOB - Global to store results
+6 ; DEF - Diagnosis category definition
+7 ;Output
+8 ; DXOK - Diag category okay flag (if 1 then patient met the criteria)
+9 NEW DXOK,BQDXN,BQREF,DTDIF,ENDT,EXDT,PLFLG,PROB,TMFRAME,VTYP
+10 NEW PRIM,SERV,VSERV,OPRM
+11 SET DXOK=0
+12 SET BQDXN=$$GDXN^BQITUTL(DEF)
+13 SET BQREF="BQIRY"
+14 DO GDF^BQITUTL(BQDXN,BQREF)
+15 IF $$PAT^BQITDGN(BQREF,BTGLOB,BDFN)
QUIT 1
+16 ;
+17 ; AMI Diagnosis check
+18 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+19 SET TAX="BGP AMI DXS (HEDIS)"
SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+20 SET PRIM=1
SET SERV="A;H"
+21 SET TMFRAME=""
SET ENDT=""
+22 KILL @TREF,@TMREF
+23 DO BLD^BQITUTL(TAX,TREF)
+24 DO PPRB(BDFN,TMREF)
+25 SET IEN=""
+26 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+27 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+28 IF '$DATA(@TREF@(TIEN))
QUIT
+29 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+30 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+31 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET OPRM=0
Begin DoDot:2
+32 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:2
IF 'OPRM
QUIT
+33 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+34 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+35 ; if service categories, check the visit for the service category
+36 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+37 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+38 DO ONE(BDFN,VSDTM)
+39 IF $DATA(@TMREF@(BDFN,VSDTM))
QUIT
+40 ;
+41 SET @TMREF@(BDFN)=$GET(@TMREF@(BDFN))+1
+42 SET @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:1
+43 ;
+44 IF $DATA(@TMREF@(BDFN))
DO AMI^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
+45 KILL @TMREF,@TREF
+46 IF DXOK
QUIT DXOK
+47 ;
+48 ; Ischemic Heart Disease
+49 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+50 SET TAX="BQI IHD DXS"
SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+51 SET TMFRAME=""
SET ENDT=""
SET SERV="A;H"
+52 KILL @TREF,@TMREF
+53 DO BLD^BQITUTL(TAX,TREF)
+54 DO PPRB(BDFN,TMREF)
+55 SET IEN=""
+56 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+57 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+58 ;
+59 IF '$DATA(@TREF@(TIEN))
QUIT
+60 ;
+61 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+62 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+63 SET OPRM=0
+64 IF FREF=9000010.07
Begin DoDot:2
+65 IF $PIECE(@GREF@(IEN,0),U,12)="P"
SET OPRM=1
QUIT
+66 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:2
+67 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+68 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+69 ; if service categories, check visit for the service category
+70 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+71 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+72 ;
+73 SET @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX_U_OPRM
+74 SET @TMREF@(BDFN)=$GET(@TMREF@(BDFN))+1
End DoDot:1
+75 ;
+76 ; If 3 different diagnoses on the same date with at least one a primary
+77 IF $DATA(@TMREF@(BDFN))
DO IHDSM^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
+78 KILL @TMREF,@TREF
+79 IF DXOK
QUIT DXOK
+80 ;
+81 ; 3 instances of any Ischemic Heart Disease
+82 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+83 SET TAX="BQI IHD DXS"
SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
+84 SET TMFRAME=""
SET EXDT=""
SET DTDIF=""
SET ENDT=""
+85 KILL @TREF,@TMREF
+86 DO BLD^BQITUTL(TAX,TREF)
+87 DO PPRB(BDFN,TMREF)
+88 SET IEN=""
+89 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+90 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+91 IF '$DATA(@TREF@(TIEN))
QUIT
+92 ;
+93 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+94 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+95 IF FREF=9000010.07
SET OPRM=0
Begin DoDot:2
+96 IF $PIECE(@GREF@(IEN,0),U,12)="P"
SET OPRM=1
QUIT
+97 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:2
IF 'OPRM
QUIT
+98 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+99 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+100 ; if service categories, check visit for service category
+101 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+102 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+103 DO ONE(BDFN,VSDTM)
+104 IF $DATA(@TMREF@(BDFN,VSDTM))
QUIT
+105 SET @TMREF@(BDFN)=$GET(@TMREF@(BDFN))+1
+106 SET @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:1
+107 ;
+108 IF $DATA(@TMREF@(BDFN))
DO IHD^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
+109 KILL @TMREF,@TREF
+110 IF DXOK
QUIT DXOK
+111 ;
+112 ; Multiple Instances of Known CVD
+113 SET TREF=$NAME(^TMP("BQITAX",UID))
SET TMREF=$NAME(^TMP("BQITMPD",UID))
+114 KILL @TMREF,BQITRY
+115 SET BQITRY(1)="BQI KNOWN CVD-MULT CPTS^9000010.18"
+116 SET BQITRY(2)="BQI KNOWN CVD-MULT DXS^9000010.07^^^^1"
+117 SET BQITRY(3)="BQI KNOWN CVD-MULT PROCEDURES^9000010.08"
+118 SET N=0
FOR
SET N=$ORDER(BQITRY(N))
IF 'N
QUIT
Begin DoDot:1
+119 KILL @TREF
+120 SET TAX=$PIECE(BQITRY(N),U,1)
SET FREF=$PIECE(BQITRY(N),U,2)
+121 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET PLFLG=+$PIECE(BQITRY(N),U,6)
+122 SET TMFRAME=$PIECE(BQITRY(N),U,4)
SET ENDT=""
+123 DO BLD^BQITUTL(TAX,TREF)
+124 IF PLFLG
DO PPRB(BDFN,TMREF)
+125 SET IEN=""
+126 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+127 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+128 IF '$DATA(@TREF@(TIEN))
QUIT
+129 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+130 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+131 IF FREF=9000010.07
SET OPRM=0
Begin DoDot:3
+132 IF $PIECE(@GREF@(IEN,0),U,12)="P"
SET OPRM=1
QUIT
+133 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET OPRM=1
End DoDot:3
IF 'OPRM
QUIT
+134 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+135 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+136 ; if service categories, check the visit for the service category
+137 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+138 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+139 DO ONE(BDFN,VSDTM)
+140 IF $DATA(@TMREF@(BDFN,VSDTM))
QUIT
+141 ;
+142 SET @TMREF@(BDFN)=$GET(@TMREF@(BDFN))+1
+143 SET @TMREF@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF_U_TAX
End DoDot:2
End DoDot:1
+144 ;
+145 ; at least 90 days apart but no more than 5 years
+146 ; between first and last
+147 IF $DATA(@TMREF@(BDFN))
DO IHD^BQITD031(BDFN,BTGLOB,TMREF,.DXOK)
+148 KILL @TREF,@TMREF
+149 QUIT DXOK
+150 ;
PRB(PVIEN,TPGLOB) ; EP - Check Problem File for instance of taxonomy
+1 ; Input
+2 ; PVIEN - Taxonomy entry
+3 ; TPGLOB - Problem file temporary global reference
+4 ; Call BQITD031 due to routine size considerations
+5 DO PRB^BQITD031
+6 QUIT
+7 ;
PPRB(DFN,TPGLOB) ;EP - Check Problem File for instance of a patient
+1 ; Input Parameters
+2 ; DFN - Patient record
+3 ; TPGLOB - Temporary global
+4 ; Call BQITD031 due to routine size considerations
+5 DO PPRB^BQITD031
+6 QUIT
+7 ;
ONE(DFN,VSDTM) ; If there was a visit and a problem on the same day, count the visit
+1 IF $DATA(@TMREF@(DFN,VSDTM))
IF $$TYP^BQITD031(DFN,VSDTM,TMREF)="P"
Begin DoDot:1
+2 KILL @TMREF@(DFN,VSDTM)
+3 SET @TMREF@(DFN)=$GET(@TMREF@(DFN))-1
End DoDot:1
QUIT
+4 QUIT
