- BGP6AUUP ; IHS/CMI/LAB - UPLOAD SITE FILES, CREATE EXCEL FILES ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;
- 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^BGP6AU1M(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 16 DATA* files
- D UPLOAD(BGPPATH,BGPBEGDT,BGPENDDT,.BGPFACS)
- ;
- ;create the 5 excel files
- D EN^BGP6AU1A(BGPBEGDT,BGPENDDT,.BGPEND,.BGPF)
- ;
- ;upload the 5 excel files into BGPGP1 GPRA FLAT
- D EN^BGP6AU1R(.BGPF)
- ;
- ;create data dump text file
- ;
- ;ihs/cmi/maw gui failing here on BGPEND
- D EN^BGP6AU1D(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 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"
- S ZTDTH=BGPX
- ;S ZTSAVE("BGP*")=""
- S ZTRTN="AUTO^BGP6AUUP"
- S ZTDESC="BGP6 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^BGP6AUUL(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'["BGPAM150"
- . S BGPFILE="BGPAM150"_$P(BGPDATA,"BGPAM150",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(^BGPGPDCM("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
- . S BGPASU=$P(^BGPGPDCM(BGPD0,0),U,9)
- . I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
- . Q:$P(^BGPGPDCM(BGPD0,0),U,12)'=1 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
- . S DA=BGPD0
- . S DIK="^BGPGPDCM("
- . D ^DIK
- ;
- S BGPD0=0 F S BGPD0=$O(^BGPGPDPM("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
- . S BGPASU=$P(^BGPGPDPM(BGPD0,0),U,9)
- . I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
- . Q:$P(^BGPGPDPM(BGPD0,0),U,12)'=1 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
- . S DA=BGPD0
- . S DIK="^BGPGPDPM("
- . D ^DIK
- ;
- S BGPD0=0 F S BGPD0=$O(^BGPGPDBM("B",BGPBEGDT,BGPD0)) Q:'BGPD0 D
- . S BGPASU=$P(^BGPGPDBM(BGPD0,0),U,9)
- . I $G(BGPFACS(BGPENDDT,BGPASU))="" Q
- . Q:$P(^BGPGPDBM(BGPD0,0),U,12)'=1 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
- . S DA=BGPD0
- . S DIK="^BGPGPDBM("
- . 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(BGPFGNT4)
- D MOVE1(BGPFDEV1)
- D MOVE1(BGPFDEV2)
- D MOVE1(BGPFDEV3)
- D MOVE1(BGPFDEV4)
- 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^BGP6AUUP"
- S ZTDESC="BGP6 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",2016,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(D)=BGPFGNT4
- .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)=BGPFDEV4
- .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^BGP6AUUL
- 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
- BGP6AUUP ; IHS/CMI/LAB - UPLOAD SITE FILES, CREATE EXCEL FILES ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +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^BGP6AU1M(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 16 DATA* files
- +48 DO UPLOAD(BGPPATH,BGPBEGDT,BGPENDDT,.BGPFACS)
- +49 ;
- +50 ;create the 5 excel files
- +51 DO EN^BGP6AU1A(BGPBEGDT,BGPENDDT,.BGPEND,.BGPF)
- +52 ;
- +53 ;upload the 5 excel files into BGPGP1 GPRA FLAT
- +54 DO EN^BGP6AU1R(.BGPF)
- +55 ;
- +56 ;create data dump text file
- +57 ;
- +58 ;ihs/cmi/maw gui failing here on BGPEND
- +59 DO EN^BGP6AU1D(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 SET BGPY=0
- +81 Begin DoDot:1
- +82 SET X=BGPDT
- DO DW^%DTC
- IF X="FRIDAY"
- SET BGPY=BGPY+1
- +83 FOR
- Begin DoDot:2
- +84 SET (X,BGPDT)=$$FMADD^XLFDT(BGPDT,1)
- +85 DO DW^%DTC
- +86 IF X'="FRIDAY"
- QUIT
- +87 SET BGPY=BGPY+1
- End DoDot:2
- IF BGPY=2
- QUIT
- End DoDot:1
- +88 SET BGPX=BGPDT_".12"
- +89 SET ZTDTH=BGPX
- +90 ;S ZTSAVE("BGP*")=""
- +91 SET ZTRTN="AUTO^BGP6AUUP"
- +92 SET ZTDESC="BGP6 AUTO GPRA AREA AGGREGATE"
- +93 SET ZTIO=""
- +94 DO ^%ZTLOAD
- +95 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^BGP6AUUL(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'["BGPAM150"
- QUIT
- +27 SET BGPFILE="BGPAM150"_$PIECE(BGPDATA,"BGPAM150",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(^BGPGPDCM("B",BGPBEGDT,BGPD0))
- IF 'BGPD0
- QUIT
- Begin DoDot:1
- +9 SET BGPASU=$PIECE(^BGPGPDCM(BGPD0,0),U,9)
- +10 IF $GET(BGPFACS(BGPENDDT,BGPASU))=""
- QUIT
- +11 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
- IF $PIECE(^BGPGPDCM(BGPD0,0),U,12)'=1
- QUIT
- +12 SET DA=BGPD0
- +13 SET DIK="^BGPGPDCM("
- +14 DO ^DIK
- End DoDot:1
- +15 ;
- +16 SET BGPD0=0
- FOR
- SET BGPD0=$ORDER(^BGPGPDPM("B",BGPBEGDT,BGPD0))
- IF 'BGPD0
- QUIT
- Begin DoDot:1
- +17 SET BGPASU=$PIECE(^BGPGPDPM(BGPD0,0),U,9)
- +18 IF $GET(BGPFACS(BGPENDDT,BGPASU))=""
- QUIT
- +19 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
- IF $PIECE(^BGPGPDPM(BGPD0,0),U,12)'=1
- QUIT
- +20 SET DA=BGPD0
- +21 SET DIK="^BGPGPDPM("
- +22 DO ^DIK
- End DoDot:1
- +23 ;
- +24 SET BGPD0=0
- FOR
- SET BGPD0=$ORDER(^BGPGPDBM("B",BGPBEGDT,BGPD0))
- IF 'BGPD0
- QUIT
- Begin DoDot:1
- +25 SET BGPASU=$PIECE(^BGPGPDBM(BGPD0,0),U,9)
- +26 IF $GET(BGPFACS(BGPENDDT,BGPASU))=""
- QUIT
- +27 ;DON'T DELETE OTHER NATIONAL, GPU, ETC.
- IF $PIECE(^BGPGPDBM(BGPD0,0),U,12)'=1
- QUIT
- +28 SET DA=BGPD0
- +29 SET DIK="^BGPGPDBM("
- +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(BGPFGNT4)
- +22 DO MOVE1(BGPFDEV1)
- +23 DO MOVE1(BGPFDEV2)
- +24 DO MOVE1(BGPFDEV3)
- +25 DO MOVE1(BGPFDEV4)
- +26 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^BGP6AUUP"
- +8 SET ZTDESC="BGP6 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",2016,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(D)=BGPFGNT4
+19 SET C=C+1
SET BGPTEXT(C)=BGPFDEV1
+20 SET C=C+1
SET BGPTEXT(C)=BGPFDEV2
+21 SET C=C+1
SET BGPTEXT(C)=BGPFDEV3
+22 SET C=C+1
SET BGPTEXT(C)=BGPFDEV4
+23 SET C=C+1
SET BGPTEXT(C)="The following data file for DeepSee has been created:"
+24 SET C=C+1
SET BGPTEXT(C)=BGPDFILE
+25 SET XQATEXT="BGPTEXT"
+26 SET XQAMSG="GPRA Auto Extract Upload Completed."
+27 SET XQAID="OR,"_DUZ_",46"
+28 DO SETUP^XQALERT
+29 ;now send mailman message
+30 DO MM
End DoDot:1
+31 QUIT
SCH ;EP - called from option to schedule the area aggregate for the next "2nd Friday"
+1 DO SCH^BGP6AUUL
+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