BTIUPCC6 ; IHS/ITSC/LJF - IHS PCC OBJECTS ;15-Dec-2015 15:40;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1006,1012,1013,1015,1015,1016**;NOV 04, 2004;Build 10
BMI(DFN,TIUCAP,NUM) ;EP -- returns BMI based on last ht and wt
; TIUCAP=1 if caption with measurement name is to be returned
N VTWT,VTHT,RSWT,RSHT,BMI,WTDT,RMAX,X,IDT,HNUM,START,END,WNUM,IDATE,RCNT,DATE,WTDT,RESULT,LINE,APCHMDT
;S VTWT=$$VTYPE("WT"),VTHT=$$VTYPE("HT")
S TIUCAP=$G(TIUCAP)
S VTWT=$$VTYPE("BMI")
K ^TMP("BTIUVM",$J),^TMP("BTIUPCC",$J)
I '$D(NUM) S NUM=1
S WNUM=NUM+2,HNUM=NUM+10,RMAX=NUM
S START=DT+1,END=0
S:START<END X=START,START=END,END=X
S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
S RCNT=0,IDT=START
;PCTILE=+G(PCTILE)
;D BLDXRF(VTWT,NUM),BLDXRF(VTHT,NUM)
D BLDXRF(VTWT,NUM)
F Q:'IDT!(RCNT=RMAX) D
.S VIEN=$C(1)
.F S VIEN=$O(^TMP("BTIUVM",$J,VTWT,IDT,VIEN),-1) Q:'VIEN D Q:RCNT=RMAX
..D GETMSR(VIEN,.BMI,.DATE,.LOC,.ENTERBY)
..;IHS/MSC/MGH Save the wt date to use if the ht isn't too old patch 4
..;S WTDT=DATE
..;S RSHT=$$FNDHT(IDT)
..;Q:'RSHT
..;S RSWT=RSWT*.45359,RSHT=RSHT*.0254,RSHT=RSHT*RSHT,BMI=+$J(RSWT/RSHT,0,2)
..;S:PCTILE BMI=$$BMIPCT(BMI,DFN,DATE)
..;Q:'BMI
..S RESULT(IDT)=$J(BMI,5,2),RCNT=RCNT+1
..;S DATE=WTDT
.S IDT=$O(^TMP("BTIUVM",$J,VTWT,IDT))
S CNT=0
S IDATE="" F S IDATE=$O(RESULT(IDATE)) Q:IDATE=""!(CNT>NUM) D
.S BMI=$G(RESULT(IDATE))
.S DATE=9999999-IDATE
.I $$PREG^BTIUPCC6(DFN,"",VIEN)=1 S BMI=BMI_"*"
.S DATE=$$FMTE^XLFDT(DATE)
.S CNT=CNT+1
.S LINE=BMI_" ("_$P(DATE,"@",1)_")"
.I TIUCAP S Y=$S(CNT=1:"BMI:",1:$$SP(4)) S LINE=Y_" "_LINE
.S ^TMP("BTIUPCC",$J,CNT,0)=LINE
I '$D(^TMP("BTIUPCC",$J)) Q "No bmi stored"
Q "~@^TMP(""BTIUPCC"",$J)"
FNDHT(IDT) ;Find closest height before weight
N VIEN,RESULT,DOB,SEX,TAGE,X2,X1,SX
S VIEN=$O(^TMP("BTIUVM",$J,VTHT,IDT,""))
I 'VIEN D
.;IHS/MSC/MGH Added in HS logic for lookback days for ht. Patch 4
.N ID1,ID2,GOOD
.S DOB=$P(^DPT(DFN,0),U,3),X2=DOB,X1=DT D ^%DTC S TAGE=X
.S ID1=$O(^TMP("BTIUVM",$J,VTHT,IDT),-1),ID2=$O(^TMP("BTIUVM",$J,VTHT,IDT))
.I ID1 D
..S X1=$P(ID1,".",1),X2=$P(IDT,".",1)
..I X1=X2 S ID2=ID1
.I ID2 D
..S X1=9999999-(ID2\1)
..S APCHMDT=$$FMDIFF^XLFDT(X1,DOB,1)
..S X1=9999999-(IDT\1),X2=9999999-ID2
..S X=$$FMDIFF^XLFDT(X1,X2,1)
..I ((X>90)&(APCHMDT<1096))!((X>180)&(APCHMDT<4381))!((X>365)&(APCHMDT<6571))!((APCHMDT<6571)&(TAGE>6571)) S ID2=""
..S:ID2 VIEN=$O(^TMP("BTIUVM",$J,VTHT,ID2,""))
D:VIEN GETMSR(VIEN,.RESULT)
Q $G(RESULT)
GETMSR(VIEN,RESULT,DATE,LOC,ENTERBY) ;
N X,X12
S X=$G(^AUPNVMSR(VIEN,0)),X12=$G(^(12))
S DATE=+X12,ENTERBY=+$P(X12,U,4)
S RESULT=$$TRIM^XLFSTR($P(X,U,4)),X=+$P(X,U,3)
S X=$G(^AUPNVSIT(X,0))
S:'DATE DATE=+X
S LOC=+$P(X,U,22),DATE(0)=DATE*10000\1/10000
Q
; Build temp xref for measurement type
BLDXRF(VTYP,VNUM) ;
N X,Y,Z,CNT
S X=0
K ^TMP("BTIUVM",$J,VTYP)
S CNT=0
F S X=$O(^AUPNVMSR("AA",DFN,VTYP,X)),VIEN=0 Q:'X!(CNT>VNUM) D
.F S VIEN=$O(^AUPNVMSR("AA",DFN,VTYP,X,VIEN)) Q:'VIEN D
..S Z=$G(^AUPNVMSR(VIEN,0)),Y=+$G(^(12)),Y=$S(Y:9999999-Y,1:X)
..Q:+Z'=VTYP
..Q:$P(Z,U,2)'=DFN
..S CNT=CNT+1
..S ^TMP("BTIUVM",$J,VTYP,Y,VIEN)=""
Q
VTYPE(X,VMSR) ;
N FNUM
S:'$D(VMSR) VMSR=$$VMSR
S FNUM=$S(VMSR:9999999.07,1:120.51)
Q +$$FIND1^DIC(FNUM,"","X",$$UP^XLFSTR(X),"B^"_$S(VMSR:"D",1:"APCE^C"))
PREG(DFN,VIEN,VMIEN) ;Determine if BMI is for pregnant patient
;Patch 1015 went back to using the ATX API after changes made
N DOB,X1,X1,TAGE,POV,CODE,TAX,RET,ARRAY
S RET=0
S VMIEN=$G(VMIEN),VIEN=$G(VIEN)
I $$GET1^DIQ(2,DFN,.02,"I")'="F" Q RET ;Wrong sex
S TAGE=$$GET1^DIQ(2,DFN,.033)
I TAGE<10!(TAGE>50) Q RET ;Wrong age
;Find POVs on this visit and check if they are pregnancy POVs
I VIEN="" D
.S VIEN=$$GET1^DIQ(9000010.01,VMIEN,.03,"I")
I '+VIEN Q RET
S TAX=$O(^ATXAX("B","BQI PREGNANCY DXS",0))
S POV="" F S POV=$O(^AUPNVPOV("AD",VIEN,POV)) Q:POV=""!(RET=1) D
.S CODE=$$GET1^DIQ(9000010.07,POV,.01,"I")
.I CODE="" Q
.S RET=$$ICD^ATXAPI(CODE,TAX,9)
Q RET
EXAMCMT(DFN,TARGET,CODE) ; Returns the last exam with comments
NEW EXAM,DATE,RESULT,N,SUB,CNT,MAXLEN,COMM,TXT2,SUBCOUNT,SUBLINE
K @TARGET
S MAXLEN=60,CNT=0
S SUB=$S($L(CODE)=2:"C",1:"B") ;was code or name sent
S EXAM=$O(^AUTTEXAM(SUB,CODE,0)) I EXAM="" Q ""
S DATE=$O(^AUPNVXAM("AA",+$G(DFN),EXAM,0)) I DATE="" Q "None Found"
S RESULT="Date: "_$$FMTE^XLFDT(9999999-DATE,"D")
S N=$O(^AUPNVXAM("AA",DFN,EXAM,DATE,0)) I 'N Q RESULT_" Results: No Results"
S CNT=CNT+1
S @TARGET@(CNT,0)=RESULT_" Results: "_$$GET1^DIQ(9000010.13,N,.04)
S COMM=$$GET1^DIQ(9000010.13,N,81101)
I $L(COMM)>MAXLEN D
.S TXT2=$$WRAP^TIULS(COMM,MAXLEN)
.F SUBCOUNT=1:1 S SUBLINE=$P(TXT2,"|",SUBCOUNT) Q:SUBLINE="" D ADD2(SUBLINE)
E D ADD2(COMM)
Q "~@"_$NA(@TARGET)
;
ADD2(TXT) ;
S CNT=CNT+1
S @TARGET@(CNT,0)=TXT
Q
; Returns true if V file is used for vital measurements
VMSR() Q ''$$GET^XPAR("ALL","BEHOVM USE VMSR")
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(NUM) ; -- SUBRTN to pad spaces
Q $$PAD(" ",NUM)
BTIUPCC6 ; IHS/ITSC/LJF - IHS PCC OBJECTS ;15-Dec-2015 15:40;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1006,1012,1013,1015,1015,1016**;NOV 04, 2004;Build 10
BMI(DFN,TIUCAP,NUM) ;EP -- returns BMI based on last ht and wt
+1 ; TIUCAP=1 if caption with measurement name is to be returned
+2 NEW VTWT,VTHT,RSWT,RSHT,BMI,WTDT,RMAX,X,IDT,HNUM,START,END,WNUM,IDATE,RCNT,DATE,WTDT,RESULT,LINE,APCHMDT
+3 ;S VTWT=$$VTYPE("WT"),VTHT=$$VTYPE("HT")
+4 SET TIUCAP=$GET(TIUCAP)
+5 SET VTWT=$$VTYPE("BMI")
+6 KILL ^TMP("BTIUVM",$JOB),^TMP("BTIUPCC",$JOB)
+7 IF '$DATA(NUM)
SET NUM=1
+8 SET WNUM=NUM+2
SET HNUM=NUM+10
SET RMAX=NUM
+9 SET START=DT+1
SET END=0
+10 IF START<END
SET X=START
SET START=END
SET END=X
+11 SET START=9999999-$SELECT(START#1:START,1:START+.9)
SET END=9999999-END
+12 SET RCNT=0
SET IDT=START
+13 ;PCTILE=+G(PCTILE)
+14 ;D BLDXRF(VTWT,NUM),BLDXRF(VTHT,NUM)
+15 DO BLDXRF(VTWT,NUM)
+16 FOR
IF 'IDT!(RCNT=RMAX)
QUIT
Begin DoDot:1
+17 SET VIEN=$CHAR(1)
+18 FOR
SET VIEN=$ORDER(^TMP("BTIUVM",$JOB,VTWT,IDT,VIEN),-1)
IF 'VIEN
QUIT
Begin DoDot:2
+19 DO GETMSR(VIEN,.BMI,.DATE,.LOC,.ENTERBY)
+20 ;IHS/MSC/MGH Save the wt date to use if the ht isn't too old patch 4
+21 ;S WTDT=DATE
+22 ;S RSHT=$$FNDHT(IDT)
+23 ;Q:'RSHT
+24 ;S RSWT=RSWT*.45359,RSHT=RSHT*.0254,RSHT=RSHT*RSHT,BMI=+$J(RSWT/RSHT,0,2)
+25 ;S:PCTILE BMI=$$BMIPCT(BMI,DFN,DATE)
+26 ;Q:'BMI
+27 SET RESULT(IDT)=$JUSTIFY(BMI,5,2)
SET RCNT=RCNT+1
+28 ;S DATE=WTDT
End DoDot:2
IF RCNT=RMAX
QUIT
+29 SET IDT=$ORDER(^TMP("BTIUVM",$JOB,VTWT,IDT))
End DoDot:1
+30 SET CNT=0
+31 SET IDATE=""
FOR
SET IDATE=$ORDER(RESULT(IDATE))
IF IDATE=""!(CNT>NUM)
QUIT
Begin DoDot:1
+32 SET BMI=$GET(RESULT(IDATE))
+33 SET DATE=9999999-IDATE
+34 IF $$PREG^BTIUPCC6(DFN,"",VIEN)=1
SET BMI=BMI_"*"
+35 SET DATE=$$FMTE^XLFDT(DATE)
+36 SET CNT=CNT+1
+37 SET LINE=BMI_" ("_$PIECE(DATE,"@",1)_")"
+38 IF TIUCAP
SET Y=$SELECT(CNT=1:"BMI:",1:$$SP(4))
SET LINE=Y_" "_LINE
+39 SET ^TMP("BTIUPCC",$JOB,CNT,0)=LINE
End DoDot:1
+40 IF '$DATA(^TMP("BTIUPCC",$JOB))
QUIT "No bmi stored"
+41 QUIT "~@^TMP(""BTIUPCC"",$J)"
FNDHT(IDT) ;Find closest height before weight
+1 NEW VIEN,RESULT,DOB,SEX,TAGE,X2,X1,SX
+2 SET VIEN=$ORDER(^TMP("BTIUVM",$JOB,VTHT,IDT,""))
+3 IF 'VIEN
Begin DoDot:1
+4 ;IHS/MSC/MGH Added in HS logic for lookback days for ht. Patch 4
+5 NEW ID1,ID2,GOOD
+6 SET DOB=$PIECE(^DPT(DFN,0),U,3)
SET X2=DOB
SET X1=DT
DO ^%DTC
SET TAGE=X
+7 SET ID1=$ORDER(^TMP("BTIUVM",$JOB,VTHT,IDT),-1)
SET ID2=$ORDER(^TMP("BTIUVM",$JOB,VTHT,IDT))
+8 IF ID1
Begin DoDot:2
+9 SET X1=$PIECE(ID1,".",1)
SET X2=$PIECE(IDT,".",1)
+10 IF X1=X2
SET ID2=ID1
End DoDot:2
+11 IF ID2
Begin DoDot:2
+12 SET X1=9999999-(ID2\1)
+13 SET APCHMDT=$$FMDIFF^XLFDT(X1,DOB,1)
+14 SET X1=9999999-(IDT\1)
SET X2=9999999-ID2
+15 SET X=$$FMDIFF^XLFDT(X1,X2,1)
+16 IF ((X>90)&(APCHMDT<1096))!((X>180)&(APCHMDT<4381))!((X>365)&(APCHMDT<6571))!((APCHMDT<6571)&(TAGE>6571))
SET ID2=""
+17 IF ID2
SET VIEN=$ORDER(^TMP("BTIUVM",$JOB,VTHT,ID2,""))
End DoDot:2
End DoDot:1
+18 IF VIEN
DO GETMSR(VIEN,.RESULT)
+19 QUIT $GET(RESULT)
GETMSR(VIEN,RESULT,DATE,LOC,ENTERBY) ;
+1 NEW X,X12
+2 SET X=$GET(^AUPNVMSR(VIEN,0))
SET X12=$GET(^(12))
+3 SET DATE=+X12
SET ENTERBY=+$PIECE(X12,U,4)
+4 SET RESULT=$$TRIM^XLFSTR($PIECE(X,U,4))
SET X=+$PIECE(X,U,3)
+5 SET X=$GET(^AUPNVSIT(X,0))
+6 IF 'DATE
SET DATE=+X
+7 SET LOC=+$PIECE(X,U,22)
SET DATE(0)=DATE*10000\1/10000
+8 QUIT
+9 ; Build temp xref for measurement type
BLDXRF(VTYP,VNUM) ;
+1 NEW X,Y,Z,CNT
+2 SET X=0
+3 KILL ^TMP("BTIUVM",$JOB,VTYP)
+4 SET CNT=0
+5 FOR
SET X=$ORDER(^AUPNVMSR("AA",DFN,VTYP,X))
SET VIEN=0
IF 'X!(CNT>VNUM)
QUIT
Begin DoDot:1
+6 FOR
SET VIEN=$ORDER(^AUPNVMSR("AA",DFN,VTYP,X,VIEN))
IF 'VIEN
QUIT
Begin DoDot:2
+7 SET Z=$GET(^AUPNVMSR(VIEN,0))
SET Y=+$GET(^(12))
SET Y=$SELECT(Y:9999999-Y,1:X)
+8 IF +Z'=VTYP
QUIT
+9 IF $PIECE(Z,U,2)'=DFN
QUIT
+10 SET CNT=CNT+1
+11 SET ^TMP("BTIUVM",$JOB,VTYP,Y,VIEN)=""
End DoDot:2
End DoDot:1
+12 QUIT
VTYPE(X,VMSR) ;
+1 NEW FNUM
+2 IF '$DATA(VMSR)
SET VMSR=$$VMSR
+3 SET FNUM=$SELECT(VMSR:9999999.07,1:120.51)
+4 QUIT +$$FIND1^DIC(FNUM,"","X",$$UP^XLFSTR(X),"B^"_$SELECT(VMSR:"D",1:"APCE^C"))
PREG(DFN,VIEN,VMIEN) ;Determine if BMI is for pregnant patient
+1 ;Patch 1015 went back to using the ATX API after changes made
+2 NEW DOB,X1,X1,TAGE,POV,CODE,TAX,RET,ARRAY
+3 SET RET=0
+4 SET VMIEN=$GET(VMIEN)
SET VIEN=$GET(VIEN)
+5 ;Wrong sex
IF $$GET1^DIQ(2,DFN,.02,"I")'="F"
QUIT RET
+6 SET TAGE=$$GET1^DIQ(2,DFN,.033)
+7 ;Wrong age
IF TAGE<10!(TAGE>50)
QUIT RET
+8 ;Find POVs on this visit and check if they are pregnancy POVs
+9 IF VIEN=""
Begin DoDot:1
+10 SET VIEN=$$GET1^DIQ(9000010.01,VMIEN,.03,"I")
End DoDot:1
+11 IF '+VIEN
QUIT RET
+12 SET TAX=$ORDER(^ATXAX("B","BQI PREGNANCY DXS",0))
+13 SET POV=""
FOR
SET POV=$ORDER(^AUPNVPOV("AD",VIEN,POV))
IF POV=""!(RET=1)
QUIT
Begin DoDot:1
+14 SET CODE=$$GET1^DIQ(9000010.07,POV,.01,"I")
+15 IF CODE=""
QUIT
+16 SET RET=$$ICD^ATXAPI(CODE,TAX,9)
End DoDot:1
+17 QUIT RET
EXAMCMT(DFN,TARGET,CODE) ; Returns the last exam with comments
+1 NEW EXAM,DATE,RESULT,N,SUB,CNT,MAXLEN,COMM,TXT2,SUBCOUNT,SUBLINE
+2 KILL @TARGET
+3 SET MAXLEN=60
SET CNT=0
+4 ;was code or name sent
SET SUB=$SELECT($LENGTH(CODE)=2:"C",1:"B")
+5 SET EXAM=$ORDER(^AUTTEXAM(SUB,CODE,0))
IF EXAM=""
QUIT ""
+6 SET DATE=$ORDER(^AUPNVXAM("AA",+$GET(DFN),EXAM,0))
IF DATE=""
QUIT "None Found"
+7 SET RESULT="Date: "_$$FMTE^XLFDT(9999999-DATE,"D")
+8 SET N=$ORDER(^AUPNVXAM("AA",DFN,EXAM,DATE,0))
IF 'N
QUIT RESULT_" Results: No Results"
+9 SET CNT=CNT+1
+10 SET @TARGET@(CNT,0)=RESULT_" Results: "_$$GET1^DIQ(9000010.13,N,.04)
+11 SET COMM=$$GET1^DIQ(9000010.13,N,81101)
+12 IF $LENGTH(COMM)>MAXLEN
Begin DoDot:1
+13 SET TXT2=$$WRAP^TIULS(COMM,MAXLEN)
+14 FOR SUBCOUNT=1:1
SET SUBLINE=$PIECE(TXT2,"|",SUBCOUNT)
IF SUBLINE=""
QUIT
DO ADD2(SUBLINE)
End DoDot:1
+15 IF '$TEST
DO ADD2(COMM)
+16 QUIT "~@"_$NAME(@TARGET)
+17 ;
ADD2(TXT) ;
+1 SET CNT=CNT+1
+2 SET @TARGET@(CNT,0)=TXT
+3 QUIT
+4 ; Returns true if V file is used for vital measurements
VMSR() QUIT ''$$GET^XPAR("ALL","BEHOVM USE VMSR")
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(NUM) ; -- SUBRTN to pad spaces
+1 QUIT $$PAD(" ",NUM)
