Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BEHOVM4

BEHOVM4.m

Go to the documentation of this file. 
  1. BEHOVM4 ;IHS/MSC/MGH - Storing BMI values ;22-Sep-2014 09:41;DU
  1.  ;;1.1;BEH COMPONENTS;**001010**;Sep 18, 2007
  1.  ;=================================================================
  1. BMISAVE(RET,DFN,WT,WTDT,VIEN) ;Store the BMI based on wt
  1.  N VTWT,VTHT,RSWT,RSHT,BMI,AGE,DONE,IEN,EIE,VTBMIP,SEX,BMIPCT,VDT
  1.  S VTWT=$$VTYPE^BEHOVM("WT"),VTHT=$$VTYPE^BEHOVM("HT")
  1.  S VTBMI=$$VTYPE^BEHOVM("BMI"),VTBMIP=$$VTYPE^BEHOVM("BMIP")
  1.  S AGE=$$PTAGE^BGOUTL(DFN,WTDT)
  1.  S SEX=$P(^DPT(DFN,0),U,2)
  1.  Q:AGE<2
  1.  ;S VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
  1.  S VDT=$$VD^APCLV(VIEN)  ;visit date
  1.  S RSHT=$$LASTHT^APCDBMI(DFN,VDT)
  1.  Q:'$P(RSHT,U,1)
  1.  S RSWT=WT
  1.  S RSWT=RSWT*.45359,RSHT=RSHT*.0254,RSHT=RSHT*RSHT,BMI=RSWT/RSHT
  1.  Q:'+BMI
  1.  D STORE(.RET,VTBMI,BMI)
  1.  I RET=0 D
  1.  .S DATA=0
  1.  .I AGE>1&(AGE<19) D
  1.  ..Q:SEX="U"
  1.  ..S BMIPCT=$$BMIPCT^BEHOVM2(BMI,DFN,WTDT)
  1.  ..I BMIPCT>0 D STORE(.DATA,VTBMIP,BMIPCT)
  1.  ..I DATA=0 S RET=0
  1.  ..E  S RET=DATA
  1.  Q
  1. STORE(DATA,TYPE,VALUE) ;Store the results
  1.  N FDA,BIEN,ERR
  1.  S DATA=0
  1.  S FDA=$NA(FDA(9000010.01,"+1,"))
  1.  S @FDA@(.01)=TYPE
  1.  S @FDA@(.02)=DFN
  1.  S @FDA@(.03)=VIEN
  1.  S @FDA@(.04)=VALUE
  1.  S @FDA@(.07)=$$NOW^XLFDT
  1.  S @FDA@(1204)=DUZ
  1.  S @FDA@(1201)=WTDT
  1.  S @FDA@(1216)=$$NOW^XLFDT
  1.  S @FDA@(1217)=DUZ
  1.  S @FDA@(1218)=$$NOW^XLFDT
  1.  S @FDA@(1219)=DUZ
  1.  D UPDATE^DIE(,"FDA","BIEN","ERR")
  1.  I $D(ERR) S DATA="-1^Unable to store BMI"
  1.  E  S DATA=0
  1.  Q
  1. BLDXRF(VTYP,START,END) ;
  1.  N X,Y,Z,TT,CVISIT,CTYPE,XREF,MDATE,EIE,VIEN
  1.  S X=0
  1.  K ^TMP("BEHOVM",$J,VTYP)
  1.  S XREF="AA"
  1.  F  S X=$O(^AUPNVMSR(XREF,DFN,VTYP,X)) Q:'X  D
  1.  .S VIEN=0 F  S VIEN=$O(^AUPNVMSR(XREF,DFN,VTYP,X,VIEN)) Q:'VIEN  D
  1.  ..S Z=$G(^AUPNVMSR(VIEN,0)),Y=+$G(^(12)),Y=$S(Y:9999999-Y,1:X)
  1.  ..S Y=$S(XREF="AA":Y,1:X)
  1.  ..Q:+Z'=VTYP
  1.  ..Q:$P(Z,U,2)'=DFN
  1.  ..S MDATE=$S(XREF="AA":Y,1:X)
  1.  ..Q:MDATE<START
  1.  ..Q:MDATE>END
  1.  ..;IHS/MSC/MGH  Quit if entered in error
  1.  ..S EIE=$$GET1^DIQ(9000010.01,VIEN,2,"I")
  1.  ..Q:EIE=1
  1.  ..S ^TMP("BEHOVM",$J,VTYP,MDATE,VIEN)=""
  1.  Q
  1. DELBMI(IEN) ;Delete and redo BMI on same visit if wt was in error
  1.  N DFN,VIEN,DATE,VTBMI,MIEN,EVDT,VTBMIP,BEHDATA,RESULT,BEHRESULT
  1.  S BEHRESULT=""
  1.  S VTBMI=$$VTYPE^BEHOVM("BMI"),VTBMIP=$$VTYPE^BEHOVM("BMIP")
  1.  S DFN=$$GET1^DIQ(9000010.01,IEN,.02,"I")
  1.  S VIEN=$$GET1^DIQ(9000010.01,IEN,.03,"I")
  1.  S EVDT=$$GET1^DIQ(9000010.01,IEN,1201,"I")
  1.  S MIEN="" F  S MIEN=$O(^AUPNVMSR("AB",EVDT,MIEN)) Q:MIEN=""  D
  1.  .I $P($G(^AUPNVMSR(MIEN,0)),U,1)=VTBMI D
  1.  ..S BEHDATA=MIEN_U_DUZ_U_"INVALID RECORD"
  1.  ..D EIE^BEHOVM2(.RESULT,BEHDATA)
  1.  .I $P($G(^AUPNVMSR(MIEN,0)),U,1)=VTBMIP D
  1.  ..S BEHDATA=MIEN_U_DUZ_U_"INVALID RECORD"
  1.  ..D EIE^BEHOVM2(.RESULT,BEHDATA)
  1.  Q
  1. DELBMIS(IEN,DFN) ;Delete all BMIs done from this date forward to a newer Ht
  1.  N DFN,VIEN,DATE,VTBMI,MIEN,EVDT,VTBMIP,BEHDATA,VTHT,VTWT,VDT
  1.  N GOODHT,NEXTAFT,NEXTBACK,INVDT
  1.  S VTWT=$$VTYPE^BEHOVM("WT"),VTHT=$$VTYPE^BEHOVM("HT")
  1.  S VTBMI=$$VTYPE^BEHOVM("BMI"),VTBMIP=$$VTYPE^BEHOVM("BMIP")
  1.  S DFN=$$GET1^DIQ(9000010.01,IEN,.02,"I")
  1.  S VIEN=$$GET1^DIQ(9000010.01,IEN,.03,"I")
  1.  S VDT=$$GET1^DIQ(9000010,VIEN,.01,"I")
  1.  S EVDT=$$GET1^DIQ(9000010.01,IEN,1201,"I")
  1.  I EVDT="" S EVDT=VDT
  1.  ;Get the next most recent ht later than the bad one
  1.  S START=DT+1,END=3000101
  1.  S:START<END X=START,START=END,END=X
  1.  S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
  1.  S RMAX=9999
  1.  D BLDXRF(VTHT,START,END)
  1.  S INVDT=9999999-EVDT
  1.  ;If the ht was replaced, find this one first
  1.  S NEXTAFT=$O(^TMP("BEHOVM",$J,VTHT,INVDT,""))
  1.  I NEXTAFT="" D
  1.  .S INVDT=$O(^TMP("BEHOVM",$J,VTHT,INVDT),-1)
  1.  .I INVDT'="" D
  1.  ..S NEXTAFT=$O(^TMP("BEHOVM",$J,VTHT,INVDT,$C(1)),-1)
  1.  ..S START=$P($G(^AUPNVMSR(NEXTAFT,12)),U,1)+1
  1.  I NEXTAFT'="" S START=$P($G(^AUPNVMSR(NEXTAFT,12)),U,1)+1
  1.  E  S START=DT+1
  1.  ;Get the next most recent ht prior to the bad one
  1.  S INVDT=9999999-EVDT
  1.  S INVDT=$P(EVDT,".",1)
  1.  S INVDT=$O(^TMP("BEHOVM",$J,VTHT,INVDT)) D
  1.  .I INVDT'="" D
  1.  ..S NEXTBACK=$O(^TMP("BEHOVM",$J,VTHT,INVDT,""))
  1.  ..I NEXTBACK'=""  D
  1.  ...S GOODHT=$$GET1^DIQ(9000010.01,NEXTBACK,.04)
  1.  ...S END=$P($G(^AUPNVMSR(NEXTBACK,12)),U,1)
  1.  ..I NEXTBACK="" S END=3000101
  1.  .E  S END=3000101
  1.  ;Get a listing of all the BMI's more recent than the bad one and prior to the good one
  1.  S:START<END X=START,START=END,END=X
  1.  S START=9999999-$S(START#1:START,1:START+.9),END=9999999-END
  1.  S RMAX=9999
  1.  D BLDXRF(VTBMIP,START,END),CHECK(VTBMIP,START,END)
  1.  D BLDXRF(VTBMI,START,END),CHECK(VTBMI,START,END)
  1.  ;If there is a good height, find WT for this visit and redo the item
  1.  I +GOODHT D ADDBACK(VIEN,GOODHT,START,END)
  1.  Q
  1. CHECK(ITEM,START,END) ;
  1.  ;Now loop through all the BAD BMIs and mark them EIE
  1.  N IDT,VIEN,BEHDATA
  1.  S IDT="" F  S IDT=$O(^TMP("BEHOVM",$J,ITEM,IDT)) Q:'IDT  D
  1.  .S VIEN=$C(1)
  1.  .F  S VIEN=$O(^TMP("BEHOVM",$J,ITEM,IDT,VIEN),-1) Q:VIEN=""  D
  1.  ..S BEHDATA=VIEN_U_DUZ_U_4
  1.  ..D EIE^BEHOVM2(.RESULT,BEHDATA)
  1.  Q
  1. ADDBACK(VMIEN,HT,START,END) ;
  1.  ;Find all the weights in this same date range and redo the BMIs
  1.  N VTWT,IDT,VIEN,VST,RET
  1.  S VTWT=$$VTYPE^BEHOVM("WT")
  1.  D BLDXRF(VTWT,START,END)
  1.  S IDT="" F  S IDT=$O(^TMP("BEHOVM",$J,VTWT,IDT)) Q:'IDT  D
  1.  .S VIEN=$C(1)
  1.  .F  S VIEN=$O(^TMP("BEHOVM",$J,VTWT,IDT,VIEN),-1) Q:'VIEN  D
  1.  ..S WT=$P($G(^AUPNVMSR(VIEN,0)),U,4),WTDT=$P($G(^AUPNVMSR(VIEN,12)),U,1)
  1.  ..S VST=$P($G(^AUPNVMSR(VIEN,0)),U,3)
  1.  ..D BMISAVE(.RET,DFN,WT,WTDT,VST)
  1.  Q