BQITD10 ;PRXM/HC/ALA-Obese Definition ; 04 Apr 2006 1:36 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
POP(BQARY,TGLOB) ; EP -- By population
;
;Description
; Finds all patients who meet the criteria for Obese
;Input
; BQIRY - Array of taxonomies and other information
; TGLOB - Global where data is to be stored
; Structure:
; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
;
; Clean out any previous data
NEW DXNN,TDFN,DA,DIK,DFN,TMPG,TX,AGE,BMI,TMFRAME,EXDT,DTDIF,ENDT,STDT
;
I $D(@BQARY) D
. D POP^BQITDGN(.BQARY,.TGLOB)
;
S TMPG=$NA(^TMP("BQIBMI",UID))
K @TMPG
S TMFRAME="T-60M",EXDT="",DTDIF=""
S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
D ABMI^BQITBMI(TMFRAME,.TMPG)
S TDFN=0
F S TDFN=$O(@TMPG@(TDFN)) Q:'TDFN D
. S AGE=$P(@TMPG@(TDFN),"^",2)
. S BMI=$P(@TMPG@(TDFN),"^",1)
. I $$OB^BQITBMI(TDFN,BMI,AGE) D
.. F TX="BMI-Height","BMI-Weight" D
... S VISIT=$O(@TMPG@(TDFN,"CRITERIA",TX,"V",""))
... S IEN=""
... F S IEN=$O(@TMPG@(TDFN,"CRITERIA",TX,"V",VISIT,IEN)) Q:IEN="" D
.... S VSDTM=@TMPG@(TDFN,"CRITERIA",TX,"V",VISIT,IEN)
.... I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
.... S @TGLOB@(TDFN,"CRITERIA","BMI","V",VISIT,IEN)=VSDTM_U_U_IEN_U_"9000010.01"
.... I EXDT'="" S $P(@TGLOB@(TDFN,"CRITERIA","BMI","V",VISIT,IEN),U,2)=EXDT
K @TMPG
Q
;
PAT(DEF,TGLOB,BDFN) ; EP -- By patient
;Description
; Checks if a patient meets the criteria for Obese
; if adult and BMI is =>30
;Input
; BDFN - patient internal entry number
;
NEW AGE,BMI,BMID,VIENS,VST,VSDTM,TMFRAME,EXDT,DTDIF,ENDT,STDT
S TMFRAME="T-60M",EXDT="",DTDIF=""
S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
S BMID=$$OBMI^BQITBMI(BDFN,TMFRAME)
S BMI=$P(BMID,"^",1),AGE=$P(BMID,"^",2),VIENS=$P(BMID,"^",3),MIENS=$P(BMID,"^",4)
I BMI'="",$$OB^BQITBMI(BDFN,BMI,AGE) D Q 1
. F I=1:1 S VST=$P(VIENS,",",I) Q:VST="" D
.. S VSDTM=$P($G(^AUPNVSIT(VST,0)),U,1)
.. S IEN=$P(MIENS,",",I)
.. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
.. S @TGLOB@(BDFN,"CRITERIA","BMI","V",VST,IEN)=VSDTM_U_U_IEN_U_"9000010.01"
.. I EXDT'="" S $P(@TGLOB@(BDFN,"CRITERIA","BMI","V",VST,IEN),U,2)=EXDT
Q 0
BQITD10 ;PRXM/HC/ALA-Obese Definition ; 04 Apr 2006 1:36 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
POP(BQARY,TGLOB) ; EP -- By population
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria for Obese
+4 ;Input
+5 ; BQIRY - Array of taxonomies and other information
+6 ; TGLOB - Global where data is to be stored
+7 ; Structure:
+8 ; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+9 ;
+10 ; Clean out any previous data
+11 NEW DXNN,TDFN,DA,DIK,DFN,TMPG,TX,AGE,BMI,TMFRAME,EXDT,DTDIF,ENDT,STDT
+12 ;
+13 IF $DATA(@BQARY)
Begin DoDot:1
+14 DO POP^BQITDGN(.BQARY,.TGLOB)
End DoDot:1
+15 ;
+16 SET TMPG=$NAME(^TMP("BQIBMI",UID))
+17 KILL @TMPG
+18 SET TMFRAME="T-60M"
SET EXDT=""
SET DTDIF=""
+19 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+20 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
+21 DO ABMI^BQITBMI(TMFRAME,.TMPG)
+22 SET TDFN=0
+23 FOR
SET TDFN=$ORDER(@TMPG@(TDFN))
IF 'TDFN
QUIT
Begin DoDot:1
+24 SET AGE=$PIECE(@TMPG@(TDFN),"^",2)
+25 SET BMI=$PIECE(@TMPG@(TDFN),"^",1)
+26 IF $$OB^BQITBMI(TDFN,BMI,AGE)
Begin DoDot:2
+27 FOR TX="BMI-Height","BMI-Weight"
Begin DoDot:3
+28 SET VISIT=$ORDER(@TMPG@(TDFN,"CRITERIA",TX,"V",""))
+29 SET IEN=""
+30 FOR
SET IEN=$ORDER(@TMPG@(TDFN,"CRITERIA",TX,"V",VISIT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+31 SET VSDTM=@TMPG@(TDFN,"CRITERIA",TX,"V",VISIT,IEN)
+32 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+33 SET @TGLOB@(TDFN,"CRITERIA","BMI","V",VISIT,IEN)=VSDTM_U_U_IEN_U_"9000010.01"
+34 IF EXDT'=""
SET $PIECE(@TGLOB@(TDFN,"CRITERIA","BMI","V",VISIT,IEN),U,2)=EXDT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 KILL @TMPG
+36 QUIT
+37 ;
PAT(DEF,TGLOB,BDFN) ; EP -- By patient
+1 ;Description
+2 ; Checks if a patient meets the criteria for Obese
+3 ; if adult and BMI is =>30
+4 ;Input
+5 ; BDFN - patient internal entry number
+6 ;
+7 NEW AGE,BMI,BMID,VIENS,VST,VSDTM,TMFRAME,EXDT,DTDIF,ENDT,STDT
+8 SET TMFRAME="T-60M"
SET EXDT=""
SET DTDIF=""
+9 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+10 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
+11 SET BMID=$$OBMI^BQITBMI(BDFN,TMFRAME)
+12 SET BMI=$PIECE(BMID,"^",1)
SET AGE=$PIECE(BMID,"^",2)
SET VIENS=$PIECE(BMID,"^",3)
SET MIENS=$PIECE(BMID,"^",4)
+13 IF BMI'=""
IF $$OB^BQITBMI(BDFN,BMI,AGE)
Begin DoDot:1
+14 FOR I=1:1
SET VST=$PIECE(VIENS,",",I)
IF VST=""
QUIT
Begin DoDot:2
+15 SET VSDTM=$PIECE($GET(^AUPNVSIT(VST,0)),U,1)
+16 SET IEN=$PIECE(MIENS,",",I)
+17 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+18 SET @TGLOB@(BDFN,"CRITERIA","BMI","V",VST,IEN)=VSDTM_U_U_IEN_U_"9000010.01"
+19 IF EXDT'=""
SET $PIECE(@TGLOB@(BDFN,"CRITERIA","BMI","V",VST,IEN),U,2)=EXDT
End DoDot:2
End DoDot:1
QUIT 1
+20 QUIT 0
