BDWDDR ;IHS/CMI/LAB - Main Driver EXPORT DATE RANGE;
;;1.0;IHS DATA WAREHOUSE;**2**;JAN 23, 2006
;
;
;
START ;Begin processing backload
D EN^XBVK("BDW"),^XBFMK K DIADD,DLAYGO
S BDW("QFLG")=0
W:$D(IOF) @IOF
W !,$$CTR($$LOC(),80),!
S X="***** IHS DATA WAREHOUSE VISIT RE-EXPORT IN A DATE RANGE *****" W !,$$CTR(X,80),!
S T="INTRO" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END" W !,X
K J,X,T
;
S BDWERR=0
D CHECK
D CHKSITE^BDWRDRI
I BDW("QFLG") D XIT Q
I BDWERR D XIT Q
GETDATES ;
W !,"Please enter the date range for which the Data Warehouse HL7 messages",!,"should be generated.",!
BD ;
S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S BDWBD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date: " D ^DIR K DIR,DA S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I Y<BDWBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S BDWED=Y
S X1=BDWBD,X2=-1 D C^%DTC S BDWSD=X
S BDWERR=0
W !!,"Log entry ",$$NLOG," will be created and messages generated for visit",!,"date range ",$$FMTE^XLFDT(BDWBD)," to ",$$FMTE^XLFDT(BDWED),".",!
VAUDIT ;
S BDWVA=""
S DIR(0)="Y",DIR("A")="Do you want to create a VISIT AUDIT report for this batch of visits",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G GETDATES
I Y S BDWVA=1
CONT ;continue or not
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"Goodbye" D XIT Q
I 'Y W !!,"Goodbye" D XIT Q
S BDWRUN="NEW",BDWERR=0
D HOME^%ZIS S BDWBS=$S('$D(ZTQUEUED):IOBS,1:"")
D GENLOG ;generate new log entry
I $G(BDWERR) D XIT Q
D QUEUE
I $G(BDWERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
I $D(BDWQUE) D XIT Q
;
PROCESS ;EP - process new run
D GIS^BDW1VBLI
S BDWDDR=1
S BDWTOTV=0
K ^TMP($J,"BDW")
K BDW,BDWERRC,BDWE
D BASICS^BDWRDRI
S BDW("RUN LOG")=BDWLOG
D NOW^%DTC S BDW("RUN START")=%,BDW("MAIN TX DATE")=$P(%,".") K %,%H,%I
S BDW("BT")=$H
S BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDWLOG)
S ^BDWTMP(BDWIEDST,BDWMSGH)=""
S DIE="^BDWXLOG(",DA=BDWLOG,DR=".15///R;.03////"_BDW("RUN START")_";.12////"_BDWMSGH D ^DIE K DA,DIE,DR
S BDWCNT=$S('$D(ZTQUEUED):"X BDWCNT1 X BDWCNT2",1:"S BDWTOTV=BDWTOTV+1"),BDWCNT1="F BDWCNTL=1:1:$L(BDWTOTV)+1 W @BDWBS",BDWCNT2="S BDWTOTV=BDWTOTV+1 W BDWTOTV,"")"""
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)"
S BDWSD=BDWSD_".9999"
;set counters
V ; Run by visit date
F S BDWSD=$O(^AUPNVSIT("B",BDWSD)) Q:BDWSD=""!((BDWSD\1)>BDWED) D V1
;update log
D ^XBFMK
D RUNTIME^BDWRDR
D LOG
S X=$$WRITE
SETV ;set 1106
S BDWTOTV=0
I '$D(ZTQUEUED) W !,"Updating visit entries with export date....("
S BDW("V DFN")=0 F S BDW("V DFN")=$O(^TMP($J,"BDW",BDW("V DFN"))) Q:BDW("V DFN")'=+BDW("V DFN") D ^XBFMK S DA=BDW("V DFN"),DIE="^AUPNVSIT(",DR="1106////"_BDW("MAIN TX DATE") D ^DIE,^XBFMK X BDWCNT
D XIT
Q
V1 ;go through each visit on this date
S BDW("V DFN")="" F S BDW("V DFN")=$O(^AUPNVSIT("B",BDWSD,BDW("V DFN"))) Q:BDW("V DFN")'=+BDW("V DFN") I $D(^AUPNVSIT(BDW("V DFN"),0)) S BDWVREC=^(0) D PROC
Q
PROC ;
Q:$P(^AUPNVSIT(BDW("V DFN"),0),U,23)=.5
;if no unique ID, stuff it
I $P($G(^AUPNVSIT(BDW("V DFN"),11)),U,4)="" D ^XBFMK S DIE="^AUPNVSIT(",DA=BDW("V DFN"),DR="1104////"_$$UID^AUPNVSIT(BDW("V DFN")) D ^DIE,^XBFMK
I $P($G(^AUPNVSIT(BDW("V DFN"),11)),U,4)="" D ^XBFMK S DIE="^AUPNVSIT(",DA=BDW("V DFN"),DR="1114////"_$$UIDV^BDWAID(BDW("V DFN")) D ^DIE,^XBFMK ;cmi/anch/maw 9/6/2007 patch 2
S BDWV("TX GENERATED")=0,^TMP($J,"BDW",BDW("V DFN"))=""
S BDW("VPROC")=$G(BDW("VPROC"))+1
X BDWCNT
S BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
I $P(BDWV("V REC"),U,11),$P($G(^AUPNVSIT(BDW("V DFN"),11)),U,6)="" D G SET
.S BDWE("ERROR")=100 D ^BDWRERR
S BDWV("V DATE")=+BDWV("V REC")\1
K BDWVMSG D ^BDWRDR2
SET S:'$D(^BDWXLOG(BDW("RUN LOG"),21,0)) ^BDWXLOG(BDW("RUN LOG"),21,0)="^90213.2101PA^^"
S ^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN"),0)=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$G(BDWVMSG)
S $P(^BDWXLOG(BDW("RUN LOG"),21,0),U,3)=BDW("V DFN"),$P(^(0),U,4)=$P(^(0),U,4)+1
K DIE,DR,DIC
I BDWVA,'$D(BDWE) D VA^BDW1VBL2
Q
;
LOG ;
S BDW("COUNT")=BDW("VISITS") W:'$D(ZTQUEUED) !!,BDW("COUNT")," HL7 Messages were generated."
W:'$D(ZTQUEUED) !,"Updating log entry."
D NOW^%DTC S BDW("RUN STOP")=%
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".04////"_BDW("RUN STOP")_";.05////"_BDW("SKIP")_";.06////"_BDW("COUNT")_";.08///"_BDW("VPROC") D ^DIE I $D(Y) S BDW("QFLG")=26 Q
K DIE,DA,DR
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".11////"_BDW("REG")_";.12////"_BDWMSGH_";.18////"_$G(BDW("VISITS")) D ^DIE I $D(Y) S BDW("QFLG")=26 Q
K DR,DIE,DA,DIV,DIU
S DIE="^BDWXLOG(",DA=BDW("RUN LOG"),DR="3101////"_BDW("DEMO")_";3102////"_BDW("ZERO")_";3103////"_BDW("DEL")_";3104////"_BDW("NO PAT")_";3105////"_BDW("NO LOC")_";3106////"_BDW("NO TYPE")_";3107////"_BDW("NO CAT")_";3111////"_BDW("MFI")
D ^DIE I $D(Y) S BDW("QFLG")=26 Q
S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" D IX1^DIK K DA,DIK
D ^XBFMK
;
TR ;trailer report
S BDWLOC=0,BDWLOCC=0,BDWTYPE="",BDWMODE="",BDWDATE="",BDWLC=0
S X="EXPORT SITE: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),.09) D S
S X="DATE OF EXPORT: "_$$FMTE^XLFDT($P($P(^BDWXLOG(BDW("RUN LOG"),0),U,3),".")) D S
S X="TOTAL NUMBER OF VISITS EXPORTED: "_$P(^BDWXLOG(BDW("RUN LOG"),0),U,18) D S
S X="TOTAL NUMBER OF ADDS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3108) D S
S X="TOTAL NUMBER OF MODS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3109) D S
S X="TOTAL NUMBER OF DELETES: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3110) D S
S X="" D S
S X="" D S
F S BDWLOC=$O(^TMP($J,"BDWTRAILER",BDWLOC)) Q:BDWLOC'=+BDWLOC D
.S BDWLC=BDWLC+1,BDWLOCC=BDWLOCC+1
.S X=BDWLOCC_". Location of Encounter "_$P(^AUTTLOC(BDWLOC,0),U,10) D S
.S X="" D S
.S X="Type/Cat",$E(X,30)="TOTAL COUNT",$E(X,49)="ADDS",$E(X,58)="DELETES",$E(X,70)="CHANGES" D S
.S X="---------------------------------------------------------------------------" D S
.S BDWTYPE="" F S BDWTYPE=$O(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE)) Q:BDWTYPE="" D
..S X=BDWTYPE,$E(X,33)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"TOT")),0,9),$E(X,46)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"A")),0,9)
..S $E(X,58)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"D")),0,9),$E(X,70)=$$C($G(^TMP($J,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"M")),0,9)
..D S
.S X="" D S
.S X="" D S
.S X="COUNT BY DATE OF VISITS" D S
.S X="TYPE/CAT",$E(X,33)="MONTH/YR",$E(X,49)="TOTAL" D S
.S X="---------------------------------------------------------------------------" D S
.S BDWTYPE="" F S BDWTYPE=$O(^TMP($J,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE)) Q:BDWTYPE="" D
..S BDWDATE=0 F S BDWDATE=$O(^TMP($J,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE)) Q:BDWDATE="" D
...S X=BDWTYPE,$E(X,33)=$$FMTE^XLFDT(BDWDATE),$E(X,46)=$$C(^TMP($J,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE),0,9) D S
...Q
..Q
.S X="" D S
.S X="" D S
.Q
S ^BDWXLOG(BDW("RUN LOG"),99,0)="^^"_BDWLC_"^"_BDWLC_"^"_DT
S DA=BDW("RUN LOG"),DIK="^BDWXLOG(" D IX1^DIK K DA,DIK
D ^XBFMK
S BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))
S ^BDWTMP(BDWIEDST,BDWMSGT)=""
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C" D ^DIE
;
Q
C(X,X2,X3) ;
I X="" Q ""
D COMMA^%DTC
Q X
S ;
S BDWLC=BDWLC+1
S ^BDWXLOG(BDW("RUN LOG"),99,BDWLC,0)=X
K X
Q
Q
CHECK ;
I '$P($G(^AUTTSITE(1,0)),U) W !!,"RPMS Site file not SET UP" S BDWERR=1 Q
I $P(^BDWSITE(1,0),U,6)="" W:'$D(ZTQUEUED) !!,"VISIT backloading has not been completed. Must be finished first." S BDWERR=2 Q
;D TAXCHK^BDWRDRI
Q
QUEUE ;EP
K ZTSK
S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y=1 D QUEUE1 Q
I BDWRUN="NEW",$D(DIRUT) S BDWERR=1 S DA=BDWLOG,DIK="^BDWXLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
Q
QUEUE1 ;
S ZTRTN="PROCESS^BDWDDR"
S ZTIO="",ZTDTH="",ZTDESC="DATA WAREHOUSE DATE RANGE" S ZTSAVE("BDW*")=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
I '$D(ZTSK),BDWRUN="NEW" S BDWERR=1 S DA=BDWLOG,DIK="^BDWXLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
S BDWQUE=""
S DIE="^BDWXLOG(",DA=BDWLOG,DR=".15///Q" D ^DIE K DIE,DA,DR
K ZTSK
Q
GENLOG ;generate new log entry
D ^XBFMK K DIADD,DLAYGO
W:'$D(ZTQUEUED) !,"Generating New Log entry.."
S X=$$FMTE^XLFDT(BDWBD),DIC="^BDWXLOG(",DIC(0)="L",DLAYGO=90213,DIC("DR")=".02////"_BDWED_";.07////D;.09////"_$P(^AUTTSITE(1,0),U)_";8801////"_DUZ_";.23///DRE" S DIADD=1
D ^DIC K DIC,DLAYGO,DR,DIADD
I Y<0 W !!,$C(7),$C(7),"Error creating log entry." S BDWERR=1 D ^XBFMK Q
S (BDWLOG,BDW("RUN LOG"))=+Y
D ^XBFMK
Q
XIT ;exit, eoj cleanup
D EOP
D ^XBFMK
D EN^XBVK("BDW")
D KILL^AUPNPAT
K AUPNCPT
Q
WRITE() ; use XBGSAVE to save the temp global (BDWDATA) to a delimited
; file that is exported to the DW system at 127.0.0.1
;
N XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
N BDWASU,BDWJUL,DT,X2,X1,X
S BDWVA("COUNT")=BDWVA("COUNT")+1,^BDWDATA(BDWVA("COUNT"))="T0^"_$P($$DATE^INHUT($$NOW^XLFDT,1),"-")
S XBGL="BDWDATA",XBMED="F",XBQ="N",XBFLT=1
S XBNAR="DW Visit Audit"
I '$D(DT) D DT^DICRW ;get julian date for file name
S X2=$E(DT,1,3)_"0101",X1=DT
D ^%DTC
S BDWJUL=X+1
S BDWASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10) ;asufac for file name
S XBFN="BDWDWVX"_BDWASU_"."_BDW("RUN LOG")
NEW DA,DIE,DR
S DA=BDW("RUN LOG"),DIE="^BDWXLOG(",DR=".21///"_XBFN D ^DIE K DA,DIE,DR
;S XBUF="/usr3/dsd/ljara/" ;used in testing to make it fail
;S XBQTO="-l dwxfer:regpcc 127.0.0.1"
S XBS1="DATA WAREHOUSE SEND"
;
D ^XBGSAVE
;
I XBFLG=0 D
. W:'$D(ZTQUEUED) !,"VISIT audit file successfully created and transferred.",!!
. K ^BDWDATA
;
I XBFLG'=0 D
. I XBFLG(1)="" W:'$D(ZTQUEUED) !!,"VISIT audit file successfully created",!! K ^BDWDATA
. I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,"VISIT audit file NOT successfully created",!!
. W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to the data warehouse",!,"you will need to manually ftp it.",!
. W:'$D(ZTQUEUED) !,XBFLG(1),!!
;
Q XBFLG
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of Job. Press Return.",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
DATE(D) ;EP ;IHS/CMI/LAB - new date format - format date in YYYYMMDD format
I $G(D)="" Q ""
Q $E(D,1,3)+1700_$E(D,4,7)
;
;
NLOG() ;get next log
NEW X,L S (X,L)=0 F S X=$O(^BDWXLOG(X)) Q:X'=+X S L=X
Q L+1
INTRO ;introductory text
;;
;;ATTENTION:
;;
;;Please do not run this export without checking with NPIRS first.
;;DRE exports cannot be loaded into the NDW without first making
;;special arrangements. You can contact the
;;Help Desk.
;;
;;You should use the GDW and RERX options for all regularly scheduled
;;exports.
;;
;;This program will generate Data Warehouse records for a visit
;;date range that you enter. A log entry will be created which will log
;;the number of visits processed and the number of Data Warehouse records
;;generated.
;;
;;END
BDWDDR ;IHS/CMI/LAB - Main Driver EXPORT DATE RANGE;
+1 ;;1.0;IHS DATA WAREHOUSE;**2**;JAN 23, 2006
+2 ;
+3 ;
+4 ;
START ;Begin processing backload
+1 DO EN^XBVK("BDW")
DO ^XBFMK
KILL DIADD,DLAYGO
+2 SET BDW("QFLG")=0
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !,$$CTR($$LOC(),80),!
+5 SET X="***** IHS DATA WAREHOUSE VISIT RE-EXPORT IN A DATE RANGE *****"
WRITE !,$$CTR(X,80),!
+6 SET T="INTRO"
FOR J=1:1
SET X=$TEXT(@T+J)
SET X=$PIECE(X,";;",2)
IF X="END"
QUIT
WRITE !,X
+7 KILL J,X,T
+8 ;
+9 SET BDWERR=0
+10 DO CHECK
+11 DO CHKSITE^BDWRDRI
+12 IF BDW("QFLG")
DO XIT
QUIT
+13 IF BDWERR
DO XIT
QUIT
GETDATES ;
+1 WRITE !,"Please enter the date range for which the Data Warehouse HL7 messages",!,"should be generated.",!
BD ;
+1 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Visit Date"
SET DIR("?")="Enter the beginning visit date."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET BDWBD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Date: "
DO ^DIR
KILL DIR,DA
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF Y<BDWBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET BDWED=Y
+5 SET X1=BDWBD
SET X2=-1
DO C^%DTC
SET BDWSD=X
+6 SET BDWERR=0
+7 WRITE !!,"Log entry ",$$NLOG," will be created and messages generated for visit",!,"date range ",$$FMTE^XLFDT(BDWBD)," to ",$$FMTE^XLFDT(BDWED),".",!
VAUDIT ;
+1 SET BDWVA=""
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to create a VISIT AUDIT report for this batch of visits"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO GETDATES
+4 IF Y
SET BDWVA=1
CONT ;continue or not
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
WRITE !!,"Goodbye"
DO XIT
QUIT
+3 IF 'Y
WRITE !!,"Goodbye"
DO XIT
QUIT
+4 SET BDWRUN="NEW"
SET BDWERR=0
+5 DO HOME^%ZIS
SET BDWBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+6 ;generate new log entry
DO GENLOG
+7 IF $GET(BDWERR)
DO XIT
QUIT
+8 DO QUEUE
+9 IF $GET(BDWERR)
WRITE !!,"Goodbye, no processing will occur.",!
DO XIT
QUIT
+10 IF $DATA(BDWQUE)
DO XIT
QUIT
+11 ;
PROCESS ;EP - process new run
+1 DO GIS^BDW1VBLI
+2 SET BDWDDR=1
+3 SET BDWTOTV=0
+4 KILL ^TMP($JOB,"BDW")
+5 KILL BDW,BDWERRC,BDWE
+6 DO BASICS^BDWRDRI
+7 SET BDW("RUN LOG")=BDWLOG
+8 DO NOW^%DTC
SET BDW("RUN START")=%
SET BDW("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+9 SET BDW("BT")=$HOROLOG
+10 SET BDWMSGH=$$DW1HDR^BHLEVENT(90213,BDWLOG)
+11 SET ^BDWTMP(BDWIEDST,BDWMSGH)=""
+12 SET DIE="^BDWXLOG("
SET DA=BDWLOG
SET DR=".15///R;.03////"_BDW("RUN START")_";.12////"_BDWMSGH
DO ^DIE
KILL DA,DIE,DR
+13 SET BDWCNT=$SELECT('$DATA(ZTQUEUED):"X BDWCNT1 X BDWCNT2",1:"S BDWTOTV=BDWTOTV+1")
SET BDWCNT1="F BDWCNTL=1:1:$L(BDWTOTV)+1 W @BDWBS"
SET BDWCNT2="S BDWTOTV=BDWTOTV+1 W BDWTOTV,"")"""
+14 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
+15 SET BDWSD=BDWSD_".9999"
+16 ;set counters
V ; Run by visit date
+1 FOR
SET BDWSD=$ORDER(^AUPNVSIT("B",BDWSD))
IF BDWSD=""!((BDWSD\1)>BDWED)
QUIT
DO V1
+2 ;update log
+3 DO ^XBFMK
+4 DO RUNTIME^BDWRDR
+5 DO LOG
+6 SET X=$$WRITE
SETV ;set 1106
+1 SET BDWTOTV=0
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Updating visit entries with export date....("
+3 SET BDW("V DFN")=0
FOR
SET BDW("V DFN")=$ORDER(^TMP($JOB,"BDW",BDW("V DFN")))
IF BDW("V DFN")'=+BDW("V DFN")
QUIT
DO ^XBFMK
SET DA=BDW("V DFN")
SET DIE="^AUPNVSIT("
SET DR="1106////"_BDW("MAIN TX DATE")
DO ^DIE
DO ^XBFMK
XECUTE BDWCNT
+4 DO XIT
+5 QUIT
V1 ;go through each visit on this date
+1 SET BDW("V DFN")=""
FOR
SET BDW("V DFN")=$ORDER(^AUPNVSIT("B",BDWSD,BDW("V DFN")))
IF BDW("V DFN")'=+BDW("V DFN")
QUIT
IF $DATA(^AUPNVSIT(BDW("V DFN"),0))
SET BDWVREC=^(0)
DO PROC
+2 QUIT
PROC ;
+1 IF $PIECE(^AUPNVSIT(BDW("V DFN"),0),U,23)=.5
QUIT
+2 ;if no unique ID, stuff it
+3 IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,4)=""
DO ^XBFMK
SET DIE="^AUPNVSIT("
SET DA=BDW("V DFN")
SET DR="1104////"_$$UID^AUPNVSIT(BDW("V DFN"))
DO ^DIE
DO ^XBFMK
+4 ;cmi/anch/maw 9/6/2007 patch 2
IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,4)=""
DO ^XBFMK
SET DIE="^AUPNVSIT("
SET DA=BDW("V DFN")
SET DR="1114////"_$$UIDV^BDWAID(BDW("V DFN"))
DO ^DIE
DO ^XBFMK
+5 SET BDWV("TX GENERATED")=0
SET ^TMP($JOB,"BDW",BDW("V DFN"))=""
+6 SET BDW("VPROC")=$GET(BDW("VPROC"))+1
+7 XECUTE BDWCNT
+8 SET BDWV("V REC")=^AUPNVSIT(BDW("V DFN"),0)
+9 IF $PIECE(BDWV("V REC"),U,11)
IF $PIECE($GET(^AUPNVSIT(BDW("V DFN"),11)),U,6)=""
Begin DoDot:1
+10 SET BDWE("ERROR")=100
DO ^BDWRERR
End DoDot:1
GOTO SET
+11 SET BDWV("V DATE")=+BDWV("V REC")\1
+12 KILL BDWVMSG
DO ^BDWRDR2
SET IF '$DATA(^BDWXLOG(BDW("RUN LOG"),21,0))
SET ^BDWXLOG(BDW("RUN LOG"),21,0)="^90213.2101PA^^"
+1 SET ^BDWXLOG(BDW("RUN LOG"),21,BDW("V DFN"),0)=BDW("V DFN")_U_BDWV("TX GENERATED")_U_$GET(BDWVMSG)
+2 SET $PIECE(^BDWXLOG(BDW("RUN LOG"),21,0),U,3)=BDW("V DFN")
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+3 KILL DIE,DR,DIC
+4 IF BDWVA
IF '$DATA(BDWE)
DO VA^BDW1VBL2
+5 QUIT
+6 ;
LOG ;
+1 SET BDW("COUNT")=BDW("VISITS")
IF '$DATA(ZTQUEUED)
WRITE !!,BDW("COUNT")," HL7 Messages were generated."
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Updating log entry."
+3 DO NOW^%DTC
SET BDW("RUN STOP")=%
+4 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".04////"_BDW("RUN STOP")_";.05////"_BDW("SKIP")_";.06////"_BDW("COUNT")_";.08///"_BDW("VPROC")
DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
+5 KILL DIE,DA,DR
+6 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".11////"_BDW("REG")_";.12////"_BDWMSGH_";.18////"_$GET(BDW("VISITS"))
DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
+7 KILL DR,DIE,DA,DIV,DIU
+8 SET DIE="^BDWXLOG("
SET DA=BDW("RUN LOG")
SET DR="3101////"_BDW("DEMO")_";3102////"_BDW("ZERO")_";3103////"_BDW("DEL")_";3104////"_BDW("NO PAT")_";3105////"_BDW("NO LOC")_";3106////"_BDW("NO TYPE")_";3107////"_BDW("NO CAT")_";3111////"_BDW("MFI")
+9 DO ^DIE
IF $DATA(Y)
SET BDW("QFLG")=26
QUIT
+10 SET DA=BDW("RUN LOG")
SET DIK="^BDWXLOG("
DO IX1^DIK
KILL DA,DIK
+11 DO ^XBFMK
+12 ;
TR ;trailer report
+1 SET BDWLOC=0
SET BDWLOCC=0
SET BDWTYPE=""
SET BDWMODE=""
SET BDWDATE=""
SET BDWLC=0
+2 SET X="EXPORT SITE: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),.09)
DO S
+3 SET X="DATE OF EXPORT: "_$$FMTE^XLFDT($PIECE($PIECE(^BDWXLOG(BDW("RUN LOG"),0),U,3),"."))
DO S
+4 SET X="TOTAL NUMBER OF VISITS EXPORTED: "_$PIECE(^BDWXLOG(BDW("RUN LOG"),0),U,18)
DO S
+5 SET X="TOTAL NUMBER OF ADDS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3108)
DO S
+6 SET X="TOTAL NUMBER OF MODS: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3109)
DO S
+7 SET X="TOTAL NUMBER OF DELETES: "_$$VAL^XBDIQ1(90213,BDW("RUN LOG"),3110)
DO S
+8 SET X=""
DO S
+9 SET X=""
DO S
+10 FOR
SET BDWLOC=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC))
IF BDWLOC'=+BDWLOC
QUIT
Begin DoDot:1
+11 SET BDWLC=BDWLC+1
SET BDWLOCC=BDWLOCC+1
+12 SET X=BDWLOCC_". Location of Encounter "_$PIECE(^AUTTLOC(BDWLOC,0),U,10)
DO S
+13 SET X=""
DO S
+14 SET X="Type/Cat"
SET $EXTRACT(X,30)="TOTAL COUNT"
SET $EXTRACT(X,49)="ADDS"
SET $EXTRACT(X,58)="DELETES"
SET $EXTRACT(X,70)="CHANGES"
DO S
+15 SET X="---------------------------------------------------------------------------"
DO S
+16 SET BDWTYPE=""
FOR
SET BDWTYPE=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE))
IF BDWTYPE=""
QUIT
Begin DoDot:2
+17 SET X=BDWTYPE
SET $EXTRACT(X,33)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"TOT")),0,9)
SET $EXTRACT(X,46)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"A")),0,9)
+18 SET $EXTRACT(X,58)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"D")),0,9)
SET $EXTRACT(X,70)=$$C($GET(^TMP($JOB,"BDWTRAILER",BDWLOC,"TYPE",BDWTYPE,"M")),0,9)
+19 DO S
End DoDot:2
+20 SET X=""
DO S
+21 SET X=""
DO S
+22 SET X="COUNT BY DATE OF VISITS"
DO S
+23 SET X="TYPE/CAT"
SET $EXTRACT(X,33)="MONTH/YR"
SET $EXTRACT(X,49)="TOTAL"
DO S
+24 SET X="---------------------------------------------------------------------------"
DO S
+25 SET BDWTYPE=""
FOR
SET BDWTYPE=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE))
IF BDWTYPE=""
QUIT
Begin DoDot:2
+26 SET BDWDATE=0
FOR
SET BDWDATE=$ORDER(^TMP($JOB,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE))
IF BDWDATE=""
QUIT
Begin DoDot:3
+27 SET X=BDWTYPE
SET $EXTRACT(X,33)=$$FMTE^XLFDT(BDWDATE)
SET $EXTRACT(X,46)=$$C(^TMP($JOB,"BDWTRAILER",BDWLOC,"DATE",BDWTYPE,BDWDATE),0,9)
DO S
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 SET X=""
DO S
+31 SET X=""
DO S
+32 QUIT
End DoDot:1
+33 SET ^BDWXLOG(BDW("RUN LOG"),99,0)="^^"_BDWLC_"^"_BDWLC_"^"_DT
+34 SET DA=BDW("RUN LOG")
SET DIK="^BDWXLOG("
DO IX1^DIK
KILL DA,DIK
+35 DO ^XBFMK
+36 SET BDWMSGT=$$DW1TRLR^BHLEVENT(90213,BDW("RUN LOG"))
+37 SET ^BDWTMP(BDWIEDST,BDWMSGT)=""
+38 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".13////"_BDWRUN_";.14////"_BDWMSGT_";.15////C"
DO ^DIE
+39 ;
+40 QUIT
C(X,X2,X3) ;
+1 IF X=""
QUIT ""
+2 DO COMMA^%DTC
+3 QUIT X
S ;
+1 SET BDWLC=BDWLC+1
+2 SET ^BDWXLOG(BDW("RUN LOG"),99,BDWLC,0)=X
+3 KILL X
+4 QUIT
+5 QUIT
CHECK ;
+1 IF '$PIECE($GET(^AUTTSITE(1,0)),U)
WRITE !!,"RPMS Site file not SET UP"
SET BDWERR=1
QUIT
+2 IF $PIECE(^BDWSITE(1,0),U,6)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT backloading has not been completed. Must be finished first."
SET BDWERR=2
QUIT
+3 ;D TAXCHK^BDWRDRI
+4 QUIT
QUEUE ;EP
+1 KILL ZTSK
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to QUEUE this to run at a later time"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=1
DO QUEUE1
QUIT
+4 IF BDWRUN="NEW"
IF $DATA(DIRUT)
SET BDWERR=1
SET DA=BDWLOG
SET DIK="^BDWXLOG("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
+5 QUIT
QUEUE1 ;
+1 SET ZTRTN="PROCESS^BDWDDR"
+2 SET ZTIO=""
SET ZTDTH=""
SET ZTDESC="DATA WAREHOUSE DATE RANGE"
SET ZTSAVE("BDW*")=""
+3 DO ^%ZTLOAD
+4 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!!",1:"Request cancelled")
+5 IF '$DATA(ZTSK)
IF BDWRUN="NEW"
SET BDWERR=1
SET DA=BDWLOG
SET DIK="^BDWXLOG("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
QUIT
+6 SET BDWQUE=""
+7 SET DIE="^BDWXLOG("
SET DA=BDWLOG
SET DR=".15///Q"
DO ^DIE
KILL DIE,DA,DR
+8 KILL ZTSK
+9 QUIT
GENLOG ;generate new log entry
+1 DO ^XBFMK
KILL DIADD,DLAYGO
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Generating New Log entry.."
+3 SET X=$$FMTE^XLFDT(BDWBD)
SET DIC="^BDWXLOG("
SET DIC(0)="L"
SET DLAYGO=90213
SET DIC("DR")=".02////"_BDWED_";.07////D;.09////"_$PIECE(^AUTTSITE(1,0),U)_";8801////"_DUZ_";.23///DRE"
SET DIADD=1
+4 DO ^DIC
KILL DIC,DLAYGO,DR,DIADD
+5 IF Y<0
WRITE !!,$CHAR(7),$CHAR(7),"Error creating log entry."
SET BDWERR=1
DO ^XBFMK
QUIT
+6 SET (BDWLOG,BDW("RUN LOG"))=+Y
+7 DO ^XBFMK
+8 QUIT
XIT ;exit, eoj cleanup
+1 DO EOP
+2 DO ^XBFMK
+3 DO EN^XBVK("BDW")
+4 DO KILL^AUPNPAT
+5 KILL AUPNCPT
+6 QUIT
WRITE() ; use XBGSAVE to save the temp global (BDWDATA) to a delimited
+1 ; file that is exported to the DW system at 127.0.0.1
+2 ;
+3 NEW XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN
+4 NEW BDWASU,BDWJUL,DT,X2,X1,X
+5 SET BDWVA("COUNT")=BDWVA("COUNT")+1
SET ^BDWDATA(BDWVA("COUNT"))="T0^"_$PIECE($$DATE^INHUT($$NOW^XLFDT,1),"-")
+6 SET XBGL="BDWDATA"
SET XBMED="F"
SET XBQ="N"
SET XBFLT=1
+7 SET XBNAR="DW Visit Audit"
+8 ;get julian date for file name
IF '$DATA(DT)
DO DT^DICRW
+9 SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
+10 DO ^%DTC
+11 SET BDWJUL=X+1
+12 ;asufac for file name
SET BDWASU=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0)),U,10)
+13 SET XBFN="BDWDWVX"_BDWASU_"."_BDW("RUN LOG")
+14 NEW DA,DIE,DR
+15 SET DA=BDW("RUN LOG")
SET DIE="^BDWXLOG("
SET DR=".21///"_XBFN
DO ^DIE
KILL DA,DIE,DR
+16 ;S XBUF="/usr3/dsd/ljara/" ;used in testing to make it fail
+17 ;S XBQTO="-l dwxfer:regpcc 127.0.0.1"
+18 SET XBS1="DATA WAREHOUSE SEND"
+19 ;
+20 DO ^XBGSAVE
+21 ;
+22 IF XBFLG=0
Begin DoDot:1
+23 IF '$DATA(ZTQUEUED)
WRITE !,"VISIT audit file successfully created and transferred.",!!
+24 KILL ^BDWDATA
End DoDot:1
+25 ;
+26 IF XBFLG'=0
Begin DoDot:1
+27 IF XBFLG(1)=""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT audit file successfully created",!!
KILL ^BDWDATA
+28 IF XBFLG(1)]""
IF '$DATA(ZTQUEUED)
WRITE !!,"VISIT audit file NOT successfully created",!!
+29 IF '$DATA(ZTQUEUED)
WRITE !,"File was NOT successfully transferred to the data warehouse",!,"you will need to manually ftp it.",!
+30 IF '$DATA(ZTQUEUED)
WRITE !,XBFLG(1),!!
End DoDot:1
+31 ;
+32 QUIT XBFLG
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="End of Job. Press Return."
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
DATE(D) ;EP ;IHS/CMI/LAB - new date format - format date in YYYYMMDD format
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,1,3)+1700_$EXTRACT(D,4,7)
+3 ;
+4 ;
NLOG() ;get next log
+1 NEW X,L
SET (X,L)=0
FOR
SET X=$ORDER(^BDWXLOG(X))
IF X'=+X
QUIT
SET L=X
+2 QUIT L+1
INTRO ;introductory text
+1 ;;
+2 ;;ATTENTION:
+3 ;;
+4 ;;Please do not run this export without checking with NPIRS first.
+5 ;;DRE exports cannot be loaded into the NDW without first making
+6 ;;special arrangements. You can contact the
+7 ;;Help Desk.
+8 ;;
+9 ;;You should use the GDW and RERX options for all regularly scheduled
+10 ;;exports.
+11 ;;
+12 ;;This program will generate Data Warehouse records for a visit
+13 ;;date range that you enter. A log entry will be created which will log
+14 ;;the number of visits processed and the number of Data Warehouse records
+15 ;;generated.
+16 ;;
+17 ;;END
