BQITDWC.m

BQITDWC ;VNGT/HS/ALA-Calculate Waist Circumference ; 18 Feb 2010  10:14 AM

 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 ;

WC(BDFN,TMFRAME) ;EP -- Waist Circumference

 ;  Get the waist circumference for a patient and a time frame

 ;Input

 ;  BDFN - Patient IEN

 ;  TMFRAME - Time frame in relative date format

 ;

 ;   If no time frame passed in, default to 60 months (5 years)  

 I $G(TMFRAME)="" S TMFRAME="T-60M"

 S BDATE=$$DATE^BQIUL1(TMFRAME),BDATE=$$FMTE^XLFDT(BDATE),EDATE=$$FMTE^XLFDT(DT)

 NEW BQIPRY

 S %=BDFN_"^LAST MEAS WC;DURING "_BDATE_"-"_EDATE

 S E=$$START1^APCLDF(%,"BQIPRY(")

 Q $P($G(BQIPRY(1)),U,2)_U_$P($G(BQIPRY(1)),U,5)_U_$P($P($G(BQIPRY(1)),U,4),";",1)

 ;

AWC(TMFRAME,TPGLOB) ;EP - Get waist circumferences for all patients

 ; Input

 ;   TMFRAME - Timeframe for search

 ;   TPGLOB  - Temporary global

 NEW BDATE,EDATE,TMDATA,BTYP,IEN,DATE,VISIT,MIEN,DFN,RESULT

 S BDATE=$$DATE^BQIUL1(TMFRAME),EDATE=DT

 S BTYP=$$FIND1^DIC(9999999.07,,"X","WC")

 S DATE=BDATE

 F  S DATE=$O(^AUPNVSIT("B",DATE)) Q:DATE=""!((DATE\1)>EDATE)  D

 . S VISIT=""

 . F  S VISIT=$O(^AUPNVSIT("B",DATE,VISIT)) Q:VISIT=""  D

 .. I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q

 .. S MIEN=""

 .. F  S MIEN=$O(^AUPNVMSR("AD",VISIT,MIEN)) Q:MIEN=""  D

 ... I $$GET1^DIQ(9000010.01,MIEN_",",.01,"I")'=BTYP Q

 ... ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error

 ... I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,MIEN_",",2,"I")=1

 ... S DFN=$$GET1^DIQ(9000010.01,MIEN_",",.02,"I") I DFN="" Q

 ... S RESULT=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E") I RESULT="" Q

 ... S @TPGLOB@(DFN,DATE)=RESULT_"^"_VISIT_"^"_MIEN_"^9000010.01"

 Q

BQITDWC   ;VNGT/HS/ALA-Calculate Waist Circumference ; 18 Feb 2010  10:14 AM

 +1       ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011

 +2       ;

WC(BDFN,TMFRAME) ;EP -- Waist Circumference

 +1       ;  Get the waist circumference for a patient and a time frame

 +2       ;Input

 +3       ;  BDFN - Patient IEN

 +4       ;  TMFRAME - Time frame in relative date format

 +5       ;

 +6       ;   If no time frame passed in, default to 60 months (5 years)  

 +7        IF $GET(TMFRAME)=""

               SET TMFRAME="T-60M"

 +8        SET BDATE=$$DATE^BQIUL1(TMFRAME)

           SET BDATE=$$FMTE^XLFDT(BDATE)

           SET EDATE=$$FMTE^XLFDT(DT)

 +9        NEW BQIPRY

 +10       SET %=BDFN_"^LAST MEAS WC;DURING "_BDATE_"-"_EDATE

 +11       SET E=$$START1^APCLDF(%,"BQIPRY(")

 +12       QUIT $PIECE($GET(BQIPRY(1)),U,2)_U_$PIECE($GET(BQIPRY(1)),U,5)_U_$PIECE($PIECE($GET(BQIPRY(1)),U,4),";",1)

 +13      ;

AWC(TMFRAME,TPGLOB) ;EP - Get waist circumferences for all patients

 +1       ; Input

 +2       ;   TMFRAME - Timeframe for search

 +3       ;   TPGLOB  - Temporary global

 +4        NEW BDATE,EDATE,TMDATA,BTYP,IEN,DATE,VISIT,MIEN,DFN,RESULT

 +5        SET BDATE=$$DATE^BQIUL1(TMFRAME)

           SET EDATE=DT

 +6        SET BTYP=$$FIND1^DIC(9999999.07,,"X","WC")

 +7        SET DATE=BDATE

 +8        FOR 

               SET DATE=$ORDER(^AUPNVSIT("B",DATE))

               IF DATE=""!((DATE\1)>EDATE)

                   QUIT 

               Begin DoDot:1

 +9                SET VISIT=""

 +10               FOR 

                       SET VISIT=$ORDER(^AUPNVSIT("B",DATE,VISIT))

                       IF VISIT=""

                           QUIT 

                       Begin DoDot:2

 +11                       IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1

                               QUIT 

 +12                       SET MIEN=""

 +13                       FOR 

                               SET MIEN=$ORDER(^AUPNVMSR("AD",VISIT,MIEN))

                               IF MIEN=""

                                   QUIT 

                               Begin DoDot:3

 +14                               IF $$GET1^DIQ(9000010.01,MIEN_",",.01,"I")'=BTYP

                                       QUIT 

 +15      ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error

 +16                               IF $$VFIELD^DILFD(9000010.01,2)

                                       IF $$GET1^DIQ(9000010.01,MIEN_",",2,"I")=1

                                           QUIT 

 +17                               SET DFN=$$GET1^DIQ(9000010.01,MIEN_",",.02,"I")

                                   IF DFN=""

                                       QUIT 

 +18                               SET RESULT=$$GET1^DIQ(9000010.01,MIEN_",",.04,"E")

                                   IF RESULT=""

                                       QUIT 

 +19                               SET @TPGLOB@(DFN,DATE)=RESULT_"^"_VISIT_"^"_MIEN_"^9000010.01"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +20       QUIT