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