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

BGP2AUUP.m

Go to the documentation of this file. 
  1. BGP2AUUP ; IHS/CMI/LAB - UPLOAD SITE FILES, CREATE EXCEL FILES ;
  1.  ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1.  ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1.  ;; 
  1.  ;;This routine processes the monthly GPRA files received from
  1.  ;;the sites.  It creates the Excel file and sends it to the
  1.  ;;DeepSee server to be uploaded into the database.
  1.  ;;$$END
  1.  ;
  1.  N I,X F I=1:1 S X=$P($T(DESC+I),";;",2) Q:X["$$END"  D EN^DDIOL(X)
  1.  Q
  1. AUTO ;EP -- AUTOQUEUED JOB ENTRY POINT
  1.  ;  
  1.  N BGPBEGDT,BGPENDDT
  1.  ;
  1.  D ^XBKVAR
  1.  ;
  1.  D CALC(.BGPBEGDT,.BGPENDDT)
  1.  D EN(BGPBEGDT,BGPENDDT)
  1.  ;
  1.  Q
  1. MAN ;EP -- MANUALLY PROCESS SITE FILES
  1.  ;
  1.  N BGPBEGDT,BGPDTS,BGPENDDT,BGPMAN
  1.  ;
  1.  D CALC(.BGPBEGDT,.BGPENDDT)
  1.  D DATES(.BGPDTS,BGPBEGDT,BGPENDDT)
  1.  Q:'BGPDTS
  1.  S BGPBEGDT=$P(BGPDTS,U)
  1.  S BGPENDDT=$P(BGPDTS,U,2)
  1.  S BGPMAN=1
  1.  D EN(BGPBEGDT,BGPENDDT,BGPMAN)
  1.  Q
  1. DQ ;EP -- QUEUED JOB STARTS HERE
  1.  ;
  1.  ;      EXPECTS BGPBEGDT,BGPENDDT
  1.  ;
  1.  D EN($G(BGPBEGDT),$G(BGPENDDT))
  1.  K BGPBEGDT,BGPENDDT
  1.  Q
  1. EN(BGPBEGDT,BGPENDDT,BGPMAN) ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  ;      INPUT:
  1.  ;      BGPBEGDT  =  DATA EXTRACT BEGIN DATE
  1.  ;      BGPENDDT  =  DATA EXTRACT END DATE
  1.  ;      BGPMAN    =  MANUAL RUN INDICATOR
  1.  ;
  1.  N BGPDFILE,BGPDPD0,BGPERR,BGPF,BGPFACS,BGPFILE,BGPOUT,BGPPATH,X,BGPLIST
  1.  ;
  1.  S BGPOUT=0
  1.  K ^TMP("BGPGPAM",$J,"FILE")
  1.  ;
  1.  S BGPDFILE=""
  1.  ;
  1.  D STAT(.BGPDPD0,BGPBEGDT)
  1.  ;quit if status=1 COMPLETED
  1.  Q:$P($G(^BGPGP1PM(1,7,BGPDPD0,0)),U,4)=1
  1.  ;quit trying to process after 5 attempts
  1.  Q:$P($G(^BGPGP1PM(1,7,BGPDPD0,0)),U,6)>5
  1.  ;
  1.  S BGPPATH=$P($G(^BGPGP1PM(1,1)),U)
  1.  Q:BGPPATH']""
  1.  ;
  1.  ;create tmp file containing list of files in directory
  1.  ;S X="dir "_BGPPATH_"BGPAM121* > "_BGPPATH_"BGPgp1tmp"
  1.  ;S X=$$JOBWAIT^%HOSTCMD(X)
  1.  ;
  1.  ;open tmp file and read it into ^TMP global
  1.  ;S BGPFILE="BGPgp1tmp"
  1.  ;D READ(BGPPATH,BGPFILE,.BGPOUT)
  1.  ;I BGPOUT D
  1.  ;. S BGPERR="CAN'T READ BGPgp1tmp FILE"
  1.  ;. I $G(BGPMAN) D  Q
  1.  ;. . W !,BGPERR
  1.  ;. D REQUE(BGPENDDT)
  1.  ;. D STAT(BGPDPD0,BGPENDDT,$$NOW^XLFDT,2,BGPERR,$$ATT(BGPDPD0))
  1.  ;Q:BGPOUT
  1.  ;
  1.  K ^TMP("BGPGPAM",$J,"FILE")
  1.  K BGPLIST S BGPLIST="",X=$$LIST^%ZISH(BGPPATH,"BGPAM121*",.BGPLIST)
  1.  ;check ^TMP global to see if all files are there
  1.  S (X,C)=0 F  S X=$O(BGPLIST(X)) Q:X'=+X  S C=C+1,^TMP("BGPGPAM",$J,"FILE",C,0)=BGPLIST(X)
  1.  S ^TMP("BGPGPAM",$J,"FILE",0)=C
  1.  D CHK(BGPENDDT,.BGPFACS,.BGPOUT)
  1.  I BGPOUT D
  1.  . S BGPERR="MISSING FACILITY FILES"
  1.  . ;S $ZE="BGP2AUUP MISSING FACILITY FILES"
  1.  . ;D ^ZTER
  1.  . K ^TMP("BGPGPAM",$J,"FILE")
  1.  . I $G(BGPMAN) D  Q
  1.  . . W !,BGPERR
  1.  . . D MSG1^BGP2AU1M(BGPBEGDT,BGPENDDT,.BGPFACS)
  1.  . ;SEND EMAIL/ALERT THAT FILES ARE NOT ALL THERE
  1.  . D ALERTMM(1,BGPBEGDT,BGPENDDT,.BGPFACS,.BGPF,BGPDFILE)
  1.  . D REQUE(BGPBEGDT,BGPENDDT)
  1.  . D STAT(BGPDPD0,BGPBEGDT,$G(BGPENDDT),$$NOW^XLFDT,2,BGPERR,$$ATT(BGPDPD0))
  1.  Q:BGPOUT
  1.  ;
  1.  ;upload all files into the BGP 11 DATA* files
  1.  D UPLOAD(BGPPATH,BGPBEGDT,BGPENDDT,.BGPFACS)
  1.  ;
  1.  ;create the 5 excel files
  1.  D EN^BGP2AU1A(BGPBEGDT,BGPENDDT,.BGPEND,.BGPF)
  1.  ;
  1.  ;upload the 5 excel files into BGPGP1 GPRA FLAT FILE DATA file
  1.  D EN^BGP2AU1R(.BGPF)
  1.  ;
  1.  ;create data dump text file
  1.  D EN^BGP2AU1D(BGPBEGDT,BGPEND,.BGPDFILE)
  1.  ;
  1.  ;***send data dump file to DeepSee server
  1.  ;D SEND(BGPDFILE)
  1.  ;
  1.  ;send email that excel and data dump files are created
  1.  D ALERTMM1(2,BGPBEGDT,BGPENDDT,,.BGPF,BGPDFILE)
  1.  ;
  1.  ;update status to completed
  1.  D STAT(BGPDPD0,BGPBEGDT,(BGPEND-17000000),$$NOW^XLFDT,1,"@",$$ATT(BGPDPD0))
  1.  ;
  1.  ;clean everything up
  1.  D CLEAN(BGPBEGDT,BGPENDDT)
  1.  K ^TMP("BGPGPAM",$J,BGPFILE)
  1.  D MOVEFL(BGPENDDT,.BGPFACS,.BGPF,BGPDFILE)
  1.  ;
  1.  I $G(BGPMAN) D
  1.  . W !,"ALL FILES SUCCESSFULLY CREATED AND EMAIL MESSAGE SENT"
  1.  Q
  1. UPLOAD(BGPPATH,BGPBEGDT,BGPENDDT,BGPFACS) ;
  1.  ;----- UPLOAD THE FILES INTO THE BGP DATA FILES
  1.  ;      use BGPFACS array created in CHK
  1.  ;      
  1.  ;      INPUT:
  1.  ;      BGPPATH   =  DIRECTORY PATH
  1.  ;      BGPBEGDT  =  THE EXTRACT BEGINNING DATE
  1.  ;      BGPFACS   =  ARRAY CONTAINING FILE NAMES
  1.  ;
  1.  N BGPASU,BGPFILE
  1.  ;
  1.  D CLEAN(BGPBEGDT,BGPENDDT)
  1.  ;
  1.  S BGPASU=0
  1.  F  S BGPASU=$O(BGPFACS(BGPENDDT,BGPASU)) Q:BGPASU=""  D
  1.  . S BGPFILE=BGPFACS(BGPENDDT,BGPASU)
  1.  . Q:BGPFILE']""
  1.  . D EN^BGP2AUUL(BGPPATH,BGPFILE)
  1.  Q
  1. SEND(BGPDFILE) ;----- SEND DATA DUMP FILE TO DEEPSEE SERVER
  1.  ;
  1.  ;***need ip address, username, password
  1.  ;***use BGPsend script?
  1.  Q
  1. CHK(BGPBEGDT,BGPFACS,BGPOUT) ;
  1.  ;----- CHECK TO SEE IF ALL FILES ARE THERE
  1.  ;      LOOKS AT THE ^TMP GLOBAL CREATED BY READ
  1.  ;      RETURNS BGPFACS ARRAY
  1.  ;
  1.  ;      INPUT:
  1.  ;      BGPBEGDT  =  BEGIN DATE OF REPORTS
  1.  ;
  1.  N BGPD0,BGPASU,BGPD1,BGPDATA,BGPDT,BGPERR,BGPFILE
  1.  ;
  1.  S BGPOUT=0
  1.  K BGPFACS
  1.  ;
  1.  ;build BGPFACS array of entries in parameters file
  1.  S BGPD1=0
  1.  F  S BGPD1=$O(^BGPGP1PM(1,9,BGPD1)) Q:'BGPD1  D
  1.  . S BGPDATA=$G(^BGPGP1PM(1,9,BGPD1,0))
  1.  . Q:'$P(BGPDATA,U,3)   ;don't include INACTIVE
  1.  . S BGPASU=$P(BGPDATA,U,2)
  1.  . S BGPFACS(BGPENDDT,BGPASU)=""
  1.  ;
  1.  ;loop through ^TMP global and see if there is a file for each
  1.  ;entry in the BGPFACS array
  1.  S BGPD0=0
  1.  F  S BGPD0=$O(^TMP("BGPGPAM",$J,"FILE",BGPD0)) Q:'BGPD0  D
  1.  . S BGPDATA=$G(^TMP("BGPGPAM",$J,"FILE",BGPD0,0))
  1.  . Q:BGPDATA'["BGPAM121"
  1.  . S BGPFILE="BGPAM121"_$P(BGPDATA,"BGPAM121",2)
  1.  . S BGPDT=$E(BGPFILE,9,15) ;use BGPDT to preserve BGPBEGDT
  1.  . S BGPASU=$E(BGPFILE,16,21)
  1.  . I $D(BGPFACS(BGPDT,BGPASU)) S BGPFACS(BGPDT,BGPASU)=BGPFILE
  1.  ;
  1.  ;see if they are all there, set BGPOUT=1 if not
  1.  S BGPASU=0
  1.  F  S BGPASU=$O(BGPFACS(BGPENDDT,BGPASU))  Q:BGPASU=""  D
  1.  . I BGPFACS(BGPENDDT,BGPASU)']"" S BGPOUT=1
  1.  ;
  1.  Q
  1. STAT(BGPDPD0,BGPBEGDT,BGPEND,BGPDT,BGPSTAT,BGPERR,BGPATT) ;
  1.  ;----- UPDATE DATE PROCESSED STATUS IN PARAMETERS FILE
  1.  ;
  1.  N DA,DIE,DR,X,Y,G
  1.  ;
  1.  S BGPEND=$G(BGPEND)
  1.  S BGPDPD0=$G(BGPDPD0)
  1.  I $P(^BGPGP1PM(1,0),U,2)="T" I '$G(BGPDPD0) S BGPDPD0=$O(^BGPGP1PM(1,7,"B",BGPBEGDT,0))
  1.  I $P(^BGPGP1PM(1,0),U,2)="G" I '$G(BGPDPD0) D
  1.  .S X=0,G=0 F  S X=$O(^BGPGP1PM(1,7,"B",BGPBEGDT,X)) Q:X'=+X!(G)  D
  1.  ..I $E($P(^BGPGP1PM(1,7,X,0),U,9),1,5)=$E(DT,1,5) S BGPDPD0=X,G=1
  1.  I 'BGPDPD0 D ADDSTAT(.BGPDPD0,BGPBEGDT)
  1.  Q:'BGPDPD0
  1.  S DR=""
  1.  S DR=".02////^S X=BGPEND" I $P(^BGPGP1PM(1,7,BGPDPD0,0),U,9)="" S DR=DR_";.09////"_DT
  1.  I $G(BGPDT)]"" S DR=DR_";.03////^S X=BGPDT"
  1.  I $G(BGPSTAT)]"" S DR=DR_";.04////^S X=BGPSTAT"
  1.  I $G(BGPERR)]"" S DR=DR_";.05////^S X=BGPERR"
  1.  I $G(BGPATT)]"" S DR=DR_";.06////^S X=BGPATT"
  1.  Q:DR']""
  1.  S DA=BGPDPD0
  1.  S DA(1)=1
  1.  S DIE="^BGPGP1PM("_DA(1)_",7,"
  1.  D ^DIE
  1.  Q
  1. ADDSTAT(BGPDPD0,BGPBEGDT) ;
  1.  ;----- ADD NEW ENTRY TOP DATE PROCESSED STATUS MULTIPLE IN PARAM FILE
  1.  ;
  1.  N DA,DD,DIC,DO,X,Y
  1.  ;
  1.  S BGPDPD0=0
  1.  S X=BGPBEGDT
  1.  S DA(1)=1
  1.  S DIC="^BGPGP1PM("_DA(1)_",7,"
  1.  S DIC(0)=""
  1.  D FILE^DICN
  1.  Q:+Y'>0
  1.  S BGPDPD0=+Y
  1.  Q
  1. CLEAN(BGPBEGDT,BGPENDDT) ;
  1.  ;----- CLEAN ENTRIES OUT OF BGP 11 DATA* FILES
  1.  ;      remove the entries sorted by the BEGINNING DATE
  1.  ;      so that old entries won't interfere with this run
  1.  ;
  1.  N BGPD0,DA,DIK,BGPASU
  1.  ;
  1.  Q:$P(^BGPGP1PM(1,0),U,2)="G"  ;don't delete out national gpra
  1.  S BGPD0=0 F  S BGPD0=$O(^BGPGPDCW("B",BGPBEGDT,BGPD0)) Q:'BGPD0  D
  1.  . S BGPASU=$P(^BGPGPDCW(BGPD0,0),U,9)
  1.  . I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
  1.  . Q:$P(^BGPGPDCW(BGPD0,0),U,12)'=1  ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
  1.  . S DA=BGPD0
  1.  . S DIK="^BGPGPDCW("
  1.  . D ^DIK
  1.  ;
  1.  S BGPD0=0 F  S BGPD0=$O(^BGPGPDPW("B",BGPBEGDT,BGPD0)) Q:'BGPD0  D
  1.  . S BGPASU=$P(^BGPGPDPW(BGPD0,0),U,9)
  1.  . I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
  1.  . Q:$P(^BGPGPDPW(BGPD0,0),U,12)'=1  ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
  1.  . S DA=BGPD0
  1.  . S DIK="^BGPGPDPW("
  1.  . D ^DIK
  1.  ;
  1.  S BGPD0=0 F  S BGPD0=$O(^BGPGPDBW("B",BGPBEGDT,BGPD0)) Q:'BGPD0  D
  1.  . S BGPASU=$P(^BGPGPDBW(BGPD0,0),U,9)
  1.  . I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
  1.  . Q:$P(^BGPGPDBW(BGPD0,0),U,12)'=1  ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
  1.  . S DA=BGPD0
  1.  . S DIK="^BGPGPDBW("
  1.  . D ^DIK
  1.  Q
  1. MOVEFL(BGPBEGDT,BGPFACS,BGPF,BGPDFILE) ;
  1.  ;----- MOVE FILES TO SUBDIRECTORY WHEN DONE WITH THEM
  1.  ;
  1.  N BGP,BGPASU,BGPFILE
  1.  ;
  1.  S BGPASU=0
  1.  F  S BGPASU=$O(BGPFACS(BGPBEGDT,BGPASU)) Q:BGPASU=""  D
  1.  . S BGPFILE=BGPFACS(BGPBEGDT,BGPASU)
  1.  . Q:BGPFILE']""
  1.  . D MOVE1(BGPFILE)
  1.  ;
  1.  S BGP=0
  1.  F  S BGP=$O(BGPF(BGP)) Q:'BGP  D
  1.  . S BGPFILE=BGPF(BGP)
  1.  . Q:BGPFILE']""
  1.  . D MOVE1(BGPFILE)
  1.  ;
  1.  D MOVE1(BGPDFILE)
  1.  D MOVE1(BGPFGNT1)
  1.  D MOVE1(BGPFGNT2)
  1.  D MOVE1(BGPFDEV1)
  1.  D MOVE1(BGPFDEV2)
  1.  D MOVE1(BGPFDEV3)
  1.  Q
  1. MOVE1(BGPFILE) ;
  1.  ;----- MOVE FILE TO ANOTHER DIRECTORY
  1.  ;
  1.  N BGPDIR,BGPDIRTO,X
  1.  ;
  1.  S BGPDIR=$P($G(^BGPGP1PM(1,1)),U)
  1.  S BGPDIRTO=$P($G(^BGPGP1PM(1,1)),U,2)
  1.  Q:BGPDIRTO']""
  1.  ;S X="mv /-Y "_BGPDIR_BGPFILE_" "_BGPDIRTO
  1.  ;S X=$$JOBWAIT^%HOSTCMD(X)
  1.  D MV^%ZISH(BGPDIR,BGPFILE,BGPDIRTO,BGPFILE)
  1.  Q
  1. REQUE(BGPBEGDT,BGPENDDT) ;
  1.  ;----- REQUEUE THE JOB FOR NEXT DAY
  1.  ;
  1.  N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  ;
  1.  S ZTRTN="DQ^BGPGP1UP"
  1.  S ZTDESC="BGPGP1 PROCESS SITE GPRA FILES"
  1.  S ZTIO=""
  1.  S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,+1)
  1.  S ZTSAVE("BGPBEGDT")=""
  1.  S ZTSAVE("BGPENDDT")=""
  1.  D ^%ZTLOAD
  1.  Q
  1. CALC(BGPBEGDT,BGPENDDT) ;
  1.  ;----- CALCULATE THE BEGINNING DATE OF THE REPORT
  1.  ;
  1.  ;Calculates the last day of the previous month based on today's
  1.  ;date.  Calculates the report beginning date based on the last
  1.  ;day of the previous month -364 days.  (The original BGP routines
  1.  ;subtract -364 days to get the beginning date.)
  1.  ;
  1.  N BGPD,BGPDT,BGPM,BGPY,BGPT
  1.  ;
  1.  S BGPT=$P(^BGPGP1PM(1,0),U,2)
  1.  I BGPT="T" D  Q
  1.  .S BGPDT=$$FMADD^XLFDT(DT,-60)
  1.  .S BGPY=$E(BGPDT,1,3)
  1.  .S BGPM=+$E(BGPDT,4,5)
  1.  .S BGPD=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,BGPM)
  1.  .I BGPM=2 S BGPD=BGPD+$$LEAP^XLFDT2(BGPY+1700)
  1.  .S BGPD=$E("00",1,2-$L(BGPD))_BGPD
  1.  .S BGPM=$E("00",1,2-$L(BGPM))_BGPM
  1.  .S BGPENDDT=BGPY_BGPM_BGPD
  1.  .S BGPBEGDT=$$FMADD^XLFDT(BGPENDDT,-364)
  1.  S Y=$O(^BGPCTRL("B",2012,0))
  1.  S Y=^BGPCTRL(Y,0)
  1.  S BGPENDDT=$P(Y,U,9)
  1.  S BGPBEGDT=$P(Y,U,8)
  1.  Q
  1.  ;original code for date
  1.  S BGPDT=$$FMADD^XLFDT(DT,-60)
  1.  S BGPY=$E(BGPDT,1,3)
  1.  S BGPM=+$E(BGPDT,4,5)
  1.  S BGPD=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,BGPM)
  1.  I BGPM=2 S BGPD=BGPD+$$LEAP^XLFDT2(BGPY)
  1.  S BGPD=$E("00",1,2-$L(BGPD))_BGPD
  1.  S BGPM=$E("00",1,2-$L(BGPM))_BGPM
  1.  S BGPENDDT=BGPY_BGPM_BGPD
  1.  S BGPBEGDT=$$FMADD^XLFDT(BGPENDDT,-364)
  1.  Q
  1. ATT(BGPDPD0) ;
  1.  ;----- RETURNS NUMBER OF PROCESSING ATTEMPTS
  1.  ;
  1.  Q $P($G(^BGPGP1PM(1,7,+$G(BGPDPD0),0)),U,6)+1
  1.  ;
  1. READ(BGPPATH,BGPFILE,BGPOUT) ;
  1.  ;----- READ CONTENTS OF DATA FILE AND PUT INTO ^TMP GLOBAL
  1.  ;
  1.  N BGPCNT,BGPEND,I,POP,X
  1.  ;
  1.  K ^TMP("BGPGPAM",$J,BGPFILE)
  1.  S BGPOUT=0
  1.  S BGPEND=0
  1.  S BGPCNT=0
  1.  D OPEN^%ZISH("FILE",BGPPATH,BGPFILE,"R")
  1.  I POP D
  1.  . S BGPOUT=1
  1.  . S BGPERR="UNABLE TO OPEN FILE '"_BGPPATH_BGPFILE_"'"
  1.  . ;S $ZE="<NOTOPEN>READ^BGPGP1UP"
  1.  . ;D ^ZTER
  1.  Q:BGPOUT
  1.  F I=1:1 D  Q:BGPEND
  1.  . U IO R X:DTIME
  1.  . I $$STATUS^%ZISH S BGPEND=1
  1.  . Q:BGPEND
  1.  . S BGPCNT=BGPCNT+1
  1.  . S ^TMP("BGPGPAM",$J,"FILE",I,0)=X
  1.  . S ^TMP("BGPGPAM",$J,"FILE",0)=BGPCNT
  1.  ;
  1.  D CLOSE^%ZISH("FILE")
  1.  Q
  1. DATES(BGPDTS,DBEG,DEND) ;
  1.  ;----- ASK DATE RANGE
  1.  ; RETURNS DATES=BEGINDATE^ENDDATE
  1.  ;
  1.  ;      INPUT:
  1.  ;      DBEG  =  DEFAULT BEGINNING DATE (OPTIONAL)
  1.  ;      DEND  =  DEFAULT ENDING DATE(OPTIONAL)
  1.  ;
  1. D ;----- DATE LOOP
  1.  ;
  1.  N BEG,DIR,DIRUT,DTOUT,DUOUT,END,X,Y
  1.  ;
  1.  S BEG=$G(DBEG)
  1.  I BEG S Y=BEG X ^DD("DD") S BEG=Y
  1.  S END=$G(DEND)
  1.  I END S Y=END X ^DD("DD") S END=Y
  1.  S BGPDTS=""
  1.  D EN^DDIOL("","","!")
  1.  S DIR(0)="DO^::E"
  1.  S DIR("A")="Select Beginning Date"
  1.  I $G(BEG)]"" S DIR("B")=$G(BEG)
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  Q:Y=""
  1.  S BEG=Y
  1.  S DIR("A")="Ending Date"
  1.  S DIR("B")="TODAY"
  1.  I $G(END)]"" S DIR("B")=$G(END)
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  Q:Y=""
  1.  S END=Y
  1.  I END<BEG D  G D
  1.  . D EN^DDIOL("ENDING DATE cannot be less than BEGINNING DATE","","*7,!")
  1.  S BGPDTS=BEG_U_END
  1.  K BEG,END
  1.  Q
  1.  ;
  1. ALERTMM(BGPMSG,BGPBEGDT,BGPENDDT,BGPFACS,BGPF,BGPDFILE,BGPUSR) ;
  1.  ;
  1.  NEW BGPX,%,P,BGPTEXT,BGPASU,T,BGPFAC
  1.  S BGPX=0 F  S BGPX=$O(^BGPGP1PM(1,99.2,BGPX)) Q:BGPX'=+BGPX  S P=$P($G(^BGPGP1PM(1,99.2,BGPX,0)),U,1) D
  1.  .S XQA(P)=""
  1.  .S XQAOPT=""
  1.  .S XQAROU=""
  1.  .S XQAFLG="D"
  1.  .S BGPTEXT(1)=" "
  1.  .S BGPTEXT(2)="Monthly GPRA report period date range:  "_$$FMTE^XLFDT(BGPBEGDT)_" to "_$$FMTE^XLFDT(BGPENDDT)
  1.  .S BGPTEXT(3)="  "
  1.  .S BGPTEXT(4)="The site GPRA files could not be uploaded because files are"
  1.  .S BGPTEXT(5)="missing from the following facilities:"
  1.  .S BGPASU=0,T=5
  1.  .F  S BGPASU=$O(BGPFACS(BGPENDDT,BGPASU)) Q:BGPASU=""  D
  1.  .. Q:BGPFACS(BGPENDDT,BGPASU)]""
  1.  .. S BGPFAC=$O(^BGPGP1PM(1,9,"C",BGPASU,0))
  1.  .. Q:'BGPFAC
  1.  .. S BGPFAC=$P($G(^BGPGP1PM(1,9,BGPFAC,0)),U)
  1.  .. I BGPFAC]"" S T=T+1 S BGPTEXT(T)=BGPASU_"   "_$$VAL^XBDIQ1(4,BGPFAC,.01)
  1.  .S T=T+1
  1.  .S BGPTEXT(T)="The aggregate excel files cannot be created until all files"
  1.  .S T=T+1,BGPTEXT(T)="are received from all facilities."
  1.  .S XQATEXT="BGPTEXT"
  1.  .S XQAMSG="GPRA Auto Extract Upload Failed."
  1.  .S XQAID="OR,"_DUZ_",46"
  1.  .D SETUP^XQALERT
  1.  .;now send mailman message
  1.  .D MM
  1.  Q
  1. MM ;mailman message
  1.  D GETRECIP
  1. SUBJECT S XMSUB="* * * GPRA AUTO UPLOAD OF DATA * * *"
  1. SENDER S XMDUZ="GPRA AUTO UPLOAD"
  1.  S XMTEXT="BGPTEXT(",XMY(1)="",XMY(DUZ)=""
  1.  D ^XMD
  1.  Q
  1.  ;
  1. GETRECIP ;
  1.  ;* * * Define key below to identify recipients * * *
  1.  ;
  1.  NEW CTR
  1.  S CTR=0
  1.  F  S CTR=$O(^BGPGP1PM(1,99.2,CTR)) Q:'CTR  S Y=$P($G(^BGPGP1PM(1,99.2,CTR,0)),U,1) I Y S XMY(Y)=""
  1.  Q
  1. ALERTMM1(BGPMSG,BGPBEGDT,BGPENDDT,BGPFACS,BGPF,BGPDFILE,BGPUSR) ;
  1.  ;
  1.  NEW BGPX,%,P,BGPTEXT,BGPASU,T,BGPFAC
  1.  S BGPX=0 F  S BGPX=$O(^BGPGP1PM(1,99.2,BGPX)) Q:BGPX'=+BGPX  S P=$P($G(^BGPGP1PM(1,99.2,BGPX,0)),U,1) D
  1.  .S XQA(P)=""
  1.  .S XQAOPT=""
  1.  .S XQAROU=""
  1.  .S XQAFLG="D"
  1.  .S BGPTEXT(1)="Monthly GPRA report period date range:  "_$$FMTE^XLFDT(BGPBEGDT)_" to "_$$FMTE^XLFDT(BGPENDDT)
  1.  .;
  1.  .S BGPTEXT(2)="The following aggregate excel files have been created:"
  1.  .;
  1.  .S BGP=0,C=3
  1.  .F  S BGP=$O(BGPF(BGP)) Q:'BGP  D
  1.  .. S C=C+1,BGPTEXT(C)=BGPF(BGP)
  1.  .S C=C+1,BGPTEXT(C)=BGPFGNT1
  1.  .S C=C+1,BGPTEXT(C)=BGPFGNT2
  1.  .S C=C+1,BGPTEXT(C)=BGPFDEV1
  1.  .S C=C+1,BGPTEXT(C)=BGPFDEV2
  1.  .S C=C+1,BGPTEXT(C)=BGPFDEV3
  1.  .S C=C+1,BGPTEXT(C)="The following data file for DeepSee has been created:"
  1.  .S C=C+1,BGPTEXT(C)=BGPDFILE
  1.  .S XQATEXT="BGPTEXT"
  1.  .S XQAMSG="GPRA Auto Extract Upload Completed."
  1.  .S XQAID="OR,"_DUZ_",46"
  1.  .D SETUP^XQALERT
  1.  .;now send mailman message
  1.  .D MM
  1.  Q