BQITDGN ;PRXM/HC/ALA-General Taxonomy Diagnosis Category ; 10 Apr 2006 6:53 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
Q
;
POP(BQARY,TGLOB,KEEP) ; EP -- By population
;
;Description
; Finds all patients who meet the criteria passed in array BQARY
;Input
; BQARY - Array of taxonomies and other information
; Format: BQARY(#)=TAX^TYPE^NIT^TMFRAME^FREF^PLFLG^SAME
; 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, this is a relative date (T-12M)
; FREF - File Number reference
; PLFLG - Active Problem flag
; SAME - Check flag for instance on same date
; GREF - Global reference
; TREF - Taxonomy temp reference
; TPGLOB - Temporary global reference for Problem File instances
; KEEP - Keep the temporary global when passed from another logic definition
; EXDT - Expiration date
; DTDIF - difference between the start and end dates of the timeframe
; STDT - Start date of the timeframe
; ENDT - End date of the timeframe
; PRIM - Clinical ranking e.g. primary diagnosis only or primary/secondary.
; SERV - Visit service categories
;
NEW N,TAX,NIT,TMFRAME,FREF,GREF,TREF,STDT,GLOBAL,IEN,TIEN,VISIT,VSDTM,ENDT
NEW TPGLOB,SAME,EXDT,DTDIF,TPRGL,PRIM,SERV,VSERV
S KEEP=$G(KEEP,0)
S TPGLOB=$NA(^TMP("TEMP",UID))
; if KEEP is zero (do not keep any previous data passed), clean out the temporary
; global
I 'KEEP K @TPGLOB
; For each defined taxonomy set up into an array from File 90506.2
I $D(@BQARY) D
. S N=0 F S N=$O(@BQARY@(N)) Q:'N D
.. D PROC
.. S DFN=0
.. F S DFN=$O(@TPGLOB@(DFN)) Q:'DFN D
... I '$D(@TGLOB@(DFN)) M @TGLOB@(DFN)=@TPGLOB@(DFN)
.. ;
.. I 'KEEP K @TPGLOB
.. Q
I $D(@TPGLOB) K @TPGLOB
I $D(@TREF) K @TREF
I $D(@TPRGL) K @TPRGL
K DFN,PLFLG,GLBL,PC,STDT
Q
;
PROC ;Process each entry
S TAX=$P(@BQARY@(N),U,1),NIT=$P(@BQARY@(N),U,3)
S TMFRAME=$P(@BQARY@(N),U,4),FREF=$P(@BQARY@(N),U,5)
S PLFLG=+$P(@BQARY@(N),U,6),SAME=+$P(@BQARY@(N),U,7)
S PRIM=+$P(@BQARY@(N),U,8),SERV=$P(@BQARY@(N),U,9)
S EXDT="",DTDIF=""
I TMFRAME'="" D
. S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
. S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
S GREF=$$ROOT^DILFD(FREF,"",1)
S TPRGL=$NA(^TMP("TPRBLM",UID)) K @TPRGL
; Build the taxonomy reference
S TREF=$NA(^TMP("BQITAX",UID))
K @TREF
D BLD^BQITUTL(TAX,TREF)
; For each entry in the taxonomy reference
S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
. ; If problem flag, check the problem file for any instances of
. ; the taxonomy entry
. I PLFLG D PRB(TIEN,TPRGL) Q
; For each entry in the appropriate file (GREF), starting with most recent
; look for patients with instances for each taxonomy entry
S DFN=""
F S DFN=$O(@TPRGL@(DFN)) Q:DFN="" M @TGLOB@(DFN)=@TPRGL@(DFN)
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
.. ; if a bad record (no zero node), quit
.. I $G(@GREF@(IEN,0))="" Q
.. ; get patient record
.. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
.. ; if the patient already has a problem instance, quit
.. ;I $D(@TPRGL@(DFN))>0,$D(@TGLOB@(DFN)) M @TGLOB@(DFN)=@TPRGL@(DFN) Q
.. I $D(@TGLOB@(DFN)) Q
.. ; get the visit information
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. ; if the visit is deleted, quit
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. ; check clinical ranking if diagnosis (9000010.07)
.. I FREF=9000010.07,PRIM I $P(@GREF@(IEN,0),U,12)'="P" S MFL=0 D Q:'MFL
... I $O(@GREF@("AD",VISIT,""))=IEN S MFL=1
.. ; check clinical ranking if procedure (9000010.18 or 9000010.08)
.. I (FREF=9000010.18)!(FREF=9000010.08)&(PRIM) I $P(@GREF@(IEN,0),U,7)'="P" S MFL=0 D Q:'MFL
... I $O(@GREF@("AD",VISIT,""))=IEN S MFL=1
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
.. ; if there is a specified timeframe for the visit and the
.. ; visit date doesn't fall within that timeframe, quit
.. 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 the SAME day flag is zero then the value cannot be on the same day
.. ; if there is already a value for this date, quit
.. I 'SAME,$D(@TPGLOB@(DFN,"VISIT",VSDTM)) Q
.. ; if the patient has already met the number of interations, quit
.. I $G(@TPGLOB@(DFN))'<NIT Q
.. ; set the qualifying criteria for this patient and diagnostic category
.. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
.. S @TPGLOB@(DFN,"CRITERIA",TAX,"V",VISIT,IEN)=VSDTM
.. S $P(@TPGLOB@(DFN,"CRITERIA",TAX,"V",VISIT,IEN),U,3)=IEN_U_FREF
.. I EXDT'="" S $P(@TPGLOB@(DFN,"CRITERIA",TAX,"V",VISIT,IEN),U,2)=EXDT
.. S @TPGLOB@(DFN,"VISIT",VSDTM)=""
.. S @TPGLOB@(DFN)=$G(@TPGLOB@(DFN))+1
S DFN=""
F S DFN=$O(@TPGLOB@(DFN)) Q:DFN="" D
. K @TPGLOB@(DFN,"VISIT")
. I @TPGLOB@(DFN)<NIT K @TPGLOB@(DFN)
Q
;
PAT(BQARY,TGLOB,PTDFN,KEEP) ; EP -- By patient
;Description
; Checks if a patient meets the criteria
;Input
; BQARY - Array of taxonomies and other information
; DFN - patient internal entry number
;
S KEEP=$G(KEEP,0)
NEW TPGLOB
S TPGLOB=$NA(^TMP("TEMP",UID))
I 'KEEP K @TPGLOB
NEW N,TAX,NIT,TMFRAME,FREF,GREF,TREF,STDT,GLOBAL,IEN
NEW TIEN,VISIT,VSDTM,SAME,PROB,TPRGL,PRIM,SERV,VSERV
S N=0 F S N=$O(@BQARY@(N)) Q:'N D
. D PROCP
. I '$D(@TGLOB@(PTDFN)) M @TGLOB@(PTDFN)=@TPGLOB@(PTDFN)
. I 'KEEP K @TPGLOB
. Q
K @TPGLOB@(PTDFN,"VISIT")
I '$D(@TGLOB@(PTDFN)),$G(@TPGLOB@(PTDFN))<NIT K @TPGLOB Q 0
D FIL Q 1
;
FIL ;
M @TGLOB@(PTDFN,"CRITERIA")=@TPGLOB@(PTDFN,"CRITERIA")
S @TGLOB@(PTDFN)=$G(@TGLOB@(PTDFN))+$G(@TPGLOB@(PTDFN))
Q
;
PROCP ; Process one patient
S TAX=$P(@BQARY@(N),U,1),NIT=$P(@BQARY@(N),U,3)
S TMFRAME=$P(@BQARY@(N),U,4),FREF=$P(@BQARY@(N),U,5)
S PLFLG=+$P(@BQARY@(N),U,6),SAME=+$P(@BQARY@(N),U,7)
S PRIM=+$P(@BQARY@(N),U,8),SERV=$P(@BQARY@(N),U,9)
S EXDT="",DTDIF=""
I TMFRAME'="" D
. S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
. S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
S GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
K @TREF
S TPRGL=$NA(^TMP("TPRBLM",UID)) K @TPRGL
D BLD^BQITUTL(TAX,TREF)
I PLFLG D PPRB(PTDFN,TPRGL) I $D(@TPRGL@(PTDFN))>0,'$D(@TGLOB@(PTDFN)) M @TGLOB@(PTDFN)=@TPRGL@(PTDFN) Q
S IEN=""
F S IEN=$O(@GREF@("AC",PTDFN,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
. ; check clinical ranking if diagnosis (9000010.07)
. I FREF=9000010.07,PRIM I $P(@GREF@(IEN,0),U,12)'="P" S MFL=0 D Q:'MFL
.. I $O(@GREF@("AD",VISIT,""))=IEN S MFL=1
. I (FREF=9000010.18)!(FREF=9000010.08)&(PRIM) I $P(@GREF@(IEN,0),U,7)'="P" S MFL=0 D Q:'MFL
.. I $O(@GREF@("AD",VISIT,""))=IEN S MFL=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
. ; if the SAME day flag is zero then the value cannot be on the same day
. ; if there is already a value for this date, quit
. I 'SAME,$D(@TPGLOB@(PTDFN,"VISIT",VSDTM)) Q
. I $G(@TPGLOB@(PTDFN))'<NIT Q
. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
. S @TPGLOB@(PTDFN,"CRITERIA",TAX,"V",VISIT,IEN)=VSDTM
. S $P(@TPGLOB@(PTDFN,"CRITERIA",TAX,"V",VISIT,IEN),U,3)=IEN_U_FREF
. I EXDT'="" S $P(@TPGLOB@(PTDFN,"CRITERIA",TAX,"V",VISIT,IEN),U,2)=EXDT
. S @TPGLOB@(PTDFN,"VISIT",VSDTM)=""
. S @TPGLOB@(PTDFN)=$G(@TPGLOB@(PTDFN))+1
K @TPGLOB@(PTDFN,"VISIT")
I $G(@TPGLOB@(PTDFN))<NIT K @TPGLOB@(PTDFN)
Q
;
PRB(PVIEN,BQTGLB) ;EP - Check Problem File for instance of taxonomy
; Input
; PVIEN - Taxonomy entry
; TPGLOB - Problem file temporary global reference
NEW IEN,PGREF,PFREF
; Go through the problem file, starting with the most recent entry
S IEN="",PGREF="^AUPNPROB",PFREF=9000011
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
. ; if there is already a problem instance for this patient, quit
. I $G(@BQTGLB@(DFN))=1 Q
. ; get the date of the problem, since not all dates exist, the
. ; hierachy is 'DATE OF ONSET', 'DATE ENTERED', and then 'DATE LAST MODIFIED'.
. ;
. ; Check class - if Family ignore
. I $$GET1^DIQ(PFREF,IEN,.04,"I")="F" Q
. 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
. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
. S @BQTGLB@(DFN,"CRITERIA",TAX,"P",IEN)=VSDTM
. I EXDT'="" S $P(@BQTGLB@(DFN,"CRITERIA",TAX,"P",IEN),U,2)=EXDT
. S @BQTGLB@(DFN)=$G(@BQTGLB@(DFN))+1
Q
;
PPRB(DFN,BQTGLB) ;EP - Check Problem File for instance of a patient
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 Q:PROB
. 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
. I '$D(@BQTGLB@(DFN,PVIEN,VSDTM)) D
.. S @BQTGLB@(DFN,PVIEN,VSDTM)=$G(@BQTGLB@(DFN,PVIEN,VSDTM))+1
.. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
.. S @BQTGLB@(DFN,"CRITERIA",TAX,"P",PVIEN)=VSDTM
.. I EXDT'="" S $P(@BQTGLB@(DFN,"CRITERIA",TAX,"P",PVIEN),U,2)=EXDT
.. S @BQTGLB@(DFN)=$G(@BQTGLB@(DFN))+1
.. S PROB=1
Q
BQITDGN ;PRXM/HC/ALA-General Taxonomy Diagnosis Category ; 10 Apr 2006 6:53 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 QUIT
+3 ;
POP(BQARY,TGLOB,KEEP) ; EP -- By population
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria passed in array BQARY
+4 ;Input
+5 ; BQARY - Array of taxonomies and other information
+6 ; Format: BQARY(#)=TAX^TYPE^NIT^TMFRAME^FREF^PLFLG^SAME
+7 ; TGLOB - Global where data is to be stored and passed back
+8 ; to calling routine
+9 ; Structure:
+10 ; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+11 ;Variables
+12 ; TAX - Taxonomy name
+13 ; NIT - Number of iterations
+14 ; TMFRAME - Time frame of check, this is a relative date (T-12M)
+15 ; FREF - File Number reference
+16 ; PLFLG - Active Problem flag
+17 ; SAME - Check flag for instance on same date
+18 ; GREF - Global reference
+19 ; TREF - Taxonomy temp reference
+20 ; TPGLOB - Temporary global reference for Problem File instances
+21 ; KEEP - Keep the temporary global when passed from another logic definition
+22 ; EXDT - Expiration date
+23 ; DTDIF - difference between the start and end dates of the timeframe
+24 ; STDT - Start date of the timeframe
+25 ; ENDT - End date of the timeframe
+26 ; PRIM - Clinical ranking e.g. primary diagnosis only or primary/secondary.
+27 ; SERV - Visit service categories
+28 ;
+29 NEW N,TAX,NIT,TMFRAME,FREF,GREF,TREF,STDT,GLOBAL,IEN,TIEN,VISIT,VSDTM,ENDT
+30 NEW TPGLOB,SAME,EXDT,DTDIF,TPRGL,PRIM,SERV,VSERV
+31 SET KEEP=$GET(KEEP,0)
+32 SET TPGLOB=$NAME(^TMP("TEMP",UID))
+33 ; if KEEP is zero (do not keep any previous data passed), clean out the temporary
+34 ; global
+35 IF 'KEEP
KILL @TPGLOB
+36 ; For each defined taxonomy set up into an array from File 90506.2
+37 IF $DATA(@BQARY)
Begin DoDot:1
+38 SET N=0
FOR
SET N=$ORDER(@BQARY@(N))
IF 'N
QUIT
Begin DoDot:2
+39 DO PROC
+40 SET DFN=0
+41 FOR
SET DFN=$ORDER(@TPGLOB@(DFN))
IF 'DFN
QUIT
Begin DoDot:3
+42 IF '$DATA(@TGLOB@(DFN))
MERGE @TGLOB@(DFN)=@TPGLOB@(DFN)
End DoDot:3
+43 ;
+44 IF 'KEEP
KILL @TPGLOB
+45 QUIT
End DoDot:2
End DoDot:1
+46 IF $DATA(@TPGLOB)
KILL @TPGLOB
+47 IF $DATA(@TREF)
KILL @TREF
+48 IF $DATA(@TPRGL)
KILL @TPRGL
+49 KILL DFN,PLFLG,GLBL,PC,STDT
+50 QUIT
+51 ;
PROC ;Process each entry
+1 SET TAX=$PIECE(@BQARY@(N),U,1)
SET NIT=$PIECE(@BQARY@(N),U,3)
+2 SET TMFRAME=$PIECE(@BQARY@(N),U,4)
SET FREF=$PIECE(@BQARY@(N),U,5)
+3 SET PLFLG=+$PIECE(@BQARY@(N),U,6)
SET SAME=+$PIECE(@BQARY@(N),U,7)
+4 SET PRIM=+$PIECE(@BQARY@(N),U,8)
SET SERV=$PIECE(@BQARY@(N),U,9)
+5 SET EXDT=""
SET DTDIF=""
+6 IF TMFRAME'=""
Begin DoDot:1
+7 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+8 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
End DoDot:1
+9 SET GREF=$$ROOT^DILFD(FREF,"",1)
+10 SET TPRGL=$NAME(^TMP("TPRBLM",UID))
KILL @TPRGL
+11 ; Build the taxonomy reference
+12 SET TREF=$NAME(^TMP("BQITAX",UID))
+13 KILL @TREF
+14 DO BLD^BQITUTL(TAX,TREF)
+15 ; For each entry in the taxonomy reference
+16 SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+17 ; If problem flag, check the problem file for any instances of
+18 ; the taxonomy entry
+19 IF PLFLG
DO PRB(TIEN,TPRGL)
QUIT
End DoDot:1
+20 ; For each entry in the appropriate file (GREF), starting with most recent
+21 ; look for patients with instances for each taxonomy entry
+22 SET DFN=""
+23 FOR
SET DFN=$ORDER(@TPRGL@(DFN))
IF DFN=""
QUIT
MERGE @TGLOB@(DFN)=@TPRGL@(DFN)
+24 SET TIEN=""
+25 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+26 SET IEN=""
+27 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+28 ; if a bad record (no zero node), quit
+29 IF $GET(@GREF@(IEN,0))=""
QUIT
+30 ; get patient record
+31 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+32 ; if the patient already has a problem instance, quit
+33 ;I $D(@TPRGL@(DFN))>0,$D(@TGLOB@(DFN)) M @TGLOB@(DFN)=@TPRGL@(DFN) Q
+34 IF $DATA(@TGLOB@(DFN))
QUIT
+35 ; get the visit information
+36 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+37 ; if the visit is deleted, quit
+38 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+39 ; check clinical ranking if diagnosis (9000010.07)
+40 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET MFL=0
Begin DoDot:3
+41 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET MFL=1
End DoDot:3
IF 'MFL
QUIT
+42 ; check clinical ranking if procedure (9000010.18 or 9000010.08)
+43 IF (FREF=9000010.18)!(FREF=9000010.08)&(PRIM)
IF $PIECE(@GREF@(IEN,0),U,7)'="P"
SET MFL=0
Begin DoDot:3
+44 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET MFL=1
End DoDot:3
IF 'MFL
QUIT
+45 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+46 ; if there is a specified timeframe for the visit and the
+47 ; visit date doesn't fall within that timeframe, quit
+48 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+49 ; if service categories, check the visit for the service category
+50 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+51 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+52 ; if the SAME day flag is zero then the value cannot be on the same day
+53 ; if there is already a value for this date, quit
+54 IF 'SAME
IF $DATA(@TPGLOB@(DFN,"VISIT",VSDTM))
QUIT
+55 ; if the patient has already met the number of interations, quit
+56 IF $GET(@TPGLOB@(DFN))'<NIT
QUIT
+57 ; set the qualifying criteria for this patient and diagnostic category
+58 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+59 SET @TPGLOB@(DFN,"CRITERIA",TAX,"V",VISIT,IEN)=VSDTM
+60 SET $PIECE(@TPGLOB@(DFN,"CRITERIA",TAX,"V",VISIT,IEN),U,3)=IEN_U_FREF
+61 IF EXDT'=""
SET $PIECE(@TPGLOB@(DFN,"CRITERIA",TAX,"V",VISIT,IEN),U,2)=EXDT
+62 SET @TPGLOB@(DFN,"VISIT",VSDTM)=""
+63 SET @TPGLOB@(DFN)=$GET(@TPGLOB@(DFN))+1
End DoDot:2
End DoDot:1
+64 SET DFN=""
+65 FOR
SET DFN=$ORDER(@TPGLOB@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+66 KILL @TPGLOB@(DFN,"VISIT")
+67 IF @TPGLOB@(DFN)<NIT
KILL @TPGLOB@(DFN)
End DoDot:1
+68 QUIT
+69 ;
PAT(BQARY,TGLOB,PTDFN,KEEP) ; EP -- By patient
+1 ;Description
+2 ; Checks if a patient meets the criteria
+3 ;Input
+4 ; BQARY - Array of taxonomies and other information
+5 ; DFN - patient internal entry number
+6 ;
+7 SET KEEP=$GET(KEEP,0)
+8 NEW TPGLOB
+9 SET TPGLOB=$NAME(^TMP("TEMP",UID))
+10 IF 'KEEP
KILL @TPGLOB
+11 NEW N,TAX,NIT,TMFRAME,FREF,GREF,TREF,STDT,GLOBAL,IEN
+12 NEW TIEN,VISIT,VSDTM,SAME,PROB,TPRGL,PRIM,SERV,VSERV
+13 SET N=0
FOR
SET N=$ORDER(@BQARY@(N))
IF 'N
QUIT
Begin DoDot:1
+14 DO PROCP
+15 IF '$DATA(@TGLOB@(PTDFN))
MERGE @TGLOB@(PTDFN)=@TPGLOB@(PTDFN)
+16 IF 'KEEP
KILL @TPGLOB
+17 QUIT
End DoDot:1
+18 KILL @TPGLOB@(PTDFN,"VISIT")
+19 IF '$DATA(@TGLOB@(PTDFN))
IF $GET(@TPGLOB@(PTDFN))<NIT
KILL @TPGLOB
QUIT 0
+20 DO FIL
QUIT 1
+21 ;
FIL ;
+1 MERGE @TGLOB@(PTDFN,"CRITERIA")=@TPGLOB@(PTDFN,"CRITERIA")
+2 SET @TGLOB@(PTDFN)=$GET(@TGLOB@(PTDFN))+$GET(@TPGLOB@(PTDFN))
+3 QUIT
+4 ;
PROCP ; Process one patient
+1 SET TAX=$PIECE(@BQARY@(N),U,1)
SET NIT=$PIECE(@BQARY@(N),U,3)
+2 SET TMFRAME=$PIECE(@BQARY@(N),U,4)
SET FREF=$PIECE(@BQARY@(N),U,5)
+3 SET PLFLG=+$PIECE(@BQARY@(N),U,6)
SET SAME=+$PIECE(@BQARY@(N),U,7)
+4 SET PRIM=+$PIECE(@BQARY@(N),U,8)
SET SERV=$PIECE(@BQARY@(N),U,9)
+5 SET EXDT=""
SET DTDIF=""
+6 IF TMFRAME'=""
Begin DoDot:1
+7 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+8 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
End DoDot:1
+9 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+10 KILL @TREF
+11 SET TPRGL=$NAME(^TMP("TPRBLM",UID))
KILL @TPRGL
+12 DO BLD^BQITUTL(TAX,TREF)
+13 IF PLFLG
DO PPRB(PTDFN,TPRGL)
IF $DATA(@TPRGL@(PTDFN))>0
IF '$DATA(@TGLOB@(PTDFN))
MERGE @TGLOB@(PTDFN)=@TPRGL@(PTDFN)
QUIT
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(@GREF@("AC",PTDFN,IEN),-1)
IF 'IEN
QUIT
Begin DoDot:1
+16 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+17 IF '$DATA(@TREF@(TIEN))
QUIT
+18 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+19 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+20 ; check clinical ranking if diagnosis (9000010.07)
+21 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET MFL=0
Begin DoDot:2
+22 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET MFL=1
End DoDot:2
IF 'MFL
QUIT
+23 IF (FREF=9000010.18)!(FREF=9000010.08)&(PRIM)
IF $PIECE(@GREF@(IEN,0),U,7)'="P"
SET MFL=0
Begin DoDot:2
+24 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET MFL=1
End DoDot:2
IF 'MFL
QUIT
+25 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+26 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+27 ; if service categories, check the visit for the service category
+28 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+29 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+30 ; if the SAME day flag is zero then the value cannot be on the same day
+31 ; if there is already a value for this date, quit
+32 IF 'SAME
IF $DATA(@TPGLOB@(PTDFN,"VISIT",VSDTM))
QUIT
+33 IF $GET(@TPGLOB@(PTDFN))'<NIT
QUIT
+34 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+35 SET @TPGLOB@(PTDFN,"CRITERIA",TAX,"V",VISIT,IEN)=VSDTM
+36 SET $PIECE(@TPGLOB@(PTDFN,"CRITERIA",TAX,"V",VISIT,IEN),U,3)=IEN_U_FREF
+37 IF EXDT'=""
SET $PIECE(@TPGLOB@(PTDFN,"CRITERIA",TAX,"V",VISIT,IEN),U,2)=EXDT
+38 SET @TPGLOB@(PTDFN,"VISIT",VSDTM)=""
+39 SET @TPGLOB@(PTDFN)=$GET(@TPGLOB@(PTDFN))+1
End DoDot:1
+40 KILL @TPGLOB@(PTDFN,"VISIT")
+41 IF $GET(@TPGLOB@(PTDFN))<NIT
KILL @TPGLOB@(PTDFN)
+42 QUIT
+43 ;
PRB(PVIEN,BQTGLB) ;EP - Check Problem File for instance of taxonomy
+1 ; Input
+2 ; PVIEN - Taxonomy entry
+3 ; TPGLOB - Problem file temporary global reference
+4 NEW IEN,PGREF,PFREF
+5 ; Go through the problem file, starting with the most recent entry
+6 SET IEN=""
SET PGREF="^AUPNPROB"
SET PFREF=9000011
+7 FOR
SET IEN=$ORDER(@PGREF@("B",PVIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+8 ; get the patient record
+9 SET DFN=$$GET1^DIQ(PFREF,IEN,.02,"I")
IF DFN=""
QUIT
+10 ; if there is already a problem instance for this patient, quit
+11 IF $GET(@BQTGLB@(DFN))=1
QUIT
+12 ; get the date of the problem, since not all dates exist, the
+13 ; hierachy is 'DATE OF ONSET', 'DATE ENTERED', and then 'DATE LAST MODIFIED'.
+14 ;
+15 ; Check class - if Family ignore
+16 IF $$GET1^DIQ(PFREF,IEN,.04,"I")="F"
QUIT
+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 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+25 SET @BQTGLB@(DFN,"CRITERIA",TAX,"P",IEN)=VSDTM
+26 IF EXDT'=""
SET $PIECE(@BQTGLB@(DFN,"CRITERIA",TAX,"P",IEN),U,2)=EXDT
+27 SET @BQTGLB@(DFN)=$GET(@BQTGLB@(DFN))+1
End DoDot:1
+28 QUIT
+29 ;
PPRB(DFN,BQTGLB) ;EP - Check Problem File for instance of a patient
+1 NEW PGREF,PFREF,PVIEN,VSDTM
+2 SET PGREF="^AUPNPROB"
SET PFREF=9000011
SET PROB=0
+3 SET PVIEN=""
+4 FOR
SET PVIEN=$ORDER(@PGREF@("AC",DFN,PVIEN),-1)
IF PVIEN=""
QUIT
Begin DoDot:1
+5 SET TIEN=$$GET1^DIQ(PFREF,PVIEN,.01,"I")
IF TIEN=""
QUIT
+6 IF '$DATA(@TREF@(TIEN))
QUIT
+7 ; Check class - if Family ignore
+8 IF $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F"
QUIT
+9 IF $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A"
QUIT
+10 SET VSDTM=$$PROB^BQIUL1(PVIEN)\1
IF VSDTM=0
QUIT
+11 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+12 IF '$DATA(@BQTGLB@(DFN,PVIEN,VSDTM))
Begin DoDot:2
+13 SET @BQTGLB@(DFN,PVIEN,VSDTM)=$GET(@BQTGLB@(DFN,PVIEN,VSDTM))+1
+14 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+15 SET @BQTGLB@(DFN,"CRITERIA",TAX,"P",PVIEN)=VSDTM
+16 IF EXDT'=""
SET $PIECE(@BQTGLB@(DFN,"CRITERIA",TAX,"P",PVIEN),U,2)=EXDT
+17 SET @BQTGLB@(DFN)=$GET(@BQTGLB@(DFN))+1
+18 SET PROB=1
End DoDot:2
End DoDot:1
IF PROB
QUIT
+19 QUIT
