BQIDCUTL.m

BQIDCUTL ;VNGT/HS/ALA-Definition Utility ; 12 Sep 2008  1:43 PM

 ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10

 ;

LAB(BQDFN,TEST) ;EP - Check for most recent result of a specified Lab test

 ;

 ; Input

 ;   BQDFN   - Patient internal entry number

 ;   TEST    - Lab Test IEN to search

 ;

 NEW LIEN,QFL,RES,TIEN,VALUE,VIEN,VSDTM,UID

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S TEMP=$NA(^TMP(UID,"BQIVLAB")) K @TEMP

 S LIEN="",QFL=0,RES=0

 F  S LIEN=$O(^AUPNVLAB("AC",BQDFN,LIEN),-1) Q:LIEN=""  D  Q:QFL

 . S TIEN=$P($G(^AUPNVLAB(LIEN,0)),U,1) I TIEN="" Q

 . I TIEN'=TEST Q

 . S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q

 . S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q

 . ; quit if deleted flag

 . I $P($G(^AUPNVSIT(VIEN,0)),"^",11)=1 Q

 . ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q

 . S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),"^",1)\1 I VSDTM=0 Q

 . S @TEMP@(VSDTM,VIEN,LIEN)=VALUE

 ;

 S VSDTM=$O(@TEMP@(""),-1)

 I VSDTM'="" D

 . S VIEN=$O(@TEMP@(VSDTM,""),-1)

 . S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)

 . S VALUE=@TEMP@(VSDTM,VIEN,LIEN)

 . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_VSDTM,QFL=1

 K @TEMP

 Q RES

 ;

MEAS(BQDFN,MEAS) ;EP - Find most recent value for a measurement

 ;

 ; Input

 ;   BQDFN   - Patient internal entry number

 ;   MEAS    - Measurement IEN to search

 ;

 NEW LIEN,QFL,RES,TIEN,VALUE,VIEN,VSDTM,TEMP,UID

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S TEMP=$NA(^TMP(UID,"BQIVMSR")) K @TEMP

 ;

 I MEAS'?.N S MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)

 I MEAS=0 Q 0

 S LIEN="",QFL=0,RES=0

 F  S LIEN=$O(^AUPNVMSR("AC",BQDFN,LIEN),-1) Q:LIEN=""  D

 . S TIEN=$P($G(^AUPNVMSR(LIEN,0)),U,1) I TIEN="" Q

 . I TIEN'=MEAS Q

 . ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error

 . I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,LIEN_",",2,"I")=1

 . S VALUE=$P(^AUPNVMSR(LIEN,0),U,4) I VALUE="" Q

 . S VIEN=$P(^AUPNVMSR(LIEN,0),U,3) I VIEN="" Q

 . ; quit if deleted flag

 . I $P($G(^AUPNVSIT(VIEN,0)),"^",11)=1 Q

 . ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q

 . S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),"^",1)\1 I VSDTM=0 Q

 . S @TEMP@(VSDTM,VIEN,LIEN)=VALUE

 ;

 S VSDTM=$O(@TEMP@(""),-1)

 I VSDTM'="" D

 . S VIEN=$O(@TEMP@(VSDTM,""),-1)

 . S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)

 . S VALUE=@TEMP@(VSDTM,VIEN,LIEN)

 . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_VSDTM

 K @TEMP

 Q RES

 ;

HMEAS(BQDFN,MEAS) ;EP - Find highest value for a measurement

 ;

 ; Input

 ;   BQDFN   - Patient internal entry number

 ;   MEAS    - Measurement IEN to search

 ;

 NEW LIEN,QFL,RES,TIEN,VALUE,VIEN,VSDTM,TEMP,UID

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S TEMP=$NA(^TMP(UID,"BQIVMSR")) K @TEMP

 I MEAS'?.N S MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)

 I MEAS=0 Q 0

 S LIEN="",QFL=0,RES=0

 F  S LIEN=$O(^AUPNVMSR("AC",BQDFN,LIEN),-1) Q:LIEN=""  D

 . S TIEN=$P($G(^AUPNVMSR(LIEN,0)),U,1) I TIEN="" Q

 . I TIEN'=MEAS Q

 . ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error

 . I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,LIEN_",",2,"I")=1

 . S VALUE=$P(^AUPNVMSR(LIEN,0),U,4) I VALUE="" Q

 . S VIEN=$P(^AUPNVMSR(LIEN,0),U,3) I VIEN="" Q

 . ; quit if deleted flag

 . I $P($G(^AUPNVSIT(VIEN,0)),"^",11)=1 Q

 . ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q

 . S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),"^",1)\1 I VSDTM=0 Q

 . S @TEMP@(VALUE,VSDTM,VIEN,LIEN)=""

 ;

 S VALUE=$O(@TEMP@(""),-1)

 I VALUE'="" D

 . S VSDTM=$O(@TEMP@(VALUE,""),-1)

 . S VIEN=$O(@TEMP@(VALUE,VSDTM,""),-1)

 . S LIEN=$O(@TEMP@(VALUE,VSDTM,VIEN,""),-1)

 . ;S VALUE=@TEMP@(VALUE,VSDTM,VIEN,LIEN)

 . S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN

 K @TEMP

 Q RES

 ;

VISIT(BQDFN,FREF,TXRY,SERV,CLNRY,PRIM,TEMP) ; EP - Get Last Visit

 ;Input Parameters

 ;  BQDFN - Patient IEN

 ;  FREF  - V File Reference number

 ;  TXRY  - List of taxonomies whose entries are applicable

 ;  SERV  - Service Category (code separated by ;) e.g. A;H

 ;  CLNRY - List of locations where the visit is applicable

 ;  PRIM  - If one, value must be a primary diagnosis

 ;  TEMP  - Array to return the list of found visits

 ;

 NEW TREF,IEN,TAX,TIEN,VISIT,VSDTM,CLINIC,CLN,GREF,OPRM,VSERV

 S GREF=$$ROOT^DILFD(FREF,"",1),PRIM=$G(PRIM,0)

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S TREF=$NA(^TMP(UID,"BQITAX"))

 K @TREF,TEMP

 ; Check for a list of taxonomies

 D

 . S TAX=""

 . F  S TAX=$O(TXRY(TAX)) Q:TAX=""  D BLD^BQITUTL(TAX,TREF)

 ;

 S IEN=""

 F  S IEN=$O(@GREF@("AC",BQDFN,IEN),-1) Q:IEN=""  D

 . S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""

 . ; Check if the record has an applicable taxonomy entry

 . I '$D(@TREF@(TIEN)) Q

 . S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""

 . ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q

 . I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q

 . ; If dependent count is one, quit

 . I $P($G(^AUPNVSIT(VISIT,0)),"^",9)=1 Q

 . ; If the V File reference is V POV and the primary diagnosis flag is defined

 . ; check if the value is a primary diagnosis

 . I FREF=9000010.07,PRIM,$P(@GREF@(IEN,0),U,12)'="P" S OPRM=0 D  Q:'OPRM

 .. I $O(@GREF@("AD",VISIT,""))=IEN S OPRM=1

 . ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM

 . S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\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")

 . S VSERV=$P($G(^AUPNVSIT(VISIT,0)),"^",7)

 . I $G(SERV)'="",SERV'[VSERV Q

 . ; If locations, check the visit for a matching location

 . ;S CLN=$$GET1^DIQ(9000010,VISIT,.08,"I")

 . S CLN=$P($G(^AUPNVSIT(VISIT,0)),"^",8),CLINIC=""

 . ;S CLINIC=$$GET1^DIQ(40.7,CLN_",",1,"E")

 . I CLN'="" S CLINIC=$P($G(^DIC(40.7,CLN,0)),"^",2)

 . I CLINIC'="",$D(CLNRY),'$D(CLNRY(CLINIC)) Q

 . S TEMP(VSDTM,IEN)=VISIT

 Q

 ;

PROB(BQDFN,TXRY,TEMP) ; EP - Get Last Problem

 ;Input Parameters

 ;  BQDFN - Patient IEN

 ;  TXRY  - List of taxonomies whose entries are applicable

 ;  TEMP  - Array to return the list of found visits

 ;

 NEW TREF,IEN,TAX,TIEN,PRDTM

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S TREF=$NA(^TMP(UID,"BQITAX"))

 K @TREF,TEMP

 ; Check for a list of taxonomies

 D

 . S TAX=""

 . F  S TAX=$O(TXRY(TAX)) Q:TAX=""  D BLD^BQITUTL(TAX,TREF)

 ;

 S IEN=""

 F  S IEN=$O(^AUPNPROB("AC",BQDFN,IEN),-1) Q:IEN=""  D

 . S TIEN=$$GET1^DIQ(9000011,IEN,.01,"I") Q:TIEN=""

 . ; Check if the record has an applicable taxonomy entry

 . I '$D(@TREF@(TIEN)) Q

 . S PRDTM=$P(^AUPNPROB(IEN,0),U,8)

 . I PRDTM="" S PRDTM=$$PROB^BQIUL1(IEN)

 . I PRDTM="" Q

 . S TEMP(PRDTM,IEN)=""

 Q

 ;

HF(BQDFN,HFACT) ;EP - Find most recent value for a Health Factor

 ; Input

 ;   BQDFN   - Patient internal entry number

 ;   HFACT   - Health Factor to search for

 ;

 NEW VISIT,HIEN,VSDTM,TEMP,UID,RESULT,ATRDT

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S TEMP=$NA(^TMP(UID,"BQIVHF")) K @TEMP

 ;

 S RESULT=""

 I HFACT'?.N S HFACT=$$FIND1^DIC(9999999.64,,"MX",HFACT)

 I HFACT=0 Q RESULT

 ;

 D

 . S ATRDT=$O(^AUPNVHF("AA",BQDFN,HFACT,"")) I ATRDT="" Q

 . S HIEN=$O(^AUPNVHF("AA",BQDFN,HFACT,ATRDT,"")) I HIEN="" Q

 . S VISIT=$P(^AUPNVHF(HIEN,0),U,3) I VISIT="" Q

 . S VSDTM=$P(^AUPNVSIT(VISIT,0),U,1)\1 I VSDTM=0 Q

 . S RESULT=VSDTM_U_"9000010:"_VISIT

 Q RESULT

BQIDCUTL  ;VNGT/HS/ALA-Definition Utility ; 12 Sep 2008  1:43 PM

 +1       ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10

 +2       ;

LAB(BQDFN,TEST) ;EP - Check for most recent result of a specified Lab test

 +1       ;

 +2       ; Input

 +3       ;   BQDFN   - Patient internal entry number

 +4       ;   TEST    - Lab Test IEN to search

 +5       ;

 +6        NEW LIEN,QFL,RES,TIEN,VALUE,VIEN,VSDTM,UID

 +7        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +8        SET TEMP=$NAME(^TMP(UID,"BQIVLAB"))

           KILL @TEMP

 +9        SET LIEN=""

           SET QFL=0

           SET RES=0

 +10       FOR 

               SET LIEN=$ORDER(^AUPNVLAB("AC",BQDFN,LIEN),-1)

               IF LIEN=""

                   QUIT 

               Begin DoDot:1

 +11               SET TIEN=$PIECE($GET(^AUPNVLAB(LIEN,0)),U,1)

                   IF TIEN=""

                       QUIT 

 +12               IF TIEN'=TEST

                       QUIT 

 +13               SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)

                   IF VALUE=""

                       QUIT 

 +14               SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)

                   IF VIEN=""

                       QUIT 

 +15      ; quit if deleted flag

 +16               IF $PIECE($GET(^AUPNVSIT(VIEN,0)),"^",11)=1

                       QUIT 

 +17      ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q

 +18               SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)\1

                   IF VSDTM=0

                       QUIT 

 +19               SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE

               End DoDot:1

               IF QFL

                   QUIT 

 +20      ;

 +21       SET VSDTM=$ORDER(@TEMP@(""),-1)

 +22       IF VSDTM'=""

               Begin DoDot:1

 +23               SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)

 +24               SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)

 +25               SET VALUE=@TEMP@(VSDTM,VIEN,LIEN)

 +26               SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_VSDTM

                   SET QFL=1

               End DoDot:1

 +27       KILL @TEMP

 +28       QUIT RES

 +29      ;

MEAS(BQDFN,MEAS) ;EP - Find most recent value for a measurement

 +1       ;

 +2       ; Input

 +3       ;   BQDFN   - Patient internal entry number

 +4       ;   MEAS    - Measurement IEN to search

 +5       ;

 +6        NEW LIEN,QFL,RES,TIEN,VALUE,VIEN,VSDTM,TEMP,UID

 +7        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +8        SET TEMP=$NAME(^TMP(UID,"BQIVMSR"))

           KILL @TEMP

 +9       ;

 +10       IF MEAS'?.N

               SET MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)

 +11       IF MEAS=0

               QUIT 0

 +12       SET LIEN=""

           SET QFL=0

           SET RES=0

 +13       FOR 

               SET LIEN=$ORDER(^AUPNVMSR("AC",BQDFN,LIEN),-1)

               IF LIEN=""

                   QUIT 

               Begin DoDot:1

 +14               SET TIEN=$PIECE($GET(^AUPNVMSR(LIEN,0)),U,1)

                   IF TIEN=""

                       QUIT 

 +15               IF TIEN'=MEAS

                       QUIT 

 +16      ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error

 +17               IF $$VFIELD^DILFD(9000010.01,2)

                       IF $$GET1^DIQ(9000010.01,LIEN_",",2,"I")=1

                           QUIT 

 +18               SET VALUE=$PIECE(^AUPNVMSR(LIEN,0),U,4)

                   IF VALUE=""

                       QUIT 

 +19               SET VIEN=$PIECE(^AUPNVMSR(LIEN,0),U,3)

                   IF VIEN=""

                       QUIT 

 +20      ; quit if deleted flag

 +21               IF $PIECE($GET(^AUPNVSIT(VIEN,0)),"^",11)=1

                       QUIT 

 +22      ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q

 +23               SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)\1

                   IF VSDTM=0

                       QUIT 

 +24               SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE

               End DoDot:1

 +25      ;

 +26       SET VSDTM=$ORDER(@TEMP@(""),-1)

 +27       IF VSDTM'=""

               Begin DoDot:1

 +28               SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)

 +29               SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)

 +30               SET VALUE=@TEMP@(VSDTM,VIEN,LIEN)

 +31               SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_VSDTM

               End DoDot:1

 +32       KILL @TEMP

 +33       QUIT RES

 +34      ;

HMEAS(BQDFN,MEAS) ;EP - Find highest value for a measurement

 +1       ;

 +2       ; Input

 +3       ;   BQDFN   - Patient internal entry number

 +4       ;   MEAS    - Measurement IEN to search

 +5       ;

 +6        NEW LIEN,QFL,RES,TIEN,VALUE,VIEN,VSDTM,TEMP,UID

 +7        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +8        SET TEMP=$NAME(^TMP(UID,"BQIVMSR"))

           KILL @TEMP

 +9        IF MEAS'?.N

               SET MEAS=$$FIND1^DIC(9999999.07,,"MX",MEAS)

 +10       IF MEAS=0

               QUIT 0

 +11       SET LIEN=""

           SET QFL=0

           SET RES=0

 +12       FOR 

               SET LIEN=$ORDER(^AUPNVMSR("AC",BQDFN,LIEN),-1)

               IF LIEN=""

                   QUIT 

               Begin DoDot:1

 +13               SET TIEN=$PIECE($GET(^AUPNVMSR(LIEN,0)),U,1)

                   IF TIEN=""

                       QUIT 

 +14               IF TIEN'=MEAS

                       QUIT 

 +15      ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error

 +16               IF $$VFIELD^DILFD(9000010.01,2)

                       IF $$GET1^DIQ(9000010.01,LIEN_",",2,"I")=1

                           QUIT 

 +17               SET VALUE=$PIECE(^AUPNVMSR(LIEN,0),U,4)

                   IF VALUE=""

                       QUIT 

 +18               SET VIEN=$PIECE(^AUPNVMSR(LIEN,0),U,3)

                   IF VIEN=""

                       QUIT 

 +19      ; quit if deleted flag

 +20               IF $PIECE($GET(^AUPNVSIT(VIEN,0)),"^",11)=1

                       QUIT 

 +21      ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q

 +22               SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)\1

                   IF VSDTM=0

                       QUIT 

 +23               SET @TEMP@(VALUE,VSDTM,VIEN,LIEN)=""

               End DoDot:1

 +24      ;

 +25       SET VALUE=$ORDER(@TEMP@(""),-1)

 +26       IF VALUE'=""

               Begin DoDot:1

 +27               SET VSDTM=$ORDER(@TEMP@(VALUE,""),-1)

 +28               SET VIEN=$ORDER(@TEMP@(VALUE,VSDTM,""),-1)

 +29               SET LIEN=$ORDER(@TEMP@(VALUE,VSDTM,VIEN,""),-1)

 +30      ;S VALUE=@TEMP@(VALUE,VSDTM,VIEN,LIEN)

 +31               SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN

               End DoDot:1

 +32       KILL @TEMP

 +33       QUIT RES

 +34      ;

VISIT(BQDFN,FREF,TXRY,SERV,CLNRY,PRIM,TEMP) ; EP - Get Last Visit

 +1       ;Input Parameters

 +2       ;  BQDFN - Patient IEN

 +3       ;  FREF  - V File Reference number

 +4       ;  TXRY  - List of taxonomies whose entries are applicable

 +5       ;  SERV  - Service Category (code separated by ;) e.g. A;H

 +6       ;  CLNRY - List of locations where the visit is applicable

 +7       ;  PRIM  - If one, value must be a primary diagnosis

 +8       ;  TEMP  - Array to return the list of found visits

 +9       ;

 +10       NEW TREF,IEN,TAX,TIEN,VISIT,VSDTM,CLINIC,CLN,GREF,OPRM,VSERV

 +11       SET GREF=$$ROOT^DILFD(FREF,"",1)

           SET PRIM=$GET(PRIM,0)

 +12       SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +13       SET TREF=$NAME(^TMP(UID,"BQITAX"))

 +14       KILL @TREF,TEMP

 +15      ; Check for a list of taxonomies

 +16       Begin DoDot:1

 +17           SET TAX=""

 +18           FOR 

                   SET TAX=$ORDER(TXRY(TAX))

                   IF TAX=""

                       QUIT 

                   DO BLD^BQITUTL(TAX,TREF)

           End DoDot:1

 +19      ;

 +20       SET IEN=""

 +21       FOR 

               SET IEN=$ORDER(@GREF@("AC",BQDFN,IEN),-1)

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +22               SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")

                   IF TIEN=""

                       QUIT 

 +23      ; Check if the record has an applicable taxonomy entry

 +24               IF '$DATA(@TREF@(TIEN))

                       QUIT 

 +25               SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")

                   IF VISIT=""

                       QUIT 

 +26      ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q

 +27               IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1

                       QUIT 

 +28      ; If dependent count is one, quit

 +29               IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",9)=1

                       QUIT 

 +30      ; If the V File reference is V POV and the primary diagnosis flag is defined

 +31      ; check if the value is a primary diagnosis

 +32               IF FREF=9000010.07

                       IF PRIM

                           IF $PIECE(@GREF@(IEN,0),U,12)'="P"

                               SET OPRM=0

                               Begin DoDot:2

 +33                               IF $ORDER(@GREF@("AD",VISIT,""))=IEN

                                       SET OPRM=1

                               End DoDot:2

                               IF 'OPRM

                                   QUIT 

 +34      ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM

 +35               SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1

                   IF VSDTM=0

                       QUIT 

 +36      ;I $G(TMFRAME)'="",VSDTM<ENDT Q

 +37      ; If service categories, check the visit for the service category

 +38      ;S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")

 +39               SET VSERV=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",7)

 +40               IF $GET(SERV)'=""

                       IF SERV'[VSERV

                           QUIT 

 +41      ; If locations, check the visit for a matching location

 +42      ;S CLN=$$GET1^DIQ(9000010,VISIT,.08,"I")

 +43               SET CLN=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",8)

                   SET CLINIC=""

 +44      ;S CLINIC=$$GET1^DIQ(40.7,CLN_",",1,"E")

 +45               IF CLN'=""

                       SET CLINIC=$PIECE($GET(^DIC(40.7,CLN,0)),"^",2)

 +46               IF CLINIC'=""

                       IF $DATA(CLNRY)

                           IF '$DATA(CLNRY(CLINIC))

                               QUIT 

 +47               SET TEMP(VSDTM,IEN)=VISIT

               End DoDot:1

 +48       QUIT 

 +49      ;

PROB(BQDFN,TXRY,TEMP) ; EP - Get Last Problem

 +1       ;Input Parameters

 +2       ;  BQDFN - Patient IEN

 +3       ;  TXRY  - List of taxonomies whose entries are applicable

 +4       ;  TEMP  - Array to return the list of found visits

 +5       ;

 +6        NEW TREF,IEN,TAX,TIEN,PRDTM

 +7        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +8        SET TREF=$NAME(^TMP(UID,"BQITAX"))

 +9        KILL @TREF,TEMP

 +10      ; Check for a list of taxonomies

 +11       Begin DoDot:1

 +12           SET TAX=""

 +13           FOR 

                   SET TAX=$ORDER(TXRY(TAX))

                   IF TAX=""

                       QUIT 

                   DO BLD^BQITUTL(TAX,TREF)

           End DoDot:1

 +14      ;

 +15       SET IEN=""

 +16       FOR 

               SET IEN=$ORDER(^AUPNPROB("AC",BQDFN,IEN),-1)

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +17               SET TIEN=$$GET1^DIQ(9000011,IEN,.01,"I")

                   IF TIEN=""

                       QUIT 

 +18      ; Check if the record has an applicable taxonomy entry

 +19               IF '$DATA(@TREF@(TIEN))

                       QUIT 

 +20               SET PRDTM=$PIECE(^AUPNPROB(IEN,0),U,8)

 +21               IF PRDTM=""

                       SET PRDTM=$$PROB^BQIUL1(IEN)

 +22               IF PRDTM=""

                       QUIT 

 +23               SET TEMP(PRDTM,IEN)=""

               End DoDot:1

 +24       QUIT 

 +25      ;

HF(BQDFN,HFACT) ;EP - Find most recent value for a Health Factor

 +1       ; Input

 +2       ;   BQDFN   - Patient internal entry number

 +3       ;   HFACT   - Health Factor to search for

 +4       ;

 +5        NEW VISIT,HIEN,VSDTM,TEMP,UID,RESULT,ATRDT

 +6        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +7        SET TEMP=$NAME(^TMP(UID,"BQIVHF"))

           KILL @TEMP

 +8       ;

 +9        SET RESULT=""

 +10       IF HFACT'?.N

               SET HFACT=$$FIND1^DIC(9999999.64,,"MX",HFACT)

 +11       IF HFACT=0

               QUIT RESULT

 +12      ;

 +13       Begin DoDot:1

 +14           SET ATRDT=$ORDER(^AUPNVHF("AA",BQDFN,HFACT,""))

               IF ATRDT=""

                   QUIT 

 +15           SET HIEN=$ORDER(^AUPNVHF("AA",BQDFN,HFACT,ATRDT,""))

               IF HIEN=""

                   QUIT 

 +16           SET VISIT=$PIECE(^AUPNVHF(HIEN,0),U,3)

               IF VISIT=""

                   QUIT 

 +17           SET VSDTM=$PIECE(^AUPNVSIT(VISIT,0),U,1)\1

               IF VSDTM=0

                   QUIT 

 +18           SET RESULT=VSDTM_U_"9000010:"_VISIT

           End DoDot:1

 +19       QUIT RESULT