BQITRUT1 ;VNGT/HS/ALA-Treatment Prompt Utility Program ; 03 Sep 2008 8:55 AM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
NEX(BQDFN,TMFRAME) ;EP - No Exercise API
NEW X,MEET,DESC
S MEET=0,DESC=""
D
. ;S X=$$DX^BQITRUTL($$DATE^BQIUL1(TMFRAME),BQDFN,"V65.41")
. S X=$$TAX^BQITRUT1(BQDFN,TMFRAME,"BQI EXERCISE COUNSELING DXS",9000010.07)
. I $P(X,U,1)=1 S MEET=0,DESC="Has DX for V65.41-EXERCISE COUNSELING" Q
. S X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-EX")
. I $P(X,U,1)=1 S MEET=0,DESC="Has Education Topic: "_$$GET1^DIQ(9000010.16,$P(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($P(X,U,2)) Q
. ;S X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-LA")
. ;I $P(X,U,1)=1 S MEET=0,DESC="Has Education Topic: "_$$GET1^DIQ(9000010.16,$P(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($P(X,U,2)) Q
. S MEET=1,DESC="Has no exercise education topics or diagnosis"
Q MEET_U_DESC
;
NNU(BQDFN,TMFRAME) ;EP - No Nutrition API
NEW X,MEET,DESC
S MEET=0,DESC=""
D
. ;S X=$$DX^BQITRUTL($$DATE^BQIUL1(TMFRAME),BQDFN,"V65.3")
. S X=$$TAX^BQITRUT1(BQDFN,TMFRAME,"BGP DIETARY SURVEILLANCE DXS",9000010.07)
. I $P(X,U,1)=1 S MEET=0,DESC="Has DX for V65.3-DIETARY SURVEIL/COUNSEL" Q
. ;S X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-NU")
. S X=$$TOP($$DATE^BQIUL1(TMFRAME),BQDFN,"-N","NUTRITION")
. I $P(X,U,1)=1 S MEET=0,DESC="Has Education topic: "_$$GET1^DIQ(9000010.16,$P(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($P(X,U,2)) Q
. S X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-MNT")
. I $P(X,U,1)=1 S MEET=0,DESC="Has Education topic: "_$$GET1^DIQ(9000010.16,$P(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($P(X,U,2)) Q
. S MEET=1,DESC="Has no nutrition education topics or diagnosis"
Q MEET_U_DESC
;
TAX(BQDFN,TMFRAME,TAX,FREF) ;EP - Documented value from a taxonomy
NEW MEET,DESC,EDATE,GREF,TREF,IEN,QFL,TIEN,VISIT,VSDTM
S MEET=0,DESC=""
S TMFRAME=$G(TMFRAME,""),TAX=$G(TAX,"")
I TMFRAME'="" S EDATE=$$DATE^BQIUL1(TMFRAME)
S GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
; Build the taxonomy reference
K @TREF
Q:TAX=""
D BLD^BQITUTL(TAX,TREF)
S IEN="",QFL=0
F S IEN=$O(@GREF@("AC",BQDFN,IEN),-1) Q:IEN="" D Q:QFL
. S TIEN=$$GET1^DIQ(FREF,IEN_",",.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. S VISIT=$$GET1^DIQ(FREF,IEN_",",.03,"I") I VISIT="" Q
. I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
. S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
. I $G(TMFRAME)'="",VSDTM<EDATE Q
. S MEET=1,DESC="Has value from taxonomy "_TAX
Q MEET_U_DESC
;
EKG(BQDFN,TMFRAME) ;EP
NEW RETURN
S RETURN=$$TAX^BQITRUT1(BQDFN,TMFRAME,"BQI EKG PROCEDURES",9000010.08)
I $P(RETURN,U,1)=0 S MEET=1,DESC="Does not have EKG procedure in past year"
I $P(RETURN,U,1)=1 S MEET=0,DESC=$P(RETURN,U,2)
Q MEET_U_DESC
;
TOP(DATE,BQDFN,CODE,TEXT) ;Build the topic data
S TREF=$NA(^TMP("BQITOPIC",UID)),RES=0
S DATE=$G(DATE,""),TEXT=$G(TEXT,"")
K @TREF
D EDTP^BQITRUTL(TREF,CODE)
S IEN=""
F S IEN=$O(@TREF@(IEN)) Q:IEN="" D
. I TEXT="" Q
. I @TREF@(IEN)'[TEXT K @TREF@(IEN)
S IEN=""
F S IEN=$O(^AUPNVPED("AC",BQDFN,IEN)) Q:IEN="" D
. S TIEN=$P($G(^AUPNVPED(IEN,0)),U,1) I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. S VIEN=$P(^AUPNVPED(IEN,0),U,3) I VIEN="" Q
. S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),U,1)\1 I VSDTM=0 Q
. I DATE'="",VSDTM<DATE Q
. S RES=1_U_VSDTM_U_U_VIEN_U_IEN
K @TREF
Q RES
;
;
LBB(START,END,RECENT,BQDFN,TAX,RESULT,OPER,RES2,OPER2,TREF) ;EP
; Check for a lab test result
;
; 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)
;
NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
S BDATE=$G(START),EDATE=$G(END)
S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
S TAX=$G(TAX,"")
I TAX'="" D
. S TREF=$NA(^TMP("BQITAX",UID)),RES2=$G(RES2,""),OPER2=$G(OPER2,""),RECENT=$G(RECENT,0)
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
;
S LIEN="",QFL=0,RES=0_U_"No Test",CT=0
I $G(BDATE)'="" 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 MIC^BQICAUTL(BQDFN,TIEN,EDT,BDT,.MICRO) Q
.. 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 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
;
I $G(BDATE)="" 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
.. ; 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
. 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
.. I $P($G(^AUPNVMIC(LIEN,11)),U,9)="D" Q
.. S MICRO(VSDTM,VIEN,LIEN)=VALUE
;
S VSDTM=""
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" D Q:QFL
. S VIEN=$O(@TEMP@(VSDTM,""),-1),LIEN=""
. F S LIEN=$O(@TEMP@(VSDTM,VIEN,LIEN),-1) Q:LIEN=""!(QFL) D
.. S VALUE=@TEMP@(VSDTM,VIEN,LIEN)
.. S CT=CT+1 I RECENT,CT=1 S QFL=1,RES=0_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$P(^AUPNVLAB(LIEN,0),U,1)
.. ;
.. I RESULT'?.N,VALUE?.N Q
.. ; If the operand is a 'contains', check the comment text
.. I OPER="[" D Q
... NEW LN
... S RESULT=$$UP^XLFSTR(RESULT)
... S LN=0 F S LN=$O(^AUPNVLAB(LIEN,21,LN)) Q:'LN D Q:QFL
.... I $$UP^XLFSTR(^AUPNVLAB(LIEN,21,LN,0))[RESULT S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$P(^AUPNVLAB(LIEN,0),U,1),QFL=1
.. ;
.. I RESULT="POS",$E(VALUE,1)'?.N,'$$POSITIVE^BQITRUTL(VALUE) Q
.. I RESULT="POS",$E(VALUE,1)'?.N,$$POSITIVE^BQITRUTL(VALUE) D Q
... S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$P(^AUPNVLAB(LIEN,0),U,1),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 RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$P(^AUPNVLAB(LIEN,0),U,1),QFL=1
.. I $E(VALUE,1)'?.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)
.. I RES2="" D
... I @("VALUE"_OPER_"RESULT") D
.... S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$P(^AUPNVLAB(LIEN,0),U,1),QFL=1
.. I RES2'="" D
... I @("VALUE"_OPER_"RESULT"),@("VALUE"_OPER2_"RES2") D
.... S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$P(^AUPNVLAB(LIEN,0),U,1),QFL=1
K @TEMP
Q RES
;
CLN(TMFRAME,BQDFN,CLINIC) ;EP
; Find visits for a clinic code
; Input
; TMFRAME - Time frame to search data for
; BQDFN - Patient internal entry number
; CLINIC - Clinic code
NEW ENDT,BCLN,IEN,QFL,RESULT
S TMFRAME=$G(TMFRAME,""),ENDT=$$DATE^BQIUL1(TMFRAME)
S BCLN=$$FIND1^DIC(40.7,"","Q",CLINIC,"C","","ERROR")
S IEN="",QFL=0,RESULT=0
I $G(TMFRAME)'="" D
. S EDT=9999999-ENDT,BDT=""
. F S BDT=$O(^AUPNVSIT("AA",BQDFN,BDT)) Q:BDT=""!(BDT>EDT) D
.. S IEN=""
.. F S IEN=$O(^AUPNVSIT("AA",BQDFN,BDT,IEN)) Q:IEN="" D
... I $$GET1^DIQ(9000010,IEN,.11,"I")=1 Q
... S VSDTM=$$GET1^DIQ(9000010,IEN,.01,"I")\1 Q:VSDTM=0
... I $$GET1^DIQ(9000010,IEN,.08,"I")=BCLN S QFL=1,RESULT=1_U_VSDTM_U_U_IEN_U
;
I $G(TMFRAME)="" D
. F S IEN=$O(^AUPNVSIT("AC",BQDFN,IEN),-1) Q:IEN="" D Q:QFL
.. I $$GET1^DIQ(9000010,IEN,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,IEN,.01,"I")\1 Q:VSDTM=0
.. I $$GET1^DIQ(9000010,IEN,.08,"I")=BCLN S QFL=1,RESULT=1_U_VSDTM_U_U_IEN_U
Q RESULT
BQITRUT1 ;VNGT/HS/ALA-Treatment Prompt Utility Program ; 03 Sep 2008 8:55 AM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
NEX(BQDFN,TMFRAME) ;EP - No Exercise API
+1 NEW X,MEET,DESC
+2 SET MEET=0
SET DESC=""
+3 Begin DoDot:1
+4 ;S X=$$DX^BQITRUTL($$DATE^BQIUL1(TMFRAME),BQDFN,"V65.41")
+5 SET X=$$TAX^BQITRUT1(BQDFN,TMFRAME,"BQI EXERCISE COUNSELING DXS",9000010.07)
+6 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has DX for V65.41-EXERCISE COUNSELING"
QUIT
+7 SET X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-EX")
+8 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has Education Topic: "_$$GET1^DIQ(9000010.16,$PIECE(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($PIECE(X,U,2))
QUIT
+9 ;S X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-LA")
+10 ;I $P(X,U,1)=1 S MEET=0,DESC="Has Education Topic: "_$$GET1^DIQ(9000010.16,$P(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($P(X,U,2)) Q
+11 SET MEET=1
SET DESC="Has no exercise education topics or diagnosis"
End DoDot:1
+12 QUIT MEET_U_DESC
+13 ;
NNU(BQDFN,TMFRAME) ;EP - No Nutrition API
+1 NEW X,MEET,DESC
+2 SET MEET=0
SET DESC=""
+3 Begin DoDot:1
+4 ;S X=$$DX^BQITRUTL($$DATE^BQIUL1(TMFRAME),BQDFN,"V65.3")
+5 SET X=$$TAX^BQITRUT1(BQDFN,TMFRAME,"BGP DIETARY SURVEILLANCE DXS",9000010.07)
+6 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has DX for V65.3-DIETARY SURVEIL/COUNSEL"
QUIT
+7 ;S X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-NU")
+8 SET X=$$TOP($$DATE^BQIUL1(TMFRAME),BQDFN,"-N","NUTRITION")
+9 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has Education topic: "_$$GET1^DIQ(9000010.16,$PIECE(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($PIECE(X,U,2))
QUIT
+10 SET X=$$FED^BQITREDU($$DATE^BQIUL1(TMFRAME),BQDFN,"-MNT")
+11 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has Education topic: "_$$GET1^DIQ(9000010.16,$PIECE(X,U,5)_",",.01,"E")_" "_$$FMTE^BQIUL1($PIECE(X,U,2))
QUIT
+12 SET MEET=1
SET DESC="Has no nutrition education topics or diagnosis"
End DoDot:1
+13 QUIT MEET_U_DESC
+14 ;
TAX(BQDFN,TMFRAME,TAX,FREF) ;EP - Documented value from a taxonomy
+1 NEW MEET,DESC,EDATE,GREF,TREF,IEN,QFL,TIEN,VISIT,VSDTM
+2 SET MEET=0
SET DESC=""
+3 SET TMFRAME=$GET(TMFRAME,"")
SET TAX=$GET(TAX,"")
+4 IF TMFRAME'=""
SET EDATE=$$DATE^BQIUL1(TMFRAME)
+5 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+6 ; Build the taxonomy reference
+7 KILL @TREF
+8 IF TAX=""
QUIT
+9 DO BLD^BQITUTL(TAX,TREF)
+10 SET IEN=""
SET QFL=0
+11 FOR
SET IEN=$ORDER(@GREF@("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+12 SET TIEN=$$GET1^DIQ(FREF,IEN_",",.01,"I")
IF TIEN=""
QUIT
+13 IF '$DATA(@TREF@(TIEN))
QUIT
+14 SET VISIT=$$GET1^DIQ(FREF,IEN_",",.03,"I")
IF VISIT=""
QUIT
+15 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+16 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDTM=0
QUIT
+17 IF $GET(TMFRAME)'=""
IF VSDTM<EDATE
QUIT
+18 SET MEET=1
SET DESC="Has value from taxonomy "_TAX
End DoDot:1
IF QFL
QUIT
+19 QUIT MEET_U_DESC
+20 ;
EKG(BQDFN,TMFRAME) ;EP
+1 NEW RETURN
+2 SET RETURN=$$TAX^BQITRUT1(BQDFN,TMFRAME,"BQI EKG PROCEDURES",9000010.08)
+3 IF $PIECE(RETURN,U,1)=0
SET MEET=1
SET DESC="Does not have EKG procedure in past year"
+4 IF $PIECE(RETURN,U,1)=1
SET MEET=0
SET DESC=$PIECE(RETURN,U,2)
+5 QUIT MEET_U_DESC
+6 ;
TOP(DATE,BQDFN,CODE,TEXT) ;Build the topic data
+1 SET TREF=$NAME(^TMP("BQITOPIC",UID))
SET RES=0
+2 SET DATE=$GET(DATE,"")
SET TEXT=$GET(TEXT,"")
+3 KILL @TREF
+4 DO EDTP^BQITRUTL(TREF,CODE)
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(@TREF@(IEN))
IF IEN=""
QUIT
Begin DoDot:1
+7 IF TEXT=""
QUIT
+8 IF @TREF@(IEN)'[TEXT
KILL @TREF@(IEN)
End DoDot:1
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^AUPNVPED("AC",BQDFN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+11 SET TIEN=$PIECE($GET(^AUPNVPED(IEN,0)),U,1)
IF TIEN=""
QUIT
+12 IF '$DATA(@TREF@(TIEN))
QUIT
+13 SET VIEN=$PIECE(^AUPNVPED(IEN,0),U,3)
IF VIEN=""
QUIT
+14 SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)\1
IF VSDTM=0
QUIT
+15 IF DATE'=""
IF VSDTM<DATE
QUIT
+16 SET RES=1_U_VSDTM_U_U_VIEN_U_IEN
End DoDot:1
+17 KILL @TREF
+18 QUIT RES
+19 ;
+20 ;
LBB(START,END,RECENT,BQDFN,TAX,RESULT,OPER,RES2,OPER2,TREF) ;EP
+1 ; Check for a lab test result
+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 ;
+15 NEW TEMP,EDATE,BDATE,LIEN,QFL,RES,CT,VALUE,VIEN,VSDTM
+16 SET BDATE=$GET(START)
SET EDATE=$GET(END)
+17 SET TEMP=$NAME(^TMP("BQITEMP",UID))
KILL @TEMP
+18 SET TAX=$GET(TAX,"")
+19 IF TAX'=""
Begin DoDot:1
+20 SET TREF=$NAME(^TMP("BQITAX",UID))
SET RES2=$GET(RES2,"")
SET OPER2=$GET(OPER2,"")
SET RECENT=$GET(RECENT,0)
+21 KILL @TREF
+22 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+23 ;
+24 SET LIEN=""
SET QFL=0
SET RES=0_U_"No Test"
SET CT=0
+25 IF $GET(BDATE)'=""
Begin DoDot:1
+26 SET TIEN=""
+27 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+28 SET EDT=9999999-BDATE
SET BDT=(9999999-EDATE)-.001
+29 IF $PIECE($GET(^LAB(60,TIEN,0)),U,4)="MI"
DO MIC^BQICAUTL(BQDFN,TIEN,EDT,BDT,.MICRO)
QUIT
+30 FOR
SET BDT=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+31 SET LIEN=""
+32 FOR
SET LIEN=$ORDER(^AUPNVLAB("AA",BQDFN,TIEN,BDT,LIEN))
IF LIEN=""
QUIT
Begin DoDot:4
+33 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
IF VALUE=""
QUIT
+34 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
IF VIEN=""
QUIT
+35 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+36 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
+37 ; quit if deleted flag
+38 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+39 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+40 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+41 ;
+42 IF $GET(BDATE)=""
Begin DoDot:1
+43 SET LIEN=""
+44 FOR
SET LIEN=$ORDER(^AUPNVLAB("AC",BQDFN,LIEN),-1)
IF LIEN=""
QUIT
Begin DoDot:2
+45 SET TIEN=$PIECE($GET(^AUPNVLAB(LIEN,0)),U,1)
IF TIEN=""
QUIT
+46 IF '$DATA(@TREF@(TIEN))
QUIT
+47 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
IF VALUE=""
QUIT
+48 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
IF VIEN=""
QUIT
+49 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+50 ; quit if deleted flag
+51 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+52 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+53 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE
End DoDot:2
+54 FOR
SET LIEN=$ORDER(^AUPNVMIC("AC",BQDFN,LIEN),-1)
IF LIEN=""
QUIT
Begin DoDot:2
+55 SET TIEN=$PIECE($GET(^AUPNVMIC(LIEN,0)),U,1)
IF TIEN=""
QUIT
+56 IF '$DATA(@TREF@(TIEN))
QUIT
+57 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
IF VALUE=""
QUIT
+58 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
IF VIEN=""
QUIT
+59 SET VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1
IF VSDTM=0
QUIT
+60 ; quit if deleted flag
+61 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+62 IF $PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)="D"
QUIT
+63 SET MICRO(VSDTM,VIEN,LIEN)=VALUE
End DoDot:2
End DoDot:1
+64 ;
+65 SET VSDTM=""
+66 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:1
+67 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
SET LIEN=""
+68 FOR
SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,LIEN),-1)
IF LIEN=""!(QFL)
QUIT
Begin DoDot:2
+69 SET VALUE=@TEMP@(VSDTM,VIEN,LIEN)
+70 SET CT=CT+1
IF RECENT
IF CT=1
SET QFL=1
SET RES=0_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$PIECE(^AUPNVLAB(LIEN,0),U,1)
+71 ;
+72 IF RESULT'?.N
IF VALUE?.N
QUIT
+73 ; If the operand is a 'contains', check the comment text
+74 IF OPER="["
Begin DoDot:3
+75 NEW LN
+76 SET RESULT=$$UP^XLFSTR(RESULT)
+77 SET LN=0
FOR
SET LN=$ORDER(^AUPNVLAB(LIEN,21,LN))
IF 'LN
QUIT
Begin DoDot:4
+78 IF $$UP^XLFSTR(^AUPNVLAB(LIEN,21,LN,0))[RESULT
SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$PIECE(^AUPNVLAB(LIEN,0),U,1)
SET QFL=1
End DoDot:4
IF QFL
QUIT
End DoDot:3
QUIT
+79 ;
+80 IF RESULT="POS"
IF $EXTRACT(VALUE,1)'?.N
IF '$$POSITIVE^BQITRUTL(VALUE)
QUIT
+81 IF RESULT="POS"
IF $EXTRACT(VALUE,1)'?.N
IF $$POSITIVE^BQITRUTL(VALUE)
Begin DoDot:3
+82 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$PIECE(^AUPNVLAB(LIEN,0),U,1)
SET QFL=1
End DoDot:3
QUIT
+83 IF RESULT="NEG"
IF $EXTRACT(VALUE,1)'?.N
IF '$$NEGATIVE^BQITRUTL(VALUE)
QUIT
+84 IF RESULT="NEG"
IF $EXTRACT(VALUE,1)'?.N
IF $$NEGATIVE^BQITRUTL(VALUE)
Begin DoDot:3
+85 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$PIECE(^AUPNVLAB(LIEN,0),U,1)
SET QFL=1
End DoDot:3
+86 IF $EXTRACT(VALUE,1)'?.N
QUIT
+87 ;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
+88 IF $EXTRACT(VALUE,$LENGTH(VALUE),$LENGTH(VALUE))?.P
SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
+89 IF RES2=""
Begin DoDot:3
+90 IF @("VALUE"_OPER_"RESULT")
Begin DoDot:4
+91 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$PIECE(^AUPNVLAB(LIEN,0),U,1)
SET QFL=1
End DoDot:4
End DoDot:3
+92 IF RES2'=""
Begin DoDot:3
+93 IF @("VALUE"_OPER_"RESULT")
IF @("VALUE"_OPER2_"RES2")
Begin DoDot:4
+94 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_$PIECE(^AUPNVLAB(LIEN,0),U,1)
SET QFL=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
IF QFL
QUIT
+95 KILL @TEMP
+96 QUIT RES
+97 ;
CLN(TMFRAME,BQDFN,CLINIC) ;EP
+1 ; Find visits for a clinic code
+2 ; Input
+3 ; TMFRAME - Time frame to search data for
+4 ; BQDFN - Patient internal entry number
+5 ; CLINIC - Clinic code
+6 NEW ENDT,BCLN,IEN,QFL,RESULT
+7 SET TMFRAME=$GET(TMFRAME,"")
SET ENDT=$$DATE^BQIUL1(TMFRAME)
+8 SET BCLN=$$FIND1^DIC(40.7,"","Q",CLINIC,"C","","ERROR")
+9 SET IEN=""
SET QFL=0
SET RESULT=0
+10 IF $GET(TMFRAME)'=""
Begin DoDot:1
+11 SET EDT=9999999-ENDT
SET BDT=""
+12 FOR
SET BDT=$ORDER(^AUPNVSIT("AA",BQDFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:2
+13 SET IEN=""
+14 FOR
SET IEN=$ORDER(^AUPNVSIT("AA",BQDFN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+15 IF $$GET1^DIQ(9000010,IEN,.11,"I")=1
QUIT
+16 SET VSDTM=$$GET1^DIQ(9000010,IEN,.01,"I")\1
IF VSDTM=0
QUIT
+17 IF $$GET1^DIQ(9000010,IEN,.08,"I")=BCLN
SET QFL=1
SET RESULT=1_U_VSDTM_U_U_IEN_U
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 IF $GET(TMFRAME)=""
Begin DoDot:1
+20 FOR
SET IEN=$ORDER(^AUPNVSIT("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+21 IF $$GET1^DIQ(9000010,IEN,.11,"I")=1
QUIT
+22 SET VSDTM=$$GET1^DIQ(9000010,IEN,.01,"I")\1
IF VSDTM=0
QUIT
+23 IF $$GET1^DIQ(9000010,IEN,.08,"I")=BCLN
SET QFL=1
SET RESULT=1_U_VSDTM_U_U_IEN_U
End DoDot:2
IF QFL
QUIT
End DoDot:1
+24 QUIT RESULT
