BQIRGHPC ;GDHSD/HS/ALA-Hep C Care Mgmt ; 18 Apr 2016 11:42 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
;
LBT ;EP - Set up Lab tests
; Clean up labs
NEW DA,IENS,CIEN
S CIEN=$O(^BQI(90506.5,"B","Hep C","")) I CIEN="" Q
S DA=0,DA(1)=CIEN
F S DA=$O(^BQI(90506.5,CIEN,10,DA)) Q:'DA D
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90506.51,IENS,.09)=1
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
NEW TAX,TREF
F TAX="BQI HCV OTHER LAB TESTS" D
. S TREF=$NA(^TMP("BQIHCVL",$J)) K @TREF
. D BLD^BQITUTL(TAX,.TREF,"L")
. D LBR
;
F TAX="BQI HCV BASELINE LAB TESTS" D
. S TREF=$NA(^TMP("BQIHCVB",$J)) K @TREF
. D BLD^BQITUTL(TAX,.TREF,"L")
. D LBB
Q
;
LBR ;EP - Set up lab tests
NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
S BN=0
F S BN=$O(@TREF@(BN)) Q:'BN D
. S NM=$P(^LAB(60,BN,.1),U,1),NAME=$P(^LAB(60,BN,0),"^",1)
. S PNL=0 I $O(^LAB(60,BN,2,0))'="" S PNL=1
. S IEN=$O(^BQI(90506.5,CIEN,10,"C",NM,""))
. I IEN'="" D
.. S DA(1)=CIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90506.51,IENS,.09)="@"
.. D FILE^DIE("","BQIUPD","ERROR")
.. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
.. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
.. D WP^DIE(90506.51,IENS,4,"","DESC")
. I IEN="" D
.. S CT=$P($G(^BQI(90506.5,CIEN,10,0)),U,3),CT=CT+1,LCT=CT
.. S CD="HC_"_$E("0000",$L(CT),2)_CT
.. S DA(1)=CIEN,X=CD,DIC="^BQI(90506.5,"_DA(1)_",10,",DIC(0)="L",DLAYGO=90506.51
.. K DO,DD D FILE^DICN S DA=+Y
.. S IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90506.51,IENS,.02)=3,BQIUPD(90506.51,IENS,.03)=NM
.. S BQIUPD(90506.51,IENS,.04)=BN
.. S BQIUPD(90506.51,IENS,.06)="O",BQIUPD(90506.51,IENS,.08)="A"
.. S BQIUPD(90506.51,IENS,5.02)="Current",BQIUPD(90506.51,IENS,5.01)="Lab"
.. S BQIUPD(90506.51,IENS,3)="D LAB^BQIRGHPC",BQIUPD(90506.51,IENS,1)="S VAL=$$DSP^BQIRGHPC(DFN,CODE)"
.. D FILE^DIE("","BQIUPD","ERROR")
.. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
.. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
.. D WP^DIE(90506.51,IENS,4,"","DESC")
K @TREF
Q
;
LBB ;EP
NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
S BN=0
S CT=$S($G(LCT)'="":LCT,1:$P(^BQI(90506.5,CIEN,10,0),"^",3))
F S BN=$O(@TREF@(BN)) Q:'BN D
. S NM=$P(^LAB(60,BN,.1),U,1),NAME=$P(^LAB(60,BN,0),"^",1)
. S PNL=0 I $O(^LAB(60,BN,2,0))'="" S PNL=1
. S IEN=$O(^BQI(90506.5,CIEN,10,"C",NM,""))
. I IEN'="" D
.. S DA(1)=CIEN,DA=IEN,IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90506.51,IENS,.09)="@"
.. D FILE^DIE("","BQIUPD","ERROR")
.. I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
.. I 'PNL S DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
.. D WP^DIE(90506.51,IENS,4,"","DESC")
. I IEN="" D
.. S CT=CT+1
.. S CD="HC_"_$E("0000",$L(CT),2)_CT
.. S DA(1)=CIEN,X=CD,DIC="^BQI(90506.5,"_DA(1)_",10,",DIC(0)="L",DLAYGO=90506.51
.. K DO,DD D FILE^DICN S DA=+Y
.. S IENS=$$IENS^DILF(.DA)
.. S BQIUPD(90506.51,IENS,.02)=3,BQIUPD(90506.51,IENS,.03)=NM
.. S BQIUPD(90506.51,IENS,.04)=BN
.. S BQIUPD(90506.51,IENS,.06)="O",BQIUPD(90506.51,IENS,.08)="A"
.. S BQIUPD(90506.51,IENS,5.02)="Baseline",BQIUPD(90506.51,IENS,5.01)="Lab"
.. S BQIUPD(90506.51,IENS,3)="D LRR^BQIRGHPC",BQIUPD(90506.51,IENS,1)="S VAL=$$DSP^BQIRGHPC(DFN,CODE)"
.. D FILE^DIE("","BQIUPD","ERROR")
.. ;I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
.. I 'PNL D
... S DESC(1)="Baseline and most recent "_NAME_" test from V Lab is displayed."
... S DESC(2)="Go to Patient View PCC Tab to see full listing of lab tests."
.. D WP^DIE(90506.51,IENS,4,"","DESC")
K @TREF
Q
;
LAB ;EP - Pull out HCV lab tests
NEW LRES,RES,IENS,DA
S DA(1)=SRIEN,DA=AIEN,IENS=$$IENS^DILF(.DA)
S FRN=$$GET1^DIQ(90506.51,IENS,.02,"I")
S FREF=$$PTR^BQIUL2(90506.51,.02,FRN,.02)
S RREF=$$PTR^BQIUL2(90506.51,.02,FRN,.08)
S ITM=$$GET1^DIQ(90506.51,IENS,.04,"E")
S NAM=$$GET1^DIQ(90506.51,IENS,.03,"E")
S TAX=$$GET1^DIQ(90506.51,IENS,.07,"E")
;S LRES=$$ITM^BQICMUTL("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
S LRES=$$ITM^BQIRGUT1("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
S VAL="",DATE="",VISIT="",OTHER=""
I $P(LRES,U,1)=0 S RESULT=0
I $P(LRES,U,1)'=0 D
. S RES=$P(LRES,U,7) I RES="" S RES=$P(LRES,U,6)
. S RESULT=1_U_$P(LRES,U,2)_U_RES
. S VAL=$P(RESULT,"^",3),DATE=$P(RESULT,"^",2),VISIT=$P(RESULT,"^",4),OTHER=$P(RESULT,"^",5)
. S VAL=VAL_" ("_$$FMTMDY^BQIUL1(DATE)_")"
Q
;
LRR ;EP
NEW RESULT,DA,IENS
S DA(1)=SRIEN,DA=AIEN,IENS=$$IENS^DILF(.DA)
S ITM=$$GET1^DIQ(90506.51,IENS,.04,"E")
S RESULT=0,VAL="",DATE="",VISIT="",OTHER=""
S RESULT=$$LBS(BQDFN,ITM)
I RESULT S VAL=$P(RESULT,"^",2)
Q
;
LBS(DFN,ITM) ;EP - Pull out baseline and most recent lab
NEW RVDB,BIEN,RESB,RVDC,CIEN,RESC,DATE,RVDT,VALUE
S DATE=$P($$FDX^BQITDUTL(DFN,"BKM HEP C DXS",""),"^",1),RVDT=9999999-DATE,VALUE=0
I $G(DATE)="" S RVDT=$O(^AUPNVLAB("AA",DFN,ITM,""),-1) I RVDT="" Q 0
S RVDB=$O(^AUPNVLAB("AA",DFN,ITM,RVDT),-1) I RVDB="" S RVDB=RVDT
S BIEN=$O(^AUPNVLAB("AA",DFN,ITM,RVDB,"")),RESB=""
I BIEN'="" S RESB=$P($G(^AUPNVLAB(BIEN,0)),"^",4)
S RVDC=$O(^AUPNVLAB("AA",DFN,ITM,""))
I RVDC'="" S CIEN=$O(^AUPNVLAB("AA",DFN,ITM,RVDC,"")),RESC=""
I $G(CIEN)'="" S RESC=$P($G(^AUPNVLAB(CIEN,0)),"^",4)
S BASE="" I RVDB'="" S BASE="B: "_RESB_" ("_$$FMTMDY^BQIUL1(9999999-RVDB)_")"
S CURR="" I RVDC'="" S CURR="C: "_RESC_" ("_$$FMTMDY^BQIUL1(9999999-RVDC)_")"
I BASE'=""!(CURR'="") S VALUE=1_"^"_BASE_$C(10)_$C(13)_CURR
Q VALUE
;
FIB(DFN) ;EP - Fibroscan
NEW TAX,TREF,FREF,TMFRAME,VALUE,VSDTM,BQQN,CT
S TAX="BQI FIBROSCAN CPT PROC",TREF="BQITREF" K @TREF
D BLD^BQITUTL(TAX,.TREF)
S FREF=9000010.18,TMFRAME=""
S VALUE=$$TAX^BQITRUTL(TMFRAME,TAX,1,DFN,FREF,"","",.TREF)
I VALUE'=0 D
. S VALUE="YES"_" ("_$$FMTMDY^BQIUL1($P(VALUE,"^",2))_")^"_$P(VALUE,"^",2)_"^"_$P(VALUE,"^",4)_"^"_$P(VALUE,"^",5)
I VALUE=0 S VALUE=""
Q VALUE
;
LU(DFN) ;EP - Liver Ultrasound
NEW TAX,TREF,FREF,TMFRAME,RAD,RIEN,VALUE,N,RVDT,VSDTM,BQQN,CT
S TAX="BQI LIVER ULTRASOUND CPT",TREF="BQITREF" K @TREF
D BLD^BQITUTL(TAX,.TREF)
S FREF=9000010.18,TMFRAME=""
S VALUE=$$TAX^BQITRUTL(TMFRAME,TAX,1,DFN,FREF,"","",.TREF)
I VALUE'=0 D
. S VALUE="YES"_" (CPT: "_$$FMTMDY^BQIUL1($P(VALUE,"^",2))_")^"_$P(VALUE,"^",2)_"^"_$P(VALUE,"^",4)_"^"_$P(VALUE,"^",5)
I VALUE=0 D
. S N="",VALUE=""
. D BLD^BQITUTL(TAX,.TREF)
. F S N=$O(@TREF@(N)) Q:N="" D
.. I '$D(^RAMIS(71,"D",N)) Q
.. S RAD="" F S RAD=$O(^RAMIS(71,"D",N,RAD)) Q:RAD="" D
... I '$D(^AUPNVRAD("AA",DFN,RAD)) Q
... S RVDT=$O(^AUPNVRAD("AA",DFN,RAD,"")),RIEN=$O(^AUPNVRAD("AA",DFN,RAD,RVDT,""))
... S RVDT=9999999-RVDT
... S VALUE="YES"_" (RAD: "_$$FMTMDY^BQIUL1(RVDT)_")^"_RVDT_"^"_$P(^AUPNVRAD(RIEN,0),U,3)_"^"_RIEN
Q VALUE
;
HLB(BQDFN,STVW) ;EP
NEW FREF,TMFRAME,VALUE,TAX,RES,HCODE
S TMFRAME="",VALUE="",ITM=""
S HCODE=$P(^BQI(90506.1,STVW,0),"^",1)
I HCODE="HCANTI" S TAX="BQI HCV ANTIBODY TAX",FREF=9000010.09,RREF=60
I HCODE="HCAST" S TAX="DM AUDIT AST TAX",FREF=9000010.09,RREF=60
I HCODE="HCALT" S TAX="DM AUDIT ALT TAX",FREF=9000010.09,RREF=60
I HCODE="HCPLAT" S TAX="BQI PLATELET TAX",FREF=9000010.09,RREF=60
I HCODE="HCVIRAL" S TAX="BQI HCV VIRAL LOAD TAX",FREF=9000010.09,RREF=60
I HCODE="HCGENO" S TAX="BQI HEP C GENOTYPE TESTS",FREF=9000010.09,RREF=60
I HCODE="HCHIV" S TAX="BGP HIV TEST TAX",FREF=9000010.09,RREF=60
I HCODE="HCRNA" S TAX="BQI HCV RNA TAX",FREF=9000010.09,RREF=60
;S VALUE=$$TAX^BQITRUTL(TMFRAME,TAX,1,BQDFN,FREF,"","",.TREF)
S VALUE=$$ITM^BQIRGUT1($G(TMFRAME),$G(BQDFN),$G(FREF),$G(RREF),$G(ITM),TAX,.TREF)
I FREF=9000010.09 D
. I VALUE=0 S VALUE="" Q
. S RES=$P(VALUE,"^",6)_" ("_$$FMTMDY^BQIUL1($P(VALUE,"^",2))_")"
. S VALUE=RES_"^"_$P(VALUE,"^",2)_"^"_$P(VALUE,"^",4)_"^"_$P(VALUE,"^",5)
Q VALUE
;
DSP(ASDFN,CODE) ; EP - Display Care Mgmt field
NEW VALUE,RESULT,ASPIEN,CRIEN,CMSN,LINK
S CRIEN=$O(^BQIPAT(ASDFN,60,"B",CRN,"")) I CRIEN="" Q ""
S ASPIEN="",VALUE="",HOVER="",LINK="",RESULT=""
F S ASPIEN=$O(^BQIPAT(ASDFN,60,CRIEN,1,"B",CODE,ASPIEN)) Q:ASPIEN="" D
. S VALUE=$P($G(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,2)
. S HOVER=$P($G(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,5),HOVER=""
. S LINK=$P($G(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,4)
I VALUE'="" S RESULT=VALUE_$C(26)_HOVER_$C(26)_LINK
E S RESULT=VALUE
Q RESULT
BQIRGHPC ;GDHSD/HS/ALA-Hep C Care Mgmt ; 18 Apr 2016 11:42 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
+3 ;
LBT ;EP - Set up Lab tests
+1 ; Clean up labs
+2 NEW DA,IENS,CIEN
+3 SET CIEN=$ORDER(^BQI(90506.5,"B","Hep C",""))
IF CIEN=""
QUIT
+4 SET DA=0
SET DA(1)=CIEN
+5 FOR
SET DA=$ORDER(^BQI(90506.5,CIEN,10,DA))
IF 'DA
QUIT
Begin DoDot:1
+6 SET IENS=$$IENS^DILF(.DA)
+7 SET BQIUPD(90506.51,IENS,.09)=1
End DoDot:1
+8 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+9 ;
+10 NEW TAX,TREF
+11 FOR TAX="BQI HCV OTHER LAB TESTS"
Begin DoDot:1
+12 SET TREF=$NAME(^TMP("BQIHCVL",$JOB))
KILL @TREF
+13 DO BLD^BQITUTL(TAX,.TREF,"L")
+14 DO LBR
End DoDot:1
+15 ;
+16 FOR TAX="BQI HCV BASELINE LAB TESTS"
Begin DoDot:1
+17 SET TREF=$NAME(^TMP("BQIHCVB",$JOB))
KILL @TREF
+18 DO BLD^BQITUTL(TAX,.TREF,"L")
+19 DO LBB
End DoDot:1
+20 QUIT
+21 ;
LBR ;EP - Set up lab tests
+1 NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
+2 SET BN=0
+3 FOR
SET BN=$ORDER(@TREF@(BN))
IF 'BN
QUIT
Begin DoDot:1
+4 SET NM=$PIECE(^LAB(60,BN,.1),U,1)
SET NAME=$PIECE(^LAB(60,BN,0),"^",1)
+5 SET PNL=0
IF $ORDER(^LAB(60,BN,2,0))'=""
SET PNL=1
+6 SET IEN=$ORDER(^BQI(90506.5,CIEN,10,"C",NM,""))
+7 IF IEN'=""
Begin DoDot:2
+8 SET DA(1)=CIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+9 SET BQIUPD(90506.51,IENS,.09)="@"
+10 DO FILE^DIE("","BQIUPD","ERROR")
+11 IF PNL
SET DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
+12 IF 'PNL
SET DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
+13 DO WP^DIE(90506.51,IENS,4,"","DESC")
End DoDot:2
+14 IF IEN=""
Begin DoDot:2
+15 SET CT=$PIECE($GET(^BQI(90506.5,CIEN,10,0)),U,3)
SET CT=CT+1
SET LCT=CT
+16 SET CD="HC_"_$EXTRACT("0000",$LENGTH(CT),2)_CT
+17 SET DA(1)=CIEN
SET X=CD
SET DIC="^BQI(90506.5,"_DA(1)_",10,"
SET DIC(0)="L"
SET DLAYGO=90506.51
+18 KILL DO,DD
DO FILE^DICN
SET DA=+Y
+19 SET IENS=$$IENS^DILF(.DA)
+20 SET BQIUPD(90506.51,IENS,.02)=3
SET BQIUPD(90506.51,IENS,.03)=NM
+21 SET BQIUPD(90506.51,IENS,.04)=BN
+22 SET BQIUPD(90506.51,IENS,.06)="O"
SET BQIUPD(90506.51,IENS,.08)="A"
+23 SET BQIUPD(90506.51,IENS,5.02)="Current"
SET BQIUPD(90506.51,IENS,5.01)="Lab"
+24 SET BQIUPD(90506.51,IENS,3)="D LAB^BQIRGHPC"
SET BQIUPD(90506.51,IENS,1)="S VAL=$$DSP^BQIRGHPC(DFN,CODE)"
+25 DO FILE^DIE("","BQIUPD","ERROR")
+26 IF PNL
SET DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
+27 IF 'PNL
SET DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
+28 DO WP^DIE(90506.51,IENS,4,"","DESC")
End DoDot:2
End DoDot:1
+29 KILL @TREF
+30 QUIT
+31 ;
LBB ;EP
+1 NEW BN,CT,CD,DA,IENS,DIC,DESC,PNL,DLAYGO,DIC,X,Y,NM,NAME
+2 SET BN=0
+3 SET CT=$SELECT($GET(LCT)'="":LCT,1:$PIECE(^BQI(90506.5,CIEN,10,0),"^",3))
+4 FOR
SET BN=$ORDER(@TREF@(BN))
IF 'BN
QUIT
Begin DoDot:1
+5 SET NM=$PIECE(^LAB(60,BN,.1),U,1)
SET NAME=$PIECE(^LAB(60,BN,0),"^",1)
+6 SET PNL=0
IF $ORDER(^LAB(60,BN,2,0))'=""
SET PNL=1
+7 SET IEN=$ORDER(^BQI(90506.5,CIEN,10,"C",NM,""))
+8 IF IEN'=""
Begin DoDot:2
+9 SET DA(1)=CIEN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+10 SET BQIUPD(90506.51,IENS,.09)="@"
+11 DO FILE^DIE("","BQIUPD","ERROR")
+12 IF PNL
SET DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
+13 IF 'PNL
SET DESC(1)="Most recent "_NAME_" lab test from V Lab is displayed."
+14 DO WP^DIE(90506.51,IENS,4,"","DESC")
End DoDot:2
+15 IF IEN=""
Begin DoDot:2
+16 SET CT=CT+1
+17 SET CD="HC_"_$EXTRACT("0000",$LENGTH(CT),2)_CT
+18 SET DA(1)=CIEN
SET X=CD
SET DIC="^BQI(90506.5,"_DA(1)_",10,"
SET DIC(0)="L"
SET DLAYGO=90506.51
+19 KILL DO,DD
DO FILE^DICN
SET DA=+Y
+20 SET IENS=$$IENS^DILF(.DA)
+21 SET BQIUPD(90506.51,IENS,.02)=3
SET BQIUPD(90506.51,IENS,.03)=NM
+22 SET BQIUPD(90506.51,IENS,.04)=BN
+23 SET BQIUPD(90506.51,IENS,.06)="O"
SET BQIUPD(90506.51,IENS,.08)="A"
+24 SET BQIUPD(90506.51,IENS,5.02)="Baseline"
SET BQIUPD(90506.51,IENS,5.01)="Lab"
+25 SET BQIUPD(90506.51,IENS,3)="D LRR^BQIRGHPC"
SET BQIUPD(90506.51,IENS,1)="S VAL=$$DSP^BQIRGHPC(DFN,CODE)"
+26 DO FILE^DIE("","BQIUPD","ERROR")
+27 ;I PNL S DESC(1)="Most recent "_NAME_" panel from V Lab is displayed."
+28 IF 'PNL
Begin DoDot:3
+29 SET DESC(1)="Baseline and most recent "_NAME_" test from V Lab is displayed."
+30 SET DESC(2)="Go to Patient View PCC Tab to see full listing of lab tests."
End DoDot:3
+31 DO WP^DIE(90506.51,IENS,4,"","DESC")
End DoDot:2
End DoDot:1
+32 KILL @TREF
+33 QUIT
+34 ;
LAB ;EP - Pull out HCV lab tests
+1 NEW LRES,RES,IENS,DA
+2 SET DA(1)=SRIEN
SET DA=AIEN
SET IENS=$$IENS^DILF(.DA)
+3 SET FRN=$$GET1^DIQ(90506.51,IENS,.02,"I")
+4 SET FREF=$$PTR^BQIUL2(90506.51,.02,FRN,.02)
+5 SET RREF=$$PTR^BQIUL2(90506.51,.02,FRN,.08)
+6 SET ITM=$$GET1^DIQ(90506.51,IENS,.04,"E")
+7 SET NAM=$$GET1^DIQ(90506.51,IENS,.03,"E")
+8 SET TAX=$$GET1^DIQ(90506.51,IENS,.07,"E")
+9 ;S LRES=$$ITM^BQICMUTL("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
+10 SET LRES=$$ITM^BQIRGUT1("",BQDFN,FREF,RREF,ITM,TAX,.TREF)
+11 SET VAL=""
SET DATE=""
SET VISIT=""
SET OTHER=""
+12 IF $PIECE(LRES,U,1)=0
SET RESULT=0
+13 IF $PIECE(LRES,U,1)'=0
Begin DoDot:1
+14 SET RES=$PIECE(LRES,U,7)
IF RES=""
SET RES=$PIECE(LRES,U,6)
+15 SET RESULT=1_U_$PIECE(LRES,U,2)_U_RES
+16 SET VAL=$PIECE(RESULT,"^",3)
SET DATE=$PIECE(RESULT,"^",2)
SET VISIT=$PIECE(RESULT,"^",4)
SET OTHER=$PIECE(RESULT,"^",5)
+17 SET VAL=VAL_" ("_$$FMTMDY^BQIUL1(DATE)_")"
End DoDot:1
+18 QUIT
+19 ;
LRR ;EP
+1 NEW RESULT,DA,IENS
+2 SET DA(1)=SRIEN
SET DA=AIEN
SET IENS=$$IENS^DILF(.DA)
+3 SET ITM=$$GET1^DIQ(90506.51,IENS,.04,"E")
+4 SET RESULT=0
SET VAL=""
SET DATE=""
SET VISIT=""
SET OTHER=""
+5 SET RESULT=$$LBS(BQDFN,ITM)
+6 IF RESULT
SET VAL=$PIECE(RESULT,"^",2)
+7 QUIT
+8 ;
LBS(DFN,ITM) ;EP - Pull out baseline and most recent lab
+1 NEW RVDB,BIEN,RESB,RVDC,CIEN,RESC,DATE,RVDT,VALUE
+2 SET DATE=$PIECE($$FDX^BQITDUTL(DFN,"BKM HEP C DXS",""),"^",1)
SET RVDT=9999999-DATE
SET VALUE=0
+3 IF $GET(DATE)=""
SET RVDT=$ORDER(^AUPNVLAB("AA",DFN,ITM,""),-1)
IF RVDT=""
QUIT 0
+4 SET RVDB=$ORDER(^AUPNVLAB("AA",DFN,ITM,RVDT),-1)
IF RVDB=""
SET RVDB=RVDT
+5 SET BIEN=$ORDER(^AUPNVLAB("AA",DFN,ITM,RVDB,""))
SET RESB=""
+6 IF BIEN'=""
SET RESB=$PIECE($GET(^AUPNVLAB(BIEN,0)),"^",4)
+7 SET RVDC=$ORDER(^AUPNVLAB("AA",DFN,ITM,""))
+8 IF RVDC'=""
SET CIEN=$ORDER(^AUPNVLAB("AA",DFN,ITM,RVDC,""))
SET RESC=""
+9 IF $GET(CIEN)'=""
SET RESC=$PIECE($GET(^AUPNVLAB(CIEN,0)),"^",4)
+10 SET BASE=""
IF RVDB'=""
SET BASE="B: "_RESB_" ("_$$FMTMDY^BQIUL1(9999999-RVDB)_")"
+11 SET CURR=""
IF RVDC'=""
SET CURR="C: "_RESC_" ("_$$FMTMDY^BQIUL1(9999999-RVDC)_")"
+12 IF BASE'=""!(CURR'="")
SET VALUE=1_"^"_BASE_$CHAR(10)_$CHAR(13)_CURR
+13 QUIT VALUE
+14 ;
FIB(DFN) ;EP - Fibroscan
+1 NEW TAX,TREF,FREF,TMFRAME,VALUE,VSDTM,BQQN,CT
+2 SET TAX="BQI FIBROSCAN CPT PROC"
SET TREF="BQITREF"
KILL @TREF
+3 DO BLD^BQITUTL(TAX,.TREF)
+4 SET FREF=9000010.18
SET TMFRAME=""
+5 SET VALUE=$$TAX^BQITRUTL(TMFRAME,TAX,1,DFN,FREF,"","",.TREF)
+6 IF VALUE'=0
Begin DoDot:1
+7 SET VALUE="YES"_" ("_$$FMTMDY^BQIUL1($PIECE(VALUE,"^",2))_")^"_$PIECE(VALUE,"^",2)_"^"_$PIECE(VALUE,"^",4)_"^"_$PIECE(VALUE,"^",5)
End DoDot:1
+8 IF VALUE=0
SET VALUE=""
+9 QUIT VALUE
+10 ;
LU(DFN) ;EP - Liver Ultrasound
+1 NEW TAX,TREF,FREF,TMFRAME,RAD,RIEN,VALUE,N,RVDT,VSDTM,BQQN,CT
+2 SET TAX="BQI LIVER ULTRASOUND CPT"
SET TREF="BQITREF"
KILL @TREF
+3 DO BLD^BQITUTL(TAX,.TREF)
+4 SET FREF=9000010.18
SET TMFRAME=""
+5 SET VALUE=$$TAX^BQITRUTL(TMFRAME,TAX,1,DFN,FREF,"","",.TREF)
+6 IF VALUE'=0
Begin DoDot:1
+7 SET VALUE="YES"_" (CPT: "_$$FMTMDY^BQIUL1($PIECE(VALUE,"^",2))_")^"_$PIECE(VALUE,"^",2)_"^"_$PIECE(VALUE,"^",4)_"^"_$PIECE(VALUE,"^",5)
End DoDot:1
+8 IF VALUE=0
Begin DoDot:1
+9 SET N=""
SET VALUE=""
+10 DO BLD^BQITUTL(TAX,.TREF)
+11 FOR
SET N=$ORDER(@TREF@(N))
IF N=""
QUIT
Begin DoDot:2
+12 IF '$DATA(^RAMIS(71,"D",N))
QUIT
+13 SET RAD=""
FOR
SET RAD=$ORDER(^RAMIS(71,"D",N,RAD))
IF RAD=""
QUIT
Begin DoDot:3
+14 IF '$DATA(^AUPNVRAD("AA",DFN,RAD))
QUIT
+15 SET RVDT=$ORDER(^AUPNVRAD("AA",DFN,RAD,""))
SET RIEN=$ORDER(^AUPNVRAD("AA",DFN,RAD,RVDT,""))
+16 SET RVDT=9999999-RVDT
+17 SET VALUE="YES"_" (RAD: "_$$FMTMDY^BQIUL1(RVDT)_")^"_RVDT_"^"_$PIECE(^AUPNVRAD(RIEN,0),U,3)_"^"_RIEN
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT VALUE
+19 ;
HLB(BQDFN,STVW) ;EP
+1 NEW FREF,TMFRAME,VALUE,TAX,RES,HCODE
+2 SET TMFRAME=""
SET VALUE=""
SET ITM=""
+3 SET HCODE=$PIECE(^BQI(90506.1,STVW,0),"^",1)
+4 IF HCODE="HCANTI"
SET TAX="BQI HCV ANTIBODY TAX"
SET FREF=9000010.09
SET RREF=60
+5 IF HCODE="HCAST"
SET TAX="DM AUDIT AST TAX"
SET FREF=9000010.09
SET RREF=60
+6 IF HCODE="HCALT"
SET TAX="DM AUDIT ALT TAX"
SET FREF=9000010.09
SET RREF=60
+7 IF HCODE="HCPLAT"
SET TAX="BQI PLATELET TAX"
SET FREF=9000010.09
SET RREF=60
+8 IF HCODE="HCVIRAL"
SET TAX="BQI HCV VIRAL LOAD TAX"
SET FREF=9000010.09
SET RREF=60
+9 IF HCODE="HCGENO"
SET TAX="BQI HEP C GENOTYPE TESTS"
SET FREF=9000010.09
SET RREF=60
+10 IF HCODE="HCHIV"
SET TAX="BGP HIV TEST TAX"
SET FREF=9000010.09
SET RREF=60
+11 IF HCODE="HCRNA"
SET TAX="BQI HCV RNA TAX"
SET FREF=9000010.09
SET RREF=60
+12 ;S VALUE=$$TAX^BQITRUTL(TMFRAME,TAX,1,BQDFN,FREF,"","",.TREF)
+13 SET VALUE=$$ITM^BQIRGUT1($GET(TMFRAME),$GET(BQDFN),$GET(FREF),$GET(RREF),$GET(ITM),TAX,.TREF)
+14 IF FREF=9000010.09
Begin DoDot:1
+15 IF VALUE=0
SET VALUE=""
QUIT
+16 SET RES=$PIECE(VALUE,"^",6)_" ("_$$FMTMDY^BQIUL1($PIECE(VALUE,"^",2))_")"
+17 SET VALUE=RES_"^"_$PIECE(VALUE,"^",2)_"^"_$PIECE(VALUE,"^",4)_"^"_$PIECE(VALUE,"^",5)
End DoDot:1
+18 QUIT VALUE
+19 ;
DSP(ASDFN,CODE) ; EP - Display Care Mgmt field
+1 NEW VALUE,RESULT,ASPIEN,CRIEN,CMSN,LINK
+2 SET CRIEN=$ORDER(^BQIPAT(ASDFN,60,"B",CRN,""))
IF CRIEN=""
QUIT ""
+3 SET ASPIEN=""
SET VALUE=""
SET HOVER=""
SET LINK=""
SET RESULT=""
+4 FOR
SET ASPIEN=$ORDER(^BQIPAT(ASDFN,60,CRIEN,1,"B",CODE,ASPIEN))
IF ASPIEN=""
QUIT
Begin DoDot:1
+5 SET VALUE=$PIECE($GET(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,2)
+6 SET HOVER=$PIECE($GET(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,5)
SET HOVER=""
+7 SET LINK=$PIECE($GET(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,4)
End DoDot:1
+8 IF VALUE'=""
SET RESULT=VALUE_$CHAR(26)_HOVER_$CHAR(26)_LINK
+9 IF '$TEST
SET RESULT=VALUE
+10 QUIT RESULT
