BPXRMTP.m

BPXRMTP ; IHS/MSC/MGH - Computed Findings for Treatment prompt reminders. ;30-Mar-2018 14:32;DU

 ;;2.0;CLINICAL REMINDERS;**1001,1002,1009**;Feb 04, 2005;Build 17

 ;=================================================================

 ;This routine is designed to use the standard PCC logic for reminders to

 ;evaluate if items are met or not met. Using the standard PCC calls ensures

 ;that all IHS items are using the same logic.

 ;Patch 1009 changed the BQI call for tag

 ;=====================================================================

CVD(DFN,TEST,DATE,VALUE,TEXT) ; EP

 ;This computed finding will check the Treatment prompt logic for CVD

 N BPXRESLT,TODAY,X,Y,X1,X2

 S X="TODAY" D ^%DT S TODAY=Y

 S X1=TODAY,X2=-3 D C^%DTC

 ;S BPXRESLT=$$CVT^BQITRPHS(DFN)

 ;IHS/MSC/MGH changed for patch 1009

 S BPXRESLT=$$ATAG^BQITDUTL(DFN,"ASCVD At Risk")

 S BPXRSLT1=$$ATAG^BQITDUTL(DFN,"ASCVD Known")

 I BPXRESLT=0&(BPXRSLT1=0) S TEST=0,VALUE=TEST,DATE=TODAY

 I $P(BPXRESLT,U,1)=1  S TEST=1,VALUE=$P(BPXRESLT,U,2),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,3)

 I $P(BPXRSLT1,U,1)=1  S TEST=1,VALUE=$P(BPXRESLT,U,2),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRSLT1,U,3)

 Q

WAR(DFN,TEST,DATE,VALUE,TEXT) ;EP

 ;This computed finding will check for active warfarin

 N BPXRESLT,TODAY,X,Y,APCHSPAT

 S X="TODAY" D ^%DT S TODAY=Y

 S APCHSPAT=DFN

 S BPXRESLT=$$ACTWARF^APCHSTP1(APCHSPAT,$$FMADD^XLFDT(DT,-45),DT)

 I $P(BPXRESLT,U,1)=1 S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT="Warfarin prescription found",DATE=DT

 I $P(BPXRESLT,U,1)=0 S TEST=0,VALUE=TEST,DATE=TODAY

 Q

INRGOAL(DFN,TEST,DATE,VALUE,TEXT) ;EP

 ;This computed finding will check the PCC logic for INR goal

 N BPXRESLT,TODAY,X,Y,APCHSPAT,ACT,ITEM

 S ITEM=$O(^APCHSURV("B","ANTICOAGULATION: INR GOAL",""))

 S ACT=$$INAC^APCHSMU(ITEM)

 S X="TODAY" D ^%DT S TODAY=Y

 I ACT=0 S TEST=1,VALUE="TP NOT ACTIVE",DATE=TODAY

 I ACT=1 D

 .S APCHSPAT=DFN

 .S BPXRESLT=$$MRGOAL^APCHSACG(APCHSPAT)

 .I $P(BPXRESLT,U,1)>0 S TEST=1,VALUE=$P(BPXRESLT,U,2),TEXT=$P(BPXRESLT,U,2),DATE=TODAY

 .E  S TEST=0,VALUE="NO INRGOAL",DATE=TODAY

 Q

INRDUR(DFN,TEST,DATE,VALUE,TEXT) ; EP

 ;This computed finding will check the PCC logic for duration of therapy

 N BPXRESLT,TODAY,X,Y,APCHSPAT,ACT,ITEM

 S ITEM=$O(^APCHSURV("B","ANTICOAGULATION: DURATION OF A",""))

 S ACT=$$INAC^APCHSMU(ITEM)

 S X="TODAY" D ^%DT S TODAY=Y

 I ACT=0 S TEST=1,VALUE="TP NOT ACTIVE",DATE=TODAY

 I ACT=1 D

 .S APCHSPAT=DFN

 .S BPXRESLT=$$MRDUR^APCHSACG(APCHSPAT)

 .I $P(BPXRESLT,U,1)>0 S TEST=1,VALUE=$P(BPXRESLT,U,2),TEXT=$P(BPXRESLT,U,2),DATE=TODAY

 .E  S TEST=0,VALUE=TEST,DATE=TODAY

 Q

INREND(DFN,TEST,DATE,VALUE,TEXT) ; EP

 ;This computed finding will check for stop date of treatment

 N BPXRESLT,TODAY,X,Y,APCHSPAT,ACT,ITEM

 S ITEM=$O(^APCHSURV("B","ANTICOAGULATION: ANTICOAGULATI",""))

 S ACT=$$INAC^APCHSMU(ITEM)

 S X="TODAY" D ^%DT S TODAY=Y

 I ACT=0 S TEST=1,VALUE="TP NOT ACTIVE",DATE=TODAY

 I ACT=1 D

 .NEW X,G

 .S APCHSPAT=DFN

 .S X=$P($$MREND^APCHSACG(APCHSPAT),U,1)  ;END DATE

 .I X="" S TEST=1,VALUE=TEST,DATE=TODAY Q  ;no end date less than t+45

 .S G=0

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

 .I X<$$FMADD^XLFDT(DT,45) S G=1

 .I G S TEST=0,VALUE=TEST,DATE=TODAY Q

 .I 'G S TEST=1,VALUE=TEST,DATE=TODAY   ;Not a candidate

 Q

ACURIN(DFN,TEST,DATE,VALUE,TEXT) ; EP

 ;This computed finding will check the PCC logic urinalysis

 N BPXRESLT,TODAY,X,Y,APCHSPAT

 S X="TODAY" D ^%DT S TODAY=Y

 S APCHSPAT=DFN

 S BPXRESLT=$$LASTACUR^APCHSACG(APCHSPAT)

 I BPXRESLT="" S TEST=0,VALUE=TEST,DATE=TODAY

 I $P(BPXRESLT,U,1)'<$$FMADD^XLFDT(DT,-365) S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT=$p(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,1)  ;had one in past year

 I $P(BPXRESLT,U,1)>0 S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,1)

 I $P(BPXRESLT,U,1)=0 S TEST=0,VALUE=TEST,DATE=TODAY

 Q

ACCBC(DFN,TEST,DATE,VALUE,TEXT) ; EP

 ;This computed finding will check the PCC logic for CBC

 N BPXRESLT,TODAY,X,Y,APCHSPAT

 S X="TODAY" D ^%DT S TODAY=Y

 S APCHSPAT=DFN

 S BPXRESLT=$$LASTACCB^APCHSACG(APCHSPAT)

 I BPXRESLT="" S TEST=0,VALUE=TEST,DATE=TODAY

 I $P(BPXRESLT,U,1)'<$$FMADD^XLFDT(DT,-365) S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,1)

 I $P(BPXRESLT,U,1)>0 S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,1)

 I $P(BPXRESLT,U,1)=0 S TEST=0,VALUE=TEST,DATE=TODAY

 Q

ACFOBT(DFN,TEST,DATE,VALUE,TEXT) ; EP

 ;This computed finding will check the PCC logic for FOBT

 N BPXRESLT,TODAY,X,Y,APCHSPAT

 S X="TODAY" D ^%DT S TODAY=Y

 S APCHSPAT=DFN

 I $$LASTDX^APCHSMU2(APCHSPAT,"BGP OSTEOPOROSIS DXS",$P(^DPT(APCHSPAT,0),U,3),TODAY) S TEST=1,VALUE="NA",TEXT="Pt has DX of osteoporosis",DATE=TODAY Q

 S BPXRESLT=$$LASTACFO^APCHSACG(APCHSPAT)

 I BPXRESLT="" S TEST=0,VALUE=TEST,DATE=TODAY

 I $P(BPXRESLT,U,1)'<$$FMADD^XLFDT(DT,-365) S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,1) Q  ;had one in past year

 I $P(BPXRESLT,U,1)>1 S TEST=1,VALUE=$P(BPXRESLT,U,4),TEXT=$P(BPXRESLT,U,2),DATE=$P(BPXRESLT,U,1)

 I $P(BPXRESLT,U,1)=0 S TEST=0,VALUE=TEST,DATE=TODAY

 Q

BPXRMTP   ; IHS/MSC/MGH - Computed Findings for Treatment prompt reminders. ;30-Mar-2018 14:32;DU

 +1       ;;2.0;CLINICAL REMINDERS;**1001,1002,1009**;Feb 04, 2005;Build 17

 +2       ;=================================================================

 +3       ;This routine is designed to use the standard PCC logic for reminders to

 +4       ;evaluate if items are met or not met. Using the standard PCC calls ensures

 +5       ;that all IHS items are using the same logic.

 +6       ;Patch 1009 changed the BQI call for tag

 +7       ;=====================================================================

CVD(DFN,TEST,DATE,VALUE,TEXT) ; EP

 +1       ;This computed finding will check the Treatment prompt logic for CVD

 +2        NEW BPXRESLT,TODAY,X,Y,X1,X2

 +3        SET X="TODAY"

           DO ^%DT

           SET TODAY=Y

 +4        SET X1=TODAY

           SET X2=-3

           DO C^%DTC

 +5       ;S BPXRESLT=$$CVT^BQITRPHS(DFN)

 +6       ;IHS/MSC/MGH changed for patch 1009

 +7        SET BPXRESLT=$$ATAG^BQITDUTL(DFN,"ASCVD At Risk")

 +8        SET BPXRSLT1=$$ATAG^BQITDUTL(DFN,"ASCVD Known")

 +9        IF BPXRESLT=0&(BPXRSLT1=0)

               SET TEST=0

               SET VALUE=TEST

               SET DATE=TODAY

 +10       IF $PIECE(BPXRESLT,U,1)=1

               SET TEST=1

               SET VALUE=$PIECE(BPXRESLT,U,2)

               SET TEXT=$PIECE(BPXRESLT,U,2)

               SET DATE=$PIECE(BPXRESLT,U,3)

 +11       IF $PIECE(BPXRSLT1,U,1)=1

               SET TEST=1

               SET VALUE=$PIECE(BPXRESLT,U,2)

               SET TEXT=$PIECE(BPXRESLT,U,2)

               SET DATE=$PIECE(BPXRSLT1,U,3)

 +12       QUIT 

WAR(DFN,TEST,DATE,VALUE,TEXT) ;EP

 +1       ;This computed finding will check for active warfarin

 +2        NEW BPXRESLT,TODAY,X,Y,APCHSPAT

 +3        SET X="TODAY"

           DO ^%DT

           SET TODAY=Y

 +4        SET APCHSPAT=DFN

 +5        SET BPXRESLT=$$ACTWARF^APCHSTP1(APCHSPAT,$$FMADD^XLFDT(DT,-45),DT)

 +6        IF $PIECE(BPXRESLT,U,1)=1

               SET TEST=1

               SET VALUE=$PIECE(BPXRESLT,U,4)

               SET TEXT="Warfarin prescription found"

               SET DATE=DT

 +7        IF $PIECE(BPXRESLT,U,1)=0

               SET TEST=0

               SET VALUE=TEST

               SET DATE=TODAY

 +8        QUIT 

INRGOAL(DFN,TEST,DATE,VALUE,TEXT) ;EP

 +1       ;This computed finding will check the PCC logic for INR goal

 +2        NEW BPXRESLT,TODAY,X,Y,APCHSPAT,ACT,ITEM

 +3        SET ITEM=$ORDER(^APCHSURV("B","ANTICOAGULATION: INR GOAL",""))

 +4        SET ACT=$$INAC^APCHSMU(ITEM)

 +5        SET X="TODAY"

           DO ^%DT

           SET TODAY=Y

 +6        IF ACT=0

               SET TEST=1

               SET VALUE="TP NOT ACTIVE"

               SET DATE=TODAY

 +7        IF ACT=1

               Begin DoDot:1

 +8                SET APCHSPAT=DFN

 +9                SET BPXRESLT=$$MRGOAL^APCHSACG(APCHSPAT)

 +10               IF $PIECE(BPXRESLT,U,1)>0

                       SET TEST=1

                       SET VALUE=$PIECE(BPXRESLT,U,2)

                       SET TEXT=$PIECE(BPXRESLT,U,2)

                       SET DATE=TODAY

 +11              IF '$TEST

                       SET TEST=0

                       SET VALUE="NO INRGOAL"

                       SET DATE=TODAY

               End DoDot:1

 +12       QUIT 

INRDUR(DFN,TEST,DATE,VALUE,TEXT) ; EP

 +1       ;This computed finding will check the PCC logic for duration of therapy

 +2        NEW BPXRESLT,TODAY,X,Y,APCHSPAT,ACT,ITEM

 +3        SET ITEM=$ORDER(^APCHSURV("B","ANTICOAGULATION: DURATION OF A",""))

 +4        SET ACT=$$INAC^APCHSMU(ITEM)

 +5        SET X="TODAY"

           DO ^%DT

           SET TODAY=Y

 +6        IF ACT=0

               SET TEST=1

               SET VALUE="TP NOT ACTIVE"

               SET DATE=TODAY

 +7        IF ACT=1

               Begin DoDot:1

 +8                SET APCHSPAT=DFN

 +9                SET BPXRESLT=$$MRDUR^APCHSACG(APCHSPAT)

 +10               IF $PIECE(BPXRESLT,U,1)>0

                       SET TEST=1

                       SET VALUE=$PIECE(BPXRESLT,U,2)

                       SET TEXT=$PIECE(BPXRESLT,U,2)

                       SET DATE=TODAY

 +11              IF '$TEST

                       SET TEST=0

                       SET VALUE=TEST

                       SET DATE=TODAY

               End DoDot:1

 +12       QUIT 

INREND(DFN,TEST,DATE,VALUE,TEXT) ; EP

 +1       ;This computed finding will check for stop date of treatment

 +2        NEW BPXRESLT,TODAY,X,Y,APCHSPAT,ACT,ITEM

 +3        SET ITEM=$ORDER(^APCHSURV("B","ANTICOAGULATION: ANTICOAGULATI",""))

 +4        SET ACT=$$INAC^APCHSMU(ITEM)

 +5        SET X="TODAY"

           DO ^%DT

           SET TODAY=Y

 +6        IF ACT=0

               SET TEST=1

               SET VALUE="TP NOT ACTIVE"

               SET DATE=TODAY

 +7        IF ACT=1

               Begin DoDot:1

 +8                NEW X,G

 +9                SET APCHSPAT=DFN

 +10      ;END DATE

                   SET X=$PIECE($$MREND^APCHSACG(APCHSPAT),U,1)

 +11      ;no end date less than t+45

                   IF X=""

                       SET TEST=1

                       SET VALUE=TEST

                       SET DATE=TODAY

                       QUIT 

 +12               SET G=0

 +13               SET X=$PIECE(X,U,1)

 +14               IF X<$$FMADD^XLFDT(DT,45)

                       SET G=1

 +15               IF G

                       SET TEST=0

                       SET VALUE=TEST

                       SET DATE=TODAY

                       QUIT 

 +16      ;Not a candidate

                   IF 'G

                       SET TEST=1

                       SET VALUE=TEST

                       SET DATE=TODAY

               End DoDot:1

 +17       QUIT 

ACURIN(DFN,TEST,DATE,VALUE,TEXT) ; EP

 +1       ;This computed finding will check the PCC logic urinalysis

 +2        NEW BPXRESLT,TODAY,X,Y,APCHSPAT

 +3        SET X="TODAY"

           DO ^%DT

           SET TODAY=Y

 +4        SET APCHSPAT=DFN

 +5        SET BPXRESLT=$$LASTACUR^APCHSACG(APCHSPAT)

 +6        IF BPXRESLT=""

               SET TEST=0

               SET VALUE=TEST

               SET DATE=TODAY

 +7       ;had one in past year

           IF $PIECE(BPXRESLT,U,1)'<$$FMADD^XLFDT(DT,-365)

               SET TEST=1

               SET VALUE=$PIECE(BPXRESLT,U,4)