BQITD031 ;PRXM/HC/ALA-CVD Known Definition ; 19 Jun 2006 5:01 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
; Utilities called by BQITD03
;
Q
;
AMI(DFN,GLOB,TMREF,DXOK) ; EP - Process AMI date logic
;
; Within any two year period, at least two diagnoses of [whatever] and
; at least 90 days between first and last diagnosis (Revised logic definition)
;
; Input
; DFN - patient whose AMI diagnoses are being examined
; GLOB - Global where data is to be stored
; Structure:
; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
; TMREF - Global used to temporarily store diagnoses that may meet the
; AMI logic and, if so, will be stored in GLOB
; DXOK - If set to '1', patient meets the AMI logic for CVD Known - value
; may be returned (if called by PAT subroutine)
; Variables
; NOK - If set to '1', no diagnoses remaining that will meet the date logic
; LDX - Most recent diagnosis that meets the AMI criteria
; FDX - Other diagnosis that must be compared to LDX to determine if they
; meet the date logic
; STOP - Set to '1' if the date range exceeds the two year maximum so new
; value for LDX must be found
; VTYP - Visit type - either 'V' for visit or 'P' for problem
N NOK,STOP,LDX,FDX,DX
I $G(@TMREF@(DFN))<2 K @TMREF@(DFN) Q
S DXOK=0,NOK=0
F D Q:DXOK!NOK K @TMREF@(DFN,LDX)
. S LDX=$O(@TMREF@(DFN,"A"),-1) I LDX="" S NOK=1 Q
. S STOP=0,FDX=LDX
. F S FDX=$O(@TMREF@(DFN,FDX),-1) Q:FDX="" D Q:DXOK!STOP
.. I $$TYP(DFN,LDX,TMREF)="P",$$TYP(DFN,FDX,TMREF)="P" Q
.. I $$FMDIFF^XLFDT(LDX,FDX,1)'<731 S STOP=1 Q ; More than 2 years apart
.. I $$FMDIFF^XLFDT(LDX,FDX,1)>89 S DXOK=1 D
... ; Delete remaining entries from temporary file
... S DX=""
... F S DX=$O(@TMREF@(DFN,DX)) Q:DX="" I DX'=LDX,DX'=FDX K @TMREF@(DFN,DX)
; Update global with criteria
I DXOK D
. M @GLOB@(DFN)=@TMREF@(DFN)
. NEW IEN,FREF,EXDT
. S VSDT="",EXDT=""
. F S VSDT=$O(@TMREF@(DFN,VSDT)) Q:VSDT="" D
.. S TIEN="" F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D
... S VISIT=$P(@TMREF@(DFN,VSDT,TIEN),U,2),VTYP=$P(@TMREF@(DFN,VSDT,TIEN),U,1)
... S IEN=$P(@TMREF@(DFN,VSDT,TIEN),U,4),FREF=$P(@TMREF@(DFN,VSDT,TIEN),U,5)
... I VTYP="V" S @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
... I VTYP="P" S @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT)=VSDT_U_EXDT
Q
;
IHD(DFN,GLOB,TMREF,DXOK) ; EP - Process IHD/Multiple Known CVD date logic
;
; Within any five year period, at least three diagnoses of [whatever] and
; at least 90 days between first and last diagnosis (Revised logic definition)
; Input
; DFN - patient whose IHD diagnoses are being examined
; GLOB - Global where data is to be stored
; Structure:
; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
; TMREF - Global used to temporarily store diagnoses that may meet the
; IHD logic and, if so, will be stored in GLOB
; DXOK - If set to '1', patient meets the IHD logic for CVD Known - value
; may be returned (if called by PAT subroutine)
; Variables
; NOK - If set to '1', no diagnoses remaining that will meet the date logic
; LDX - Most recent diagnosis that meets the IHD criteria
; LDX1 - Next recent diagnosis that meets the IHD criteria
; FDX - Third diagnosis that must be compared to LDX to determine if they
; meet the date logic
; STOP - Set to '1' if the date range exceeds the two year maximum so new
; value for LDX must be found
; VTYP - Visit type - either 'V' for visit or 'P' for problem
N NOK,STOP,LDX,LDX1,FDX,DX
I $G(@TMREF@(DFN))<3 K @TMREF@(DFN) Q
S DXOK=0,NOK=0
F D Q:DXOK!NOK K @TMREF@(DFN,LDX)
. S LDX=$O(@TMREF@(DFN,"A"),-1) I LDX="" S NOK=1 Q
. S LDX1=$O(@TMREF@(DFN,LDX),-1) I LDX1="" S NOK=1 Q
. ; Only one problem can be included
. I $$TYP(DFN,LDX,TMREF)="P",$$TYP(DFN,LDX1,TMREF)="P" D I LDX1="" S NOK=1 Q
.. F S LDX1=$O(@TMREF@(DFN,LDX1),-1) Q:LDX1="" I $$TYP(DFN,LDX1,TMREF)="V" Q
. S STOP=0,FDX=LDX1
. F S FDX=$O(@TMREF@(DFN,FDX),-1) Q:FDX="" D Q:DXOK!STOP
.. I $$TYP(DFN,LDX,TMREF)="P"!($$TYP(DFN,LDX1,TMREF)="P"),$$TYP(DFN,FDX,TMREF)="P" Q
.. I $$FMDIFF^XLFDT(LDX,FDX,1)'<1826 S STOP=1 Q ; More than 5 years apart
.. I $$FMDIFF^XLFDT(LDX,FDX,1)>89 S DXOK=1 D
... ; Delete remaining entries from temporary file
... S DX=""
... F S DX=$O(@TMREF@(DFN,DX)) Q:DX="" I DX'=LDX,DX'=LDX1,DX'=FDX K @TMREF@(DFN,DX)
I DXOK D
. M @GLOB@(DFN)=@TMREF@(DFN)
. NEW IEN,FREF,EXDT
. S VSDT="",EXDT=""
. F S VSDT=$O(@TMREF@(DFN,VSDT)) Q:VSDT="" D
.. S TIEN="" F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D
... S VISIT=$P(@TMREF@(DFN,VSDT,TIEN),U,2),VTYP=$P(@TMREF@(DFN,VSDT,TIEN),U,1)
... S IEN=$P(@TMREF@(DFN,VSDT,TIEN),U,4),FREF=$P(@TMREF@(DFN,VSDT,TIEN),U,5)
... S TAX=$P(@TMREF@(DFN,VSDT,TIEN),U,6)
... I VTYP="V" S @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
... I VTYP="P" S @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT)=VSDT_U_EXDT
Q
;
IHDSM(DFN,GLOB,TMREF,DXOK) ; EP - Process IHD same day date logic
;
; 3 different instances of IHD on same day
; Input
; DFN - patient whose IHD diagnoses are being examined
; GLOB - Global where data is to be stored
; Structure:
; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
; TMREF - Global used to temporarily store diagnoses that may meet the
; IHD logic and, if so, will be stored in GLOB
; DXOK - If set to '1', patient meets the IHD logic for CVD Known - value
; may be returned (if called by PAT subroutine)
; Variables
; VSDT - Visit date
; TIEN - Diagnosis internal entry number
; CT - Count of diagnoses for a date
; VCT - Count of diagnoses associated with a visit
; STOP - Set to '1' if the date range exceeds the two year maximum so new
; value for LDX must be found
; VTYP - Visit type - either 'V' for visit or 'P' for problem
; VST - Array of visits to be included in the criteria
; PVST - If there are only 2 visit dxs, set to the problem to be included
;
N VSDT,TIEN,CT,VCT,VISIT,VTYP,VST,PVST,PRM,VPRM
I $G(@TMREF@(DFN))<3 K @TMREF@(DFN) Q
S DXOK=0,VSDT="",VPRM=""
F S VSDT=$O(@TMREF@(DFN,VSDT),-1) Q:VSDT="" D Q:DXOK
. S STOP=0,TIEN="",CT=0,VCT=0,PVST="" K VST
. F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D Q:VPRM
.. I $P(@TMREF@(DFN,VSDT,TIEN),U,7) S VPRM=1,VST(TIEN)="",CT=1,VCT=1
. Q:'VPRM S TIEN=""
. F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" I '$D(VST(TIEN)) D
.. S CT=CT+1
.. ; There must be three different diagnoses
.. ; and of these three only one can be a problem
.. ; One diagnosis must be a primary (PRM)
.. S VTYP=$P(@TMREF@(DFN,VSDT,TIEN),U),PRM=$P(@TMREF@(DFN,VSDT,TIEN),U,7)
.. I VTYP="V" S VCT=VCT+1 I CT'>3 S VST(TIEN)=""
.. I VTYP="P",PVST="" S PVST=TIEN
.. I CT'<3,VCT'<2 S DXOK=1
. I DXOK D DEL(VSDT,CT,VCT,PVST,.VST)
; Update global with criteria
; VSDT is the date for which there are 3 different diagnoses
;
I DXOK D
. M @GLOB@(DFN,VSDT)=@TMREF@(DFN,VSDT)
. NEW IEN,FREF,EXDT
. S TIEN="",EXDT=""
. F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D
.. S VISIT=$P(@TMREF@(DFN,VSDT,TIEN),U,2),VTYP=$P(@TMREF@(DFN,VSDT,TIEN),U,1)
.. S IEN=$P(@TMREF@(DFN,VSDT,TIEN),U,4),FREF=$P(@TMREF@(DFN,VSDT,TIEN),U,5)
.. I VTYP="V" S @GLOB@(DFN,"CRITERIA","Ischemic Heart Disease (3 diff)",VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
.. I VTYP="P" S @GLOB@(DFN,"CRITERIA","Ischemic Heart Disease (3 diff)",VTYP,VISIT)=VSDT_U_EXDT
Q
;
TYP(DFN,DX,TMREF) ; EP - Return 'V' or 'P' to identify type of visit
; Input
; DFN - Patient
; DX - Diagnosis internal entry number
; TMREF - Temporary array of diagnoses
; Variables
; LTYP - Either 'V' for visit or 'P' for problem
N LIEN,LTYP
S LTYP="P"
S LIEN=""
F S LIEN=$O(@TMREF@(DFN,DX,LIEN)) Q:LIEN="" D Q:LTYP="V"
. S LTYP=$P(@TMREF@(DFN,DX,LIEN),U)
Q LTYP
;
DEL(VSDT,CT,VCT,PVST,VST) ; EP - Delete diagnoses from temporary file
; If more than three diagnoses on same day, remove extras
; preferentially keeping visit diagnoses over problem diagnoses
; and retaining a maximum of one problem diagnosis
;
; Input
; VSDT - Visit date
; CT - Count of diagnoses for a date
; VCT - Count of diagnoses associated with a visit
; PVST - If there are problem dxs, set to the first problem ien
; VST - array of visit iens; if there are more than three only the
; first three are included
;
I CT=3 Q ; If only 3 diagnoses we're done
I VCT'<3 D Q ; keep three visit diagnoses and remove the rest
. S TIEN=""
. F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D
.. I '$D(VST(TIEN)) K @TMREF@(DFN,VSDT,TIEN)
; keep the problem and two visit diagnoses and remove the rest
S TIEN=""
F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D
. I '$D(VST(TIEN)),TIEN'=PVST K @TMREF@(DFN,VSDT,TIEN)
Q
PRB ; EP - Check Problem File for instance of taxonomy
; Called by BQITD03
;
; PVIEN - Taxonomy entry
; TPGLOB - Problem file temporary global reference
;
NEW IEN,PGREF,PFREF,DFN,VSDTM
; Go through the problem file, starting with the most recent entry
S IEN="",PGREF="^AUPNPROB",PFREF=9000011,PROB=0
F S IEN=$O(@PGREF@("B",PVIEN,IEN),-1) Q:IEN="" D
. ; get the patient record
. S DFN=$$GET1^DIQ(PFREF,IEN,.02,"I") I DFN="" Q
. ; get the date of the problem, since not all dates exist, the
. ;
. ; Check class - if Family ignore
. I $$GET1^DIQ(PFREF,IEN,.04,"I")="F" Q
. ; hierarchy is 'DATE ENTERED', and then 'DATE LAST MODIFIED'.
. S VSDTM=$$PROB^BQIUL1(IEN)\1 Q:VSDTM=0
. ; if there is a specified timeframe for the instance and the
. ; problem date doesn't fall within that timeframe, quit
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. ; if the problem is not an 'active' one, quit
. I $$GET1^DIQ(PFREF,IEN,.12,"I")'="A" Q
. ; set the qualifying criteria for this patient and diagnostic category
. S @TPGLOB@(DFN,VSDTM,PVIEN)="P"_U_IEN
. S $P(@TPGLOB@(DFN,VSDTM,PVIEN),U,6)=TAX
. S @TPGLOB@(DFN)=$G(@TPGLOB@(DFN))+1
Q
;
PPRB ;EP - Check Problem File for instance of a patient
; Called by BQITD03
; Input Parameters
; DFN - Patient record
; TPGLOB - Temporary global
NEW PGREF,PFREF,PVIEN,VSDTM
S PGREF="^AUPNPROB",PFREF=9000011,PROB=0
S PVIEN=""
F S PVIEN=$O(@PGREF@("AC",DFN,PVIEN),-1) Q:PVIEN="" D
. S TIEN=$$GET1^DIQ(PFREF,PVIEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. ; Check class - if Family ignore
. I $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F" Q
. I $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A" Q
. S VSDTM=$$PROB^BQIUL1(PVIEN)\1 Q:VSDTM=0
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. S @TPGLOB@(DFN,VSDTM,TIEN)="P"_U_PVIEN
. S $P(@TPGLOB@(DFN,VSDTM,TIEN),U,6)=TAX
. S @TPGLOB@(DFN)=$G(@TPGLOB@(DFN))+1
Q
BQITD031 ;PRXM/HC/ALA-CVD Known Definition ; 19 Jun 2006 5:01 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Utilities called by BQITD03
+3 ;
+4 QUIT
+5 ;
AMI(DFN,GLOB,TMREF,DXOK) ; EP - Process AMI date logic
+1 ;
+2 ; Within any two year period, at least two diagnoses of [whatever] and
+3 ; at least 90 days between first and last diagnosis (Revised logic definition)
+4 ;
+5 ; Input
+6 ; DFN - patient whose AMI diagnoses are being examined
+7 ; GLOB - Global where data is to be stored
+8 ; Structure:
+9 ; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+10 ; TMREF - Global used to temporarily store diagnoses that may meet the
+11 ; AMI logic and, if so, will be stored in GLOB
+12 ; DXOK - If set to '1', patient meets the AMI logic for CVD Known - value
+13 ; may be returned (if called by PAT subroutine)
+14 ; Variables
+15 ; NOK - If set to '1', no diagnoses remaining that will meet the date logic
+16 ; LDX - Most recent diagnosis that meets the AMI criteria
+17 ; FDX - Other diagnosis that must be compared to LDX to determine if they
+18 ; meet the date logic
+19 ; STOP - Set to '1' if the date range exceeds the two year maximum so new
+20 ; value for LDX must be found
+21 ; VTYP - Visit type - either 'V' for visit or 'P' for problem
+22 NEW NOK,STOP,LDX,FDX,DX
+23 IF $GET(@TMREF@(DFN))<2
KILL @TMREF@(DFN)
QUIT
+24 SET DXOK=0
SET NOK=0
+25 FOR
Begin DoDot:1
+26 SET LDX=$ORDER(@TMREF@(DFN,"A"),-1)
IF LDX=""
SET NOK=1
QUIT
+27 SET STOP=0
SET FDX=LDX
+28 FOR
SET FDX=$ORDER(@TMREF@(DFN,FDX),-1)
IF FDX=""
QUIT
Begin DoDot:2
+29 IF $$TYP(DFN,LDX,TMREF)="P"
IF $$TYP(DFN,FDX,TMREF)="P"
QUIT
+30 ; More than 2 years apart
IF $$FMDIFF^XLFDT(LDX,FDX,1)'<731
SET STOP=1
QUIT
+31 IF $$FMDIFF^XLFDT(LDX,FDX,1)>89
SET DXOK=1
Begin DoDot:3
+32 ; Delete remaining entries from temporary file
+33 SET DX=""
+34 FOR
SET DX=$ORDER(@TMREF@(DFN,DX))
IF DX=""
QUIT
IF DX'=LDX
IF DX'=FDX
KILL @TMREF@(DFN,DX)
End DoDot:3
End DoDot:2
IF DXOK!STOP
QUIT
End DoDot:1
IF DXOK!NOK
QUIT
KILL @TMREF@(DFN,LDX)
+35 ; Update global with criteria
+36 IF DXOK
Begin DoDot:1
+37 MERGE @GLOB@(DFN)=@TMREF@(DFN)
+38 NEW IEN,FREF,EXDT
+39 SET VSDT=""
SET EXDT=""
+40 FOR
SET VSDT=$ORDER(@TMREF@(DFN,VSDT))
IF VSDT=""
QUIT
Begin DoDot:2
+41 SET TIEN=""
FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+42 SET VISIT=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,2)
SET VTYP=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,1)
+43 SET IEN=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,4)
SET FREF=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,5)
+44 IF VTYP="V"
SET @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
+45 IF VTYP="P"
SET @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT)=VSDT_U_EXDT
End DoDot:3
End DoDot:2
End DoDot:1
+46 QUIT
+47 ;
IHD(DFN,GLOB,TMREF,DXOK) ; EP - Process IHD/Multiple Known CVD date logic
+1 ;
+2 ; Within any five year period, at least three diagnoses of [whatever] and
+3 ; at least 90 days between first and last diagnosis (Revised logic definition)
+4 ; Input
+5 ; DFN - patient whose IHD diagnoses are being examined
+6 ; GLOB - Global where data is to be stored
+7 ; Structure:
+8 ; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+9 ; TMREF - Global used to temporarily store diagnoses that may meet the
+10 ; IHD logic and, if so, will be stored in GLOB
+11 ; DXOK - If set to '1', patient meets the IHD logic for CVD Known - value
+12 ; may be returned (if called by PAT subroutine)
+13 ; Variables
+14 ; NOK - If set to '1', no diagnoses remaining that will meet the date logic
+15 ; LDX - Most recent diagnosis that meets the IHD criteria
+16 ; LDX1 - Next recent diagnosis that meets the IHD criteria
+17 ; FDX - Third diagnosis that must be compared to LDX to determine if they
+18 ; meet the date logic
+19 ; STOP - Set to '1' if the date range exceeds the two year maximum so new
+20 ; value for LDX must be found
+21 ; VTYP - Visit type - either 'V' for visit or 'P' for problem
+22 NEW NOK,STOP,LDX,LDX1,FDX,DX
+23 IF $GET(@TMREF@(DFN))<3
KILL @TMREF@(DFN)
QUIT
+24 SET DXOK=0
SET NOK=0
+25 FOR
Begin DoDot:1
+26 SET LDX=$ORDER(@TMREF@(DFN,"A"),-1)
IF LDX=""
SET NOK=1
QUIT
+27 SET LDX1=$ORDER(@TMREF@(DFN,LDX),-1)
IF LDX1=""
SET NOK=1
QUIT
+28 ; Only one problem can be included
+29 IF $$TYP(DFN,LDX,TMREF)="P"
IF $$TYP(DFN,LDX1,TMREF)="P"
Begin DoDot:2
+30 FOR
SET LDX1=$ORDER(@TMREF@(DFN,LDX1),-1)
IF LDX1=""
QUIT
IF $$TYP(DFN,LDX1,TMREF)="V"
QUIT
End DoDot:2
IF LDX1=""
SET NOK=1
QUIT
+31 SET STOP=0
SET FDX=LDX1
+32 FOR
SET FDX=$ORDER(@TMREF@(DFN,FDX),-1)
IF FDX=""
QUIT
Begin DoDot:2
+33 IF $$TYP(DFN,LDX,TMREF)="P"!($$TYP(DFN,LDX1,TMREF)="P")
IF $$TYP(DFN,FDX,TMREF)="P"
QUIT
+34 ; More than 5 years apart
IF $$FMDIFF^XLFDT(LDX,FDX,1)'<1826
SET STOP=1
QUIT
+35 IF $$FMDIFF^XLFDT(LDX,FDX,1)>89
SET DXOK=1
Begin DoDot:3
+36 ; Delete remaining entries from temporary file
+37 SET DX=""
+38 FOR
SET DX=$ORDER(@TMREF@(DFN,DX))
IF DX=""
QUIT
IF DX'=LDX
IF DX'=LDX1
IF DX'=FDX
KILL @TMREF@(DFN,DX)
End DoDot:3
End DoDot:2
IF DXOK!STOP
QUIT
End DoDot:1
IF DXOK!NOK
QUIT
KILL @TMREF@(DFN,LDX)
+39 IF DXOK
Begin DoDot:1
+40 MERGE @GLOB@(DFN)=@TMREF@(DFN)
+41 NEW IEN,FREF,EXDT
+42 SET VSDT=""
SET EXDT=""
+43 FOR
SET VSDT=$ORDER(@TMREF@(DFN,VSDT))
IF VSDT=""
QUIT
Begin DoDot:2
+44 SET TIEN=""
FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+45 SET VISIT=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,2)
SET VTYP=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,1)
+46 SET IEN=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,4)
SET FREF=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,5)
+47 SET TAX=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,6)
+48 IF VTYP="V"
SET @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
+49 IF VTYP="P"
SET @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT)=VSDT_U_EXDT
End DoDot:3
End DoDot:2
End DoDot:1
+50 QUIT
+51 ;
IHDSM(DFN,GLOB,TMREF,DXOK) ; EP - Process IHD same day date logic
+1 ;
+2 ; 3 different instances of IHD on same day
+3 ; Input
+4 ; DFN - patient whose IHD diagnoses are being examined
+5 ; GLOB - Global where data is to be stored
+6 ; Structure:
+7 ; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+8 ; TMREF - Global used to temporarily store diagnoses that may meet the
+9 ; IHD logic and, if so, will be stored in GLOB
+10 ; DXOK - If set to '1', patient meets the IHD logic for CVD Known - value
+11 ; may be returned (if called by PAT subroutine)
+12 ; Variables
+13 ; VSDT - Visit date
+14 ; TIEN - Diagnosis internal entry number
+15 ; CT - Count of diagnoses for a date
+16 ; VCT - Count of diagnoses associated with a visit
+17 ; STOP - Set to '1' if the date range exceeds the two year maximum so new
+18 ; value for LDX must be found
+19 ; VTYP - Visit type - either 'V' for visit or 'P' for problem
+20 ; VST - Array of visits to be included in the criteria
+21 ; PVST - If there are only 2 visit dxs, set to the problem to be included
+22 ;
+23 NEW VSDT,TIEN,CT,VCT,VISIT,VTYP,VST,PVST,PRM,VPRM
+24 IF $GET(@TMREF@(DFN))<3
KILL @TMREF@(DFN)
QUIT
+25 SET DXOK=0
SET VSDT=""
SET VPRM=""
+26 FOR
SET VSDT=$ORDER(@TMREF@(DFN,VSDT),-1)
IF VSDT=""
QUIT
Begin DoDot:1
+27 SET STOP=0
SET TIEN=""
SET CT=0
SET VCT=0
SET PVST=""
KILL VST
+28 FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+29 IF $PIECE(@TMREF@(DFN,VSDT,TIEN),U,7)
SET VPRM=1
SET VST(TIEN)=""
SET CT=1
SET VCT=1
End DoDot:2
IF VPRM
QUIT
+30 IF 'VPRM
QUIT
SET TIEN=""
+31 FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
IF '$DATA(VST(TIEN))
Begin DoDot:2
+32 SET CT=CT+1
+33 ; There must be three different diagnoses
+34 ; and of these three only one can be a problem
+35 ; One diagnosis must be a primary (PRM)
+36 SET VTYP=$PIECE(@TMREF@(DFN,VSDT,TIEN),U)
SET PRM=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,7)
+37 IF VTYP="V"
SET VCT=VCT+1
IF CT'>3
SET VST(TIEN)=""
+38 IF VTYP="P"
IF PVST=""
SET PVST=TIEN
+39 IF CT'<3
IF VCT'<2
SET DXOK=1
End DoDot:2
+40 IF DXOK
DO DEL(VSDT,CT,VCT,PVST,.VST)
End DoDot:1
IF DXOK
QUIT
+41 ; Update global with criteria
+42 ; VSDT is the date for which there are 3 different diagnoses
+43 ;
+44 IF DXOK
Begin DoDot:1
+45 MERGE @GLOB@(DFN,VSDT)=@TMREF@(DFN,VSDT)
+46 NEW IEN,FREF,EXDT
+47 SET TIEN=""
SET EXDT=""
+48 FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+49 SET VISIT=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,2)
SET VTYP=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,1)
+50 SET IEN=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,4)
SET FREF=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,5)
+51 IF VTYP="V"
SET @GLOB@(DFN,"CRITERIA","Ischemic Heart Disease (3 diff)",VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
+52 IF VTYP="P"
SET @GLOB@(DFN,"CRITERIA","Ischemic Heart Disease (3 diff)",VTYP,VISIT)=VSDT_U_EXDT
End DoDot:2
End DoDot:1
+53 QUIT
+54 ;
TYP(DFN,DX,TMREF) ; EP - Return 'V' or 'P' to identify type of visit
+1 ; Input
+2 ; DFN - Patient
+3 ; DX - Diagnosis internal entry number
+4 ; TMREF - Temporary array of diagnoses
+5 ; Variables
+6 ; LTYP - Either 'V' for visit or 'P' for problem
+7 NEW LIEN,LTYP
+8 SET LTYP="P"
+9 SET LIEN=""
+10 FOR
SET LIEN=$ORDER(@TMREF@(DFN,DX,LIEN))
IF LIEN=""
QUIT
Begin DoDot:1
+11 SET LTYP=$PIECE(@TMREF@(DFN,DX,LIEN),U)
End DoDot:1
IF LTYP="V"
QUIT
+12 QUIT LTYP
+13 ;
DEL(VSDT,CT,VCT,PVST,VST) ; EP - Delete diagnoses from temporary file
+1 ; If more than three diagnoses on same day, remove extras
+2 ; preferentially keeping visit diagnoses over problem diagnoses
+3 ; and retaining a maximum of one problem diagnosis
+4 ;
+5 ; Input
+6 ; VSDT - Visit date
+7 ; CT - Count of diagnoses for a date
+8 ; VCT - Count of diagnoses associated with a visit
+9 ; PVST - If there are problem dxs, set to the first problem ien
+10 ; VST - array of visit iens; if there are more than three only the
+11 ; first three are included
+12 ;
+13 ; If only 3 diagnoses we're done
IF CT=3
QUIT
+14 ; keep three visit diagnoses and remove the rest
IF VCT'<3
Begin DoDot:1
+15 SET TIEN=""
+16 FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+17 IF '$DATA(VST(TIEN))
KILL @TMREF@(DFN,VSDT,TIEN)
End DoDot:2
End DoDot:1
QUIT
+18 ; keep the problem and two visit diagnoses and remove the rest
+19 SET TIEN=""
+20 FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+21 IF '$DATA(VST(TIEN))
IF TIEN'=PVST
KILL @TMREF@(DFN,VSDT,TIEN)
End DoDot:1
+22 QUIT
PRB ; EP - Check Problem File for instance of taxonomy
+1 ; Called by BQITD03
+2 ;
+3 ; PVIEN - Taxonomy entry
+4 ; TPGLOB - Problem file temporary global reference
+5 ;
+6 NEW IEN,PGREF,PFREF,DFN,VSDTM
+7 ; Go through the problem file, starting with the most recent entry
+8 SET IEN=""
SET PGREF="^AUPNPROB"
SET PFREF=9000011
SET PROB=0
+9 FOR
SET IEN=$ORDER(@PGREF@("B",PVIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+10 ; get the patient record
+11 SET DFN=$$GET1^DIQ(PFREF,IEN,.02,"I")
IF DFN=""
QUIT
+12 ; get the date of the problem, since not all dates exist, the
+13 ;
+14 ; Check class - if Family ignore
+15 IF $$GET1^DIQ(PFREF,IEN,.04,"I")="F"
QUIT
+16 ; hierarchy is 'DATE ENTERED', and then 'DATE LAST MODIFIED'.
+17 SET VSDTM=$$PROB^BQIUL1(IEN)\1
IF VSDTM=0
QUIT
+18 ; if there is a specified timeframe for the instance and the
+19 ; problem date doesn't fall within that timeframe, quit
+20 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+21 ; if the problem is not an 'active' one, quit
+22 IF $$GET1^DIQ(PFREF,IEN,.12,"I")'="A"
QUIT
+23 ; set the qualifying criteria for this patient and diagnostic category
+24 SET @TPGLOB@(DFN,VSDTM,PVIEN)="P"_U_IEN
+25 SET $PIECE(@TPGLOB@(DFN,VSDTM,PVIEN),U,6)=TAX
+26 SET @TPGLOB@(DFN)=$GET(@TPGLOB@(DFN))+1
End DoDot:1
+27 QUIT
+28 ;
PPRB ;EP - Check Problem File for instance of a patient
+1 ; Called by BQITD03
+2 ; Input Parameters
+3 ; DFN - Patient record
+4 ; TPGLOB - Temporary global
+5 NEW PGREF,PFREF,PVIEN,VSDTM
+6 SET PGREF="^AUPNPROB"
SET PFREF=9000011
SET PROB=0
+7 SET PVIEN=""
+8 FOR
SET PVIEN=$ORDER(@PGREF@("AC",DFN,PVIEN),-1)
IF PVIEN=""
QUIT
Begin DoDot:1
+9 SET TIEN=$$GET1^DIQ(PFREF,PVIEN,.01,"I")
IF TIEN=""
QUIT
+10 IF '$DATA(@TREF@(TIEN))
QUIT
+11 ; Check class - if Family ignore
+12 IF $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F"
QUIT
+13 IF $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A"
QUIT
+14 SET VSDTM=$$PROB^BQIUL1(PVIEN)\1
IF VSDTM=0
QUIT
+15 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+16 SET @TPGLOB@(DFN,VSDTM,TIEN)="P"_U_PVIEN
+17 SET $PIECE(@TPGLOB@(DFN,VSDTM,TIEN),U,6)=TAX
+18 SET @TPGLOB@(DFN)=$GET(@TPGLOB@(DFN))+1
End DoDot:1
+19 QUIT
