BGP3AUEX ; IHS/CMI/LAB - BUILD SITE GPRA FILES, EXPORT TO AREA ; 05 Nov 2012 12:13 PM
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
;Thanks to Anne Fughat. The original routines were written by
;Anne Fughat, Phoexnix Area Office. They were copied into the
;BGP namespace and modified for national use.
;;Some code in EN taken from the BGP3DGPU routine.
;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This routine automatically extracts the GPRA data, creates a
;;text file, and sends it to the area. It should be autoqueued
;;to run each month via option BGP3AUEX AUTO GPRA EXTRACT.
;;$$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 BGPD,BGPDT,BGPEND,BGPM,BGPY,ZTDTH,BGPSITE,BGPT
;
S Q=0
F F=.02,4.2,4.3,4.4,4.5,5.1 I $$VAL^XBDIQ1(90241.04,DUZ(2),F)="" S Q=1
I Q Q ;W !!,"These values must be entered into the parameter file",!,"before you can run this option.",! D PAUSE^BGP3DU Q
S BGPSITE=$S($G(BGPLOC):BGPLOC,1:DUZ(2)) ;site who queued report
S BGPT=$P(^BGPGP2PM(BGPSITE,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 BGPEND=BGPY_BGPM_BGPD
.S ZTDTH=""
.D QUE(BGPEND)
S Y=$O(^BGPCTRL("B",2013,0))
S Y=^BGPCTRL(Y,0)
;S BGPEND=$P(Y,U,9)
S BGPEND=$S(+$E(DT,4,7)<701:$E(DT,1,3)_"0630",1:$E(DT,1,3)+1_"0630")
NT1 ;
S ZTDTH=""
D QUE(BGPEND)
Q
MAN ;EP -- MANUALLY RUN GPRA EXTRACT
;
N BGPEND,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZTSK,F,Q
;
;D ^XBKVAR -user should be in kernel, no need to do this
;
N DIC,BGPSITE
S BGPSITE=""
S DIC="^BGPGP2PM(",DIC(0)="AEMQ",DIC("A")="Enter the site to run the extract for: ",DIC("S")="I $P(^(0),U,1)=DUZ(2)" D ^DIC
I Y=-1 Q
S BGPSITE=+Y
I BGPSITE'=DUZ(2) W !,"You need to be logged in as ",$$VAL^XBDIQ1(90241.04,BGPSITE,.01)," to run the report",!,"for that site." G MAN
S BGPT=$P(^BGPGP2PM(BGPSITE,0),U,2)
S Q=0
F F=.02,4.2,4.3,4.4,4.5 I $$VAL^XBDIQ1(90241.04,BGPSITE,F)="" W !,$P(^DD(90241.04,F,0),U,1)," is missing." S Q=1
I Q W !!,"These values must be entered into the parameter file",!,"before you can run this option.",! D PAUSE^BGP3DU Q
I BGPT="T" D G MAN1
.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 BGPEND=BGPY_BGPM_BGPD
.S (BGPBD,BGPED,BGPTP)=""
.S BGPBD=$$FMADD^XLFDT(BGPEND,-364),BGPED=BGPEND,BGPPER=$E(BGPED,1,3)_"0000"
.S BGPVDT=3000000 ;***HARD CODED TO BASELINE YEAR 2000
.S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)
.S X=X_"0000"
.S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)
.S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)
.S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)
.S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)
S X=$O(^BGPCTRL("B",2013,0))
S Y=^BGPCTRL(X,0)
S BGPBD=$S(+$E(DT,4,7)<701:$E(DT,1,3)-1_"0701",1:$E(DT,1,3)_"0701")
S (BGPEND,BGPED)=$S(+$E(DT,4,7)<701:$E(DT,1,3)_"0630",1:$E(DT,1,3)+1_"0630")
;S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
S BGPPBD=$E(BGPBD,1,3)-1_"0701",BGPPED=$E(BGPED,1,3)-1_"0630"
S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)
S BGPPER=$P(Y,U,14)
S BGPQTR=3
S BGPVDT=3000000 ;***HARD CODED TO BASELINE YEAR 2000
MAN1 S BGPAMEX=1,BGPERRM=""
S X=$$DEMOCHK^BGP3UTL2()
I 'X W !!,"Exiting Report....." D PAUSE^BGP3DU,XIT Q
W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
K BGPTAX
S BGPTAXI=""
S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
D ^DIC
I Y=-1 W !!,"Exiting Report..." D PAUSE^BGP3DU,XIT Q
S BGPTAXI=+Y
;S BGPAMFN="BGPGPAM121"_DT_$P(^AUTTLOC(BGPSITE,0),U,10)_$$LZERO^BGP3UTL(BGPLOG)_".TXT"
W:$D(IOF) @IOF
W !,$$CTR^BGP3DNG("SUMMARY OF NATIONAL GPRA/GPRAMA REPORT TO BE GENERATED")
W !!,"The date ranges for this report are:"
W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
S BGPMAN=1
D QUE(BGPEND)
I $G(ZTSK) D
. ;
. W !,"GPRA EXTRACT QUEUED AS TASK #",ZTSK
. ;W !!,"The BGPGPAM121"_DT_$P(^AUTTLOC(DUZ(2),0),U,10)_"nnnnnn.TXT file will be sent to the Area Office.",!
. W ! D PAUSE^BGP3DU
D XIT
Q
;
QUE(BGPEND,ZTDTH) ;EP
;------ QUEUEING CODE
;
I '$G(BGPMAN) D DQ Q ;AUTO
;
N ZTDESC,ZTRTN,ZTIO
;
S ZTSAVE("BGP*")=""
S ZTRTN="DQ^BGP3AUEX"
S ZTDESC="BGP3 AUTO GPRA DATA EXTRACT"
S ZTIO=""
D ^%ZTLOAD
;
Q
DQ ;EP -- QUEUED JOB STARTS HERE
;
D EN(BGPEND)
;now reschedule for the 1st Friday of next month
I $G(BGPMAN) Q ;not manual
;GET FIRST OF NEXT MONTH AND RESCHEDULE
;ADD 1 UNTIL DAY IS 01
S X=DT F S X=$$FMADD^XLFDT(X,1) Q:$E(X,6,7)="01"
S BGPX=$$FRIDAY(X)
S ZTDTH=BGPX
S ZTSAVE("BGP*")=""
S ZTRTN="AUTO^BGP3AUEX"
S ZTDESC="BGP3 AUTO GPRA DATA EXTRACT"
S ZTIO=""
D ^%ZTLOAD
K BGPEND
Q
EN(BGPEND) ;EP -- MAIN ENTRY POINT
;
; INPUT:
; BGPEND = REPORT END DATE
;
N BGPED,BGPPER,BGPRTYPE,BGP1RPTH,BGP1GPU,BGPBD,BGPED,BGPTP,BGPVDT
N X,BGPBBD,BGPBED,BGPPBD,BGPPED,BGPTAX,BGPBEN,BGPBENF
N BGPHOME,BGPINDH,BGPEXPT,BGPEXCEL,BGPUF,BGPQUIT,BGPRPT,BGPFILE
;
;D ^XBKVAR - KERNAL VARS SHOULD BE SET UP BY TASKMAN
;
S BGPAMEX=1 ;in automated
S BGPRTYPE=1,BGP1RPTH="",BGP1GPU=1
S (BGPBD,BGPED,BGPTP)=""
S BGPT=$P(^BGPGP2PM(BGPSITE,0),U,2)
I BGPT="G" D
.S X=$O(^BGPCTRL("B",2013,0)) ;get GPRA year dates
.;per Megan - run automated report for gpra year dates
.;
.S Y=^BGPCTRL(X,0)
.S BGPBD=$S(+$E(DT,4,7)<701:$E(DT,1,3)-1_"0701",1:$E(DT,1,3)_"0701")
.S (BGPEND,BGPED)=$S(+$E(DT,4,7)<701:$E(DT,1,3)_"0630",1:$E(DT,1,3)+1_"0630")
.;S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
.S BGPPBD=$E(BGPBD,1,3)-1_"0701",BGPPED=$E(BGPED,1,3)-1_"0630"
.S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)
.S BGPPER=$P(Y,U,14)
.S BGPQTR=3
.S BGPVDT=3000000 ;***HARD CODED TO BASELINE YEAR 2000
I BGPT="T" D
.S (BGPBD,BGPED,BGPTP)=""
.S BGPBD=$$FMADD^XLFDT(BGPEND,-364),BGPED=BGPEND,BGPPER=$E(BGPED,1,3)_"0000"
.S BGPVDT=3000000 ;***HARD CODED TO BASELINE YEAR 2000
.S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)
.S X=X_"0000"
.S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)
.S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)
.S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)
.S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)
COM ;
S BGPTAXI=$P($G(^BGPGP2PM(DUZ(2),5)),U)
S X=0
I BGPTAXI F S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X D
. S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""
S BGPBEN=1
S BGPBENF="Indian/Alaskan Native (Classification 01)"
S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)
S X=0 F S X=$O(^BGPINDH("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDH="G"
S BGPEXPT=1
S BGPEXCEL=""
S BGPUF=$$GETDIR^BGP3UTL2()
D REPORT^BGP3UTL ;***CREATES THE ENTRIES IN THE BGP 13 DATA FILES AND RETURNS BGPRPT
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
S BGPAMFN="BGPAM130"_BGPEND_$P(^AUTTLOC(BGPSITE,0),U,10)_$$LZERO^BGP3UTL(BGPRPT,6)_".TXT"
D ^BGP3D1
D GS^BGP3UTL ;***CREATES BG130 FILE
S BGPFILE=BGPAMFN
D LOG(BGPFILE,BGPBD,BGPEND,BGPERRM)
D XIT
Q
LOG(BGPFILE,BGPBD,BGPEND,BGPERRM) ;
;----- LOG EXTRACT DATE AND FILE NAME
;
N DA,DD,DIC,DIE,DO,DR,X,Y
;
S X=$$NOW^XLFDT
S DA(1)=BGPSITE
S DIC="^BGPGP2PM("_DA(1)_",8,"
S DIC(0)=""
D FILE^DICN
Q:+Y'>0
S DA=+Y
S DIE=DIC
S DR=".02///"_BGPFILE_";.03///"_BGPBD_";.04///"_BGPEND_";.05///"_BGPERRM
D ^DIE
Q
ASUFAC() ;
;---- RETURNS ASUFAC OF MAIN SITE IN RPMS SITE FILE
;
N Y
S Y=""
S Y=$P($G(^AUTTLOC(+$P($G(^AUTTSITE(1,0)),U),0)),U,10)
Q Y
FRIDAY(DT) ;
;----- RETURNS DATE/TIME FOR THE NEXT FRIDAY BEGINNING WITH DT
; Prevents the auto job from running on a weekday which could spill
; over into business hours impacting system performance. This will
; find the first Friday after the date passed in DT. If the date
; passed is already a Friday it returns the original date passed.
; The time of 22:00 is concatenated to the date.
;
N X,Y
S Y=""
S X=DT,BGPDT=DT
D DW^%DTC
I X'="FRIDAY" D
. S BGPDT=DT
. F D Q:X="FRIDAY"
. . S (X,BGPDT)=$$FMADD^XLFDT(BGPDT,1)
. . D DW^%DTC
S Y=BGPDT_".22"
Q Y
XIT ;
D ^%ZISC
D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
K DIRUT,DUOUT,DIR,DOD
K DIADD,DLAYGO
D KILL^AUPNPAT
K X,X1,X2,X3,X4,X5,X6
K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
K N,N1,N2,N3,N4,N5,N6
K BD,ED
D KILL^AUPNPAT
D ^XBFMK
Q
AUTOEX ;EP
NEW XBGL S XBGL="BGPDATA"
S F=BGPAMFN
NEW XBFN,XBMED,XBF,XBFLT
S XBMED="F",XBFN=F,XBTLE="SAVE OF CRS AUTOMATED DATA",XBF=0,XBFLT=1
S XBS1="BGP GPRA AUTO SEND "_$P(^AUTTLOC(BGPSITE,0),U,10)
S XBUF=BGPUF D ^XBGSAVE
S BGPERRM=""
I XBFLG'=0 D
. I XBFLG(1)="" S BGPERRM="GPRA DATA file successfully created"
. I XBFLG(1)]"" S BGPERRM="GPRA DATA file NOT successfully created"
. S BGPERRM="File was NOT successfully transferred. "_XBFLG(1)
L -^BGPDATA
K ^TMP($J),^BGPDATA ;NOTE: kill of unsubscripted global for use in export to area.
Q
;
SITEPAR ;EP - called from option
;GET ENTRY
;
W !!,"This option is used by Area Office personnel to set up an"
W !,"automated GPRA extract for the site you select. All "
W !,"questions are mandatory and must be answered before the"
W !,"first extract will be queued to run.",!,"You must be logged into the site for which you want to schedule",!,"this extract.",!!
;
S DIC(0)="AEMQL",DIC="^BGPGP2PM(",DIC("S")="I $P(^(0),U,1)=DUZ(2)" D ^DIC K DIC
I Y=-1 K Y Q
S (BGPSITE,BGPLOC)=+Y
S BGPTASK=$$CHKFQT(BGPSITE) ;check for currently queued task, allow user to edit params or to delete scheduled task
I BGPTASK D EDITDEL Q
D EDITPAR
D SCHED
;D QUE
Q
SCHED ;EP -scedule task in option scheduling
K DIR,DIRUT S DIR(0)="Y",DIR("A")="Do you wish to continue to schedule this monthly" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I 'Y Q
SCHEDGUI ;EP - gui entry point to schedule
S BGPERR="",BGPX=""
;get 1st Friday of this month, if it is already passed find 1st Friday of next month.
;
S BGPX=$$FRIDAY($E(DT,1,5)_"00")
I $P(BGPX,".")<DT D
.S BGPX=$E(DT,4,5),BGPX=$S(+BGPX="12":"01",1:BGPX+1),BGPX=$S($L(BGPX)=1:"0"_BGPX,1:BGPX),BGPX=$S(BGPX="01":$E(DT)_($E(DT,2,3)+1)_BGPX_"00",1:$E(DT,1,3)_BGPX_"00")
.S BGPX=$$FRIDAY(BGPX)
G NT
;
S BGPX=$$FMADD^XLFDT($$NOW^XLFDT,,,5) ;LORI TAKE OUT WHEN DONE TESTING
NT ;
D BMES^XPDUTL("SETTING OPTION 'BGP 13 AUTO GPRA EXTRACT' to run in taskman")
;
;S BGPOPT="BGP 13 AUTO GPRA EXTRACT"
;S BGPOPTD0=$O(^DIC(19,"B",BGPOPT,0))
;I 'BGPOPTD0 D Q
;. D BMES^XPDUTL("'BGP 13 AUTO GPRA EXTRACT' OPTION NOT FOUND!")
;Q:'BGPOPTD0
;S BGPD0=$O(^DIC(19.2,"B",BGPOPTD0,0))
;D ADDOPT(BGPOPTD0,.BGPD0)
;I 'BGPD0 D Q
;. D BMES^XPDUTL("UNABLE TO SCHEDULE OPTION 'BGP 13 AUTO GPRA EXTRACT'")
;D RESCH^XUTMOPT("BGP 13 AUTO GPRA EXTRACT",BGPX,"","1M","L",.BGPERR)
;D; EDITOPT(BGPD0)
;S BGPTSK=+$G(^DIC(19.2,BGPD0,1))
S ZTDTH=BGPX
S ZTSAVE("BGP*")=""
S ZTRTN="AUTO^BGP3AUEX"
S ZTDESC="BGP3 AUTO GPRA DATA EXTRACT"
S ZTIO=""
D ^%ZTLOAD
S BGPTSK=$G(ZTSK)
D BMES^XPDUTL("OPTION 'BGP3 AUTO GPRA EXTRACT' SCHEDULED AS TASK #"_BGPTSK)
Q
ADDOPT(BGPOPTD0,BGPD0) ;
;----- ADD OPTION TO OPTION SCHEDULING FILE
;
N DD,DIC,DO,X,Y
;
S BGPD0=0
S X=BGPOPTD0
S DIC="^DIC(19.2,"
S DIC(0)=""
D FILE^DICN
Q:+Y'>0
S BGPD0=+Y
Q
EDITOPT(BGPD0) ;
;----- EDIT OPTION SCHEDULING OPTION
;
N %DT,%L,%X,%Y,BGPDT,BGPF,DIFROM,D,D0,DA,DI,DIC,DIE,DIE,DQ,DR,X,Y
;
S BGPF="1M"
S DA=BGPD0
S DIE="^DIC(19.2,"
S DR="2///^S X=BGPX;6///^S X=BGPF"
D ^DIE
Q
;
EDITPAR ;
S DA=BGPSITE,DIE="^BGPGP2PM(",DR=".02;5.1;4.2;4.3;4.4;4.5" D ^DIE
S Q=0
F F=.02,4.2,4.3,4.4,4.5,5.1 I $$VAL^XBDIQ1(90241.04,BGPSITE,F)="" W !!,$P(^DD(90241.04,F,0),U,1)," is missing." S Q=1
I Q W !!,"These values must be entered into the parameter file",!,"before you can schedule the automated report option.",! D PAUSE^BGP3DU Q
S BGPZIB=$O(^%ZIB(9888888.93,"B","BGP GPRA AUTO SEND "_$P(^AUTTLOC(BGPSITE,0),U,10),0))
I 'BGPZIB D CZIB
I 'BGPZIB Q
S DA=BGPZIB,DIE="^%ZIB(9888888.93,",DR=".02///"_$P($G(^BGPGP2PM(BGPSITE,4)),U,2)_";.05///"_$P($G(^BGPGP2PM(BGPSITE,4)),U,3)_";.03///"_$P($G(^BGPGP2PM(BGPSITE,4)),U,4)_";.04///"_$P($G(^BGPGP2PM(BGPSITE,4)),U,5)
D ^DIE
K DA,DIE,DR
Q
CZIB ;create entry in ZISH SEND PARAMETERS
S BGPZIB=""
K DIADD,DLAYGO,DIC,DD,D0,DO
S X="BGP GPRA AUTO SEND "_$P(^AUTTLOC(BGPSITE,0),U,10),DIC(0)="L",DIC="^%ZIB(9888888.93," D FILE^DICN
I Y=-1 W !!,"error creating ZISH SEND PARAMETERS entry" Q
S (BGPZIB,DA)=+Y,DIE="^%ZIB(9888888.93,",DR=".06///-u;.07///B;.08///sendto"
D ^DIE
I $D(Y) W !!,"error updating ZISH SEND PARAMETERS entry, NOTIFY IT" Q
K DIADD,DLAYGO,DIC,DD,D0,DO
Q
CHKFQT(F) ;EP -check for queued task (BGP AUTO GPRA EXTRACT and BGPSITE variable within the task
NEW X,Y,Z,Q
S F=$G(F)
S Y=$$FMTH^XLFDT(DT)
S Q="" ;not found
S X=0
F S X=$O(^%ZTSK(X)) Q:X'=+X D
.Q:$P($G(^%ZTSK(X,0)),U,1,2)'="AUTO^BGP3AUEX"
.Q:$P($G(^%ZTSK(X,.03)),U,1)'="BGP3 AUTO GPRA DATA EXTRACT" ;"BGP 13 AUTO GPRA EXTRACT" ;not the gpra export
.S Z=$P($G(^%ZTSK(X,.3,"DUZ(",2)),U,1)
.Q:Z'=F
.Q:$P($G(^%ZTSK(X,0)),U,6)<Y
.S Q=X ;found it scheduled
Q Q
EDITDEL ;does user just want to edit the parameters or delete the scheduled task?
W !!,"It seems that the automated GPRA extract is already scheduled to run."
W !,"You can't schedule it to run twice, but you can edit the parameters"
W !,"or delete the scheduled task so it won't run in the future.",!!
S DIR(0)="S^E:Edit Auto Extract Parameters;D:Delete/Unschedule the Auto Extract Task;Q:Quit, I don't want to do either"
S DIR("A")="Which would you like to do",DIR("B")="E"
KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I Y="Q" Q
I Y="E" D EDITPAR Q
I Y="D" D DELTASK Q
Q
DELTASK ;EP
;CHECK STATUS OF TASK - IF RUNNING WARN USER TO DO THIS LATER
S ZTSK=BGPTASK
D STAT^%ZTLOAD
I ZTSK(1)=2,ZTSK(2)="Active: Running" W !!,"The task may be currently running. Please try this later." K ZTSK
S ZTSK=BGPTASK
D KILL^%ZTLOAD
W !!,"Deleted Task ",BGPTASK,!
K ZTSK
Q
BGP3AUEX ; IHS/CMI/LAB - BUILD SITE GPRA FILES, EXPORT TO AREA ; 05 Nov 2012 12:13 PM
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
+3 ;Thanks to Anne Fughat. The original routines were written by
+4 ;Anne Fughat, Phoexnix Area Office. They were copied into the
+5 ;BGP namespace and modified for national use.
+6 ;;Some code in EN taken from the BGP3DGPU routine.
+7 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This routine automatically extracts the GPRA data, creates a
+3 ;;text file, and sends it to the area. It should be autoqueued
+4 ;;to run each month via option BGP3AUEX AUTO GPRA EXTRACT.
+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 BGPD,BGPDT,BGPEND,BGPM,BGPY,ZTDTH,BGPSITE,BGPT
+3 ;
+4 SET Q=0
+5 FOR F=.02,4.2,4.3,4.4,4.5,5.1
IF $$VAL^XBDIQ1(90241.04,DUZ(2),F)=""
SET Q=1
+6 ;W !!,"These values must be entered into the parameter file",!,"before you can run this option.",! D PAUSE^BGP3DU Q
IF Q
QUIT
+7 ;site who queued report
SET BGPSITE=$SELECT($GET(BGPLOC):BGPLOC,1:DUZ(2))
+8 SET BGPT=$PIECE(^BGPGP2PM(BGPSITE,0),U,2)
+9 IF BGPT="T"
Begin DoDot:1
+10 SET BGPDT=$$FMADD^XLFDT(DT,-60)
+11 SET BGPY=$EXTRACT(BGPDT,1,3)
+12 SET BGPM=+$EXTRACT(BGPDT,4,5)
+13 SET BGPD=$PIECE("31^28^31^30^31^30^31^31^30^31^30^31",U,BGPM)
+14 IF BGPM=2
SET BGPD=BGPD+$$LEAP^XLFDT2(BGPY+1700)
+15 SET BGPD=$EXTRACT("00",1,2-$LENGTH(BGPD))_BGPD
+16 SET BGPM=$EXTRACT("00",1,2-$LENGTH(BGPM))_BGPM
+17 SET BGPEND=BGPY_BGPM_BGPD
+18 SET ZTDTH=""
+19 DO QUE(BGPEND)
End DoDot:1
QUIT
+20 SET Y=$ORDER(^BGPCTRL("B",2013,0))
+21 SET Y=^BGPCTRL(Y,0)
+22 ;S BGPEND=$P(Y,U,9)
+23 SET BGPEND=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)_"0630",1:$EXTRACT(DT,1,3)+1_"0630")
NT1 ;
+1 SET ZTDTH=""
+2 DO QUE(BGPEND)
+3 QUIT
MAN ;EP -- MANUALLY RUN GPRA EXTRACT
+1 ;
+2 NEW BGPEND,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZTSK,F,Q
+3 ;
+4 ;D ^XBKVAR -user should be in kernel, no need to do this
+5 ;
+6 NEW DIC,BGPSITE
+7 SET BGPSITE=""
+8 SET DIC="^BGPGP2PM("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the site to run the extract for: "
SET DIC("S")="I $P(^(0),U,1)=DUZ(2)"
DO ^DIC
+9 IF Y=-1
QUIT
+10 SET BGPSITE=+Y
+11 IF BGPSITE'=DUZ(2)
WRITE !,"You need to be logged in as ",$$VAL^XBDIQ1(90241.04,BGPSITE,.01)," to run the report",!,"for that site."
GOTO MAN
+12 SET BGPT=$PIECE(^BGPGP2PM(BGPSITE,0),U,2)
+13 SET Q=0
+14 FOR F=.02,4.2,4.3,4.4,4.5
IF $$VAL^XBDIQ1(90241.04,BGPSITE,F)=""
WRITE !,$PIECE(^DD(90241.04,F,0),U,1)," is missing."
SET Q=1
+15 IF Q
WRITE !!,"These values must be entered into the parameter file",!,"before you can run this option.",!
DO PAUSE^BGP3DU
QUIT
+16 IF BGPT="T"
Begin DoDot:1
+17 SET BGPDT=$$FMADD^XLFDT(DT,-60)
+18 SET BGPY=$EXTRACT(BGPDT,1,3)
+19 SET BGPM=+$EXTRACT(BGPDT,4,5)
+20 SET BGPD=$PIECE("31^28^31^30^31^30^31^31^30^31^30^31",U,BGPM)
+21 IF BGPM=2
SET BGPD=BGPD+$$LEAP^XLFDT2(BGPY+1700)
+22 SET BGPD=$EXTRACT("00",1,2-$LENGTH(BGPD))_BGPD
+23 SET BGPM=$EXTRACT("00",1,2-$LENGTH(BGPM))_BGPM
+24 SET BGPEND=BGPY_BGPM_BGPD
+25 SET (BGPBD,BGPED,BGPTP)=""
+26 SET BGPBD=$$FMADD^XLFDT(BGPEND,-364)
SET BGPED=BGPEND
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
+27 ;***HARD CODED TO BASELINE YEAR 2000
SET BGPVDT=3000000
+28 SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)
+29 SET X=X_"0000"
+30 SET BGPBBD=BGPBD-X
SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)
+31 SET BGPBED=BGPED-X
SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)
+32 SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)
+33 SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)
End DoDot:1
GOTO MAN1
+34 SET X=$ORDER(^BGPCTRL("B",2013,0))
+35 SET Y=^BGPCTRL(X,0)
+36 SET BGPBD=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)-1_"0701",1:$EXTRACT(DT,1,3)_"0701")
+37 SET (BGPEND,BGPED)=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)_"0630",1:$EXTRACT(DT,1,3)+1_"0630")
+38 ;S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
+39 SET BGPPBD=$EXTRACT(BGPBD,1,3)-1_"0701"
SET BGPPED=$EXTRACT(BGPED,1,3)-1_"0630"
+40 SET BGPBBD=$PIECE(Y,U,12)
SET BGPBED=$PIECE(Y,U,13)
+41 SET BGPPER=$PIECE(Y,U,14)
+42 SET BGPQTR=3
+43 ;***HARD CODED TO BASELINE YEAR 2000
SET BGPVDT=3000000
MAN1 SET BGPAMEX=1
SET BGPERRM=""
+1 SET X=$$DEMOCHK^BGP3UTL2()
+2 IF 'X
WRITE !!,"Exiting Report....."
DO PAUSE^BGP3DU
DO XIT
QUIT
+3 WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
+4 KILL BGPTAX
+5 SET BGPTAXI=""
+6 SET DIC("S")="I $P(^(0),U,15)=9999999.05"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Community Taxonomy: "
+7 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+8 DO ^DIC
+9 IF Y=-1
WRITE !!,"Exiting Report..."
DO PAUSE^BGP3DU
DO XIT
QUIT
+10 SET BGPTAXI=+Y
+11 ;S BGPAMFN="BGPGPAM121"_DT_$P(^AUTTLOC(BGPSITE,0),U,10)_$$LZERO^BGP3UTL(BGPLOG)_".TXT"
+12 IF $DATA(IOF)
WRITE @IOF
+13 WRITE !,$$CTR^BGP3DNG("SUMMARY OF NATIONAL GPRA/GPRAMA REPORT TO BE GENERATED")
+14 WRITE !!,"The date ranges for this report are:"
+15 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+16 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+17 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
+18 WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)
+19 SET BGPMAN=1
+20 DO QUE(BGPEND)
+21 IF $GET(ZTSK)
Begin DoDot:1
+22 ;
+23 WRITE !,"GPRA EXTRACT QUEUED AS TASK #",ZTSK
+24 ;W !!,"The BGPGPAM121"_DT_$P(^AUTTLOC(DUZ(2),0),U,10)_"nnnnnn.TXT file will be sent to the Area Office.",!
+25 WRITE !
DO PAUSE^BGP3DU
End DoDot:1
+26 DO XIT
+27 QUIT
+28 ;
QUE(BGPEND,ZTDTH) ;EP
+1 ;------ QUEUEING CODE
+2 ;
+3 ;AUTO
IF '$GET(BGPMAN)
DO DQ
QUIT
+4 ;
+5 NEW ZTDESC,ZTRTN,ZTIO
+6 ;
+7 SET ZTSAVE("BGP*")=""
+8 SET ZTRTN="DQ^BGP3AUEX"
+9 SET ZTDESC="BGP3 AUTO GPRA DATA EXTRACT"
+10 SET ZTIO=""
+11 DO ^%ZTLOAD
+12 ;
+13 QUIT
DQ ;EP -- QUEUED JOB STARTS HERE
+1 ;
+2 DO EN(BGPEND)
+3 ;now reschedule for the 1st Friday of next month
+4 ;not manual
IF $GET(BGPMAN)
QUIT
+5 ;GET FIRST OF NEXT MONTH AND RESCHEDULE
+6 ;ADD 1 UNTIL DAY IS 01
+7 SET X=DT
FOR
SET X=$$FMADD^XLFDT(X,1)
IF $EXTRACT(X,6,7)="01"
QUIT
+8 SET BGPX=$$FRIDAY(X)
+9 SET ZTDTH=BGPX
+10 SET ZTSAVE("BGP*")=""
+11 SET ZTRTN="AUTO^BGP3AUEX"
+12 SET ZTDESC="BGP3 AUTO GPRA DATA EXTRACT"
+13 SET ZTIO=""
+14 DO ^%ZTLOAD
+15 KILL BGPEND
+16 QUIT
EN(BGPEND) ;EP -- MAIN ENTRY POINT
+1 ;
+2 ; INPUT:
+3 ; BGPEND = REPORT END DATE
+4 ;
+5 NEW BGPED,BGPPER,BGPRTYPE,BGP1RPTH,BGP1GPU,BGPBD,BGPED,BGPTP,BGPVDT
+6 NEW X,BGPBBD,BGPBED,BGPPBD,BGPPED,BGPTAX,BGPBEN,BGPBENF
+7 NEW BGPHOME,BGPINDH,BGPEXPT,BGPEXCEL,BGPUF,BGPQUIT,BGPRPT,BGPFILE
+8 ;
+9 ;D ^XBKVAR - KERNAL VARS SHOULD BE SET UP BY TASKMAN
+10 ;
+11 ;in automated
SET BGPAMEX=1
+12 SET BGPRTYPE=1
SET BGP1RPTH=""
SET BGP1GPU=1
+13 SET (BGPBD,BGPED,BGPTP)=""
+14 SET BGPT=$PIECE(^BGPGP2PM(BGPSITE,0),U,2)
+15 IF BGPT="G"
Begin DoDot:1
+16 ;get GPRA year dates
SET X=$ORDER(^BGPCTRL("B",2013,0))
+17 ;per Megan - run automated report for gpra year dates
+18 ;
+19 SET Y=^BGPCTRL(X,0)
+20 SET BGPBD=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)-1_"0701",1:$EXTRACT(DT,1,3)_"0701")
+21 SET (BGPEND,BGPED)=$SELECT(+$EXTRACT(DT,4,7)<701:$EXTRACT(DT,1,3)_"0630",1:$EXTRACT(DT,1,3)+1_"0630")
+22 ;S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
+23 SET BGPPBD=$EXTRACT(BGPBD,1,3)-1_"0701"
SET BGPPED=$EXTRACT(BGPED,1,3)-1_"0630"
+24 SET BGPBBD=$PIECE(Y,U,12)
SET BGPBED=$PIECE(Y,U,13)
+25 SET BGPPER=$PIECE(Y,U,14)
+26 SET BGPQTR=3
+27 ;***HARD CODED TO BASELINE YEAR 2000
SET BGPVDT=3000000
End DoDot:1
+28 IF BGPT="T"
Begin DoDot:1
+29 SET (BGPBD,BGPED,BGPTP)=""
+30 SET BGPBD=$$FMADD^XLFDT(BGPEND,-364)
SET BGPED=BGPEND
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
+31 ;***HARD CODED TO BASELINE YEAR 2000
SET BGPVDT=3000000
+32 SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)
+33 SET X=X_"0000"
+34 SET BGPBBD=BGPBD-X
SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)
+35 SET BGPBED=BGPED-X
SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)
+36 SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)
+37 SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)
End DoDot:1
COM ;
+1 SET BGPTAXI=$PIECE($GET(^BGPGP2PM(DUZ(2),5)),U)
+2 SET X=0
+3 IF BGPTAXI
FOR
SET X=$ORDER(^ATXAX(BGPTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+4 SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""
End DoDot:1
+5 SET BGPBEN=1
+6 SET BGPBENF="Indian/Alaskan Native (Classification 01)"
+7 SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)
+8 SET X=0
FOR
SET X=$ORDER(^BGPINDH("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+9 SET BGPINDH="G"
+10 SET BGPEXPT=1
+11 SET BGPEXCEL=""
+12 SET BGPUF=$$GETDIR^BGP3UTL2()
+13 ;***CREATES THE ENTRIES IN THE BGP 13 DATA FILES AND RETURNS BGPRPT
DO REPORT^BGP3UTL
+14 IF $GET(BGPQUIT)
DO XIT
QUIT
+15 IF BGPRPT=""
DO XIT
QUIT
+16 SET BGPAMFN="BGPAM130"_BGPEND_$PIECE(^AUTTLOC(BGPSITE,0),U,10)_$$LZERO^BGP3UTL(BGPRPT,6)_".TXT"
+17 DO ^BGP3D1
+18 ;***CREATES BG130 FILE
DO GS^BGP3UTL
+19 SET BGPFILE=BGPAMFN
+20 DO LOG(BGPFILE,BGPBD,BGPEND,BGPERRM)
+21 DO XIT
+22 QUIT
LOG(BGPFILE,BGPBD,BGPEND,BGPERRM) ;
+1 ;----- LOG EXTRACT DATE AND FILE NAME
+2 ;
+3 NEW DA,DD,DIC,DIE,DO,DR,X,Y
+4 ;
+5 SET X=$$NOW^XLFDT
+6 SET DA(1)=BGPSITE
+7 SET DIC="^BGPGP2PM("_DA(1)_",8,"
+8 SET DIC(0)=""
+9 DO FILE^DICN
+10 IF +Y'>0
QUIT
+11 SET DA=+Y
+12 SET DIE=DIC
+13 SET DR=".02///"_BGPFILE_";.03///"_BGPBD_";.04///"_BGPEND_";.05///"_BGPERRM
+14 DO ^DIE
+15 QUIT
ASUFAC() ;
+1 ;---- RETURNS ASUFAC OF MAIN SITE IN RPMS SITE FILE
+2 ;
+3 NEW Y
+4 SET Y=""
+5 SET Y=$PIECE($GET(^AUTTLOC(+$PIECE($GET(^AUTTSITE(1,0)),U),0)),U,10)
+6 QUIT Y
FRIDAY(DT) ;
+1 ;----- RETURNS DATE/TIME FOR THE NEXT FRIDAY BEGINNING WITH DT
+2 ; Prevents the auto job from running on a weekday which could spill
+3 ; over into business hours impacting system performance. This will
+4 ; find the first Friday after the date passed in DT. If the date
+5 ; passed is already a Friday it returns the original date passed.
+6 ; The time of 22:00 is concatenated to the date.
+7 ;
+8 NEW X,Y
+9 SET Y=""
+10 SET X=DT
SET BGPDT=DT
+11 DO DW^%DTC
+12 IF X'="FRIDAY"
Begin DoDot:1
+13 SET BGPDT=DT
+14 FOR
Begin DoDot:2
+15 SET (X,BGPDT)=$$FMADD^XLFDT(BGPDT,1)
+16 DO DW^%DTC
End DoDot:2
IF X="FRIDAY"
QUIT
End DoDot:1
+17 SET Y=BGPDT_".22"
+18 QUIT Y
XIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL DIRUT,DUOUT,DIR,DOD
+4 KILL DIADD,DLAYGO
+5 DO KILL^AUPNPAT
+6 KILL X,X1,X2,X3,X4,X5,X6
+7 KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
+8 KILL N,N1,N2,N3,N4,N5,N6
+9 KILL BD,ED
+10 DO KILL^AUPNPAT
+11 DO ^XBFMK
+12 QUIT
AUTOEX ;EP
+1 NEW XBGL
SET XBGL="BGPDATA"
+2 SET F=BGPAMFN
+3 NEW XBFN,XBMED,XBF,XBFLT
+4 SET XBMED="F"
SET XBFN=F
SET XBTLE="SAVE OF CRS AUTOMATED DATA"
SET XBF=0
SET XBFLT=1
+5 SET XBS1="BGP GPRA AUTO SEND "_$PIECE(^AUTTLOC(BGPSITE,0),U,10)
+6 SET XBUF=BGPUF
DO ^XBGSAVE
+7 SET BGPERRM=""
+8 IF XBFLG'=0
Begin DoDot:1
+9 IF XBFLG(1)=""
SET BGPERRM="GPRA DATA file successfully created"
+10 IF XBFLG(1)]""
SET BGPERRM="GPRA DATA file NOT successfully created"
+11 SET BGPERRM="File was NOT successfully transferred. "_XBFLG(1)
End DoDot:1
+12 LOCK -^BGPDATA
+13 ;NOTE: kill of unsubscripted global for use in export to area.
KILL ^TMP($JOB),^BGPDATA
+14 QUIT
+15 ;
SITEPAR ;EP - called from option
+1 ;GET ENTRY
+2 ;
+3 WRITE !!,"This option is used by Area Office personnel to set up an"
+4 WRITE !,"automated GPRA extract for the site you select. All "
+5 WRITE !,"questions are mandatory and must be answered before the"
+6 WRITE !,"first extract will be queued to run.",!,"You must be logged into the site for which you want to schedule",!,"this extract.",!!
+7 ;
+8 SET DIC(0)="AEMQL"
SET DIC="^BGPGP2PM("
SET DIC("S")="I $P(^(0),U,1)=DUZ(2)"
DO ^DIC
KILL DIC
+9 IF Y=-1
KILL Y
QUIT
+10 SET (BGPSITE,BGPLOC)=+Y
+11 ;check for currently queued task, allow user to edit params or to delete scheduled task
SET BGPTASK=$$CHKFQT(BGPSITE)
+12 IF BGPTASK
DO EDITDEL
QUIT
+13 DO EDITPAR
+14 DO SCHED
+15 ;D QUE
+16 QUIT
SCHED ;EP -scedule task in option scheduling
+1 KILL DIR,DIRUT
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue to schedule this monthly"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
QUIT
+3 IF 'Y
QUIT
SCHEDGUI ;EP - gui entry point to schedule
+1 SET BGPERR=""
SET BGPX=""
+2 ;get 1st Friday of this month, if it is already passed find 1st Friday of next month.
+3 ;
+4 SET BGPX=$$FRIDAY($EXTRACT(DT,1,5)_"00")
+5 IF $PIECE(BGPX,".")<DT
Begin DoDot:1
+6 SET BGPX=$EXTRACT(DT,4,5)
SET BGPX=$SELECT(+BGPX="12":"01",1:BGPX+1)
SET BGPX=$SELECT($LENGTH(BGPX)=1:"0"_BGPX,1:BGPX)
SET BGPX=$SELECT(BGPX="01":$EXTRACT(DT)_($EXTRACT(DT,2,3)+1)_BGPX_"00",1:$EXTRACT(DT,1,3)_BGPX_"00")
+7 SET BGPX=$$FRIDAY(BGPX)
End DoDot:1
+8 GOTO NT
+9 ;
+10 ;LORI TAKE OUT WHEN DONE TESTING
SET BGPX=$$FMADD^XLFDT($$NOW^XLFDT,,,5)
NT ;
+1 DO BMES^XPDUTL("SETTING OPTION 'BGP 13 AUTO GPRA EXTRACT' to run in taskman")
+2 ;
+3 ;S BGPOPT="BGP 13 AUTO GPRA EXTRACT"
+4 ;S BGPOPTD0=$O(^DIC(19,"B",BGPOPT,0))
+5 ;I 'BGPOPTD0 D Q
+6 ;. D BMES^XPDUTL("'BGP 13 AUTO GPRA EXTRACT' OPTION NOT FOUND!")
+7 ;Q:'BGPOPTD0
+8 ;S BGPD0=$O(^DIC(19.2,"B",BGPOPTD0,0))
+9 ;D ADDOPT(BGPOPTD0,.BGPD0)
+10 ;I 'BGPD0 D Q
+11 ;. D BMES^XPDUTL("UNABLE TO SCHEDULE OPTION 'BGP 13 AUTO GPRA EXTRACT'")
+12 ;D RESCH^XUTMOPT("BGP 13 AUTO GPRA EXTRACT",BGPX,"","1M","L",.BGPERR)
+13 ;D; EDITOPT(BGPD0)
+14 ;S BGPTSK=+$G(^DIC(19.2,BGPD0,1))
+15 SET ZTDTH=BGPX
+16 SET ZTSAVE("BGP*")=""
+17 SET ZTRTN="AUTO^BGP3AUEX"
+18 SET ZTDESC="BGP3 AUTO GPRA DATA EXTRACT"
+19 SET ZTIO=""
+20 DO ^%ZTLOAD
+21 SET BGPTSK=$GET(ZTSK)
+22 DO BMES^XPDUTL("OPTION 'BGP3 AUTO GPRA EXTRACT' SCHEDULED AS TASK #"_BGPTSK)
+23 QUIT
ADDOPT(BGPOPTD0,BGPD0) ;
+1 ;----- ADD OPTION TO OPTION SCHEDULING FILE
+2 ;
+3 NEW DD,DIC,DO,X,Y
+4 ;
+5 SET BGPD0=0
+6 SET X=BGPOPTD0
+7 SET DIC="^DIC(19.2,"
+8 SET DIC(0)=""
+9 DO FILE^DICN
+10 IF +Y'>0
QUIT
+11 SET BGPD0=+Y
+12 QUIT
EDITOPT(BGPD0) ;
+1 ;----- EDIT OPTION SCHEDULING OPTION
+2 ;
+3 NEW %DT,%L,%X,%Y,BGPDT,BGPF,DIFROM,D,D0,DA,DI,DIC,DIE,DIE,DQ,DR,X,Y
+4 ;
+5 SET BGPF="1M"
+6 SET DA=BGPD0
+7 SET DIE="^DIC(19.2,"
+8 SET DR="2///^S X=BGPX;6///^S X=BGPF"
+9 DO ^DIE
+10 QUIT
+11 ;
EDITPAR ;
+1 SET DA=BGPSITE
SET DIE="^BGPGP2PM("
SET DR=".02;5.1;4.2;4.3;4.4;4.5"
DO ^DIE
+2 SET Q=0
+3 FOR F=.02,4.2,4.3,4.4,4.5,5.1
IF $$VAL^XBDIQ1(90241.04,BGPSITE,F)=""
WRITE !!,$PIECE(^DD(90241.04,F,0),U,1)," is missing."
SET Q=1
+4 IF Q
WRITE !!,"These values must be entered into the parameter file",!,"before you can schedule the automated report option.",!
DO PAUSE^BGP3DU
QUIT
+5 SET BGPZIB=$ORDER(^%ZIB(9888888.93,"B","BGP GPRA AUTO SEND "_$PIECE(^AUTTLOC(BGPSITE,0),U,10),0))
+6 IF 'BGPZIB
DO CZIB
+7 IF 'BGPZIB
QUIT
+8 SET DA=BGPZIB
SET DIE="^%ZIB(9888888.93,"
SET DR=".02///"_$PIECE($GET(^BGPGP2PM(BGPSITE,4)),U,2)_";.05///"_$PIECE($GET(^BGPGP2PM(BGPSITE,4)),U,3)_";.03///"_$PIECE($GET(^BGPGP2PM(BGPSITE,4)),U,4)_";.04///"_$PIECE($GET(^BGPGP2PM(BGPSITE,4)),U,5)
+9 DO ^DIE
+10 KILL DA,DIE,DR
+11 QUIT
CZIB ;create entry in ZISH SEND PARAMETERS
+1 SET BGPZIB=""
+2 KILL DIADD,DLAYGO,DIC,DD,D0,DO
+3 SET X="BGP GPRA AUTO SEND "_$PIECE(^AUTTLOC(BGPSITE,0),U,10)
SET DIC(0)="L"
SET DIC="^%ZIB(9888888.93,"
DO FILE^DICN
+4 IF Y=-1
WRITE !!,"error creating ZISH SEND PARAMETERS entry"
QUIT
+5 SET (BGPZIB,DA)=+Y
SET DIE="^%ZIB(9888888.93,"
SET DR=".06///-u;.07///B;.08///sendto"
+6 DO ^DIE
+7 IF $DATA(Y)
WRITE !!,"error updating ZISH SEND PARAMETERS entry, NOTIFY IT"
QUIT
+8 KILL DIADD,DLAYGO,DIC,DD,D0,DO
+9 QUIT
CHKFQT(F) ;EP -check for queued task (BGP AUTO GPRA EXTRACT and BGPSITE variable within the task
+1 NEW X,Y,Z,Q
+2 SET F=$GET(F)
+3 SET Y=$$FMTH^XLFDT(DT)
+4 ;not found
SET Q=""
+5 SET X=0
+6 FOR
SET X=$ORDER(^%ZTSK(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^%ZTSK(X,0)),U,1,2)'="AUTO^BGP3AUEX"
QUIT
+8 ;"BGP 13 AUTO GPRA EXTRACT" ;not the gpra export
IF $PIECE($GET(^%ZTSK(X,.03)),U,1)'="BGP3 AUTO GPRA DATA EXTRACT"
QUIT
+9 SET Z=$PIECE($GET(^%ZTSK(X,.3,"DUZ(",2)),U,1)
+10 IF Z'=F
QUIT
+11 IF $PIECE($GET(^%ZTSK(X,0)),U,6)<Y
QUIT
+12 ;found it scheduled
SET Q=X
End DoDot:1
+13 QUIT Q
EDITDEL ;does user just want to edit the parameters or delete the scheduled task?
+1 WRITE !!,"It seems that the automated GPRA extract is already scheduled to run."
+2 WRITE !,"You can't schedule it to run twice, but you can edit the parameters"
+3 WRITE !,"or delete the scheduled task so it won't run in the future.",!!
+4 SET DIR(0)="S^E:Edit Auto Extract Parameters;D:Delete/Unschedule the Auto Extract Task;Q:Quit, I don't want to do either"
+5 SET DIR("A")="Which would you like to do"
SET DIR("B")="E"
+6 KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF Y="Q"
QUIT
+9 IF Y="E"
DO EDITPAR
QUIT
+10 IF Y="D"
DO DELTASK
QUIT
+11 QUIT
DELTASK ;EP
+1 ;CHECK STATUS OF TASK - IF RUNNING WARN USER TO DO THIS LATER
+2 SET ZTSK=BGPTASK
+3 DO STAT^%ZTLOAD
+4 IF ZTSK(1)=2
IF ZTSK(2)="Active: Running"
WRITE !!,"The task may be currently running. Please try this later."
KILL ZTSK
+5 SET ZTSK=BGPTASK
+6 DO KILL^%ZTLOAD
+7 WRITE !!,"Deleted Task ",BGPTASK,!
+8 KILL ZTSK
+9 QUIT
