BQITDGN.m

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=""