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
