BQITRACB.m

BQITRACB ;PRXM/HC/ALA-Treatment Prompt for ACEI or ARB ; 22 May 2007  10:56 AM

 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41

 ;

ACB(BQDFN,BQRM) ;EP - Ace Inhibitor or ARB CVD.TP-17

 ; Input

 ;   BQDFN - Patient IEN

 ;

 ; If it didn't meet the criteria of NOT on ACEI or ARB, then quit

 ;

 NEW ACT,X,COND,BQI,QFL,BN,LBN,LAST,DDESC,X1,X2,BI

 S ACT=0

 ;S X1=$$TAX^BQITRUTL("T-12M","BGP HYPERTENSION DXS",1,BQDFN,9000010.07)

 ;S X2=$$TAX^BQITRUTL("","BGP HYPERTENSION DXS",2,BQDFN,9000010.07,1,0)

 S X=$$TAX^BQITRUTL("","BGP HYPERTENSION DXS",2,BQDFN,9000010.07,1,0)

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

 . NEW BQVDTM,BQDATA,OK,BQVIS

 . ; I visit is blank, then this is an active problem

 . I $P(X,U,3)="",$P(X,U,4)'="" S ACT=ACT+1,COND(ACT)="HTN" Q

 . S BQVDTM=$$DATE^BQIUL1("T-12M"),BQDATA=$P(X,U,2),OK=0

 . F BI=1:1:$L(BQDATA) I $P(BQDATA,";",BI)'<BQVDTM S OK=1

 . I 'OK Q

 . S ACT=ACT+1,COND(ACT)="HTN"

 ;

 S X=$$BP^BQITRUTL("T-24M",BQDFN,140,90,"'<")

 I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="High BP"

 ;

 D

 . S X=$$TAX^BQITRUTL("T-24M","BGP NEPHROPATHY CPTS",1,BQDFN,9000010.18)

 . I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="Nephropathy" Q

 . S X=$$TAX^BQITRUTL("T-24M","BQI NEPHROPATHY PROCEDURES",1,BQDFN,9000010.08)

 . I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="Nephropathy" Q

 . S X=$$TAX^BQITRUTL("T-24M","BQI NEPHROPATHY DXS",2,BQDFN,9000010.07,1,0)

 . I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="Nephropathy" Q

 ;

 ;  Check for positive microalbuminuria tests in the last year

 D

 . S X=$$LAB^BQITRUTL("T-12M",0,BQDFN,"DM AUDIT MICROALBUMINURIA TAX","POS","=")

 . I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="Positive microalbuminuria" Q

 . S X=$$LAB^BQITRUTL("T-12M",0,BQDFN,"BGP MICROALBUM LOINC CODES","POS","=")

 . I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="Positive microalbuminuria"

 ;

 S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"BGP GPRA ESTIMATED GFR TAX",60,"<")

 I $P(X,U,1)=1 S ACT=ACT+1,COND(ACT)="Est GFR < 60"

 ;

 ;Update the remarks

 I ACT=0 K BQRM Q 0_U_"No applicable conditions"

 ;

 I ACT>0 D

 . S BN=0,DDESC=""

 . F  S BN=$O(BQRM(BN)) Q:BN=""  D

 .. I BQRM(BN)["|" D

 ... S LBN=$O(BQRM(BN)),LAST=BQRM(LBN)

 ... S BI=0 F  S BI=$O(COND(BI)) Q:BI=""  D

 .... S BQRM(BN)=$C(10)_"   "_COND(BI),BN=BN+1,DDESC=DDESC_COND(BI)_"; "

 . S BN=$O(BQRM(BN),-1)

 . I BN'="",BQRM(BN)'=LAST S BN=BN+1,BQRM(BN)=LAST

 Q 1_U_DDESC

BQITRACB  ;PRXM/HC/ALA-Treatment Prompt for ACEI or ARB ; 22 May 2007  10:56 AM

 +1       ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41

 +2       ;

ACB(BQDFN,BQRM) ;EP - Ace Inhibitor or ARB CVD.TP-17

 +1       ; Input

 +2       ;   BQDFN - Patient IEN

 +3       ;

 +4       ; If it didn't meet the criteria of NOT on ACEI or ARB, then quit

 +5       ;

 +6        NEW ACT,X,COND,BQI,QFL,BN,LBN,LAST,DDESC,X1,X2,BI

 +7        SET ACT=0

 +8       ;S X1=$$TAX^BQITRUTL("T-12M","BGP HYPERTENSION DXS",1,BQDFN,9000010.07)

 +9       ;S X2=$$TAX^BQITRUTL("","BGP HYPERTENSION DXS",2,BQDFN,9000010.07,1,0)

 +10       SET X=$$TAX^BQITRUTL("","BGP HYPERTENSION DXS",2,BQDFN,9000010.07,1,0)

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

               Begin DoDot:1

 +12               NEW BQVDTM,BQDATA,OK,BQVIS

 +13      ; I visit is blank, then this is an active problem

 +14               IF $PIECE(X,U,3)=""

                       IF $PIECE(X,U,4)'=""

                           SET ACT=ACT+1

                           SET COND(ACT)="HTN"

                           QUIT 

 +15               SET BQVDTM=$$DATE^BQIUL1("T-12M")

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

                   SET OK=0

 +16               FOR BI=1:1:$LENGTH(BQDATA)

                       IF $PIECE(BQDATA,";",BI)'<BQVDTM

                           SET OK=1

 +17               IF 'OK

                       QUIT 

 +18               SET ACT=ACT+1

                   SET COND(ACT)="HTN"

               End DoDot:1

 +19      ;

 +20       SET X=$$BP^BQITRUTL("T-24M",BQDFN,140,90,"'<")

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

               SET ACT=ACT+1

               SET COND(ACT)="High BP"

 +22      ;

 +23       Begin DoDot:1

 +24           SET X=$$TAX^BQITRUTL("T-24M","BGP NEPHROPATHY CPTS",1,BQDFN,9000010.18)

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

                   SET ACT=ACT+1

                   SET COND(ACT)="Nephropathy"

                   QUIT 

 +26           SET X=$$TAX^BQITRUTL("T-24M","BQI NEPHROPATHY PROCEDURES",1,BQDFN,9000010.08)

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

                   SET ACT=ACT+1

                   SET COND(ACT)="Nephropathy"

                   QUIT 

 +28           SET X=$$TAX^BQITRUTL("T-24M","BQI NEPHROPATHY DXS",2,BQDFN,9000010.07,1,0)

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

                   SET ACT=ACT+1

                   SET COND(ACT)="Nephropathy"

                   QUIT 

           End DoDot:1

 +30      ;

 +31      ;  Check for positive microalbuminuria tests in the last year

 +32       Begin DoDot:1

 +33           SET X=$$LAB^BQITRUTL("T-12M",0,BQDFN,"DM AUDIT MICROALBUMINURIA TAX","POS","=")

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

                   SET ACT=ACT+1

                   SET COND(ACT)="Positive microalbuminuria"

                   QUIT 

 +35           SET X=$$LAB^BQITRUTL("T-12M",0,BQDFN,"BGP MICROALBUM LOINC CODES","POS","=")

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

                   SET ACT=ACT+1

                   SET COND(ACT)="Positive microalbuminuria"

           End DoDot:1

 +37      ;

 +38       SET X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"BGP GPRA ESTIMATED GFR TAX",60,"<")

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

               SET ACT=ACT+1

               SET COND(ACT)="Est GFR < 60"

 +40      ;

 +41      ;Update the remarks

 +42       IF ACT=0

               KILL BQRM

               QUIT 0_U_"No applicable conditions"

 +43      ;

 +44       IF ACT>0

               Begin DoDot:1

 +45               SET BN=0

                   SET DDESC=""

 +46               FOR 

                       SET BN=$ORDER(BQRM(BN))

                       IF BN=""

                           QUIT 

                       Begin DoDot:2

 +47                       IF BQRM(BN)["|"

                               Begin DoDot:3

 +48                               SET LBN=$ORDER(BQRM(BN))

                                   SET LAST=BQRM(LBN)

 +49                               SET BI=0

                                   FOR 

                                       SET BI=$ORDER(COND(BI))

                                       IF BI=""

                                           QUIT 

                                       Begin DoDot:4

 +50                                       SET BQRM(BN)=$CHAR(10)_"   "_COND(BI)

                                           SET BN=BN+1

                                           SET DDESC=DDESC_COND(BI)_"; "

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +51               SET BN=$ORDER(BQRM(BN),-1)

 +52               IF BN'=""

                       IF BQRM(BN)'=LAST

                           SET BN=BN+1

                           SET BQRM(BN)=LAST

               End DoDot:1

 +53       QUIT 1_U_DDESC