BQIRGCOP.m

BQIRGCOP ;GDIT/HS/ALA-COPD Care Mgmt ; 26 Oct 2012  9:24 AM

 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27

 ;

MS(DFN,TYP) ;EP

 NEW RESULT,RES,DATE,VALUE,VISIT

 S RES=$$MEAS^BQITUTL(DFN,TYP)

 I RES=0 Q ""

 S DATE=$P(RES,U,2),RESULT=$P(RES,U,3),VISIT=$P(RES,U,4)

 I TYP="WC"!(TYP="AG") D  Q VALUE

 . S VALUE=$$FMTMDY^BQIUL1(DATE)_" ("_RESULT_")"_U_VISIT_U_DATE

 Q $$FMTMDY^BQIUL1(DATE)_U_VISIT_U_DATE

 ;

TBHF(DFN) ;EP

 NEW N,HDATA,HC,IEN,HF,VISIT,VDATE,HFN,DATE,CAT,TOB,PAT

 ; Get the tobacco categories first

 S N=0

 F  S N=$O(^AUTTHF(N)) Q:'N  D

 . S HDATA=$G(^AUTTHF(N,0))

 . I $P(HDATA,U,13)=1 Q

 . I $P(HDATA,U,10)'="C" Q

 . I $P(HDATA,U,1)'["TOBACCO" Q

 . S CAT(N)=""

 ;

 ; Get the tobacco health factors

 S N=0

 F  S N=$O(^AUTTHF(N)) Q:'N  D

 . S HDATA=$G(^AUTTHF(N,0))

 . I $P(HDATA,U,13)=1 Q

 . S HC=$P(HDATA,U,3) I HC="" Q

 . I '$D(CAT(HC)) Q

 . S TOB(N)=""

 ;

 S IEN=""

 F  S IEN=$O(^AUPNVHF("AC",DFN,IEN),-1) Q:IEN=""  D

 . S HDATA=$G(^AUPNVHF(IEN,0))

 . S HF=$P(HDATA,U,1) I HF="" Q

 . I '$D(TOB(HF)) Q

 . S VISIT=$P(HDATA,U,3) I VISIT="" Q

 . S VDATE=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1

 . S PAT(VDATE)=IEN

 ;

 S DATE=$O(PAT(""),-1)

 I DATE="" Q DATE

 S IEN=PAT(DATE),HFN=$P(^AUPNVHF(IEN,0),U,1),HF=$P(^AUTTHF(HFN,0),U,1)

 Q $$FMTMDY^BQIUL1(DATE)_" ("_HF_")"_U_$P(^AUPNVHF(IEN,0),U,3)_U_DATE

 ;

INHST(DFN) ; EP - Inhaled Steroids

 NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT

 I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DESC=""

 S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF

 F TAX="BGP ASTHMA INHALED STEROIDS","BGP ASTHMA INHALED STEROIDS NDC" D BLD^BQITUTL(TAX,TREF)

 S X=$$TAX^BQITRUTL("","",1,DFN,9000010.14,"","",.TREF)

 ; if returns a found medication, check if it is an active medication

 I $P(X,U,1)=1 D

 . I $$ACTMED^BKMQQCR4($P(X,U,5)) Q

 . S $P(X,U,1)=0

 K @TREF

 S RESULT="N/A",OTHER="",VISIT=""

 I 'X S RESULT="NO" Q RESULT

 S RESULT="YES",VISIT=$P(X,U,4),OTHER=$P(X,U,2)

 Q RESULT_U_OTHER_U_VISIT

 ;

GLS(DATA,FAKE) ;EP - BQI GET COPD GLOSSARY

 NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN

 ;

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP(UID,"BQIRGCOP"))

 K @DATA

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGCOP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S @DATA@(II)="T32767REPORT_TEXT"_$C(30)

 S GLIEN=$O(^BQI(90508.2,"B","COPD","")) I GLIEN="" S BMXSEC="Problem with COPD glossary in file 90508.2" G DONE

 S IEN=0 F  S IEN=$O(^BQI(90508.2,GLIEN,1,IEN)) Q:'IEN  D

 . S II=II+1,@DATA@(II)=$G(^BQI(90508.2,GLIEN,1,IEN,0))

 I II>0 S @DATA@(II)=@DATA@(II)_$C(30)

 ;

DONE S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

 Q

BQIRGCOP  ;GDIT/HS/ALA-COPD Care Mgmt ; 26 Oct 2012  9:24 AM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27

 +2       ;

MS(DFN,TYP) ;EP

 +1        NEW RESULT,RES,DATE,VALUE,VISIT

 +2        SET RES=$$MEAS^BQITUTL(DFN,TYP)

 +3        IF RES=0

               QUIT ""

 +4        SET DATE=$PIECE(RES,U,2)

           SET RESULT=$PIECE(RES,U,3)

           SET VISIT=$PIECE(RES,U,4)

 +5        IF TYP="WC"!(TYP="AG")

               Begin DoDot:1

 +6                SET VALUE=$$FMTMDY^BQIUL1(DATE)_" ("_RESULT_")"_U_VISIT_U_DATE

               End DoDot:1

               QUIT VALUE

 +7        QUIT $$FMTMDY^BQIUL1(DATE)_U_VISIT_U_DATE

 +8       ;

TBHF(DFN) ;EP

 +1        NEW N,HDATA,HC,IEN,HF,VISIT,VDATE,HFN,DATE,CAT,TOB,PAT

 +2       ; Get the tobacco categories first

 +3        SET N=0

 +4        FOR 

               SET N=$ORDER(^AUTTHF(N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +5                SET HDATA=$GET(^AUTTHF(N,0))

 +6                IF $PIECE(HDATA,U,13)=1

                       QUIT 

 +7                IF $PIECE(HDATA,U,10)'="C"

                       QUIT 

 +8                IF $PIECE(HDATA,U,1)'["TOBACCO"

                       QUIT 

 +9                SET CAT(N)=""

               End DoDot:1

 +10      ;

 +11      ; Get the tobacco health factors

 +12       SET N=0

 +13       FOR 

               SET N=$ORDER(^AUTTHF(N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +14               SET HDATA=$GET(^AUTTHF(N,0))

 +15               IF $PIECE(HDATA,U,13)=1

                       QUIT 

 +16               SET HC=$PIECE(HDATA,U,3)

                   IF HC=""

                       QUIT 

 +17               IF '$DATA(CAT(HC))

                       QUIT 

 +18               SET TOB(N)=""

               End DoDot:1

 +19      ;

 +20       SET IEN=""

 +21       FOR 

               SET IEN=$ORDER(^AUPNVHF("AC",DFN,IEN),-1)

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +22               SET HDATA=$GET(^AUPNVHF(IEN,0))

 +23               SET HF=$PIECE(HDATA,U,1)

                   IF HF=""

                       QUIT 

 +24               IF '$DATA(TOB(HF))

                       QUIT 

 +25               SET VISIT=$PIECE(HDATA,U,3)

                   IF VISIT=""

                       QUIT 

 +26               SET VDATE=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1

 +27               SET PAT(VDATE)=IEN

               End DoDot:1

 +28      ;

 +29       SET DATE=$ORDER(PAT(""),-1)

 +30       IF DATE=""

               QUIT DATE

 +31       SET IEN=PAT(DATE)

           SET HFN=$PIECE(^AUPNVHF(IEN,0),U,1)

           SET HF=$PIECE(^AUTTHF(HFN,0),U,1)

 +32       QUIT $$FMTMDY^BQIUL1(DATE)_" ("_HF_")"_U_$PIECE(^AUPNVHF(IEN,0),U,3)_U_DATE

 +33      ;

INHST(DFN) ; EP - Inhaled Steroids

 +1        NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT

 +2        IF $GET(UID)=""

               SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DESC=""

 +4        SET TREF=$NAME(^TMP(UID,"BQITAX"))

           KILL @TREF

 +5        FOR TAX="BGP ASTHMA INHALED STEROIDS","BGP ASTHMA INHALED STEROIDS NDC"

               DO BLD^BQITUTL(TAX,TREF)

 +6        SET X=$$TAX^BQITRUTL("","",1,DFN,9000010.14,"","",.TREF)

 +7       ; if returns a found medication, check if it is an active medication

 +8        IF $PIECE(X,U,1)=1

               Begin DoDot:1

 +9                IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))

                       QUIT 

 +10               SET $PIECE(X,U,1)=0

               End DoDot:1

 +11       KILL @TREF

 +12       SET RESULT="N/A"

           SET OTHER=""

           SET VISIT=""

 +13       IF 'X

               SET RESULT="NO"

               QUIT RESULT

 +14       SET RESULT="YES"

           SET VISIT=$PIECE(X,U,4)

           SET OTHER=$PIECE(X,U,2)

 +15       QUIT RESULT_U_OTHER_U_VISIT

 +16      ;

GLS(DATA,FAKE) ;EP - BQI GET COPD GLOSSARY

 +1        NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN

 +2       ;

 +3        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +4        SET DATA=$NAME(^TMP(UID,"BQIRGCOP"))

 +5        KILL @DATA

 +6       ;

 +7        SET II=0

 +8       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIRGCOP D UNWIND^%ZTER"

 +9       ;

 +10       SET @DATA@(II)="T32767REPORT_TEXT"_$CHAR(30)

 +11       SET GLIEN=$ORDER(^BQI(90508.2,"B","COPD",""))

           IF GLIEN=""

               SET BMXSEC="Problem with COPD glossary in file 90508.2"

               GOTO DONE

 +12       SET IEN=0

           FOR 

               SET IEN=$ORDER(^BQI(90508.2,GLIEN,1,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +13               SET II=II+1

                   SET @DATA@(II)=$GET(^BQI(90508.2,GLIEN,1,IEN,0))

               End DoDot:1

 +14       IF II>0

               SET @DATA@(II)=@DATA@(II)_$CHAR(30)

 +15      ;

DONE       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +1        QUIT 

 +2       ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT