BEHOVM4 ;IHS/MSC/MGH - Storing BMI values ;22-Sep-2014 09:41;DU
;;1.1;BEH COMPONENTS;**001010**;Sep 18, 2007
;=================================================================
BMISAVE(RET,DFN,WT,WTDT,VIEN) ;Store the BMI based on wt
N VTWT,VTHT,RSWT,RSHT,BMI,AGE,DONE,IEN,EIE,VTBMIP,SEX,BMIPCT,VDT
S VTWT=$$VTYPE^BEHOVM("WT"),VTHT=$$VTYPE^BEHOVM("HT")
S VTBMI=$$VTYPE^BEHOVM("BMI"),VTBMIP=$$VTYPE^BEHOVM("BMIP")
S AGE=$$PTAGE^BGOUTL(DFN,WTDT)
S SEX=$P(^DPT(DFN,0),U,2)
Q:AGE<2
;S VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
S VDT=$$VD^APCLV(VIEN) ;visit date
S RSHT=$$LASTHT^APCDBMI(DFN,VDT)
Q:'$P(RSHT,U,1)
S RSWT=WT
S RSWT=RSWT*.45359,RSHT=RSHT*.0254,RSHT=RSHT*RSHT,BMI=RSWT/RSHT
Q:'+BMI
D STORE(.RET,VTBMI,BMI)
I RET=0 D
.S DATA=0
.I AGE>1&(AGE<19) D
..Q:SEX="U"
..S BMIPCT=$$BMIPCT^BEHOVM2(BMI,DFN,WTDT)
..I BMIPCT>0 D STORE(.DATA,VTBMIP,BMIPCT)
..I DATA=0 S RET=0
..E S RET=DATA
Q
STORE(DATA,TYPE,VALUE) ;Store the results
N FDA,BIEN,ERR
S DATA=0
S FDA=$NA(FDA(9000010.01,"+1,"))
S @FDA@(.01)=TYPE
S @FDA@(.02)=DFN
S @FDA@(.03)=VIEN
S @FDA@(.04)=VALUE
S @FDA@(.07)=$$NOW^XLFDT
S @FDA@(1204)=DUZ
S @FDA@(1201)=WTDT
S @FDA@(1216)=$$NOW^XLFDT
S @FDA@(1217)=DUZ
S @FDA@(1218)=$$NOW^XLFDT
S @FDA@(1219)=DUZ
D UPDATE^DIE(,"FDA","BIEN","ERR")
I $D(ERR) S DATA="-1^Unable to store BMI"
E S DATA=0
Q
BLDXRF(VTYP,START,END) ;
N X,Y,Z,TT,CVISIT,CTYPE,XREF,MDATE,EIE,VIEN
S X=0
K ^TMP("BEHOVM",$J,VTYP)
S XREF="AA"
F S X=$O(^AUPNVMSR(XREF,DFN,VTYP,X)) Q:'X D
.S VIEN=0 F S VIEN=$O(^AUPNVMSR(XREF,DFN,VTYP,X,VIEN)) Q:'VIEN D
..S Z=$G(^AUPNVMSR(VIEN,0)),Y=+$G(^(12)),Y=$S(Y:9999999-Y,1:X)
..S Y=$S(XREF="AA":Y,1:X)
..Q:+Z'=VTYP
..Q:$P(Z,U,2)'=DFN
..S MDATE=$S(XREF="AA":Y,1:X)
..Q:MDATE<START
..Q:MDATE>END
..;IHS/MSC/MGH Quit if entered in error
..S EIE=$$GET1^DIQ(9000010.01,VIEN,2,"I")
..Q:EIE=1
..S ^TMP("BEHOVM",$J,VTYP,MDATE,VIEN)=""
Q
DELBMI(IEN) ;Delete and redo BMI on same visit if wt was in error
N DFN,VIEN,DATE,VTBMI,MIEN,EVDT,VTBMIP,BEHDATA,RESULT,BEHRESULT
S BEHRESULT=""
S VTBMI=$$VTYPE^BEHOVM("BMI"),VTBMIP=$$VTYPE^BEHOVM("BMIP")
S DFN=$$GET1^DIQ(9000010.01,IEN,.02,"I")
S VIEN=$$GET1^DIQ(9000010.01,IEN,.03,"I")
S EVDT=$$GET1^DIQ(9000010.01,IEN,1201,"I")
S MIEN="" F S MIEN=$O(^AUPNVMSR("AB",EVDT,MIEN)) Q:MIEN="" D
.I $P($G(^AUPNVMSR(MIEN,0)),U,1)=VTBMI D
..S BEHDATA=MIEN_U_DUZ_U_"INVALID RECORD"
..D EIE^BEHOVM2(.RESULT,BEHDATA)
.I $P($G(^AUPNVMSR(MIEN,0)),U,1)=VTBMIP D
..S BEHDATA=MIEN_U_DUZ_U_"INVALID RECORD"
..D EIE^BEHOVM2(.RESULT,BEHDATA)
Q
DELBMIS(IEN,DFN) ;Delete all BMIs done from this date forward to a newer Ht
N DFN,VIEN,DATE,VTBMI,MIEN,EVDT,VTBMIP,BEHDATA,VTHT,VTWT,VDT
N GOODHT,NEXTAFT,NEXTBACK,INVDT
S VTWT=$$VTYPE^BEHOVM("WT"),VTHT=$$VTYPE^BEHOVM("HT")
S VTBMI=$$VTYPE^BEHOVM("BMI"),VTBMIP=$$VTYPE^BEHOVM("BMIP")
S DFN=$$GET1^DIQ(9000010.01,IEN,.02,"I")
S VIEN=$$GET1^DIQ(9000010.01,IEN,.03,"I")
S VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
S EVDT=$$GET1^DIQ(9000010.01,IEN,1201,"I")
I EVDT="" S EVDT=VDT
;Get the next most recent ht later than the bad one
S START=DT+1,END=3000101
S:START<END X=START,START=END,END=X
S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
S RMAX=9999
D BLDXRF(VTHT,START,END)
S INVDT=9999999-EVDT
;If the ht was replaced, find this one first
S NEXTAFT=$O(^TMP("BEHOVM",$J,VTHT,INVDT,""))
I NEXTAFT="" D
.S INVDT=$O(^TMP("BEHOVM",$J,VTHT,INVDT),-1)
.I INVDT'="" D
..S NEXTAFT=$O(^TMP("BEHOVM",$J,VTHT,INVDT,$C(1)),-1)
..S START=$P($G(^AUPNVMSR(NEXTAFT,12)),U,1)+1
I NEXTAFT'="" S START=$P($G(^AUPNVMSR(NEXTAFT,12)),U,1)+1
E S START=DT+1
;Get the next most recent ht prior to the bad one
S INVDT=9999999-EVDT
S INVDT=$P(EVDT,".",1)
S INVDT=$O(^TMP("BEHOVM",$J,VTHT,INVDT)) D
.I INVDT'="" D
..S NEXTBACK=$O(^TMP("BEHOVM",$J,VTHT,INVDT,""))
..I NEXTBACK'="" D
...S GOODHT=$$GET1^DIQ(9000010.01,NEXTBACK,.04)
...S END=$P($G(^AUPNVMSR(NEXTBACK,12)),U,1)
..I NEXTBACK="" S END=3000101
.E S END=3000101
;Get a listing of all the BMI's more recent than the bad one and prior to the good one
S:START<END X=START,START=END,END=X
S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
S RMAX=9999
D BLDXRF(VTBMIP,START,END),CHECK(VTBMIP,START,END)
D BLDXRF(VTBMI,START,END),CHECK(VTBMI,START,END)
;If there is a good height, find WT for this visit and redo the item
I +GOODHT D ADDBACK(VIEN,GOODHT,START,END)
Q
CHECK(ITEM,START,END) ;
;Now loop through all the BAD BMIs and mark them EIE
N IDT,VIEN,BEHDATA
S IDT="" F S IDT=$O(^TMP("BEHOVM",$J,ITEM,IDT)) Q:'IDT D
.S VIEN=$C(1)
.F S VIEN=$O(^TMP("BEHOVM",$J,ITEM,IDT,VIEN),-1) Q:VIEN="" D
..S BEHDATA=VIEN_U_DUZ_U_4
..D EIE^BEHOVM2(.RESULT,BEHDATA)
Q
ADDBACK(VMIEN,HT,START,END) ;
;Find all the weights in this same date range and redo the BMIs
N VTWT,IDT,VIEN,VST,RET
S VTWT=$$VTYPE^BEHOVM("WT")
D BLDXRF(VTWT,START,END)
S IDT="" F S IDT=$O(^TMP("BEHOVM",$J,VTWT,IDT)) Q:'IDT D
.S VIEN=$C(1)
.F S VIEN=$O(^TMP("BEHOVM",$J,VTWT,IDT,VIEN),-1) Q:'VIEN D
..S WT=$P($G(^AUPNVMSR(VIEN,0)),U,4),WTDT=$P($G(^AUPNVMSR(VIEN,12)),U,1)
..S VST=$P($G(^AUPNVMSR(VIEN,0)),U,3)
..D BMISAVE(.RET,DFN,WT,WTDT,VST)
Q
BEHOVM4 ;IHS/MSC/MGH - Storing BMI values ;22-Sep-2014 09:41;DU
+1 ;;1.1;BEH COMPONENTS;**001010**;Sep 18, 2007
+2 ;=================================================================
BMISAVE(RET,DFN,WT,WTDT,VIEN) ;Store the BMI based on wt
+1 NEW VTWT,VTHT,RSWT,RSHT,BMI,AGE,DONE,IEN,EIE,VTBMIP,SEX,BMIPCT,VDT
+2 SET VTWT=$$VTYPE^BEHOVM("WT")
SET VTHT=$$VTYPE^BEHOVM("HT")
+3 SET VTBMI=$$VTYPE^BEHOVM("BMI")
SET VTBMIP=$$VTYPE^BEHOVM("BMIP")
+4 SET AGE=$$PTAGE^BGOUTL(DFN,WTDT)
+5 SET SEX=$PIECE(^DPT(DFN,0),U,2)
+6 IF AGE<2
QUIT
+7 ;S VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
+8 ;visit date
SET VDT=$$VD^APCLV(VIEN)
+9 SET RSHT=$$LASTHT^APCDBMI(DFN,VDT)
+10 IF '$PIECE(RSHT,U,1)
QUIT
+11 SET RSWT=WT
+12 SET RSWT=RSWT*.45359
SET RSHT=RSHT*.0254
SET RSHT=RSHT*RSHT
SET BMI=RSWT/RSHT
+13 IF '+BMI
QUIT
+14 DO STORE(.RET,VTBMI,BMI)
+15 IF RET=0
Begin DoDot:1
+16 SET DATA=0
+17 IF AGE>1&(AGE<19)
Begin DoDot:2
+18 IF SEX="U"
QUIT
+19 SET BMIPCT=$$BMIPCT^BEHOVM2(BMI,DFN,WTDT)
+20 IF BMIPCT>0
DO STORE(.DATA,VTBMIP,BMIPCT)
+21 IF DATA=0
SET RET=0
+22 IF '$TEST
SET RET=DATA
End DoDot:2
End DoDot:1
+23 QUIT
STORE(DATA,TYPE,VALUE) ;Store the results
+1 NEW FDA,BIEN,ERR
+2 SET DATA=0
+3 SET FDA=$NAME(FDA(9000010.01,"+1,"))
+4 SET @FDA@(.01)=TYPE
+5 SET @FDA@(.02)=DFN
+6 SET @FDA@(.03)=VIEN
+7 SET @FDA@(.04)=VALUE
+8 SET @FDA@(.07)=$$NOW^XLFDT
+9 SET @FDA@(1204)=DUZ
+10 SET @FDA@(1201)=WTDT
+11 SET @FDA@(1216)=$$NOW^XLFDT
+12 SET @FDA@(1217)=DUZ
+13 SET @FDA@(1218)=$$NOW^XLFDT
+14 SET @FDA@(1219)=DUZ
+15 DO UPDATE^DIE(,"FDA","BIEN","ERR")
+16 IF $DATA(ERR)
SET DATA="-1^Unable to store BMI"
+17 IF '$TEST
SET DATA=0
+18 QUIT
BLDXRF(VTYP,START,END) ;
+1 NEW X,Y,Z,TT,CVISIT,CTYPE,XREF,MDATE,EIE,VIEN
+2 SET X=0
+3 KILL ^TMP("BEHOVM",$JOB,VTYP)
+4 SET XREF="AA"
+5 FOR
SET X=$ORDER(^AUPNVMSR(XREF,DFN,VTYP,X))
IF 'X
QUIT
Begin DoDot:1
+6 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVMSR(XREF,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 SET Y=$SELECT(XREF="AA":Y,1:X)
+9 IF +Z'=VTYP
QUIT
+10 IF $PIECE(Z,U,2)'=DFN
QUIT
+11 SET MDATE=$SELECT(XREF="AA":Y,1:X)
+12 IF MDATE<START
QUIT
+13 IF MDATE>END
QUIT
+14 ;IHS/MSC/MGH Quit if entered in error
+15 SET EIE=$$GET1^DIQ(9000010.01,VIEN,2,"I")
+16 IF EIE=1
QUIT
+17 SET ^TMP("BEHOVM",$JOB,VTYP,MDATE,VIEN)=""
End DoDot:2
End DoDot:1
+18 QUIT
DELBMI(IEN) ;Delete and redo BMI on same visit if wt was in error
+1 NEW DFN,VIEN,DATE,VTBMI,MIEN,EVDT,VTBMIP,BEHDATA,RESULT,BEHRESULT
+2 SET BEHRESULT=""
+3 SET VTBMI=$$VTYPE^BEHOVM("BMI")
SET VTBMIP=$$VTYPE^BEHOVM("BMIP")
+4 SET DFN=$$GET1^DIQ(9000010.01,IEN,.02,"I")
+5 SET VIEN=$$GET1^DIQ(9000010.01,IEN,.03,"I")
+6 SET EVDT=$$GET1^DIQ(9000010.01,IEN,1201,"I")
+7 SET MIEN=""
FOR
SET MIEN=$ORDER(^AUPNVMSR("AB",EVDT,MIEN))
IF MIEN=""
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^AUPNVMSR(MIEN,0)),U,1)=VTBMI
Begin DoDot:2
+9 SET BEHDATA=MIEN_U_DUZ_U_"INVALID RECORD"
+10 DO EIE^BEHOVM2(.RESULT,BEHDATA)
End DoDot:2
+11 IF $PIECE($GET(^AUPNVMSR(MIEN,0)),U,1)=VTBMIP
Begin DoDot:2
+12 SET BEHDATA=MIEN_U_DUZ_U_"INVALID RECORD"
+13 DO EIE^BEHOVM2(.RESULT,BEHDATA)
End DoDot:2
End DoDot:1
+14 QUIT
DELBMIS(IEN,DFN) ;Delete all BMIs done from this date forward to a newer Ht
+1 NEW DFN,VIEN,DATE,VTBMI,MIEN,EVDT,VTBMIP,BEHDATA,VTHT,VTWT,VDT
+2 NEW GOODHT,NEXTAFT,NEXTBACK,INVDT
+3 SET VTWT=$$VTYPE^BEHOVM("WT")
SET VTHT=$$VTYPE^BEHOVM("HT")
+4 SET VTBMI=$$VTYPE^BEHOVM("BMI")
SET VTBMIP=$$VTYPE^BEHOVM("BMIP")
+5 SET DFN=$$GET1^DIQ(9000010.01,IEN,.02,"I")
+6 SET VIEN=$$GET1^DIQ(9000010.01,IEN,.03,"I")
+7 SET VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
+8 SET EVDT=$$GET1^DIQ(9000010.01,IEN,1201,"I")
+9 IF EVDT=""
SET EVDT=VDT
+10 ;Get the next most recent ht later than the bad one
+11 SET START=DT+1
SET END=3000101
+12 IF START<END
SET X=START
SET START=END
SET END=X
+13 SET START=9999999-$SELECT(START#1:START,1:START+.9)
SET END=9999999-END
+14 SET RMAX=9999
+15 DO BLDXRF(VTHT,START,END)
+16 SET INVDT=9999999-EVDT
+17 ;If the ht was replaced, find this one first
+18 SET NEXTAFT=$ORDER(^TMP("BEHOVM",$JOB,VTHT,INVDT,""))
+19 IF NEXTAFT=""
Begin DoDot:1
+20 SET INVDT=$ORDER(^TMP("BEHOVM",$JOB,VTHT,INVDT),-1)
+21 IF INVDT'=""
Begin DoDot:2
+22 SET NEXTAFT=$ORDER(^TMP("BEHOVM",$JOB,VTHT,INVDT,$CHAR(1)),-1)
+23 SET START=$PIECE($GET(^AUPNVMSR(NEXTAFT,12)),U,1)+1
End DoDot:2
End DoDot:1
+24 IF NEXTAFT'=""
SET START=$PIECE($GET(^AUPNVMSR(NEXTAFT,12)),U,1)+1
+25 IF '$TEST
SET START=DT+1
+26 ;Get the next most recent ht prior to the bad one
+27 SET INVDT=9999999-EVDT
+28 SET INVDT=$PIECE(EVDT,".",1)
+29 SET INVDT=$ORDER(^TMP("BEHOVM",$JOB,VTHT,INVDT))
Begin DoDot:1
+30 IF INVDT'=""
Begin DoDot:2
+31 SET NEXTBACK=$ORDER(^TMP("BEHOVM",$JOB,VTHT,INVDT,""))
+32 IF NEXTBACK'=""
Begin DoDot:3
+33 SET GOODHT=$$GET1^DIQ(9000010.01,NEXTBACK,.04)
+34 SET END=$PIECE($GET(^AUPNVMSR(NEXTBACK,12)),U,1)
End DoDot:3
+35 IF NEXTBACK=""
SET END=3000101
End DoDot:2
+36 IF '$TEST
SET END=3000101
End DoDot:1
+37 ;Get a listing of all the BMI's more recent than the bad one and prior to the good one
+38 IF START<END
SET X=START
SET START=END
SET END=X
+39 SET START=9999999-$SELECT(START#1:START,1:START+.9)
SET END=9999999-END
+40 SET RMAX=9999
+41 DO BLDXRF(VTBMIP,START,END)
DO CHECK(VTBMIP,START,END)
+42 DO BLDXRF(VTBMI,START,END)
DO CHECK(VTBMI,START,END)
+43 ;If there is a good height, find WT for this visit and redo the item
+44 IF +GOODHT
DO ADDBACK(VIEN,GOODHT,START,END)
+45 QUIT
CHECK(ITEM,START,END) ;
+1 ;Now loop through all the BAD BMIs and mark them EIE
+2 NEW IDT,VIEN,BEHDATA
+3 SET IDT=""
FOR
SET IDT=$ORDER(^TMP("BEHOVM",$JOB,ITEM,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+4 SET VIEN=$CHAR(1)
+5 FOR
SET VIEN=$ORDER(^TMP("BEHOVM",$JOB,ITEM,IDT,VIEN),-1)
IF VIEN=""
QUIT
Begin DoDot:2
+6 SET BEHDATA=VIEN_U_DUZ_U_4
+7 DO EIE^BEHOVM2(.RESULT,BEHDATA)
End DoDot:2
End DoDot:1
+8 QUIT
ADDBACK(VMIEN,HT,START,END) ;
+1 ;Find all the weights in this same date range and redo the BMIs
+2 NEW VTWT,IDT,VIEN,VST,RET
+3 SET VTWT=$$VTYPE^BEHOVM("WT")
+4 DO BLDXRF(VTWT,START,END)
+5 SET IDT=""
FOR
SET IDT=$ORDER(^TMP("BEHOVM",$JOB,VTWT,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+6 SET VIEN=$CHAR(1)
+7 FOR
SET VIEN=$ORDER(^TMP("BEHOVM",$JOB,VTWT,IDT,VIEN),-1)
IF 'VIEN
QUIT
Begin DoDot:2
+8 SET WT=$PIECE($GET(^AUPNVMSR(VIEN,0)),U,4)
SET WTDT=$PIECE($GET(^AUPNVMSR(VIEN,12)),U,1)
+9 SET VST=$PIECE($GET(^AUPNVMSR(VIEN,0)),U,3)
+10 DO BMISAVE(.RET,DFN,WT,WTDT,VST)
End DoDot:2
End DoDot:1
+11 QUIT
