BQITRUTL ;PRXM/HC/ALA-Treatment Prompts Utilities ; 18 May 2007 12:40 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
;
BP(TMFRAME,BQDFN,SYS,DIA,OPER) ;EP
;NonER blood pressures
;
; Input
; TMFRAME - Time frame to search data for
; BQDFN - Patient internal entry number
; SYS - The systolic value to compare against
; DIA - The diastolic value to compare against
; OPER - The operand to check the systolic and diastolic with
;
NEW BDATE,EDATE,TBP,N,CT,OK,BCLN,VIS,VALUE,VSYS,VDIA,RESULT
S TMFRAME=$G(TMFRAME,"T-60M"),RESULT=0
S BDATE=$$DATE^BQIUL1(TMFRAME),BDATE=$$FMTE^XLFDT(BDATE),EDATE=$$FMTE^XLFDT(DT)
S %=BQDFN_"^ALL MEAS BP;DURING "_BDATE_"-"_EDATE
K TBP
S E=$$START1^APCLDF(%,"TBP(")
I $G(OPER)="" D Q RESULT
. I '$D(TBP) Q
. S RESULT=1
S OPER=$G(OPER,">")
S (RESULT,N)="",(CT,OK)=0,BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
F S N=$O(TBP(N),-1) Q:N="" D Q:CT=3
. S VIS=$P(TBP(N),U,5) Q:VIS=""
. I $P($G(^AUPNVSIT(VIS,0)),U,8)=BCLN Q
. S VALUE=$P(TBP(N),U,2)
. S DATE=$P(TBP(N),U,1),IEN=$P($P(TBP(N),U,4),";",1)
. S VSYS=$P(VALUE,"/",1),VDIA=$P(VALUE,"/",2)
. I VSYS=""!(VDIA="") Q
. S CT=CT+1 I CT>3 Q
. I @(VSYS_OPER_SYS) S OK=OK+1 D FBP Q
. I @(VDIA_OPER_DIA) S OK=OK+1 D FBP Q
. D FBP
. ;I @(VSYS_OPER_SYS)!(@(VDIA_OPER_DIA)) S OK=OK+1
. ;I VSYS>SYS!(VDIA>DIA) S OK=OK+1
I OK>1 Q 1_U_RESULT
Q 0_U_$S(RESULT'="":RESULT,1:"No BPs in timeframe")
;
FBP ; Set BP variables
S $P(RESULT,U,1)=$P(RESULT,U,1)_DATE_";"
S $P(RESULT,U,2)=$P(RESULT,U,2)_IEN_";"
S $P(RESULT,U,3)=$P(RESULT,U,3)_VIS_";"
S $P(RESULT,U,4)=$P(RESULT,U,4)_VALUE_";"
Q
;
LAB(TMFRAME,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,MICRO,OVALUE,NCT
S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT
S TEMP=$NA(^TMP(UID,"BQITEMP")) K @TEMP
S TAX=$G(TAX,"")
I TAX'="" D
. S TREF=$NA(^TMP(UID,"BQITAX")),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(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 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 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
.... S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),"^",1)\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_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
.. S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),"^",1)\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_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
.. S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),"^",1)\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 @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_TIEN
;
S VSDTM="",CT=0,NCT=0
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM="" S CT=CT+1
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 TIEN=$P(@TEMP@(VSDTM,VIEN,LIEN),U,2)
. K ROPER
. S NCT=NCT+1
. I OPER="'=",RESULT=0,VALUE'="" S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN,QFL=1 Q
. I RECENT,NCT=1 D Q
.. D RCHK I 'RES Q
.. S QFL=1,RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN Q
. D RCHK
K @TEMP
Q RES
;
EDTP(GREF,SRCH) ;EP - Search for education topics and put into a passed reference
;Input
; GREF - Reference
; SRCH - Search text
;
NEW BQNM,IEN
S BQNM=""
F S BQNM=$O(^AUTTEDT("C",BQNM)) Q:BQNM="" D
. I $E(SRCH,1,1)="-" D Q
.. I BQNM'[SRCH Q
.. D EFIL
. I $E(BQNM,1,$L(SRCH))'=SRCH Q
. D EFIL
Q
;
EFIL ; File data into reference
S IEN=""
F S IEN=$O(^AUTTEDT("C",BQNM,IEN)) Q:IEN="" D
. I $P($G(^AUTTEDT(IEN,0)),U,3)=1 Q
. I $G(^AUTTEDT(IEN,0))="" Q
. S @GREF@(IEN)=$P(^AUTTEDT(IEN,0),U,1)
Q
;
MED(GREF,SRCH) ;EP
;Search for Medications
;Input
; GREF - Reference where results are to be stored
; SRCH - Value that is being searched on
NEW BQNM,IEN
S BQNM=""
F S BQNM=$O(^PSDRUG("B",BQNM)) Q:BQNM="" D
. I BQNM'[SRCH Q
. S IEN=""
. F S IEN=$O(^PSDRUG("B",BQNM,IEN)) Q:IEN="" D
.. I $G(^PSDRUG(IEN,0))="" Q
.. I $P($G(^PSDRUG(IEN,"I")),U,1)'="",$P($G(^PSDRUG(IEN,"I")),U,1)<DT Q
.. S @GREF@(IEN)=$P(^PSDRUG(IEN,0),U,1)
Q
;
POSITIVE(RESULT) ; EP
; If the result is positive return a 1 else return a 0.
I $E(RESULT,1)="+" Q 1
I $E(RESULT,1)=">" Q 1
S RESULT=$$UP^XLFSTR(RESULT)
I RESULT="P" Q 1 ; Positive
I RESULT="R" Q 1 ; Reactive
I RESULT="WR" Q 1 ; Weakly Reactive
I RESULT="REACTIVE" Q 1 ; Reactive
I RESULT="WEAKLY REACTIVE" Q 1 ; Weakly Reactive
I RESULT["POS" Q 1 ; Positive
I RESULT["NOT DETECTED" Q 0
I RESULT["NOTDETECTED" Q 0
I RESULT["DETECTED" Q 1 ; Detected
I RESULT="D" Q 1 ; Detected
Q 0
;
NEGATIVE(RESULT) ; EP
; If the result is negative return a 1 else return a 0.
I $E(RESULT,1)="-" Q 1
; **NOTE: Documentation does not specify if "<" is considered negative.
S RESULT=$$UP^XLFSTR(RESULT)
I RESULT="N" Q 1 ; Negative (or Non-Reactive)
I RESULT="NR" Q 1 ; Non-Reactive
I RESULT="NON-REACTIVE" Q 1 ; Non-Reactive
I RESULT="NON REACTIVE" Q 1 ; Non-Reactive
I RESULT="NONREACTIVE" Q 1 ; Non-Reactive
I RESULT["NON REAC" Q 1 ;non-reactive
I RESULT["NEG" Q 1 ; Negative
I RESULT["NOT DETECTED" Q 1
I RESULT["NOTDETECTED" Q 1
I RESULT["NOT DET" Q 1
Q 0
;
TAX(TMFRAME,TAX,NIT,PTDFN,FREF,PRB,SAME,TREF,START,END) ;EP
; Find value for a taxonomy (TAX) or list of taxonomies (TREF)
; Input
; TMFRAME - Timeframe to search for data
; TAX - Taxonomy
; NIT - Number of iterations
; PTDFN - Patient IEN
; FREF - File number reference
; PRB - If Active Problem okay
; SAME - If NIT is allowed for the same day or not (1 same day okay)
; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
; into reference (usually global)
; START - Starting Date
; END - Ending Date
;
NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL,SRCTYP,VFL,VALUE
S TMFRAME=$G(TMFRAME,""),NIT=$G(NIT,1),PRB=$G(PRB,0),SAME=$G(SAME,1)
S RESULT=0,TREF=$G(TREF,""),TAX=$G(TAX,"")
S START=$G(START,""),END=$G(END,"")
I $G(TMFRAME)'="" S ENDT=$$DATE^BQIUL1(TMFRAME),BDT=""
I $G(START)'=""!($G(END)'="") S ENDT=START,BDT=(9999999-END)-.001
I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
I TAX'="" D
. S TREF=$NA(^TMP(UID,"BQITAX"))
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
S GREF=$$ROOT^DILFD(FREF,"",1)
S TEMP=$NA(^TMP(UID,"BQITEMP")) K @TEMP
;
I PRB D
. S IEN="",QFL=0,RESULT=0
. F S IEN=$O(^AUPNPROB("AC",PTDFN,IEN),-1) Q:IEN="" D Q:QFL
.. ;S TIEN=$$GET1^DIQ(9000011,IEN,.01,"I") I TIEN="" Q
.. S TIEN=$P($G(^AUPNPROB(IEN,0)),"^",1) I TIEN="" Q
.. I '$D(@TREF@(TIEN)) Q
.. ; Check class - if Family ignore
.. ;I $$GET1^DIQ(9000011,IEN,.04,"I")="F" Q
.. I $P($G(^AUPNPROB(IEN,0)),"^",4)="F" Q
.. I $P($G(^AUPNPROB(IEN,0)),"^",12)'="A" Q
.. ;I $$GET1^DIQ(9000011,IEN,.12,"I")'="A" Q
.. S VSDTM=$$PROB^BQIUL1(IEN)\1 Q:VSDTM=0
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=1_U_VSDTM,$P(RESULT,U,4)=IEN,QFL=1
;
I 'RESULT D
. S IEN="",QFL=0,RESULT=0,CT=0
. D
.. I $G(TMFRAME)="",$G(START)="",$G(END)="" Q
.. S VFL=$O(^BQI(90508.6,"B",FREF,""))
.. I VFL'="" S SRCTYP=$P(^BQI(90508.6,VFL,0),U,3)
.. S EDT=9999999-ENDT
.. I SRCTYP'=2 D Q
... F S BDT=$O(@GREF@("AA",PTDFN,BDT)) Q:BDT=""!(BDT>EDT) D
.... S IEN=""
.... F S IEN=$O(@GREF@("AA",PTDFN,BDT,IEN)) Q:IEN="" D
..... 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 Q:VSDTM=0
..... S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
..... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
..... S VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
..... ; Set temporary
..... S @TEMP@(VSDTM,VISIT,IEN)=VALUE
.. S TIEN=""
.. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
... I $G(TMFRAME)'="" S ENDT=$$DATE^BQIUL1(TMFRAME),BDT=""
... I $G(START)'=""!($G(END)'="") S ENDT=START,BDT=(9999999-END)-.001
... F S BDT=$O(@GREF@("AA",PTDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
.... S IEN=""
.... F S IEN=$O(@GREF@("AA",PTDFN,TIEN,BDT,IEN)) Q:IEN="" D
..... 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 Q:VSDTM=0
..... S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
..... S VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
..... S @TEMP@(VSDTM,VISIT,IEN)=VALUE
. ;
. I $G(TMFRAME)="" D
.. I $G(START)'="",$G(END)'="" Q
.. F S IEN=$O(@GREF@("AC",PTDFN,IEN),-1) Q:IEN="" D
... 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
... I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q
... ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
... S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
... S VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
... ; Set temporary
... S @TEMP@(VSDTM,VISIT,IEN)=VALUE
;
S VSDTM="",QFL=0
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM=""!(QFL) D
. S VISIT=""
. F S VISIT=$O(@TEMP@(VSDTM,VISIT),-1) Q:VISIT="" D Q:QFL
.. S IEN=""
.. F S IEN=$O(@TEMP@(VSDTM,VISIT,IEN),-1) Q:IEN="" D Q:QFL
... ; If result cannot be on the same day, quit
... I 'SAME,$P(RESULT,U,2)=VSDTM Q
... S VALUE=@TEMP@(VSDTM,VISIT,IEN)
... S CT=CT+1
... I $P(RESULT,U,2)'="",(CT'>NIT) D
.... S $P(RESULT,U,2)=$P(RESULT,U,2)_";"_VSDTM
.... S $P(RESULT,U,4)=$P(RESULT,U,4)_";"_VISIT
.... S $P(RESULT,U,5)=$P(RESULT,U,5)_";"_IEN
.... S $P(RESULT,U,6)=$P(RESULT,U,6)_";"_VALUE
... I $P(RESULT,U,2)="" S $P(RESULT,U,2)=VSDTM,$P(RESULT,U,4)=VISIT_U_IEN,$P(RESULT,U,6)=VALUE
... ;S $P(RESULT,U,4)=VISIT_U_IEN,CT=CT+1
... ;S RESULT=U_VSDTM_U_U_VISIT_U_IEN,CT=CT+1
... I CT=NIT S QFL=1,$P(RESULT,U,1)=1
K @TREF
Q RESULT
;
FED(TMFRAME,BQDFN,TOP) ;EP
; Find visits for a topic
; Input
; TMFRAME - Time frame to search data for
; BQDFN - Patient internal entry number
; TOP - Education Topic
NEW BQITOP,ARRAY,FREF,GREF,ENDT,IEN,QFL,RESULT,EDT,BDT,TIEN,VISIT,VSDTM
S TMFRAME=$G(TMFRAME,"")
S ARRAY="BQITOP",FREF=9000010.16,GREF=$$ROOT^DILFD(FREF,"",1)
D EDTP(.ARRAY,TOP)
S ENDT=$$DATE^BQIUL1(TMFRAME)
S IEN="",QFL=0,RESULT=0
I $G(TMFRAME)'="" D
. S EDT=9999999-ENDT,BDT=""
. F S BDT=$O(@GREF@("AA",BQDFN,BDT)) Q:BDT=""!(BDT>EDT) D
.. S IEN=""
.. F S IEN=$O(@GREF@("AA",BQDFN,BDT,IEN)) Q:IEN="" D
... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
... I '$D(BQITOP(TIEN)) Q
... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
... ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
... I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q
... ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
... S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
... S RESULT=1_U_VSDTM_U_U_VISIT_U_IEN,QFL=1
;
I $G(TMFRAME)="" D
. 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(BQITOP(TIEN)) Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.. ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q
.. ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
.. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
.. ;I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=1_U_VSDTM_U_U_VISIT_U_IEN,QFL=1
Q RESULT
;
RCHK ;EP - Result check
I RESULT'?.N,VALUE?.N Q
;
I RESULT="POS",$E(VALUE,1)'?.N,'$$POSITIVE(VALUE) Q
I RESULT="POS",$E(VALUE,1)'?.N,$$POSITIVE(VALUE) D Q
. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN,QFL=1
I RESULT="NEG",$E(VALUE,1)'?.N,'$$NEGATIVE(VALUE) Q
I RESULT="NEG",$E(VALUE,1)'?.N,$$NEGATIVE(VALUE) D
. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN,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 RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN,QFL=1
. I $G(ROPER)'="",OPER=ROPER,@("VALUE"_OPER_"RESULT") D Q
.. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN,QFL=1
. I $G(ROPER)'="",OPER'=ROPER Q
I RES2'="" D
. I @("VALUE"_OPER_"RESULT"),@("VALUE"_OPER2_"RES2") D
.. S RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN,QFL=1
Q
BQITRUTL ;PRXM/HC/ALA-Treatment Prompts Utilities ; 18 May 2007 12:40 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
+2 ;
BP(TMFRAME,BQDFN,SYS,DIA,OPER) ;EP
+1 ;NonER blood pressures
+2 ;
+3 ; Input
+4 ; TMFRAME - Time frame to search data for
+5 ; BQDFN - Patient internal entry number
+6 ; SYS - The systolic value to compare against
+7 ; DIA - The diastolic value to compare against
+8 ; OPER - The operand to check the systolic and diastolic with
+9 ;
+10 NEW BDATE,EDATE,TBP,N,CT,OK,BCLN,VIS,VALUE,VSYS,VDIA,RESULT
+11 SET TMFRAME=$GET(TMFRAME,"T-60M")
SET RESULT=0
+12 SET BDATE=$$DATE^BQIUL1(TMFRAME)
SET BDATE=$$FMTE^XLFDT(BDATE)
SET EDATE=$$FMTE^XLFDT(DT)
+13 SET %=BQDFN_"^ALL MEAS BP;DURING "_BDATE_"-"_EDATE
+14 KILL TBP
+15 SET E=$$START1^APCLDF(%,"TBP(")
+16 IF $GET(OPER)=""
Begin DoDot:1
+17 IF '$DATA(TBP)
QUIT
+18 SET RESULT=1
End DoDot:1
QUIT RESULT
+19 SET OPER=$GET(OPER,">")
+20 SET (RESULT,N)=""
SET (CT,OK)=0
SET BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
+21 FOR
SET N=$ORDER(TBP(N),-1)
IF N=""
QUIT
Begin DoDot:1
+22 SET VIS=$PIECE(TBP(N),U,5)
IF VIS=""
QUIT
+23 IF $PIECE($GET(^AUPNVSIT(VIS,0)),U,8)=BCLN
QUIT
+24 SET VALUE=$PIECE(TBP(N),U,2)
+25 SET DATE=$PIECE(TBP(N),U,1)
SET IEN=$PIECE($PIECE(TBP(N),U,4),";",1)
+26 SET VSYS=$PIECE(VALUE,"/",1)
SET VDIA=$PIECE(VALUE,"/",2)
+27 IF VSYS=""!(VDIA="")
QUIT
+28 SET CT=CT+1
IF CT>3
QUIT
+29 IF @(VSYS_OPER_SYS)
SET OK=OK+1
DO FBP
QUIT
+30 IF @(VDIA_OPER_DIA)
SET OK=OK+1
DO FBP
QUIT
+31 DO FBP
+32 ;I @(VSYS_OPER_SYS)!(@(VDIA_OPER_DIA)) S OK=OK+1
+33 ;I VSYS>SYS!(VDIA>DIA) S OK=OK+1
End DoDot:1
IF CT=3
QUIT
+34 IF OK>1
QUIT 1_U_RESULT
+35 QUIT 0_U_$SELECT(RESULT'="":RESULT,1:"No BPs in timeframe")
+36 ;
FBP ; Set BP variables
+1 SET $PIECE(RESULT,U,1)=$PIECE(RESULT,U,1)_DATE_";"
+2 SET $PIECE(RESULT,U,2)=$PIECE(RESULT,U,2)_IEN_";"
+3 SET $PIECE(RESULT,U,3)=$PIECE(RESULT,U,3)_VIS_";"
+4 SET $PIECE(RESULT,U,4)=$PIECE(RESULT,U,4)_VALUE_";"
+5 QUIT
+6 ;
LAB(TMFRAME,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,MICRO,OVALUE,NCT
+16 SET BDATE=$$DATE^BQIUL1(TMFRAME)
SET EDATE=DT
+17 SET TEMP=$NAME(^TMP(UID,"BQITEMP"))
KILL @TEMP
+18 SET TAX=$GET(TAX,"")
+19 IF TAX'=""
Begin DoDot:1
+20 SET TREF=$NAME(^TMP(UID,"BQITAX"))
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(TMFRAME)'=""
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 FLAG=$PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)
IF FLAG=""
QUIT
+36 IF FLAG'="R"&(FLAG'="M")
QUIT
+37 ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
+38 SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)\1
IF VSDTM=0
QUIT
+39 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
+40 ; quit if deleted flag
+41 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+42 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+43 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_TIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+44 ;
+45 IF $GET(TMFRAME)=""
Begin DoDot:1
+46 SET LIEN=""
+47 FOR
SET LIEN=$ORDER(^AUPNVLAB("AC",BQDFN,LIEN),-1)
IF LIEN=""
QUIT
Begin DoDot:2
+48 SET TIEN=$PIECE($GET(^AUPNVLAB(LIEN,0)),U,1)
IF TIEN=""
QUIT
+49 IF '$DATA(@TREF@(TIEN))
QUIT
+50 SET VALUE=$PIECE(^AUPNVLAB(LIEN,0),U,4)
IF VALUE=""
QUIT
+51 SET VIEN=$PIECE(^AUPNVLAB(LIEN,0),U,3)
IF VIEN=""
QUIT
+52 ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
+53 SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)\1
IF VSDTM=0
QUIT
+54 ;I $G(TMFRAME)'="",VSDTM<BDATE Q
+55 ; quit if deleted flag
+56 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+57 IF $PIECE($GET(^AUPNVLAB(LIEN,11)),U,9)="D"
QUIT
+58 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_TIEN
End DoDot:2
+59 FOR
SET LIEN=$ORDER(^AUPNVMIC("AC",BQDFN,LIEN),-1)
IF LIEN=""
QUIT
Begin DoDot:2
+60 SET TIEN=$PIECE($GET(^AUPNVMIC(LIEN,0)),U,1)
IF TIEN=""
QUIT
+61 IF '$DATA(@TREF@(TIEN))
QUIT
+62 SET VALUE=$PIECE(^AUPNVMIC(LIEN,0),U,7)
IF VALUE=""
QUIT
+63 SET VIEN=$PIECE(^AUPNVMIC(LIEN,0),U,3)
IF VIEN=""
QUIT
+64 ;S VSDTM=$$GET1^DIQ(9000010,VIEN_",",.01,"I")\1 I VSDTM=0 Q
+65 SET VSDTM=$PIECE($GET(^AUPNVSIT(VIEN,0)),"^",1)\1
IF VSDTM=0
QUIT
+66 ; quit if deleted flag
+67 IF $PIECE($GET(^AUPNVSIT(VIEN,0)),U,11)=1
QUIT
+68 IF $PIECE($GET(^AUPNVMIC(LIEN,11)),U,9)="D"
QUIT
+69 SET @TEMP@(VSDTM,VIEN,LIEN)=VALUE_U_TIEN
End DoDot:2
End DoDot:1
+70 ;
+71 SET VSDTM=""
SET CT=0
SET NCT=0
+72 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""
QUIT
SET CT=CT+1
+73 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""
QUIT
Begin DoDot:1
+74 SET VIEN=$ORDER(@TEMP@(VSDTM,""),-1)
+75 SET LIEN=$ORDER(@TEMP@(VSDTM,VIEN,""),-1)
+76 SET VALUE=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,1)
SET OVALUE=VALUE
+77 SET TIEN=$PIECE(@TEMP@(VSDTM,VIEN,LIEN),U,2)
+78 KILL ROPER
+79 SET NCT=NCT+1
+80 IF OPER="'="
IF RESULT=0
IF VALUE'=""
SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN
SET QFL=1
QUIT
+81 IF RECENT
IF NCT=1
Begin DoDot:2
+82 DO RCHK
IF 'RES
QUIT
+83 SET QFL=1
SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN
QUIT
End DoDot:2
QUIT
+84 DO RCHK
End DoDot:1
IF QFL
QUIT
+85 KILL @TEMP
+86 QUIT RES
+87 ;
EDTP(GREF,SRCH) ;EP - Search for education topics and put into a passed reference
+1 ;Input
+2 ; GREF - Reference
+3 ; SRCH - Search text
+4 ;
+5 NEW BQNM,IEN
+6 SET BQNM=""
+7 FOR
SET BQNM=$ORDER(^AUTTEDT("C",BQNM))
IF BQNM=""
QUIT
Begin DoDot:1
+8 IF $EXTRACT(SRCH,1,1)="-"
Begin DoDot:2
+9 IF BQNM'[SRCH
QUIT
+10 DO EFIL
End DoDot:2
QUIT
+11 IF $EXTRACT(BQNM,1,$LENGTH(SRCH))'=SRCH
QUIT
+12 DO EFIL
End DoDot:1
+13 QUIT
+14 ;
EFIL ; File data into reference
+1 SET IEN=""
+2 FOR
SET IEN=$ORDER(^AUTTEDT("C",BQNM,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^AUTTEDT(IEN,0)),U,3)=1
QUIT
+4 IF $GET(^AUTTEDT(IEN,0))=""
QUIT
+5 SET @GREF@(IEN)=$PIECE(^AUTTEDT(IEN,0),U,1)
End DoDot:1
+6 QUIT
+7 ;
MED(GREF,SRCH) ;EP
+1 ;Search for Medications
+2 ;Input
+3 ; GREF - Reference where results are to be stored
+4 ; SRCH - Value that is being searched on
+5 NEW BQNM,IEN
+6 SET BQNM=""
+7 FOR
SET BQNM=$ORDER(^PSDRUG("B",BQNM))
IF BQNM=""
QUIT
Begin DoDot:1
+8 IF BQNM'[SRCH
QUIT
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^PSDRUG("B",BQNM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+11 IF $GET(^PSDRUG(IEN,0))=""
QUIT
+12 IF $PIECE($GET(^PSDRUG(IEN,"I")),U,1)'=""
IF $PIECE($GET(^PSDRUG(IEN,"I")),U,1)<DT
QUIT
+13 SET @GREF@(IEN)=$PIECE(^PSDRUG(IEN,0),U,1)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
POSITIVE(RESULT) ; EP
+1 ; If the result is positive return a 1 else return a 0.
+2 IF $EXTRACT(RESULT,1)="+"
QUIT 1
+3 IF $EXTRACT(RESULT,1)=">"
QUIT 1
+4 SET RESULT=$$UP^XLFSTR(RESULT)
+5 ; Positive
IF RESULT="P"
QUIT 1
+6 ; Reactive
IF RESULT="R"
QUIT 1
+7 ; Weakly Reactive
IF RESULT="WR"
QUIT 1
+8 ; Reactive
IF RESULT="REACTIVE"
QUIT 1
+9 ; Weakly Reactive
IF RESULT="WEAKLY REACTIVE"
QUIT 1
+10 ; Positive
IF RESULT["POS"
QUIT 1
+11 IF RESULT["NOT DETECTED"
QUIT 0
+12 IF RESULT["NOTDETECTED"
QUIT 0
+13 ; Detected
IF RESULT["DETECTED"
QUIT 1
+14 ; Detected
IF RESULT="D"
QUIT 1
+15 QUIT 0
+16 ;
NEGATIVE(RESULT) ; EP
+1 ; If the result is negative return a 1 else return a 0.
+2 IF $EXTRACT(RESULT,1)="-"
QUIT 1
+3 ; **NOTE: Documentation does not specify if "<" is considered negative.
+4 SET RESULT=$$UP^XLFSTR(RESULT)
+5 ; Negative (or Non-Reactive)
IF RESULT="N"
QUIT 1
+6 ; Non-Reactive
IF RESULT="NR"
QUIT 1
+7 ; Non-Reactive
IF RESULT="NON-REACTIVE"
QUIT 1
+8 ; Non-Reactive
IF RESULT="NON REACTIVE"
QUIT 1
+9 ; Non-Reactive
IF RESULT="NONREACTIVE"
QUIT 1
+10 ;non-reactive
IF RESULT["NON REAC"
QUIT 1
+11 ; Negative
IF RESULT["NEG"
QUIT 1
+12 IF RESULT["NOT DETECTED"
QUIT 1
+13 IF RESULT["NOTDETECTED"
QUIT 1
+14 IF RESULT["NOT DET"
QUIT 1
+15 QUIT 0
+16 ;
TAX(TMFRAME,TAX,NIT,PTDFN,FREF,PRB,SAME,TREF,START,END) ;EP
+1 ; Find value for a taxonomy (TAX) or list of taxonomies (TREF)
+2 ; Input
+3 ; TMFRAME - Timeframe to search for data
+4 ; TAX - Taxonomy
+5 ; NIT - Number of iterations
+6 ; PTDFN - Patient IEN
+7 ; FREF - File number reference
+8 ; PRB - If Active Problem okay
+9 ; SAME - If NIT is allowed for the same day or not (1 same day okay)
+10 ; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
+11 ; into reference (usually global)
+12 ; START - Starting Date
+13 ; END - Ending Date
+14 ;
+15 NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL,SRCTYP,VFL,VALUE
+16 SET TMFRAME=$GET(TMFRAME,"")
SET NIT=$GET(NIT,1)
SET PRB=$GET(PRB,0)
SET SAME=$GET(SAME,1)
+17 SET RESULT=0
SET TREF=$GET(TREF,"")
SET TAX=$GET(TAX,"")
+18 SET START=$GET(START,"")
SET END=$GET(END,"")
+19 IF $GET(TMFRAME)'=""
SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET BDT=""
+20 IF $GET(START)'=""!($GET(END)'="")
SET ENDT=START
SET BDT=(9999999-END)-.001
+21 IF $GET(UID)=""
SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+22 IF TAX'=""
Begin DoDot:1
+23 SET TREF=$NAME(^TMP(UID,"BQITAX"))
+24 KILL @TREF
+25 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+26 SET GREF=$$ROOT^DILFD(FREF,"",1)
+27 SET TEMP=$NAME(^TMP(UID,"BQITEMP"))
KILL @TEMP
+28 ;
+29 IF PRB
Begin DoDot:1
+30 SET IEN=""
SET QFL=0
SET RESULT=0
+31 FOR
SET IEN=$ORDER(^AUPNPROB("AC",PTDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+32 ;S TIEN=$$GET1^DIQ(9000011,IEN,.01,"I") I TIEN="" Q
+33 SET TIEN=$PIECE($GET(^AUPNPROB(IEN,0)),"^",1)
IF TIEN=""
QUIT
+34 IF '$DATA(@TREF@(TIEN))
QUIT
+35 ; Check class - if Family ignore
+36 ;I $$GET1^DIQ(9000011,IEN,.04,"I")="F" Q
+37 IF $PIECE($GET(^AUPNPROB(IEN,0)),"^",4)="F"
QUIT
+38 IF $PIECE($GET(^AUPNPROB(IEN,0)),"^",12)'="A"
QUIT
+39 ;I $$GET1^DIQ(9000011,IEN,.12,"I")'="A" Q
+40 SET VSDTM=$$PROB^BQIUL1(IEN)\1
IF VSDTM=0
QUIT
+41 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+42 SET RESULT=1_U_VSDTM
SET $PIECE(RESULT,U,4)=IEN
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+43 ;
+44 IF 'RESULT
Begin DoDot:1
+45 SET IEN=""
SET QFL=0
SET RESULT=0
SET CT=0
+46 Begin DoDot:2
+47 IF $GET(TMFRAME)=""
IF $GET(START)=""
IF $GET(END)=""
QUIT
+48 SET VFL=$ORDER(^BQI(90508.6,"B",FREF,""))
+49 IF VFL'=""
SET SRCTYP=$PIECE(^BQI(90508.6,VFL,0),U,3)
+50 SET EDT=9999999-ENDT
+51 IF SRCTYP'=2
Begin DoDot:3
+52 FOR
SET BDT=$ORDER(@GREF@("AA",PTDFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:4
+53 SET IEN=""
+54 FOR
SET IEN=$ORDER(@GREF@("AA",PTDFN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:5
+55 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+56 IF '$DATA(@TREF@(TIEN))
QUIT
+57 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+58 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+59 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
+60 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+61 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
+62 SET VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
+63 ; Set temporary
+64 SET @TEMP@(VSDTM,VISIT,IEN)=VALUE
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
+65 SET TIEN=""
+66 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+67 IF $GET(TMFRAME)'=""
SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET BDT=""
+68 IF $GET(START)'=""!($GET(END)'="")
SET ENDT=START
SET BDT=(9999999-END)-.001
+69 FOR
SET BDT=$ORDER(@GREF@("AA",PTDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:4
+70 SET IEN=""
+71 FOR
SET IEN=$ORDER(@GREF@("AA",PTDFN,TIEN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:5
+72 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+73 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+74 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
+75 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+76 SET VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
+77 SET @TEMP@(VSDTM,VISIT,IEN)=VALUE
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+78 ;
+79 IF $GET(TMFRAME)=""
Begin DoDot:2
+80 IF $GET(START)'=""
IF $GET(END)'=""
QUIT
+81 FOR
SET IEN=$ORDER(@GREF@("AC",PTDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+82 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+83 IF '$DATA(@TREF@(TIEN))
QUIT
+84 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+85 ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
+86 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1
QUIT
+87 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
+88 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+89 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
+90 SET VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
+91 ; Set temporary
+92 SET @TEMP@(VSDTM,VISIT,IEN)=VALUE
End DoDot:3
End DoDot:2
End DoDot:1
+93 ;
+94 SET VSDTM=""
SET QFL=0
+95 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""!(QFL)
QUIT
Begin DoDot:1
+96 SET VISIT=""
+97 FOR
SET VISIT=$ORDER(@TEMP@(VSDTM,VISIT),-1)
IF VISIT=""
QUIT
Begin DoDot:2
+98 SET IEN=""
+99 FOR
SET IEN=$ORDER(@TEMP@(VSDTM,VISIT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+100 ; If result cannot be on the same day, quit
+101 IF 'SAME
IF $PIECE(RESULT,U,2)=VSDTM
QUIT
+102 SET VALUE=@TEMP@(VSDTM,VISIT,IEN)
+103 SET CT=CT+1
+104 IF $PIECE(RESULT,U,2)'=""
IF (CT'>NIT)
Begin DoDot:4
+105 SET $PIECE(RESULT,U,2)=$PIECE(RESULT,U,2)_";"_VSDTM
+106 SET $PIECE(RESULT,U,4)=$PIECE(RESULT,U,4)_";"_VISIT
+107 SET $PIECE(RESULT,U,5)=$PIECE(RESULT,U,5)_";"_IEN
+108 SET $PIECE(RESULT,U,6)=$PIECE(RESULT,U,6)_";"_VALUE
End DoDot:4
+109 IF $PIECE(RESULT,U,2)=""
SET $PIECE(RESULT,U,2)=VSDTM
SET $PIECE(RESULT,U,4)=VISIT_U_IEN
SET $PIECE(RESULT,U,6)=VALUE
+110 ;S $P(RESULT,U,4)=VISIT_U_IEN,CT=CT+1
+111 ;S RESULT=U_VSDTM_U_U_VISIT_U_IEN,CT=CT+1
+112 IF CT=NIT
SET QFL=1
SET $PIECE(RESULT,U,1)=1
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+113 KILL @TREF
+114 QUIT RESULT
+115 ;
FED(TMFRAME,BQDFN,TOP) ;EP
+1 ; Find visits for a topic
+2 ; Input
+3 ; TMFRAME - Time frame to search data for
+4 ; BQDFN - Patient internal entry number
+5 ; TOP - Education Topic
+6 NEW BQITOP,ARRAY,FREF,GREF,ENDT,IEN,QFL,RESULT,EDT,BDT,TIEN,VISIT,VSDTM
+7 SET TMFRAME=$GET(TMFRAME,"")
+8 SET ARRAY="BQITOP"
SET FREF=9000010.16
SET GREF=$$ROOT^DILFD(FREF,"",1)
+9 DO EDTP(.ARRAY,TOP)
+10 SET ENDT=$$DATE^BQIUL1(TMFRAME)
+11 SET IEN=""
SET QFL=0
SET RESULT=0
+12 IF $GET(TMFRAME)'=""
Begin DoDot:1
+13 SET EDT=9999999-ENDT
SET BDT=""
+14 FOR
SET BDT=$ORDER(@GREF@("AA",BQDFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:2
+15 SET IEN=""
+16 FOR
SET IEN=$ORDER(@GREF@("AA",BQDFN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+17 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+18 IF '$DATA(BQITOP(TIEN))
QUIT
+19 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+20 ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
+21 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1
QUIT
+22 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
+23 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+24 SET RESULT=1_U_VSDTM_U_U_VISIT_U_IEN
SET QFL=1
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 IF $GET(TMFRAME)=""
Begin DoDot:1
+27 FOR
SET IEN=$ORDER(@GREF@("AC",BQDFN,IEN),-1)
IF 'IEN
QUIT
Begin DoDot:2
+28 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+29 IF '$DATA(BQITOP(TIEN))
QUIT
+30 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+31 ;I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
+32 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1
QUIT
+33 ;S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
+34 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+35 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
+36 SET RESULT=1_U_VSDTM_U_U_VISIT_U_IEN
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+37 QUIT RESULT
+38 ;
RCHK ;EP - Result check
+1 IF RESULT'?.N
IF VALUE?.N
QUIT
+2 ;
+3 IF RESULT="POS"
IF $EXTRACT(VALUE,1)'?.N
IF '$$POSITIVE(VALUE)
QUIT
+4 IF RESULT="POS"
IF $EXTRACT(VALUE,1)'?.N
IF $$POSITIVE(VALUE)
Begin DoDot:1
+5 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN
SET QFL=1
End DoDot:1
QUIT
+6 IF RESULT="NEG"
IF $EXTRACT(VALUE,1)'?.N
IF '$$NEGATIVE(VALUE)
QUIT
+7 IF RESULT="NEG"
IF $EXTRACT(VALUE,1)'?.N
IF $$NEGATIVE(VALUE)
Begin DoDot:1
+8 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_VALUE_U_VIEN_U_LIEN_U_TIEN
SET QFL=1
End DoDot:1
+9 IF VALUE'?.PN
IF VALUE'?.N
QUIT
+10 ;I $E(VALUE,$L(VALUE))?.P S VALUE=VALUE_"0"
+11 IF $EXTRACT(VALUE,$LENGTH(VALUE),$LENGTH(VALUE))?.P
SET VALUE=$EXTRACT(VALUE,1,$LENGTH(VALUE)-1)
+12 ; if value starts with a punctuation e.g. < or >
+13 IF $EXTRACT(VALUE,1,1)?.P
SET ROPER=$EXTRACT(VALUE,1,1)
SET VALUE=$EXTRACT(VALUE,2,$LENGTH(VALUE))
+14 IF RES2=""
Begin DoDot:1
+15 IF $GET(ROPER)=""
IF @("VALUE"_OPER_"RESULT")
Begin DoDot:2
+16 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN
SET QFL=1
End DoDot:2
QUIT
+17 IF $GET(ROPER)'=""
IF OPER=ROPER
IF @("VALUE"_OPER_"RESULT")
Begin DoDot:2
+18 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN
SET QFL=1
End DoDot:2
QUIT
+19 IF $GET(ROPER)'=""
IF OPER'=ROPER
QUIT
End DoDot:1
+20 IF RES2'=""
Begin DoDot:1
+21 IF @("VALUE"_OPER_"RESULT")
IF @("VALUE"_OPER2_"RES2")
Begin DoDot:2
+22 SET RES=1_U_$$FMTE^BQIUL1(VSDTM)_U_OVALUE_U_VIEN_U_LIEN_U_TIEN
SET QFL=1
End DoDot:2
End DoDot:1
+23 QUIT
