BQIRGHPC.m

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))_")"