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

BGP6AUUP.m

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