BGP2DCI.m

BGP2DCI ; IHS/CMI/LAB - IHS area GPRA 10 Dec 2006 9:12 AM ;

 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 ;

CALCIND ;EP - CALCULATE ALL MEASURES

 S BGPIC=0 F  S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC'=+BGPIC  D

 .I BGPRTYPE=1,$P(^BGPINDW(BGPIC,0),U,7)'=1 Q  ;national gpra report

 .I BGPRTYPE=7,$P($G(^BGPINDW(BGPIC,12)),U,1)'=1 Q  ;OTHER NATIONAL

 .K BGPSTOP,BGPVAL,BGPVALUE,BGPVALUD,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z,BGPVALUD

 .K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30

 .K BGPN31,BGPN32,BGPN33,BGPN34,BGPN35,BGPN36,BGPN37,BGPN38,BGPN39,BGPN40,BGPN41,BGPN42,BGPN43,BGPN44,BGPN45,BGPN46,BGPN50,BGPN51,BGPN52,BGPN60,BGPN61,BGPN62,BGPN70,BGPN71,BGPN72,BGPN80,BGPN81,BGPN82

 .K BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13

 .K BGPNUMV

 .K ^TMP($J)

 .I $D(^BGPINDW(BGPIC,1)) X ^BGPINDW(BGPIC,1)

 .K BGPVAL,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 .K ^TMP($J)

 .;Set up global for iCare

 .I $G(BQIGREF)'="",$D(BGPSTOP) S @BQIGREF@(DFN,BGPIC)=$P(^BGPINDW(BGPIC,0),U,3)_"^N/A" Q

 .I $D(BGPSTOP) Q  ;no need to set since no num/denom

 .;loop each individual to set numerator and denominator

 .S BGPI=0 F  S BGPI=$O(^BGPINDWC("B",BGPIC,BGPI)) Q:BGPI'=+BGPI  D

 ..S (BGPNUM,BGPDEN)=0

 ..X ^BGPINDWC(BGPI,1)

 ..X ^BGPINDWC(BGPI,2) ;denominator 1 or 0

 ..;set field counter

 ..S BGPNF=$P(^BGPINDWC(BGPI,0),U,9)

 ..S BGPN=$P(^DD(90548.03,BGPNF,0),U,4)

 ..S N=$P(BGPN,";"),P=$P(BGPN,";",2)

 ..D S(BGPRPT,BGPGBL,N,P,BGPNUM),S1("N",BGPNUM)

 ..S BGPDF=$P(^BGPINDWC(BGPI,0),U,8)

 ..S BGPN=$P(^DD(90548.03,BGPDF,0),U,4),N=$P(BGPN,";"),P=$P(BGPN,";",2)

 ..I BGPDEN'="NO" D S(BGPRPT,BGPGBL,N,P,BGPDEN),S1("D",BGPDEN)

 ..I $G(BGPCPPL) D CPL

 .I $D(BGPLIST(BGPIC)) D STMP^BGP2UTL

 .I $G(BGPNPL) D NPL

 K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26

 Q

 ;

CPL ;comprehensive pat list check and set xtmp

 I BGPLIST="P",$P(^AUPNPAT(DFN,0),U,14)'=BGPLPRV Q  ;not this provider

 Q:BGPTIME'=1

 Q:$P($G(^BGPINDWC(BGPI,12)),U,1)=""

 X ^BGPINDWC(BGPI,3) Q:'$T

 S C=$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN")

 S S=$P(^DPT(DFN,0),U,2)

 S D=$P(BGPVALUE,"|||")

 S F=$P($G(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN)),"|||")

 I D["UP" S $P(F,"$$",1)="UP"

 I D["AC" S $P(F,"$$",2)="AC"

 I D["AD" S $P(F,"$$",3)="AD"

 I D["AAD" S $P(F,"$$",4)="AAD"

 I D["PREG" S $P(F,"$$",5)="PREG"

 I D["IMM" S $P(F,"$$",6)="IMM"

 I D["IHD" S $P(F,"$$",7)="IHD"

 I '$D(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN)) D  Q

 .S ^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN)=F_"|||"_$P(^BGPINDWC(BGPI,12),U),BGPCPLC=BGPCPLC+1

 S $P(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN),"|||")=F

 S $P(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN),"|||",2)=$P(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN),"|||",2)_"#"_$P(^BGPINDWC(BGPI,12),U)

 Q

NPL ;

 Q:BGPTIME'=1

 Q:'$D(BGPINDL(BGPIC))  ;not a selected topic

 S BGPX=0 F  S BGPX=$O(BGPINDL(BGPIC,BGPX)) Q:BGPX'=+BGPX  D

 .I BGPLIST="P",$P(^AUPNPAT(DFN,0),U,14)'=BGPLPRV Q

 .S BGPORD=$P($G(^BGPINDW(BGPIC,12)),U,6)

 .X ^BGPNPLW(BGPX,12) K ^TMP($J) Q:'$T

 .S BGPINDL(BGPIC,BGPX)=$G(BGPINDL(BGPIC,BGPX))+1

 .I $G(BGPYNPLT) S ^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPIC,BGPX,DFN)="" Q

 .S BGPO=$S(BGPRTYPE=7:$P(^BGPNPLW(BGPX,0),U,6),1:$P(^BGPNPLW(BGPX,0),U,5))

 .I $P(^BGPNPLW(BGPX,0),U,7)=9,$G(BGPVALUD)]"" S BGPVALUE=BGPVALUD

 .S ^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPIC,BGPO,BGPX,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEB,DFN)=$G(BGPVALUE)

 K BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPX

 Q

S(R,G,N,P,V) ;

 I 'V Q  ;no value to add

 S $P(@(G_R_","_N_")"),U,P)=$P($G(@(G_R_","_N_")")),U,P)+V

 Q

D(D) ;

 I D="" Q ""

 Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))

 ;

S1(BQITYP,BQIVAL) ; Return data by patient for iCare into global reference BQIGREF

 ;Input Variables

 ;  BQITYP - Type of value

 ;           D = Denominator

 ;           N = Numerator

 ;  BQIVAL - Value of the type; 0 or 1

 ;Assumed variables

 ;  BGPVALUE - the measure value

 ;  BQIGREF  - global reference where data will be stored temporarily

 ;  BGPIC    - Indicator IEN

 ;  BGPI     - Individual Indicator IEN

 ;  DFN      - Patient IEN

 ;

 ; If no value of BQIGREF, then it's the regular GPRA report calling the code

 ; and nothing needs to be set for iCare.

 Q:$G(BQIGREF)=""

 ;

 ; If no denominator or numerator value, then it doesn't need to be set for iCare

 I '$G(BQIVAL) Q

 ;

 NEW BQITIT,BQILTIT,BQILTIT1,BQILTIT2,BQILTIT3,BQILDTI1,BQILDTI2

 NEW BQIDTIT,BQIFTIT,BQITWEN,BQICURR,BQIIDTA,BQIDTA,BQILDTI3

 S BQIIDTA=$G(^BGPINDWC(BGPI,0))

 S BQIDTA=$G(^BGPINDWC(BGPI,14))

 ;

 ; Get the Individual Indicator TITLE (1404) 

 S BQITIT=$P(BQIDTA,U,4)

 ;

 ; Get the Individual Indicator LINE TITLE 1 (.15)

 S BQILTIT1=$P(BQIIDTA,U,15)

 I BQILTIT1="" Q

 ; Get the Individual Indicator LINE TITLE 2 and 3 (.16,.19) 

 S BQILTIT2=$P(BQIIDTA,U,16)

 S BQILTIT3=$P(BQIIDTA,U,19)

 S BQILTIT=BQILTIT1_" "_BQILTIT2_" "_BQILTIT3

 ;

 ; Get the Individual Indicator LOCAL DENOM TITLE 1, 2, and 3 (.17,.18,.21)

 S BQILDTI1=$P(BQIIDTA,U,17)

 S BQILDTI2=$P(BQIIDTA,U,18)

 S BQILDTI3=$P(BQIIDTA,U,21)

 S BQIDTIT=BQILDTI1_" "_BQILDTI2_" "_BQILDTI3

 ;

 ;  Full title is all title fields

 S BQIFTIT=BQITIT_" "_BQILTIT_" "_BQIDTIT

 S $P(@BQIGREF@(DFN,BGPIC,BGPI),"^",1)=BQIFTIT

 ;

 ;  Get the GOAL 2012 value and the GOAL 06 value

 S BQITWEN=$P(BQIDTA,U,3)

 S BQICURR=$P(BQIDTA,U,8)

 ;

 I BQITYP="N" S $P(@BQIGREF@(DFN,BGPIC,BGPI),"^",2)=$G(BQIVAL)

 ;

 I BQITYP="D" S $P(@BQIGREF@(DFN,BGPIC,BGPI),"^",3)=$G(BQIVAL)

 ;

 ;  Set the Indicator TITLE (.03)

 S $P(@BQIGREF@(DFN,BGPIC),U,1)=$P(^BGPINDW(BGPIC,0),U,3)

 S $P(@BQIGREF@(DFN,BGPIC),U,2)=$G(BGPVALUE)

 I BQITWEN'="" S $P(@BQIGREF@(DFN,BGPIC),U,3)=BQITWEN

 I BQICURR'="" S $P(@BQIGREF@(DFN,BGPIC),U,4)=BQICURR

 Q

BGP2DCI   ; IHS/CMI/LAB - IHS area GPRA 10 Dec 2006 9:12 AM ;

 +1       ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66

 +2       ;

CALCIND   ;EP - CALCULATE ALL MEASURES

 +1        SET BGPIC=0

           FOR 

               SET BGPIC=$ORDER(BGPIND(BGPIC))

               IF BGPIC'=+BGPIC

                   QUIT 

               Begin DoDot:1

 +2       ;national gpra report

                   IF BGPRTYPE=1

                       IF $PIECE(^BGPINDW(BGPIC,0),U,7)'=1

                           QUIT 

 +3       ;OTHER NATIONAL

                   IF BGPRTYPE=7

                       IF $PIECE($GET(^BGPINDW(BGPIC,12)),U,1)'=1

                           QUIT 

 +4                KILL BGPSTOP,BGPVAL,BGPVALUE,BGPVALUD,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z,BGPVALUD

 +5                KILL BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPN27,BGPN28,BGPN29,BGPN30

 +6                KILL BGPN31,BGPN32,BGPN33,BGPN34,BGPN35,BGPN36,BGPN37,BGPN38,BGPN39,BGPN40,BGPN41,BGPN42,BGPN43,BGPN44,BGPN45,BGPN46,BGPN50,BGPN51,BGPN52,BGPN60,BGPN61,BGPN62,BGPN70,BGPN71,BGPN72,BGPN80,BGPN81,BGPN82

 +7                KILL BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9,BGPD10,BGPD11,BGPD12,BGPD13

 +8                KILL BGPNUMV

 +9                KILL ^TMP($JOB)

 +10               IF $DATA(^BGPINDW(BGPIC,1))

                       XECUTE ^BGPINDW(BGPIC,1)

 +11               KILL BGPVAL,BGPG,BGPC,BGPALLED,BGPV,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +12               KILL ^TMP($JOB)

 +13      ;Set up global for iCare

 +14               IF $GET(BQIGREF)'=""

                       IF $DATA(BGPSTOP)

                           SET @BQIGREF@(DFN,BGPIC)=$PIECE(^BGPINDW(BGPIC,0),U,3)_"^N/A"

                           QUIT 

 +15      ;no need to set since no num/denom

                   IF $DATA(BGPSTOP)

                       QUIT 

 +16      ;loop each individual to set numerator and denominator

 +17               SET BGPI=0

                   FOR 

                       SET BGPI=$ORDER(^BGPINDWC("B",BGPIC,BGPI))

                       IF BGPI'=+BGPI

                           QUIT 

                       Begin DoDot:2

 +18                       SET (BGPNUM,BGPDEN)=0

 +19                       XECUTE ^BGPINDWC(BGPI,1)

 +20      ;denominator 1 or 0

                           XECUTE ^BGPINDWC(BGPI,2)

 +21      ;set field counter

 +22                       SET BGPNF=$PIECE(^BGPINDWC(BGPI,0),U,9)

 +23                       SET BGPN=$PIECE(^DD(90548.03,BGPNF,0),U,4)

 +24                       SET N=$PIECE(BGPN,";")

                           SET P=$PIECE(BGPN,";",2)

 +25                       DO S(BGPRPT,BGPGBL,N,P,BGPNUM)

                           DO S1("N",BGPNUM)

 +26                       SET BGPDF=$PIECE(^BGPINDWC(BGPI,0),U,8)

 +27                       SET BGPN=$PIECE(^DD(90548.03,BGPDF,0),U,4)

                           SET N=$PIECE(BGPN,";")

                           SET P=$PIECE(BGPN,";",2)

 +28                       IF BGPDEN'="NO"

                               DO S(BGPRPT,BGPGBL,N,P,BGPDEN)

                               DO S1("D",BGPDEN)

 +29                       IF $GET(BGPCPPL)

                               DO CPL

                       End DoDot:2

 +30               IF $DATA(BGPLIST(BGPIC))

                       DO STMP^BGP2UTL

 +31               IF $GET(BGPNPL)

                       DO NPL

               End DoDot:1

 +32       KILL BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26

 +33       QUIT 

 +34      ;

CPL       ;comprehensive pat list check and set xtmp

 +1       ;not this provider

           IF BGPLIST="P"

               IF $PIECE(^AUPNPAT(DFN,0),U,14)'=BGPLPRV

                   QUIT 

 +2        IF BGPTIME'=1

               QUIT 

 +3        IF $PIECE($GET(^BGPINDWC(BGPI,12)),U,1)=""

               QUIT 

 +4        XECUTE ^BGPINDWC(BGPI,3)

           IF '$TEST

               QUIT 

 +5        SET C=$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN")

 +6        SET S=$PIECE(^DPT(DFN,0),U,2)

 +7        SET D=$PIECE(BGPVALUE,"|||")

 +8        SET F=$PIECE($GET(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN)),"|||")

 +9        IF D["UP"

               SET $PIECE(F,"$$",1)="UP"

 +10       IF D["AC"

               SET $PIECE(F,"$$",2)="AC"

 +11       IF D["AD"

               SET $PIECE(F,"$$",3)="AD"

 +12       IF D["AAD"

               SET $PIECE(F,"$$",4)="AAD"

 +13       IF D["PREG"

               SET $PIECE(F,"$$",5)="PREG"

 +14       IF D["IMM"

               SET $PIECE(F,"$$",6)="IMM"

 +15       IF D["IHD"

               SET $PIECE(F,"$$",7)="IHD"

 +16       IF '$DATA(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN))

               Begin DoDot:1

 +17               SET ^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN)=F_"|||"_$PIECE(^BGPINDWC(BGPI,12),U)

                   SET BGPCPLC=BGPCPLC+1

               End DoDot:1

               QUIT 

 +18       SET $PIECE(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN),"|||")=F

 +19       SET $PIECE(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN),"|||",2)=$PIECE(^XTMP("BGP28CPL",BGPJ,BGPH,"LIST",C,S,BGPAGEB,DFN),"|||",2)_"#"_$PIECE(^BGPINDWC(BGPI,12),U)

 +20       QUIT 

NPL       ;

 +1        IF BGPTIME'=1

               QUIT 

 +2       ;not a selected topic

           IF '$DATA(BGPINDL(BGPIC))

               QUIT 

 +3        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(BGPINDL(BGPIC,BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               Begin DoDot:1

 +4                IF BGPLIST="P"

                       IF $PIECE(^AUPNPAT(DFN,0),U,14)'=BGPLPRV

                           QUIT 

 +5                SET BGPORD=$PIECE($GET(^BGPINDW(BGPIC,12)),U,6)

 +6                XECUTE ^BGPNPLW(BGPX,12)

                   KILL ^TMP($JOB)

                   IF '$TEST

                       QUIT 

 +7                SET BGPINDL(BGPIC,BGPX)=$GET(BGPINDL(BGPIC,BGPX))+1

 +8                IF $GET(BGPYNPLT)

                       SET ^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPIC,BGPX,DFN)=""

                       QUIT 

 +9                SET BGPO=$SELECT(BGPRTYPE=7:$PIECE(^BGPNPLW(BGPX,0),U,6),1:$PIECE(^BGPNPLW(BGPX,0),U,5))

 +10               IF $PIECE(^BGPNPLW(BGPX,0),U,7)=9

                       IF $GET(BGPVALUD)]""

                           SET BGPVALUE=BGPVALUD

 +11               SET ^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPIC,BGPO,BGPX,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEB,DFN)=$GET(BGPVALUE)

               End DoDot:1

 +12       KILL BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPN14,BGPN15,BGPN16,BGPN17,BGPN18,BGPN19,BGPN20,BGPN21,BGPN22,BGPN23,BGPN24,BGPN25,BGPN26,BGPX

 +13       QUIT 

S(R,G,N,P,V) ;

 +1       ;no value to add

           IF 'V

               QUIT 

 +2        SET $PIECE(@(G_R_","_N_")"),U,P)=$PIECE($GET(@(G_R_","_N_")")),U,P)+V

 +3        QUIT 

D(D)      ;

 +1        IF D=""

               QUIT ""

 +2        QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+$EXTRACT(D,1,3))

 +3       ;

S1(BQITYP,BQIVAL) ; Return data by patient for iCare into global reference BQIGREF

 +1       ;Input Variables

 +2       ;  BQITYP - Type of value

 +3       ;           D = Denominator

 +4       ;           N = Numerator

 +5       ;  BQIVAL - Value of the type; 0 or 1

 +6       ;Assumed variables

 +7       ;  BGPVALUE - the measure value

 +8       ;  BQIGREF  - global reference where data will be stored temporarily

 +9       ;  BGPIC    - Indicator IEN

 +10      ;  BGPI     - Individual Indicator IEN

 +11      ;  DFN      - Patient IEN

 +12      ;

 +13      ; If no value of BQIGREF, then it's the regular GPRA report calling the code

 +14      ; and nothing needs to be set for iCare.

 +15       IF $GET(BQIGREF)=""

               QUIT 

 +16      ;

 +17      ; If no denominator or numerator value, then it doesn't need to be set for iCare

 +18       IF '$GET(BQIVAL)

               QUIT 

 +19      ;

 +20       NEW BQITIT,BQILTIT,BQILTIT1,BQILTIT2,BQILTIT3,BQILDTI1,BQILDTI2

 +21       NEW BQIDTIT,BQIFTIT,BQITWEN,BQICURR,BQIIDTA,BQIDTA,BQILDTI3

 +22       SET BQIIDTA=$GET(^BGPINDWC(BGPI,0))

 +23       SET BQIDTA=$GET(^BGPINDWC(BGPI,14))

 +24      ;

 +25      ; Get the Individual Indicator TITLE (1404) 

 +26       SET BQITIT=$PIECE(BQIDTA,U,4)

 +27      ;

 +28      ; Get the Individual Indicator LINE TITLE 1 (.15)

 +29       SET BQILTIT1=$PIECE(BQIIDTA,U,15)

 +30       IF BQILTIT1=""

               QUIT 

 +31      ; Get the Individual Indicator LINE TITLE 2 and 3 (.16,.19) 

 +32       SET BQILTIT2=$PIECE(BQIIDTA,U,16)

 +33       SET BQILTIT3=$PIECE(BQIIDTA,U,19)

 +34       SET BQILTIT=BQILTIT1_" "_BQILTIT2_" "_BQILTIT3

 +35      ;

 +36      ; Get the Individual Indicator LOCAL DENOM TITLE 1, 2, and 3 (.17,.18,.21)

 +37       SET BQILDTI1=$PIECE(BQIIDTA,U,17)

 +38       SET BQILDTI2=$PIECE(BQIIDTA,U,18)

 +39       SET BQILDTI3=$PIECE(BQIIDTA,U,21)

 +40       SET BQIDTIT=BQILDTI1_" "_BQILDTI2_" "_BQILDTI3

 +41      ;

 +42      ;  Full title is all title fields

 +43       SET BQIFTIT=BQITIT_" "_BQILTIT_" "_BQIDTIT

 +44       SET $PIECE(@BQIGREF@(DFN,BGPIC,BGPI),"^",1)=BQIFTIT

 +45      ;

 +46      ;  Get the GOAL 2012 value and the GOAL 06 value

 +47       SET BQITWEN=$PIECE(BQIDTA,U,3)

 +48       SET BQICURR=$PIECE(BQIDTA,U,8)

 +49      ;

 +50       IF BQITYP="N"

               SET $PIECE(@BQIGREF@(DFN,BGPIC,BGPI),"^",2)=$GET(BQIVAL)

 +51      ;

 +52       IF BQITYP="D"

               SET $PIECE(@BQIGREF@(DFN,BGPIC,BGPI),"^",3)=$GET(BQIVAL)

 +53      ;

 +54      ;  Set the Indicator TITLE (.03)

 +55       SET $PIECE(@BQIGREF@(DFN,BGPIC),U,1)=$PIECE(^BGPINDW(BGPIC,0),U,3)

 +56       SET $PIECE(@BQIGREF@(DFN,BGPIC),U,2)=$GET(BGPVALUE)

 +57       IF BQITWEN'=""

               SET $PIECE(@BQIGREF@(DFN,BGPIC),U,3)=BQITWEN

 +58       IF BQICURR'=""

               SET $PIECE(@BQIGREF@(DFN,BGPIC),U,4)=BQICURR

 +59       QUIT