Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP8PDL

BGP8PDL.m

Go to the documentation of this file. 
  1. BGP8PDL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2010 8:02 PM ;
  1.  ;;18.1;IHS CLINICAL REPORTING;**1**;MAY 25, 2018;Build 65
  1.  ;
  1.  ;
  1.  ;
  1. SAVEDEL ;EP
  1.  I $G(BGPSUMON) D SUMONLY Q  ;NEW FOR 09, SUMMARY ONLY
  1.  I BGPDELT="S" D SCREEN,EXIT Q
  1.  ;call xbgsave to create output file
  1.  S XBGL="BGPDATA"
  1.  L +^BGPDATA:300 E  W:'$D(ZTQUEUED) "Unable to lock global" Q
  1.  K ^TMP($J,"SUMMARYDEL")
  1.  K ^BGPDATA ;global for saving
  1.  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)
  1.  I '$D(BGPGUI) D
  1.  .;I $P($G(^BGPSITE(DUZ(2),0)),U,14) S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)
  1.  .S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 18.1 DELIMITED OUTPUT",XBQ="N",XBF=0
  1.  .D ^XBGSAVE
  1.  .K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
  1.  I $D(BGPGUI) D
  1.  .S (C,X)=0 F  S X=$O(^BGPDATA(X)) Q:X'=+X  S C=C+1,^BGPGUIR(BGPGIEN,12,C,0)=^BGPDATA(X)
  1.  .S ^BGPGUIR(BGPGIEN,12,0)="^90560.1912^"_C_"^"_C_"^"_DT
  1.  L -^BGPDATA
  1.  K ^BGPDATA ;export global
  1.  D EXIT
  1.  Q
  1. SUMONLY ;
  1.  ;if screen selected do screen
  1.  I BGPDELT="S" D SCREENSO,EXIT Q
  1.  ;call xbgsave to create output file
  1.  S XBGL="BGPDATA"
  1.  L +^BGPDATA:300 E  W:'$D(ZTQUEUED) "Unable to lock global" Q
  1.  K ^TMP($J,"SUMMARYDEL")
  1.  K ^BGPDATA ;global for saving
  1.  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
  1.  ;GET STARTING POINT
  1.  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
  1.  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
  1.  I $G(BGPAREAA) D
  1.  .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
  1.  .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
  1.  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
  1.  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)
  1.  I '$D(BGPGUI) D
  1.  .;I $P($G(^BGPSITE(DUZ(2),0)),U,14) ;S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)
  1.  .S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 18.1 DELIMITED OUTPUT",XBQ="N",XBF=0
  1.  .D ^XBGSAVE
  1.  .K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
  1.  I $D(BGPGUI) D
  1.  .S (C,X)=0 F  S X=$O(^BGPDATA(X)) Q:X'=+X  S C=C+1,^BGPGUIR(BGPGIEN,12,C,0)=^BGPDATA(X)
  1.  .S ^BGPGUIR(BGPGIEN,12,0)="^90560.1912^"_C_"^"_C_"^"_DT
  1.  L -^BGPDATA
  1.  K ^BGPDATA ;export global
  1.  D EXIT
  1.  Q
  1. SCREENSO ;
  1.  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
  1.  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
  1.  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
  1.  I $G(BGPAREAA) D
  1.  .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
  1.  .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
  1.  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
  1.  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)
  1.  Q
  1.  ;
  1. SCREEN ;
  1.  S X=0 F  S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X  W:^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" !,^TMP($J,"BGPDEL",X)
  1.  Q
  1.  S Y=$P(^VA(200,DUZ,0),U,2),$E(Y,35)=$$FMTE^XLFDT(DT) D S(Y,1,1)
  1.  I BGPRTYPE=7 S Y="*** IHS 2018 Other National Measures Report ***" D S(Y,1,1)
  1.  I BGPRTYPE=4 S Y="*** IHS 2018 Clinical Performance Report ***" D S(Y,1,1)
  1.  I BGPRTYPE=1,'$G(BGPNGR09) S Y="*** IHS 2018 National GPRA/GPRAMA Report ***" D S(Y,1,1)
  1.  I BGPRTYPE=1,$G(BGPNGR09) S Y="*** IHS 2018 National GPRA/GPRAMA Report, Run Using 2018 Logic ***" D S(Y,1,1)
  1.  I $G(BGPAREAA) S Y="AREA AGGREGATE" D S(Y,1,1)
  1.  I '$G(BGPAREAA) S Y=$P(^DIC(4,DUZ(2),0),U) D S(Y,1,1)
  1.  ;S X=$$RPTVER^BGP8BAN D S(X,1,1)
  1.  S X="Report Period:  "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
  1.  S X="Previous Year Period:  "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D S(X,1,1)
  1.  S X="Baseline Period:  "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D S(X,1,1)
  1.  S X=" " D S(X,1,1)
  1.  Q:$G(BGPSUMP)
  1.  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)
  1.  S X=" " D S(X,1,1)
  1.  I BGPRTYPE=1 S X="Population:  AI/AN Only (Classification 01)" D S(X,1,1)
  1.  S X=" " D S(X,1,1)
  1.  S BGPI=$O(^BGPCTRL("B",2018,0))
  1.  S BGPX=0 F  S BGPX=$O(^BGPCTRL(BGPI,14,BGPX)) Q:BGPX'=+BGPX  D
  1.  .S X=^BGPCTRL(BGPI,14,BGPX,0) D S(X,1,1)
  1.  I $G(BGPEXPT) S X="A file will be created called BG"_$$FV^BGP8BAN()_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT_"." D S(X,1,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)
  1.  S X=" " D S(X,1,1)
  1.  I $G(BGPALLPT) S X="All Communities Included." D S(X,1,1)
  1.  I '$G(BGPALLPT),'$G(BGPSEAT) D
  1.  .I BGPTAXI S X="Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U) D S(X,1,1)
  1.  .I $G(BGPCOMMI) S X="Community Name: "_$P(^AUTTCOM(BGPCOMMI,0),U) D S(X,1,1)
  1.  I '$G(BGPALLPT),'$G(BGPSEAT) S X="The following communities are included in this report:" D S(X,1,1) D
  1.  .S BGPZZ="",N=0,Y="" F  S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ=""  S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ
  1.  .S BGPZZ=0,C=0 F BGPZZ=1:3:N D
  1.  ..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)
  1.  ..Q
  1.  K BGPX,BGPQUIT
  1.  S X=$TR($J(""," ","-"),80) D S(X,1,1)
  1.  Q
  1. EXIT ;
  1.  K ^TMP($J)
  1.  Q
  1. CTR(X,Y) ;EP - Center
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return user
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. S(Y,F,P) ;EP set up array
  1.  I '$G(F) S F=0
  1.  S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
  1.  I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
  1.  S $P(^TMP($J,"BGPDEL",%),U,P)=Y
  1.  Q
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q X