BGP3PDL.m

BGP3PDL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2010 8:02 PM ;

 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 ;

 ;

DEL ;

 K ^TMP($J)

 S ^TMP($J,"BGPDEL",0)=0

 K BGPSUMP

 D ^BGP3PDLH

 D DEL1

 I BGPRTYPE=1 D NONSUM^BGP3PDLN

 I BGPRTYPE=1 D DEVSUM^BGP3PDLD

 ;I BGPRTYPE=1 D SUMMARY

 I BGPRTYPE=1 D SDP^BGP3PDLN

 I BGPRTYPE=1 D SDP^BGP3PDLD

 ;I BGPRTYPE=1 D SDP

 I BGPRTYPE=7 D OTHSUM^BGP3PDLO

 D ^BGP3PDLS ;print lists to delimited file

 I $G(BGPCPPL) D CPPL1^BGP3DCLD

 ;if screen selected do screen

 ;

SAVEDEL ;EP

 I $G(BGPSUMON) D SUMONLY Q  ;NEW FOR 09, SUMMARY ONLY

 I BGPDELT="S" D SCREEN,EXIT Q

 ;call xbgsave to create output file

 S XBGL="BGPDATA"

 L +^BGPDATA:300 E  W:'$D(ZTQUEUED) "Unable to lock global" Q

 K ^TMP($J,"SUMMARYDEL")

 K ^BGPDATA ;global for saving

 S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" S ^BGPDATA(X)=^TMP($J,"BGPDEL",X)

 I '$D(BGPGUI) D

 .;I $P($G(^BGPSITE(DUZ(2),0)),U,14) S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)

 .S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 11 DELIMITED OUTPUT",XBQ="N",XBF=0

 .D ^XBGSAVE

 .K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF

 I $D(BGPGUI) D

 .S (C,X)=0 F  S X=$O(^BGPDATA(X)) Q:X'=+X  S C=C+1,^BGPGUIH(BGPGIEN,12,C,0)=^BGPDATA(X)

 .S ^BGPGUIH(BGPGIEN,12,0)="^90549.1912^"_C_"^"_C_"^"_DT

 L -^BGPDATA

 K ^BGPDATA ;export global

 D EXIT

 Q

SUMONLY ;

 ;if screen selected do screen

 I BGPDELT="S" D SCREENSO,EXIT Q

 ;call xbgsave to create output file

 S XBGL="BGPDATA"

 L +^BGPDATA:300 E  W:'$D(ZTQUEUED) "Unable to lock global" Q

 K ^TMP($J,"SUMMARYDEL")

 K ^BGPDATA ;global for saving

 S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(^TMP($J,"BGPDEL",X)="ENDCOVERPAGE")  S ^BGPDATA(X)=^TMP($J,"BGPDEL",X),BGPLX=X

 ;GET STARTING POINT

 S BGPSTP=0,X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X

 S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE)  S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X

 I $G(BGPAREAA) D

 .S BGPSTP=0,X=BGPDEVE F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPSTP=X

 .S X=BGPDEVE,BGPLX=BGPLX+1,BGPDEVE=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE)  S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X

 S BGPSTP=0,X=BGPDEVE F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X

 S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X)

 I '$D(BGPGUI) D

 .;I $P($G(^BGPSITE(DUZ(2),0)),U,14) ;S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)

 .S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 10 DELIMITED OUTPUT",XBQ="N",XBF=0

 .D ^XBGSAVE

 .K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF

 I $D(BGPGUI) D

 .S (C,X)=0 F  S X=$O(^BGPDATA(X)) Q:X'=+X  S C=C+1,^BGPGUIH(BGPGIEN,12,C,0)=^BGPDATA(X)

 .S ^BGPGUIH(BGPGIEN,12,0)="^90549.1912^"_C_"^"_C_"^"_DT

 L -^BGPDATA

 K ^BGPDATA ;export global

 D EXIT

 Q

SCREENSO ;

 S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(^TMP($J,"BGPDEL",X)="ENDCOVERPAGE")  W !,^TMP($J,"BGPDEL",X) S BGPLX=X

 S BGPSTP=0,X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)["GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X

 S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE)  S BGPLX=BGPLX+1 W !,^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X

 I $G(BGPAREAA) D

 .S BGPSTP=0,X=BGPDEVE F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPSTP=X

 .S X=BGPDEVE,BGPLX=BGPLX+1,BGPDEVE=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE)  S BGPLX=BGPLX+1 W !,^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X

 S BGPSTP=0,X=BGPDEVE F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  I ^TMP($J,"BGPDEL",X)["SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X

 S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  S BGPLX=BGPLX+1 W !,^TMP($J,"BGPDEL",X)

 Q

 ;

SCREEN ;

 S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  W:^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" !,^TMP($J,"BGPDEL",X)

 Q

DEL1 ;EP

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

 .D PRINT2

 .I $G(BGPNPL),$D(BGPINDL(BGPIC)),'$D(BGPYNPLT) S BGPINDH=BGPIC D NPL1^BGP3NPLP ;printed nat gpra list

 .I $G(BGPNPL),$D(BGPINDL(BGPIC)),$D(BGPYNPLT) S BGPINDH=BGPIC D CT^BGP3DSTM ;printed nat gpra SEARCH TEMPLATE

 Q:BGPQUIT

 I BGPRTYPE'=1 G PRINT3

 ;now print gpra dev measures

 S BGPGDEV=1,BGPRTYPE=9  ;control variable

 S BGPIC=0 F  S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC=""!(BGPQUIT)  I $P(^BGPINDH(BGPIC,0),U,14) D PRINT2 D

 .Q:BGPQUIT

 .I $G(BGPNPL),$D(BGPINDL(BGPIC)),'$D(BGPYNPLT) S BGPINDH=BGPIC D NPL1^BGP3NPLP ;printed nat gpra list

 .I $G(BGPNPL),$D(BGPINDL(BGPIC)),$D(BGPYNPLT) S BGPINDH=BGPIC D CT^BGP3DSTM ;printed nat gpra SEARCH TEMPLATE

 Q:BGPQUIT

 ;set back to report 1

 S BGPRTYPE=1

PRINT3 ;

 Q

PRINT2 ;

 D

 .S X=" " D S(X,1,1),S(X,1,1)

 .S X=$P(^BGPINDH(BGPIC,0),U,3) D S(X,1,1)

 .S X=" " D S(X,1,1)

 .S X="Denominator(s):" D S(X,1,1)

 .S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)

 .S BGPX=0 F  S BGPX=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX  D

 ..S BGPY=0 F  S BGPY=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY  D

 ...;I $P(^BGPINDH(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q  ;not a denom def for this report

 ...;I '$D(^BGPINDH(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q

 ...I BGPRTYPE=4,'$D(^BGPINDH(BGPIC,BGPNODE,BGPY,12,"B",BGPINDH)) Q

 ...S BGPZ=0 F  S BGPZ=$O(^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ  D

 ....S Y=^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ,0) D S(Y,1,1)

 ....Q

 ...Q

 ..Q

 .S X=" " D S(X,1,1)

 .S X="Numerator(s):" D S(X,1,1)

 .S BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)

 .S BGPX=0 F  S BGPX=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX  D

 ..S BGPY=0 F  S BGPY=$O(^BGPINDH(BGPIC,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY  D

 ...;I $P(^BGPINDH(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q  ;not a denom def for this report

 ...;I BGPRTYPE=4,BGPINDH'="S",$P(^BGPINDH(BGPIC,62,BGPY,0),U,3)'[BGPINDH Q  ;don't display

 ...;I '$D(^BGPINDH(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q  ;not this report type

 ...I BGPRTYPE=4,'$D(^BGPINDH(BGPIC,BGPNODE,BGPY,12,"B",BGPINDH)) Q

 ...S BGPZ=0 F  S BGPZ=$O(^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ  D

 ....S X=^BGPINDH(BGPIC,BGPNODE,BGPY,1,BGPZ,0) D S(X,1,1)

 ....Q

 ...Q

 ..Q

 .S X=" " D S(X,1,1)

 .S BGPNODE=11

 .I BGPRTYPE=1,$O(^BGPINDH(BGPIC,54,0)) S BGPNODE=54

 .I BGPRTYPE=7,$O(^BGPINDH(BGPIC,56,0)) S BGPNODE=56

 .I BGPRTYPE=9,$O(^BGPINDH(BGPIC,58,0)) S BGPNODE=58

 .S X="Logic:" D S(X,1,1)

 .S BGPX=0 F  S BGPX=$O(^BGPINDH(BGPIC,BGPNODE,BGPX)) Q:BGPX'=+BGPX  D

 ..S X=^BGPINDH(BGPIC,BGPNODE,BGPX,0) D S(X,1,1)

 .I BGPRTYPE=9 G CALC

 .S X=" " D S(X,1,1) S X="Performance Measure Description:" D S(X,1,1) S BGPX=0 F  S BGPX=$O(^BGPINDH(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX  D

 ..S X=^BGPINDH(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX,0) D S(X,1,1)

 .I $O(^BGPINDH(BGPIC,52,0)) S X=" " D S(X,1,1) S X="Past Performance and/or Target:" D S(X,1,1) S BGPX=0 F  S BGPX=$O(^BGPINDH(BGPIC,52,BGPX)) Q:BGPX'=+BGPX  D

 ..S X=^BGPINDH(BGPIC,52,BGPX,0) D S(X,1,1)

 .I $O(^BGPINDH(BGPIC,55,0)) S X=" " D S(X,1,1) S X="Source:" D S(X,1,1) S BGPX=0 F  S BGPX=$O(^BGPINDH(BGPIC,55,BGPX)) Q:BGPX'=+BGPX  D

 ..S X=^BGPINDH(BGPIC,55,BGPX,0) D S(X,1,1)

 .I '$O(^BGPINDH(BGPIC,55,0)) D S(" ",1,1)

CALC .X ^BGPINDH(BGPIC,4)

 Q

HEADER ;EP

 S Y=$P(^VA(200,DUZ,0),U,2),$E(Y,35)=$$FMTE^XLFDT(DT) D S(Y,1,1)

 I BGPRTYPE=7 S Y="*** IHS 2013 Other National Measures Report ***" D S(Y,1,1)

 I BGPRTYPE=4 S Y="*** IHS 2013 Clinical Performance Report ***" D S(Y,1,1)

 I BGPRTYPE=1,'$G(BGPNGR09) S Y="*** IHS 2013 National GPRA/GPRAMA Report ***" D S(Y,1,1)

 I BGPRTYPE=1,$G(BGPNGR09) S Y="*** IHS 2014 National GPRA/GPRAMA Report, Run Using 2013 Logic ***" D S(Y,1,1)

 I $G(BGPAREAA) S Y="AREA AGGREGATE" D S(Y,1,1)

 I '$G(BGPAREAA) S Y=$P(^DIC(4,DUZ(2),0),U) D S(Y,1,1)

 ;S X=$$RPTVER^BGP3BAN D S(X,1,1)

 S X="Report Period:  "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)

 S X="Previous Year Period:  "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D S(X,1,1)

 S X="Baseline Period:  "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D S(X,1,1)

 S X=" " D S(X,1,1)

 Q:$G(BGPSUMP)

 I BGPRTYPE=1 S X="Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and Selected Other Clinical Denominators and Numerators" D S(X,1,1)

 S X=" " D S(X,1,1)

 I BGPRTYPE=1 S X="Population:  AI/AN Only (Classification 01)" D S(X,1,1)

 S X=" " D S(X,1,1)

 S BGPI=$O(^BGPCTRL("B",2013,0))

 S BGPX=0 F  S BGPX=$O(^BGPCTRL(BGPI,14,BGPX)) Q:BGPX'=+BGPX  D

 .S X=^BGPCTRL(BGPI,14,BGPX,0) D S(X,1,1)

 I $G(BGPEXPT) S X="A file will be created called BG130"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT_"." D S(X,1,1)

 S X="It will reside in the public/export directory.  This file should be sent to your Area Office." D S(X,1,1)

 S X=" " D S(X,1,1)

 I $G(BGPALLPT) S X="All Communities Included." D S(X,1,1)

 I '$G(BGPALLPT),'$G(BGPSEAT) S X="Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U) D S(X,1,1)

 I '$G(BGPALLPT),'$G(BGPSEAT) S X="The following communities are included in this report:" D S(X,1,1) D

 .S BGPZZ="",N=0,Y="" F  S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ=""  S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ

 .S BGPZZ=0,C=0 F BGPZZ=1:3:N D

 ..S X=$E($P(Y,";",BGPZZ),1,20),$E(X,3)=$E($P(Y,";",(BGPZZ+1)),1,20),$E(X,60)=$E($P(Y,";",(BGPZZ+2)),1,20)

 ..Q

 I $G(BGPMFITI) S X="MFI Location Taxonomy Name: "_$P(^ATXAX(BGPMFITI,0),U) D S(X,1,1)

 I $G(BGPMFITI) S X="The following locations are used for patient visits in this report:" D S(X,1,1) D

 .S BGPZZ="",N=0,Y="" F  S BGPZZ=$O(^ATXAX(BGPMFITI,21,"B",BGPZZ)) Q:BGPZZ=""  S N=N+1,Y=Y_$S(N=1:"",1:";")_$P($G(^DIC(4,BGPZZ,0)),U)

 .S BGPZZ=0,C=0 F BGPZZ=1:3:N D

 ..S X=$E($P(Y,";",BGPZZ),1,20),$E(X,3)=$E($P(Y,";",(BGPZZ+1)),1,20),$E(X,60)=$E($P(Y,";",(BGPZZ+2)),1,20)

 ..Q

 K BGPX,BGPQUIT

 S X=$TR($J(""," ","-"),80) D S(X,1,1)

 Q

EXIT ;

 K ^TMP($J)

 Q

CTR(X,Y) ;EP - Center

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

USR() ;EP - Return user

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

S(Y,F,P) ;EP set up array

 I '$G(F) S F=0

 S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%

 I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""

 S $P(^TMP($J,"BGPDEL",%),U,P)=Y

 Q

C(X,X2,X3) ;

 D COMMA^%DTC

 Q X

BGP3PDL   ; IHS/CMI/LAB - IHS gpra print 01 Jul 2010 8:02 PM ;

 +1       ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81

 +2       ;

 +3       ;

DEL       ;

 +1        KILL ^TMP($JOB)

 +2        SET ^TMP($JOB,"BGPDEL",0)=0

 +3        KILL BGPSUMP

 +4        DO ^BGP3PDLH

 +5        DO DEL1

 +6        IF BGPRTYPE=1

               DO NONSUM^BGP3PDLN

 +7        IF BGPRTYPE=1

               DO DEVSUM^BGP3PDLD

 +8       ;I BGPRTYPE=1 D SUMMARY

 +9        IF BGPRTYPE=1

               DO SDP^BGP3PDLN

 +10       IF BGPRTYPE=1

               DO SDP^BGP3PDLD

 +11      ;I BGPRTYPE=1 D SDP

 +12       IF BGPRTYPE=7

               DO OTHSUM^BGP3PDLO

 +13      ;print lists to delimited file

           DO ^BGP3PDLS

 +14       IF $GET(BGPCPPL)

               DO CPPL1^BGP3DCLD

 +15      ;if screen selected do screen

 +16      ;

SAVEDEL   ;EP

 +1       ;NEW FOR 09, SUMMARY ONLY

           IF $GET(BGPSUMON)

               DO SUMONLY

               QUIT 

 +2        IF BGPDELT="S"

               DO SCREEN

               DO EXIT

               QUIT 

 +3       ;call xbgsave to create output file

 +4        SET XBGL="BGPDATA"

 +5        LOCK +^BGPDATA:300

          IF '$TEST

               IF '$DATA(ZTQUEUED)

                   WRITE "Unable to lock global"

               QUIT 

 +6        KILL ^TMP($JOB,"SUMMARYDEL")

 +7       ;global for saving

           KILL ^BGPDATA

 +8        SET X=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               IF ^TMP($JOB,"BGPDEL",X)'="ENDCOVERPAGE"

                   SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)

 +9        IF '$DATA(BGPGUI)

               Begin DoDot:1

 +10      ;I $P($G(^BGPSITE(DUZ(2),0)),U,14) S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)

 +11               SET XBFLT=1

                   SET XBFN=BGPDELF_".txt"

                   SET XBMED="F"

                   SET XBTLE="GPRA 11 DELIMITED OUTPUT"

                   SET XBQ="N"

                   SET XBF=0

 +12               DO ^XBGSAVE

 +13               KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF

               End DoDot:1

 +14       IF $DATA(BGPGUI)

               Begin DoDot:1

 +15               SET (C,X)=0

                   FOR 

                       SET X=$ORDER(^BGPDATA(X))

                       IF X'=+X

                           QUIT 

                       SET C=C+1

                       SET ^BGPGUIH(BGPGIEN,12,C,0)=^BGPDATA(X)

 +16               SET ^BGPGUIH(BGPGIEN,12,0)="^90549.1912^"_C_"^"_C_"^"_DT

               End DoDot:1

 +17       LOCK -^BGPDATA

 +18      ;export global

           KILL ^BGPDATA

 +19       DO EXIT

 +20       QUIT 

SUMONLY   ;

 +1       ;if screen selected do screen

 +2        IF BGPDELT="S"

               DO SCREENSO

               DO EXIT

               QUIT 

 +3       ;call xbgsave to create output file

 +4        SET XBGL="BGPDATA"

 +5        LOCK +^BGPDATA:300

          IF '$TEST

               IF '$DATA(ZTQUEUED)

                   WRITE "Unable to lock global"

               QUIT 

 +6        KILL ^TMP($JOB,"SUMMARYDEL")

 +7       ;global for saving

           KILL ^BGPDATA

 +8        SET X=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X!(^TMP($JOB,"BGPDEL",X)="ENDCOVERPAGE")

                   QUIT 

               SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)

               SET BGPLX=X

 +9       ;GET STARTING POINT

 +10       SET BGPSTP=0

           SET X=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               IF ^TMP($JOB,"BGPDEL",X)="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY"

                   SET BGPSTP=X

 +11       SET X=BGPSTP-1

           SET BGPLX=BGPLX+1

           SET BGPDEVE=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X!(BGPDEVE)

                   QUIT 

               SET BGPLX=BGPLX+1

               SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)

               IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."

                   SET BGPDEVE=X

 +12       IF $GET(BGPAREAA)

               Begin DoDot:1

 +13               SET BGPSTP=0

                   SET X=BGPDEVE

                   FOR 

                       SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

                       IF X'=+X

                           QUIT 

                       IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."

                           SET BGPSTP=X

 +14               SET X=BGPDEVE

                   SET BGPLX=BGPLX+1

                   SET BGPDEVE=0

                   FOR 

                       SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

                       IF X'=+X!(BGPDEVE)

                           QUIT 

                       SET BGPLX=BGPLX+1

                       SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)

                       IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."

                           SET BGPDEVE=X

               End DoDot:1

 +15       SET BGPSTP=0

           SET X=BGPDEVE

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               IF ^TMP($JOB,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"

                   SET BGPSTP=X

 +16       SET X=BGPSTP-1

           SET BGPLX=BGPLX+1

           SET BGPDEVE=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               SET BGPLX=BGPLX+1

               SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)

 +17       IF '$DATA(BGPGUI)

               Begin DoDot:1

 +18      ;I $P($G(^BGPSITE(DUZ(2),0)),U,14) ;S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)

 +19               SET XBFLT=1

                   SET XBFN=BGPDELF_".txt"

                   SET XBMED="F"

                   SET XBTLE="GPRA 10 DELIMITED OUTPUT"

                   SET XBQ="N"

                   SET XBF=0

 +20               DO ^XBGSAVE

 +21               KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF

               End DoDot:1

 +22       IF $DATA(BGPGUI)

               Begin DoDot:1

 +23               SET (C,X)=0

                   FOR 

                       SET X=$ORDER(^BGPDATA(X))

                       IF X'=+X

                           QUIT 

                       SET C=C+1

                       SET ^BGPGUIH(BGPGIEN,12,C,0)=^BGPDATA(X)

 +24               SET ^BGPGUIH(BGPGIEN,12,0)="^90549.1912^"_C_"^"_C_"^"_DT

               End DoDot:1

 +25       LOCK -^BGPDATA

 +26      ;export global

           KILL ^BGPDATA

 +27       DO EXIT

 +28       QUIT 

SCREENSO  ;

 +1        SET X=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X!(^TMP($JOB,"BGPDEL",X)="ENDCOVERPAGE")

                   QUIT 

               WRITE !,^TMP($JOB,"BGPDEL",X)

               SET BGPLX=X

 +2        SET BGPSTP=0

           SET X=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               IF ^TMP($JOB,"BGPDEL",X)["GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY"

                   SET BGPSTP=X

 +3        SET X=BGPSTP-1

           SET BGPLX=BGPLX+1

           SET BGPDEVE=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X!(BGPDEVE)

                   QUIT 

               SET BGPLX=BGPLX+1

               WRITE !,^TMP($JOB,"BGPDEL",X)

               IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."

                   SET BGPDEVE=X

 +4        IF $GET(BGPAREAA)

               Begin DoDot:1

 +5                SET BGPSTP=0

                   SET X=BGPDEVE

                   FOR 

                       SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

                       IF X'=+X

                           QUIT 

                       IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."

                           SET BGPSTP=X

 +6                SET X=BGPDEVE

                   SET BGPLX=BGPLX+1

                   SET BGPDEVE=0

                   FOR 

                       SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

                       IF X'=+X!(BGPDEVE)

                           QUIT 

                       SET BGPLX=BGPLX+1

                       WRITE !,^TMP($JOB,"BGPDEL",X)

                       IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."

                           SET BGPDEVE=X

               End DoDot:1

 +7        SET BGPSTP=0

           SET X=BGPDEVE

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               IF ^TMP($JOB,"BGPDEL",X)["SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"

                   SET BGPSTP=X

 +8        SET X=BGPSTP-1

           SET BGPLX=BGPLX+1

           SET BGPDEVE=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               SET BGPLX=BGPLX+1

               WRITE !,^TMP($JOB,"BGPDEL",X)

 +9        QUIT 

 +10      ;

SCREEN    ;

 +1        SET X=0

           FOR 

               SET X=$ORDER(^TMP($JOB,"BGPDEL",X))

               IF X'=+X

                   QUIT 

               IF ^TMP($JOB,"BGPDEL",X)'="ENDCOVERPAGE"

                   WRITE !,^TMP($JOB,"BGPDEL",X)

 +2        QUIT 

DEL1      ;EP

 +1        SET BGPIC=0

           FOR 

               SET BGPIC=$ORDER(BGPIND(BGPIC))

               IF BGPIC=""

                   QUIT 

               Begin DoDot:1

 +2                DO PRINT2

 +3       ;printed nat gpra list

                   IF $GET(BGPNPL)

                       IF $DATA(BGPINDL(BGPIC))

                           IF '$DATA(BGPYNPLT)

                               SET BGPINDH=BGPIC

                               DO NPL1^BGP3NPLP

 +4       ;printed nat gpra SEARCH TEMPLATE

                   IF $GET(BGPNPL)

                       IF $DATA(BGPINDL(BGPIC))

                           IF $DATA(BGPYNPLT)

                               SET BGPINDH=BGPIC

                               DO CT^BGP3DSTM

               End DoDot:1

 +5        IF BGPQUIT

               QUIT 

 +6        IF BGPRTYPE'=1

               GOTO PRINT3

 +7       ;now print gpra dev measures

 +8       ;control variable

           SET BGPGDEV=1

           SET BGPRTYPE=9

 +9        SET BGPIC=0

           FOR 

               SET BGPIC=$ORDER(BGPIND(BGPIC))

               IF BGPIC=""!(BGPQUIT)

                   QUIT 

               IF $PIECE(^BGPINDH(BGPIC,0),U,14)

                   DO PRINT2

                   Begin DoDot:1

 +10                   IF BGPQUIT

                           QUIT 

 +11      ;printed nat gpra list

                       IF $GET(BGPNPL)

                           IF $DATA(BGPINDL(BGPIC))

                               IF '$DATA(BGPYNPLT)

                                   SET BGPINDH=BGPIC

                                   DO NPL1^BGP3NPLP

 +12      ;printed nat gpra SEARCH TEMPLATE

                       IF $GET(BGPNPL)

                           IF $DATA(BGPINDL(BGPIC))

                               IF $DATA(BGPYNPLT)

                                   SET BGPINDH=BGPIC

                                   DO CT^BGP3DSTM

                   End DoDot:1

 +13       IF BGPQUIT

               QUIT 

 +14      ;set back to report 1

 +15       SET BGPRTYPE=1

PRINT3    ;

 +1        QUIT 

PRINT2    ;

 +1        Begin DoDot:1

 +2            SET X=" "

               DO S(X,1,1)

               DO S(X,1,1)

 +3            SET X=$PIECE(^BGPINDH(BGPIC,0),U,3)