BGP4AUUP ; IHS/CMI/LAB - UPLOAD SITE FILES, CREATE EXCEL FILES ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine processes the monthly GPRA files received from
;;the sites. It creates the Excel fileUYYYY 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 CALC(.BGPBEGDT,.BGPENDDT)
D EN(BGPBEGDT,BGPENDDT)
;
S BGPY=0
Q
MAN ;EP -- MANUALLY PROCESS
;
W !!,"This option is used to aggregate all GPRA Extract files that have"
W !,"been received from the facilities.",!!
W !,"The process will run immediately.",!
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I 'Y Q
N BGPBEGDT,BGPDTS,BGPENDDT,BGPMAN
;
D CALC(.BGPBEGDT,.BGPENDDT)
W !!,"Processing ",$$VAL^XBDIQ1(90245,1,.02)," for ",$$FMTE^XLFDT(BGPBEGDT),"-",$$FMTE^XLFDT(BGPENDDT),".",!
S BGPMAN=1
D EN(BGPBEGDT,BGPENDDT,BGPMAN)
Q
GUIDQ ;EP -- gui entry point for manual
D CALC(.BGPBEGDT,.BGPENDDT)
S BGPMAN=1
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
I $P($G(^BGPGP1PM(1,7,BGPDPD0,0)),U,4)=1 D:$G(BGPMAN) Q
.W !!,"Those files for the 1st Friday in "
.S X=+$E($P(^BGPGP1PM(1,7,BGPDPD0,0),U,9),4,5)
.;
.S X=$P($T(MON+X),";;",2)
.W X," were already successfully uploaded and",!,"processed on ",$$FMTE^XLFDT($P(^BGPGP1PM(1,7,BGPDPD0,0),U,9)),!
;quit trying to process after 5 attempts
Q:$P($G(^BGPGP1PM(1,7,BGPDPD0,0)),U,6)>50
;
S BGPPATH=$P($G(^BGPGP1PM(1,1)),U)
Q:BGPPATH']""
;
;
K ^TMP("BGPGPAM",$J,"FILE")
K BGPLIST S BGPLIST="",X=$$LIST^%ZISH(BGPPATH,"BGPAM140*",.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"
. K ^TMP("BGPGPAM",$J,"FILE")
. I $G(BGPMAN) D Q
. . W !,BGPERR
. . D MSG1^BGP4AU1M(BGPBEGDT,BGPENDDT,.BGPFACS)
. ;SEND EMAIL/ALERT THAT FILES ARE NOT ALL THERE
. D ALERTMM(1,BGPBEGDT,BGPENDDT,.BGPFACS,.BGPF,BGPDFILE)
. I '$G(BGPMAN) D REQUE(BGPBEGDT,BGPENDDT)
. D STAT(BGPDPD0,BGPBEGDT,$G(BGPENDDT),$$NOW^XLFDT,2,BGPERR,$$ATT(BGPDPD0))
Q:BGPOUT
;
;upload all files into the BGP 14 DATA* files
D UPLOAD(BGPPATH,BGPBEGDT,BGPENDDT,.BGPFACS)
;
;create the 5 excel files
D EN^BGP4AU1A(BGPBEGDT,BGPENDDT,.BGPEND,.BGPF)
;
;upload the 5 excel files into BGPGP1 GPRA FLAT
D EN^BGP4AU1R(.BGPF)
;
;create data dump text file
;
;ihs/cmi/maw gui failing here on BGPEND
D EN^BGP4AU1D(BGPBEGDT,BGPEND,.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 Q
. W !,"ALL FILES SUCCESSFULLY CREATED AND EMAIL MESSAGE SENT"
;REQUEUE
NEW BGPDT,BGPX,BGPY
S X=DT F S X=$$FMADD^XLFDT(X,1) Q:$E(X,6,7)="01"
S BGPDT=X
;get next "second Friday" in this month
;S BGPX=$E(DT,1,5)_"01" ;first of this month
S BGPY=0
D
. S X=BGPDT D DW^%DTC I X="FRIDAY" S BGPY=BGPY+1
. F D Q:BGPY=2
. . S (X,BGPDT)=$$FMADD^XLFDT(BGPDT,1)
. . D DW^%DTC
. . Q:X'="FRIDAY"
. . S BGPY=BGPY+1
S BGPX=BGPDT_".12"
;ztload
S ZTDTH=BGPX
;S ZTSAVE("BGP*")=""
S ZTRTN="AUTO^BGP4AUUP"
S ZTDESC="BGP4 AUTO GPRA AREA AGGREGATE"
S ZTIO=""
D ^%ZTLOAD
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^BGP4AUUL(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'["BGPAM140"
. S BGPFILE="BGPAM140"_$P(BGPDATA,"BGPAM140",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(^BGPGPDCJ("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
. S BGPASU=$P(^BGPGPDCJ(BGPD0,0),U,9)
. I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
. Q:$P(^BGPGPDCJ(BGPD0,0),U,12)'=1 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
. S DA=BGPD0
. S DIK="^BGPGPDCJ("
. D ^DIK
;
S BGPD0=0 F S BGPD0=$O(^BGPGPDPJ("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
. S BGPASU=$P(^BGPGPDPJ(BGPD0,0),U,9)
. I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
. Q:$P(^BGPGPDPJ(BGPD0,0),U,12)'=1 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
. S DA=BGPD0
. S DIK="^BGPGPDPJ("
. D ^DIK
;
S BGPD0=0 F S BGPD0=$O(^BGPGPDBJ("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
. S BGPASU=$P(^BGPGPDBJ(BGPD0,0),U,9)
. I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
. Q:$P(^BGPGPDBJ(BGPD0,0),U,12)'=1 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
. S DA=BGPD0
. S DIK="^BGPGPDBJ("
. 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(BGPFGNT3)
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 ZTSAVE("BGP*")=""
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,+1)
S ZTRTN="AUTO^BGP4AUUP"
S ZTDESC="BGP4 AUTO GPRA AREA AGGREGATE"
S ZTIO=""
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",2014,0))
S Y=^BGPCTRL(Y,0)
;S BGPENDDT=$P(Y,U,9)
;S BGPBEGDT=$P(Y,U,8)
S BGPBEGDT=$S(+$E(DT,4,7)<701:$E(DT,1,3)-1_"0701",1:$E(DT,1,3)_"0701")
S BGPENDDT=$S(+$E(DT,4,7)<701:$E(DT,1,3)_"0630",1:$E(DT,1,3)+1_"0630")
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_"'"
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
.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)=BGPFGNT3
.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
SCH ;EP - called from option to schedule the area aggregate for the next "2nd Friday"
D SCH^BGP4AUUL
Q
XIT ;EP
D EN^XBVK("BGP")
Q
MON ;;
1 ;;JANUARY
2 ;;FEBRUARY
3 ;;MARCH
4 ;;APRIL
5 ;;MAY
6 ;;JUNE
7 ;;JULY
8 ;;AUGUST
9 ;;SEPTEMBER
10 ;;OCTOBER
11 ;;NOVEMBER
12 ;;DECEMBER
BGP4AUUP ; IHS/CMI/LAB - UPLOAD SITE FILES, CREATE EXCEL FILES ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine processes the monthly GPRA files received from
+3 ;;the sites. It creates the Excel fileUYYYY 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 CALC(.BGPBEGDT,.BGPENDDT)
+5 DO EN(BGPBEGDT,BGPENDDT)
+6 ;
+7 SET BGPY=0
+8 QUIT
MAN ;EP -- MANUALLY PROCESS
+1 ;
+2 WRITE !!,"This option is used to aggregate all GPRA Extract files that have"
+3 WRITE !,"been received from the facilities.",!!
+4 WRITE !,"The process will run immediately.",!
+5 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 IF 'Y
QUIT
+8 NEW BGPBEGDT,BGPDTS,BGPENDDT,BGPMAN
+9 ;
+10 DO CALC(.BGPBEGDT,.BGPENDDT)
+11 WRITE !!,"Processing ",$$VAL^XBDIQ1(90245,1,.02)," for ",$$FMTE^XLFDT(BGPBEGDT),"-",$$FMTE^XLFDT(BGPENDDT),".",!
+12 SET BGPMAN=1
+13 DO EN(BGPBEGDT,BGPENDDT,BGPMAN)
+14 QUIT
GUIDQ ;EP -- gui entry point for manual
+1 DO CALC(.BGPBEGDT,.BGPENDDT)
+2 SET BGPMAN=1
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
IF $GET(BGPMAN)
Begin DoDot:1
+17 WRITE !!,"Those files for the 1st Friday in "
+18 SET X=+$EXTRACT($PIECE(^BGPGP1PM(1,7,BGPDPD0,0),U,9),4,5)
+19 ;
+20 SET X=$PIECE($TEXT(MON+X),";;",2)
+21 WRITE X," were already successfully uploaded and",!,"processed on ",$$FMTE^XLFDT($PIECE(^BGPGP1PM(1,7,BGPDPD0,0),U,9)),!
End DoDot:1
QUIT
+22 ;quit trying to process after 5 attempts
+23 IF $PIECE($GET(^BGPGP1PM(1,7,BGPDPD0,0)),U,6)>50
QUIT
+24 ;
+25 SET BGPPATH=$PIECE($GET(^BGPGP1PM(1,1)),U)
+26 IF BGPPATH']""
QUIT
+27 ;
+28 ;
+29 KILL ^TMP("BGPGPAM",$JOB,"FILE")
+30 KILL BGPLIST
SET BGPLIST=""
SET X=$$LIST^%ZISH(BGPPATH,"BGPAM140*",.BGPLIST)
+31 ;check ^TMP global to see if all files are there
+32 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)
+33 SET ^TMP("BGPGPAM",$JOB,"FILE",0)=C
+34 DO CHK(BGPENDDT,.BGPFACS,.BGPOUT)
+35 IF BGPOUT
Begin DoDot:1
+36 SET BGPERR="MISSING FACILITY FILES"
+37 KILL ^TMP("BGPGPAM",$JOB,"FILE")
+38 IF $GET(BGPMAN)
Begin DoDot:2
+39 WRITE !,BGPERR
+40 DO MSG1^BGP4AU1M(BGPBEGDT,BGPENDDT,.BGPFACS)
End DoDot:2
QUIT
+41 ;SEND EMAIL/ALERT THAT FILES ARE NOT ALL THERE
+42 DO ALERTMM(1,BGPBEGDT,BGPENDDT,.BGPFACS,.BGPF,BGPDFILE)
+43 IF '$GET(BGPMAN)
DO REQUE(BGPBEGDT,BGPENDDT)
+44 DO STAT(BGPDPD0,BGPBEGDT,$GET(BGPENDDT),$$NOW^XLFDT,2,BGPERR,$$ATT(BGPDPD0))
End DoDot:1
+45 IF BGPOUT
QUIT
+46 ;
+47 ;upload all files into the BGP 14 DATA* files
+48 DO UPLOAD(BGPPATH,BGPBEGDT,BGPENDDT,.BGPFACS)
+49 ;
+50 ;create the 5 excel files
+51 DO EN^BGP4AU1A(BGPBEGDT,BGPENDDT,.BGPEND,.BGPF)
+52 ;
+53 ;upload the 5 excel files into BGPGP1 GPRA FLAT
+54 DO EN^BGP4AU1R(.BGPF)
+55 ;
+56 ;create data dump text file
+57 ;
+58 ;ihs/cmi/maw gui failing here on BGPEND
+59 DO EN^BGP4AU1D(BGPBEGDT,BGPEND,.BGPDFILE)
+60 ;
+61 ;
+62 ;send email that excel and data dump files are created
+63 DO ALERTMM1(2,BGPBEGDT,BGPENDDT,,.BGPF,BGPDFILE)
+64 ;
+65 ;update status to completed
+66 DO STAT(BGPDPD0,BGPBEGDT,(BGPEND-17000000),$$NOW^XLFDT,1,"@",$$ATT(BGPDPD0))
+67 ;
+68 ;clean everything up
+69 DO CLEAN(BGPBEGDT,BGPENDDT)
+70 KILL ^TMP("BGPGPAM",$JOB,BGPFILE)
+71 DO MOVEFL(BGPENDDT,.BGPFACS,.BGPF,BGPDFILE)
+72 ;
+73 IF $GET(BGPMAN)
Begin DoDot:1
+74 WRITE !,"ALL FILES SUCCESSFULLY CREATED AND EMAIL MESSAGE SENT"
End DoDot:1
QUIT
+75 ;REQUEUE
+76 NEW BGPDT,BGPX,BGPY
+77 SET X=DT
FOR
SET X=$$FMADD^XLFDT(X,1)
IF $EXTRACT(X,6,7)="01"
QUIT
+78 SET BGPDT=X
+79 ;get next "second Friday" in this month
+80 ;S BGPX=$E(DT,1,5)_"01" ;first of this month
+81 SET BGPY=0
+82 Begin DoDot:1
+83 SET X=BGPDT
DO DW^%DTC
IF X="FRIDAY"
SET BGPY=BGPY+1
+84 FOR
Begin DoDot:2
+85 SET (X,BGPDT)=$$FMADD^XLFDT(BGPDT,1)
+86 DO DW^%DTC
+87 IF X'="FRIDAY"
QUIT
+88 SET BGPY=BGPY+1
End DoDot:2
IF BGPY=2
QUIT
End DoDot:1
+89 SET BGPX=BGPDT_".12"
+90 ;ztload
+91 SET ZTDTH=BGPX
+92 ;S ZTSAVE("BGP*")=""
+93 SET ZTRTN="AUTO^BGP4AUUP"
+94 SET ZTDESC="BGP4 AUTO GPRA AREA AGGREGATE"
+95 SET ZTIO=""
+96 DO ^%ZTLOAD
+97 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^BGP4AUUL(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'["BGPAM140"
QUIT
+27 SET BGPFILE="BGPAM140"_$PIECE(BGPDATA,"BGPAM140",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(^BGPGPDCJ("B",BGPBEGDT,BGPD0))
IF 'BGPD0
QUIT
Begin DoDot:1
+9 SET BGPASU=$PIECE(^BGPGPDCJ(BGPD0,0),U,9)
+10 IF $GET(BGPFACS(BGPENDDT,BGPASU))=""
QUIT
+11 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
IF $PIECE(^BGPGPDCJ(BGPD0,0),U,12)'=1
QUIT
+12 SET DA=BGPD0
+13 SET DIK="^BGPGPDCJ("
+14 DO ^DIK
End DoDot:1
+15 ;
+16 SET BGPD0=0
FOR
SET BGPD0=$ORDER(^BGPGPDPJ("B",BGPBEGDT,BGPD0))
IF 'BGPD0
QUIT
Begin DoDot:1
+17 SET BGPASU=$PIECE(^BGPGPDPJ(BGPD0,0),U,9)
+18 IF $GET(BGPFACS(BGPENDDT,BGPASU))=""
QUIT
+19 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
IF $PIECE(^BGPGPDPJ(BGPD0,0),U,12)'=1
QUIT
+20 SET DA=BGPD0
+21 SET DIK="^BGPGPDPJ("
+22 DO ^DIK
End DoDot:1
+23 ;
+24 SET BGPD0=0
FOR
SET BGPD0=$ORDER(^BGPGPDBJ("B",BGPBEGDT,BGPD0))
IF 'BGPD0
QUIT
Begin DoDot:1
+25 SET BGPASU=$PIECE(^BGPGPDBJ(BGPD0,0),U,9)
+26 IF $GET(BGPFACS(BGPENDDT,BGPASU))=""
QUIT
+27 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
IF $PIECE(^BGPGPDBJ(BGPD0,0),U,12)'=1
QUIT
+28 SET DA=BGPD0
+29 SET DIK="^BGPGPDBJ("
+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(BGPFGNT3)
+21 DO MOVE1(BGPFDEV1)
+22 DO MOVE1(BGPFDEV2)
+23 DO MOVE1(BGPFDEV3)
+24 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 ZTSAVE("BGP*")=""
+6 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,+1)
+7 SET ZTRTN="AUTO^BGP4AUUP"
+8 SET ZTDESC="BGP4 AUTO GPRA AREA AGGREGATE"
+9 SET ZTIO=""
+10 DO ^%ZTLOAD
+11 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",2014,0))
+22 SET Y=^BGPCTRL(Y,0)
+23 ;S BGPENDDT=$P(Y,U,9)
+24 ;S BGPBEGDT=$P(Y,U,8)
+25 SET BGPBEGDT=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)-1_"0701",1:$EXTRACT(DT,1,3)_"0701")
+26 SET BGPENDDT=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)_"0630",1:$EXTRACT(DT,1,3)+1_"0630")
+27 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_"'"
End DoDot:1
+13 IF BGPOUT
QUIT
+14 FOR I=1:1
Begin DoDot:1
+15 USE IO
READ X:DTIME
+16 IF $$STATUS^%ZISH
SET BGPEND=1
+17 IF BGPEND
QUIT
+18 SET BGPCNT=BGPCNT+1
+19 SET ^TMP("BGPGPAM",$JOB,"FILE",I,0)=X
+20 SET ^TMP("BGPGPAM",$JOB,"FILE",0)=BGPCNT
End DoDot:1
IF BGPEND
QUIT
+21 ;
+22 DO CLOSE^%ZISH("FILE")
+23 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 DO MM
End DoDot:1
+28 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)=BGPFGNT3
+18 SET C=C+1
SET BGPTEXT(C)=BGPFDEV1
+19 SET C=C+1
SET BGPTEXT(C)=BGPFDEV2
+20 SET C=C+1
SET BGPTEXT(C)=BGPFDEV3
+21 SET C=C+1
SET BGPTEXT(C)="The following data file for DeepSee has been created:"
+22 SET C=C+1
SET BGPTEXT(C)=BGPDFILE
+23 SET XQATEXT="BGPTEXT"
+24 SET XQAMSG="GPRA Auto Extract Upload Completed."
+25 SET XQAID="OR,"_DUZ_",46"
+26 DO SETUP^XQALERT
+27 ;now send mailman message
+28 DO MM
End DoDot:1
+29 QUIT
SCH ;EP - called from option to schedule the area aggregate for the next "2nd Friday"
+1 DO SCH^BGP4AUUL
+2 QUIT
XIT ;EP
+1 DO EN^XBVK("BGP")
+2 QUIT
MON ;;
1 ;;JANUARY
2 ;;FEBRUARY
3 ;;MARCH
4 ;;APRIL
5 ;;MAY
6 ;;JUNE
7 ;;JULY
8 ;;AUGUST
9 ;;SEPTEMBER
10 ;;OCTOBER
11 ;;NOVEMBER
12 ;;DECEMBER
