BQITDLAB ;GDIT/HS/ALA-Labs ; 20 Oct 2014 3:13 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
LBP(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF,ARRAY) ;EP
; Check for a lab test results by patient
;
; Input
; TMFRAME - Time frame to search data for
; RECENT - 1=Only check most recent lab,0=Check all within timeframe
; BQDFN - Patient internal entry number
; TAX - Lab taxonomy to search
; RESULT - Lab result to check for
; OPER - Operand to use for result check
; RES2 - If range, the other result value
; OPER2 - If range, the other result operand
; TREF - Multiple same resulting taxonomies built
; into reference (usually global)
; ARRAY - Where to place data
;
NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT
S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
S TAX=$G(TAX,""),RECENT=$G(RECENT,0),ARRAY(0)=0_U_"No Test"
I TAX'="" D
. S TREF=$NA(^TMP("BQITAX",UID))
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
;
S LIEN="",QFL=0,CT=0
I $G(TMFRAME)'="" D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S EDT=9999999-BDATE,BDT=(9999999-EDATE)-.001
.. I $P($G(^LAB(60,TIEN,0)),U,4)="MI" D Q
... D MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
... M @TEMP=MICRO
... K MICRO
.. F S BDT=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
... S LIEN=""
... F S LIEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
.... S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
.... S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
.... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
.... I FLAG'="R"&(FLAG'="M") Q
.... S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
.... ;I $G(TMFRAME)'="",VSDTM<BDATE Q
.... ; quit if deleted flag
.... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
.... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
.... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
;
I $G(TMFRAME)="" D
. S LIEN=""
. F S LIEN=$O(^AUPNVLAB("AC",BQDFN,LIEN),-1) Q:LIEN="" D
.. S TIEN=$P($G(^AUPNVLAB(LIEN,0)),U,1) I TIEN="" Q
.. I '$D(@TREF@(TIEN)) Q
.. S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
.. S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
.. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
.. ;I $G(TMFRAME)'="",VSDTM<BDATE Q
.. ; quit if deleted flag
.. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
.. I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
.. S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
. F S LIEN=$O(^AUPNVMIC("AC",BQDFN,LIEN),-1) Q:LIEN="" D
.. S TIEN=$P($G(^AUPNVMIC(LIEN,0)),U,1) I TIEN="" Q
.. I '$D(@TREF@(TIEN)) Q
.. S VALUE=$P(^AUPNVMIC(LIEN,0),U,7) I VALUE="" Q
.. S VIEN=$P(^AUPNVMIC(LIEN,0),U,3) I VIEN="" Q
.. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
.. ; quit if deleted flag
.. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
.. S FLAG=$P($G(^AUPNVMIC(LIEN,11)),U,9)
.. I FLAG'="R"&(FLAG'="M") Q
.. S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
;
S VSDTM=""
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D
. S VIEN=$O(@TEMP@(VSDTM,""),-1)
. S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)
. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
. K ROPER
. S RN=""
. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
.. S OPER=$P(SEARCH(RN),U,2),RESULT=$P(SEARCH(RN),U,1),OPER2=$P(SEARCH(RN),U,4),RES2=$P(SEARCH(RN),U,3)
.. D RCHK
K @TEMP
S ARRAY(0)=CT
Q
;
RCHK ;
I OPER="'=",RESULT="",VALUE'="" S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1 Q
;
I RESULT'?.N,VALUE?.N Q
;
I RESULT="POS",$E(VALUE,1)'?.N,'$$POSITIVE^BQITRUTL(VALUE) Q
I RESULT="POS",$E(VALUE,1)'?.N,$$POSITIVE^BQITRUTL(VALUE) D Q
. S CT=CT+1,ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
I RESULT="NEG",$E(VALUE,1)'?.N,'$$NEGATIVE^BQITRUTL(VALUE) Q
I RESULT="NEG",$E(VALUE,1)'?.N,$$NEGATIVE^BQITRUTL(VALUE) D
. S CT=CT+1,ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
I VALUE'?.PN,VALUE'?.N Q
;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
I $E(VALUE,$L(VALUE),$L(VALUE))?.P S VALUE=$E(VALUE,1,$L(VALUE)-1)
; if value starts with a punctuation e.g. < or >
I $E(VALUE,1,1)?.P S ROPER=$E(VALUE,1,1),VALUE=$E(VALUE,2,$L(VALUE))
I RES2="" D
. I $G(ROPER)="",@("VALUE"_OPER_"RESULT") D Q
.. S CT=CT+1,ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
. I $G(ROPER)'="",OPER=ROPER,@("VALUE"_OPER_"RESULT") D Q
.. S CT=CT+1,ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
. I $G(ROPER)'="",OPER'=ROPER Q
I RES2'="" D
. I @("VALUE"_OPER_"RESULT"),@("VALUE"_OPER2_"RES2") D
.. S CT=CT+1,ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE,QFL=1
Q
;
MIC(BQDFN,TIEN,EDT,BDT,MICRO) ;EP - Look through Microbiology file
NEW FLAG,LIEN,VALUE,VIEN,VSDTM
K MICRO
F S BDT=$O(^AUPNVMIC("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
. S LIEN=""
. F S LIEN=$O(^AUPNVMIC("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
.. S VALUE=$P(^AUPNVMIC(LIEN,0),U,7) I VALUE="" Q
.. S VIEN=$P(^AUPNVMIC(LIEN,0),U,3) I VIEN="" Q
.. S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
.. ; quit if deleted flag
.. I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
.. S FLAG=$P($G(^AUPNVMIC(LIEN,11)),U,9)
.. I FLAG'="R"&(FLAG'="M") Q
.. S MICRO(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
Q
;
LBB(TMFRAME,RECENT,DATE,BQDFN,TAX,SEARCH,TREF,ARRAY) ;EP
I $G(TMFRAME)'="" D
. I TMFRAME'["-" Q
. S TMFRAME=$P(TMFRAME,"-",2)
S BDATE=$$FMADD^XLFDT(DATE,-TMFRAME),EDATE=$$FMADD^XLFDT(DATE,TMFRAME)
S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
S TAX=$G(TAX,""),RECENT=$G(RECENT,0)
I TAX'="" D
. S TREF=$NA(^TMP("BQITAX",UID))
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
;
S LIEN="",QFL=0,ARRAY(0)=0_U_"No Test",CT=0
D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S EDT=9999999-BDATE,BDT=(9999999-EDATE)-.001
.. I $P($G(^LAB(60,TIEN,0)),U,4)="MI" D Q
... D MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
... M @TEMP=MICRO
... K MICRO
.. F S BDT=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
... S LIEN=""
... F S LIEN=$O(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN)) Q:LIEN="" D
.... S VALUE=$P(^AUPNVLAB(LIEN,0),U,4) I VALUE="" Q
.... S VIEN=$P(^AUPNVLAB(LIEN,0),U,3) I VIEN="" Q
.... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
.... I FLAG'="R"&(FLAG'="M") Q
.... S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
.... ;I $G(TMFRAME)'="",VSDTM<BDATE Q
.... ; quit if deleted flag
.... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
.... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
.... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
;
S VSDTM=""
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
. S VIEN=$O(@TEMP@(VSDTM,""),-1)
. S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)
. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
. K ROPER
. S RN=""
. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
.. S OPER=$P(SEARCH(RN),U,2),RESULT=$P(SEARCH(RN),U,1),OPER2=$P(SEARCH(RN),U,4),RES2=$P(SEARCH(RN),U,3)
.. D RCHK
K @TEMP
S ARRAY(0)=CT
Q
;
LPOP(TMFRAME,RECENT,TAX,SEARCH,TREF,ARRAY) ;EP
I $G(TMFRAME)'="" D
. I TMFRAME'["-" Q
. S TMFRAME=$P(TMFRAME,"-",2)
S FDT=$$DATE^BQIUL1(TMFRAME),TDT=DT
S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
S TAX=$G(TAX,""),RECENT=$G(RECENT,0)
I TAX'="" D
. S TREF=$NA(^TMP("BQITAX",UID))
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
;
S LIEN="",QFL=0,ARRAY(0)=0_U_"No Test",CT=0
D
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. S IEN=""
.. F S IEN=$O(^AUPNVLAB("B",TIEN,IEN)) Q:IEN="" D
... I $G(^AUPNVLAB(IEN,0))="" Q
... S DFN=$P($G(^AUPNVLAB(IEN,0)),U,2),VIS=$P(^AUPNVLAB(IEN,0),U,3) I VIS="" Q
... I $G(^AUPNVSIT(VIS,0))="" Q
... Q:"DXCTI"[$P(^AUPNVSIT(VIS,0),U,7)
... S VSDTM=$P(^AUPNVSIT(VIS,0),U,1)\1
... I FDT'="",VSDTM<FDT!(VSDTM>TDT) Q
... S VALUE=$P($G(^AUPNVLAB(IEN,0)),U,4)
... I $P($G(^AUPNVSIT(VIEN,0)),U,11)=1 Q
... I $P($G(^AUPNVLAB(LIEN,11)),U,9)="D" Q
... S FLAG=$P($G(^AUPNVLAB(LIEN,11)),U,9) I FLAG="" Q
... I FLAG'="R"&(FLAG'="M") Q
... S @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
;
S VSDTM=""
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
. S VIEN=$O(@TEMP@(VSDTM,""),-1)
. S LIEN=$O(@TEMP@(VSDTM,VIEN,""),-1)
. S VALUE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,1),OVALUE=VALUE
. S FILE=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
. S TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,3)
. K ROPER
. S RN=""
. F S RN=$O(SEARCH(RN)) Q:RN="" D Q:QFL
.. S OPER=$P(SEARCH(RN),U,2),RESULT=$P(SEARCH(RN),U,1),OPER2=$P(SEARCH(RN),U,4),RES2=$P(SEARCH(RN),U,3)
.. D RCHK
K @TEMP
S ARRAY(0)=CT
Q
BQITDLAB ;GDIT/HS/ALA-Labs ; 20 Oct 2014 3:13 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
LBP(TMFRAME,RECENT,BQDFN,TAX,SEARCH,TREF,ARRAY) ;EP
+1 ; Check for a lab test results by patient
+2 ;
+3 ; Input
+4 ; TMFRAME - Time frame to search data for
+5 ; RECENT - 1=Only check most recent lab,0=Check all within timeframe
+6 ; BQDFN - Patient internal entry number
+7 ; TAX - Lab taxonomy to search
+8 ; RESULT - Lab result to check for
+9 ; OPER - Operand to use for result check
+10 ; RES2 - If range, the other result value
+11 ; OPER2 - If range, the other result operand
+12 ; TREF - Multiple same resulting taxonomies built
+13 ; into reference (usually global)
+14 ; ARRAY - Where to place data
+15 ;
+16 NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
+17 SET BDATE=$$DATE^BQIUL1(TMFRAME)
SET EDATE=DT
+18 SET TEMP=$NAME(^TMP("BQITEMP",UID))
KILL @TEMP
+19 SET TAX=$GET(TAX,"")
SET RECENT=$GET(RECENT,0)
SET ARRAY(0)=0_U_"No Test"
+20 IF TAX'=""
Begin DoDot:1
+21 SET TREF=$NAME(^TMP("BQITAX",UID))
+22 KILL @TREF
+23 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+24 ;
+25 SET LIEN=""
SET QFL=0
SET CT=0
+26 IF $GET(TMFRAME)'=""
Begin DoDot:1
+27 SET TIEN=""
+28 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+29 SET EDT=9999999-BDATE
SET BDT=(9999999-EDATE)-.001
+30 IF $PIECE($GET(^LAB(60,TIEN,0)),U,4)="MI"
Begin DoDot:3
+31 DO MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
+32 MERGE @TEMP=MICRO
+33 KILL MICRO
End DoDot:3
QUIT
+34 FOR
SET BDT=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+35 SET LIEN=""
+36 FOR
SET LIEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN))
IF LIEN=""
QUIT
Begin DoDot:4
+37 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
IF VALUE=""
QUIT
+38 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
IF VIEN=""
QUIT
+39 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
IF FLAG=""
QUIT
+40 IF FLAG'="R"&(FLAG'="M")
QUIT
+41 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+42 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
+43 ; quit if deleted flag
+44 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+45 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+46 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;
+48 IF $GET(TMFRAME)=""
Begin DoDot:1
+49 SET LIEN=""
+50 FOR
SET LIEN=$ORDER(^AUPNVLAB("AC",BQDFN,LIEN),-1)
IF LIEN=""
QUIT
Begin DoDot:2
+51 SET TIEN=$PIECE($GET(^AUPNVLAB(LIEN,0)),U,1)
IF TIEN=""
QUIT
+52 IF '$DATA(@TREF@(TIEN))
QUIT
+53 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
IF VALUE=""
QUIT
+54 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
IF VIEN=""
QUIT
+55 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+56 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
+57 ; quit if deleted flag
+58 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+59 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+60 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
End DoDot:2
+61 FOR
SET LIEN=$ORDER(^AUPNVMIC("AC",BQDFN,LIEN),-1)
IF LIEN=""
QUIT
Begin DoDot:2
+62 SET TIEN=$PIECE($GET(^AUPNVMIC(LIEN,0)),U,1)
IF TIEN=""
QUIT
+63 IF '$DATA(@TREF@(TIEN))
QUIT
+64 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
IF VALUE=""
QUIT
+65 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
IF VIEN=""
QUIT
+66 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+67 ; quit if deleted flag
+68 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+69 SET FLAG=$PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)
+70 IF FLAG'="R"&(FLAG'="M")
QUIT
+71 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
End DoDot:2
End DoDot:1
+72 ;
+73 SET VSDTM=""
+74 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:1
+75 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
+76 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
+77 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
SET OVALUE=VALUE
+78 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
+79 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
+80 KILL ROPER
+81 SET RN=""
+82 FOR
SET RN=$ORDER(SEARCH(RN))
IF RN=""
QUIT
Begin DoDot:2
+83 SET OPER=$PIECE(SEARCH(RN),U,2)
SET RESULT=$PIECE(SEARCH(RN),U,1)
SET OPER2=$PIECE(SEARCH(RN),U,4)
SET RES2=$PIECE(SEARCH(RN),U,3)
+84 DO RCHK
End DoDot:2
IF QFL
QUIT
End DoDot:1
+85 KILL @TEMP
+86 SET ARRAY(0)=CT
+87 QUIT
+88 ;
RCHK ;
+1 IF OPER="'="
IF RESULT=""
IF VALUE'=""
SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
SET QFL=1
QUIT
+2 ;
+3 IF RESULT'?.N
IF VALUE?.N
QUIT
+4 ;
+5 IF RESULT="POS"
IF $EXTRACT(VALUE,1)'?.N
IF '$$POSITIVE^BQITRUTL(VALUE)
QUIT
+6 IF RESULT="POS"
IF $EXTRACT(VALUE,1)'?.N
IF $$POSITIVE^BQITRUTL(VALUE)
Begin DoDot:1
+7 SET CT=CT+1
SET ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
SET QFL=1
End DoDot:1
QUIT
+8 IF RESULT="NEG"
IF $EXTRACT(VALUE,1)'?.N
IF '$$NEGATIVE^BQITRUTL(VALUE)
QUIT
+9 IF RESULT="NEG"
IF $EXTRACT(VALUE,1)'?.N
IF $$NEGATIVE^BQITRUTL(VALUE)
Begin DoDot:1
+10 SET CT=CT+1
SET ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
SET QFL=1
End DoDot:1
+11 IF VALUE'?.PN
IF VALUE'?.N
QUIT
+12 ;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
+13 IF $EXTRACT(VALUE,$LENGTH(VALUE),$LENGTH(VALUE))?.P
SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
+14 ; if value starts with a punctuation e.g. < or >
+15 IF $EXTRACT(VALUE,1,1)?.P
SET ROPER=$EXTRACT(VALUE,1,1)
SET VALUE=$EXTRACT(VALUE,2,$LENGTH(VALUE))
+16 IF RES2=""
Begin DoDot:1
+17 IF $GET(ROPER)=""
IF @("VALUE"_OPER_"RESULT")
Begin DoDot:2
+18 SET CT=CT+1
SET ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
SET QFL=1
End DoDot:2
QUIT
+19 IF $GET(ROPER)'=""
IF OPER=ROPER
IF @("VALUE"_OPER_"RESULT")
Begin DoDot:2
+20 SET CT=CT+1
SET ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
SET QFL=1
End DoDot:2
QUIT
+21 IF $GET(ROPER)'=""
IF OPER'=ROPER
QUIT
End DoDot:1
+22 IF RES2'=""
Begin DoDot:1
+23 IF @("VALUE"_OPER_"RESULT")
IF @("VALUE"_OPER2_"RES2")
Begin DoDot:2
+24 SET CT=CT+1
SET ARRAY(CT)=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN_U_FILE
SET QFL=1
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
MIC(BQDFN,TIEN,EDT,BDT,MICRO) ;EP - Look through Microbiology file
+1 NEW FLAG,LIEN,VALUE,VIEN,VSDTM
+2 KILL MICRO
+3 FOR
SET BDT=$ORDER(^AUPNVMIC("AA",BQDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:1
+4 SET LIEN=""
+5 FOR
SET LIEN=$ORDER(^AUPNVMIC("AA",BQDFN,TIEN,BDT,LIEN))
IF LIEN=""
QUIT
Begin DoDot:2
+6 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
IF VALUE=""
QUIT
+7 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
IF VIEN=""
QUIT
+8 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+9 ; quit if deleted flag
+10 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+11 SET FLAG=$PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)
+12 IF FLAG'="R"&(FLAG'="M")
QUIT
+13 SET MICRO(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.25"_U_TIEN
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
LBB(TMFRAME,RECENT,DATE,BQDFN,TAX,SEARCH,TREF,ARRAY) ;EP
+1 IF $GET(TMFRAME)'=""
Begin DoDot:1
+2 IF TMFRAME'["-"
QUIT
+3 SET TMFRAME=$PIECE(TMFRAME,"-",2)
End DoDot:1
+4 SET BDATE=$$FMADD^XLFDT(DATE,-TMFRAME)
SET EDATE=$$FMADD^XLFDT(DATE,TMFRAME)
+5 SET TEMP=$NAME(^TMP("BQITEMP",UID))
KILL @TEMP
+6 SET TAX=$GET(TAX,"")
SET RECENT=$GET(RECENT,0)
+7 IF TAX'=""
Begin DoDot:1
+8 SET TREF=$NAME(^TMP("BQITAX",UID))
+9 KILL @TREF
+10 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+11 ;
+12 SET LIEN=""
SET QFL=0
SET ARRAY(0)=0_U_"No Test"
SET CT=0
+13 Begin DoDot:1
+14 SET TIEN=""
+15 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+16 SET EDT=9999999-BDATE
SET BDT=(9999999-EDATE)-.001
+17 IF $PIECE($GET(^LAB(60,TIEN,0)),U,4)="MI"
Begin DoDot:3
+18 DO MIC(BQDFN,TIEN,EDT,BDT,.MICRO)
+19 MERGE @TEMP=MICRO
+20 KILL MICRO
End DoDot:3
QUIT
+21 FOR
SET BDT=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+22 SET LIEN=""
+23 FOR
SET LIEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN))
IF LIEN=""
QUIT
Begin DoDot:4
+24 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
IF VALUE=""
QUIT
+25 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
IF VIEN=""
QUIT
+26 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
IF FLAG=""
QUIT
+27 IF FLAG'="R"&(FLAG'="M")
QUIT
+28 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+29 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
+30 ; quit if deleted flag
+31 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+32 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+33 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 SET VSDTM=""
+36 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:1
+37 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
+38 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
+39 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
SET OVALUE=VALUE
+40 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
+41 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
+42 KILL ROPER
+43 SET RN=""
+44 FOR
SET RN=$ORDER(SEARCH(RN))
IF RN=""
QUIT
Begin DoDot:2
+45 SET OPER=$PIECE(SEARCH(RN),U,2)
SET RESULT=$PIECE(SEARCH(RN),U,1)
SET OPER2=$PIECE(SEARCH(RN),U,4)
SET RES2=$PIECE(SEARCH(RN),U,3)
+46 DO RCHK
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+47 KILL @TEMP
+48 SET ARRAY(0)=CT
+49 QUIT
+50 ;
LPOP(TMFRAME,RECENT,TAX,SEARCH,TREF,ARRAY) ;EP
+1 IF $GET(TMFRAME)'=""
Begin DoDot:1
+2 IF TMFRAME'["-"
QUIT
+3 SET TMFRAME=$PIECE(TMFRAME,"-",2)
End DoDot:1
+4 SET FDT=$$DATE^BQIUL1(TMFRAME)
SET TDT=DT
+5 SET TEMP=$NAME(^TMP("BQITEMP",UID))
KILL @TEMP
+6 SET TAX=$GET(TAX,"")
SET RECENT=$GET(RECENT,0)
+7 IF TAX'=""
Begin DoDot:1
+8 SET TREF=$NAME(^TMP("BQITAX",UID))
+9 KILL @TREF
+10 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+11 ;
+12 SET LIEN=""
SET QFL=0
SET ARRAY(0)=0_U_"No Test"
SET CT=0
+13 Begin DoDot:1
+14 SET TIEN=""
+15 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+16 SET IEN=""
+17 FOR
SET IEN=$ORDER(^AUPNVLAB("B",TIEN,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+18 IF $GET(^AUPNVLAB(IEN,0))=""
QUIT
+19 SET DFN=$PIECE($GET(^AUPNVLAB(IEN,0)),U,2)
SET VIS=$PIECE(^AUPNVLAB(IEN,0),U,3)
IF VIS=""
QUIT
+20 IF $GET(^AUPNVSIT(VIS,0))=""
QUIT
+21 IF "DXCTI"[$PIECE(^AUPNVSIT(VIS,0),U,7)
QUIT
+22 SET VSDTM=$PIECE(^AUPNVSIT(VIS,0),U,1)\1
+23 IF FDT'=""
IF VSDTM<FDT!(VSDTM>TDT)
QUIT
+24 SET VALUE=$PIECE($GET(^AUPNVLAB(IEN,0)),U,4)
+25 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+26 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+27 SET FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
IF FLAG=""
QUIT
+28 IF FLAG'="R"&(FLAG'="M")
QUIT
+29 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_"9000010.09"_U_TIEN
End DoDot:3
End DoDot:2
End DoDot:1
+30 ;
+31 SET VSDTM=""
+32 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:1
+33 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
+34 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
+35 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
SET OVALUE=VALUE
+36 SET FILE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
+37 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,3)
+38 KILL ROPER
+39 SET RN=""
+40 FOR
SET RN=$ORDER(SEARCH(RN))
IF RN=""
QUIT
Begin DoDot:2
+41 SET OPER=$PIECE(SEARCH(RN),U,2)
SET RESULT=$PIECE(SEARCH(RN),U,1)
SET OPER2=$PIECE(SEARCH(RN),U,4)
SET RES2=$PIECE(SEARCH(RN),U,3)
+42 DO RCHK
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+43 KILL @TEMP
+44 SET ARRAY(0)=CT
+45 QUIT
