BDW1BLR ; IHS/CMI/LAB - DW EXPORT REG DATA BACKLOAD VIA HL7 ;
;;1.0;IHS DATA WAREHOUSE;**2**;JAN 23, 2006
;
;IHS/SD/lwj 4/21/04 added call to Patient Reg audit file rtn
;
S X=$O(^INRHD("B","HL IHS DW1 IE",0))
I $D(^BDWTMP(X)) W !!,"previous DW export not written to host file" S DIR(0)="EO",DIR("A")="Press return to continue" KILL DA D ^DIR KILL DIR Q
N AGPEXF ;IHS/SD/lwj 4/21/04 patient audit flag
D EXIT
S BDWAIN01=$$NOW^XLFDT,BDWATXST=$P(^AUTTSITE(1,0),U),(BDWA("TOT"),BDWAROUT,BDWAIN03,BDWAIN06)=0
D HOME^%ZIS
HDR ;;^Export Data for ALL Registration Records to Data Warehouse via HL7
W @IOF,!
F I=1:1:(IOM-2) W "*"
W !,"*",?(IOM\2-($L($P($T(HDR),U,2))\2)),$P($T(HDR),U,2),?(IOM-3),"*",!
F I=1:1:(IOM-2) W "*"
W !!?10,"Exporting all Registration info for ",$P(^DIC(4,BDWATXST,0),U)
W !?10,"** Merge'd or Deleted Pts are not exported."
W !?10,"** Data checks are -not- performed, as in the Reg export."
CONT ;do you want to continue?
W !!
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
;
S BDWUSER=DUZ
;IHS/SD/lwj 04/21/04 run the patient export audit/chk result
S AGEXPF=$$FULLEP^BDWDWPX ;Patient Reg audit file creation
I AGEXPF'=0 D
. W !!?10,"Creation of audit file unsuccessful.",!!
. S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
. I $D(DIRUT) D EXIT Q
. I 'Y D EXIT Q
;IHS/SD/lwj 04/21/04 end changes for patient audit
;
G D GIS
W !!?10,"NOW PROCESSING ALL REGISTRATION RECORDS...",!
;create log entry
K DD,DA,DO,D0,DLAYGO,DIADD
S DLAYGO=90215,DIADD=1,DIC(0)="L",DIC="^BDWRBLOG(",X=$$NOW^XLFDT,DIC("DR")=".04////"_DUZ_";.06////"_BDWATXST_";8801////"_DUZ_";.23///RBL" D FILE^DICN
I Y=-1 W !!,"Creating log entry failed....notify programmer." D EXIT Q
K DIC,DA,DO,D0,DD,DIADD,DLAYGO
S BDWIEN=+Y
;get header message number
S X=""
S X=$$DW1HDR^BHLEVENT(90215,BDWIEN)
S ^BDWTMP(BDWIEDST,X)=""
S DA=BDWIEN,DIE="^BDWRBLOG(",DR=".07////"_X D ^DIE K DA,DIE,DR
D ^XBFMK
;loop through AUPNPAT and generate all messages
;
D LOOP
W !?10,"NUMBER OF PATIENT ENTRIES PROCESSED = ",$J(BDWA("TOT"),5)
W !?10,"NUMBER OF REGISTRATION RECORDS (HL7 MESSAGES) TO SEND = ",$J(BDWAIN03,6)
;do trailer
S X=""
S X=$$DW1TRLR^BHLEVENT(90215,BDWIEN)
S ^BDWTMP(BDWIEDST,X)=""
;update log with trailer message number, etc
S DA=BDWIEN,DIE="^BDWRBLOG(",DR=".03///"_BDWA("TOT")_";.05///"_BDWAIN03_";.08////"_X D ^DIE K DA,DIE,DR
D ^XBFMK
S DA=1,DR=".04////"_DT,DIE="^BDWSITE(" D ^DIE
D ^XBFMK
W !!?17,"DW EXPORT HAS BEEN COMPLETED."
S DIR(0)="EO",DIR("A")="Press return to continue" KILL DA D ^DIR KILL DIR
EXIT ;
K DIADD,DLAYGO
D EN^XBVK("BDWA"),^XBFMK
Q
;
GIS ;-- check background jobs for gis
S BDWIEDST=$O(^INRHD("B","HL IHS DW1 IE",0))
W !!,"Checking GIS Background Jobs..."
N BDWGISI
F BDWGISI="FORMAT CONTROLLER" D
. N BDWGISS
. S BDWGISS=$$CHK^BHLBCK(BDWGISI,0)
Q
;
LOOP ;LOOP PATS
NEW DFN,BDWADONE,BDWAP3,DX,DY,BDWASITE,BDWAN11,BDWADPT0,BDWAPAT0,T
S (BDWALDAT,DFN)=0,BDWAFDAT=9999999,BDWAP3=$P(^AUPNPAT(0),U,3)
S DX=$X,DY=$Y+1
S X=0 F S X=$O(^AUPNPAT(X)) Q:X'=+X I $D(^AUPNPAT(X,4)) F Y=1:1:5 S $P(^AUPNPAT(X,4),U,Y)="" I X>10000 W:'(X\10000) "."
W !,"resetting DW AUDIT file"
S BDWDA=0 F S BDWDA=$O(^AUPNDWAF(BDWDA)) Q:BDWDA'=+BDWDA S DA=BDWDA,DIK="^AUPNDWAF(" D ^DIK
F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D I '(DFN#100),'$D(ZTQUEUED) X IOXY W "On IEN ",DFN," of ",BDWAP3," in ^AUPNPAT(..."
. Q:'$D(^DPT(DFN))
. Q:$P(^DPT(DFN,0),U,19) ; merged pt
. S BDWA("TOT")=BDWA("TOT")+1
. Q:'$$ORF(DFN) ;quit if no ORF charts per Lisa P 4-30-04
. S (BDWADONE,BDWASITE)=0
. F S BDWASITE=$O(^AUPNPAT(DFN,41,BDWASITE)) Q:'BDWASITE D Q:BDWADONE
.. I $L($P(^AUPNPAT(DFN,41,BDWASITE,0),U,5)) Q:"M"[$P(^(0),U,5) ; deleted or merged patient
.. ;Q:"T"=$E($P(^AUPNPAT(DFN,41,BDWASITE,0),U,2)) ; Temp HRN
.. KILL T
.. S BDWADPT0=$G(^DPT(DFN,0)),BDWAPAT0=$G(^AUPNPAT(DFN,0)),BDWAN11=$G(^AUPNPAT(DFN,11))
.. S X=""
.. S X=$$DW1REG^BHLEVENT(DFN,1)
.. S ^BDWTMP(BDWIEDST,X)=""
.. S BDWADONE=1 ; pt is done, one and only one time
.. S BDWAIN03=BDWAIN03+1
.. S DA=DFN,DIE="^AUPNPAT(",DR=".41////"_DT_";.42////"_DT_";.44////"_DT
.. I $O(^DPT(DFN,.01,0)) S DR=DR_";.43////"_DT
.. I $D(^AUPNMCR(DFN))!($D(^AUPNPRVT(DFN)))!($O(^AUPNMCD("B",DFN,0))) S DR=DR_";.45////"_DT
.. D ^DIE K DIE,DA,DR,DIU,DIV,DIW,DIX
.. Q
. Q
Q
;
ORF(P) ;patient has ORF?
I '$G(P) Q 0
NEW FLAG,D
S FLAG=0
;
S D=0
F S D=$O(^AUPNPAT(P,41,D)) Q:+D=0 D
. Q:$P($G(^AGFAC(D,0)),"^",21)'="Y" ;only want ORFs
. S FLAG=1 ;found one
. Q
Q FLAG
BDW1BLR ; IHS/CMI/LAB - DW EXPORT REG DATA BACKLOAD VIA HL7 ;
+1 ;;1.0;IHS DATA WAREHOUSE;**2**;JAN 23, 2006
+2 ;
+3 ;IHS/SD/lwj 4/21/04 added call to Patient Reg audit file rtn
+4 ;
+5 SET X=$ORDER(^INRHD("B","HL IHS DW1 IE",0))
+6 IF $DATA(^BDWTMP(X))
WRITE !!,"previous DW export not written to host file"
SET DIR(0)="EO"
SET DIR("A")="Press return to continue"
KILL DA
DO ^DIR
KILL DIR
QUIT
+7 ;IHS/SD/lwj 4/21/04 patient audit flag
NEW AGPEXF
+8 DO EXIT
+9 SET BDWAIN01=$$NOW^XLFDT
SET BDWATXST=$PIECE(^AUTTSITE(1,0),U)
SET (BDWA("TOT"),BDWAROUT,BDWAIN03,BDWAIN06)=0
+10 DO HOME^%ZIS
HDR ;;^Export Data for ALL Registration Records to Data Warehouse via HL7
+1 WRITE @IOF,!
+2 FOR I=1:1:(IOM-2)
WRITE "*"
+3 WRITE !,"*",?(IOM\2-($LENGTH($PIECE($TEXT(HDR),U,2))\2)),$PIECE($TEXT(HDR),U,2),?(IOM-3),"*",!
+4 FOR I=1:1:(IOM-2)
WRITE "*"
+5 WRITE !!?10,"Exporting all Registration info for ",$PIECE(^DIC(4,BDWATXST,0),U)
+6 WRITE !?10,"** Merge'd or Deleted Pts are not exported."
+7 WRITE !?10,"** Data checks are -not- performed, as in the Reg export."
CONT ;do you want to continue?
+1 WRITE !!
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 IF 'Y
DO EXIT
QUIT
+5 ;
+6 SET BDWUSER=DUZ
+7 ;IHS/SD/lwj 04/21/04 run the patient export audit/chk result
+8 ;Patient Reg audit file creation
SET AGEXPF=$$FULLEP^BDWDWPX
+9 IF AGEXPF'=0
Begin DoDot:1
+10 WRITE !!?10,"Creation of audit file unsuccessful.",!!
+11 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
DO EXIT
QUIT
+13 IF 'Y
DO EXIT
QUIT
End DoDot:1
+14 ;IHS/SD/lwj 04/21/04 end changes for patient audit
+15 ;
G DO GIS
+1 WRITE !!?10,"NOW PROCESSING ALL REGISTRATION RECORDS...",!
+2 ;create log entry
+3 KILL DD,DA,DO,D0,DLAYGO,DIADD
+4 SET DLAYGO=90215
SET DIADD=1
SET DIC(0)="L"
SET DIC="^BDWRBLOG("
SET X=$$NOW^XLFDT
SET DIC("DR")=".04////"_DUZ_";.06////"_BDWATXST_";8801////"_DUZ_";.23///RBL"
DO FILE^DICN
+5 IF Y=-1
WRITE !!,"Creating log entry failed....notify programmer."
DO EXIT
QUIT
+6 KILL DIC,DA,DO,D0,DD,DIADD,DLAYGO
+7 SET BDWIEN=+Y
+8 ;get header message number
+9 SET X=""
+10 SET X=$$DW1HDR^BHLEVENT(90215,BDWIEN)
+11 SET ^BDWTMP(BDWIEDST,X)=""
+12 SET DA=BDWIEN
SET DIE="^BDWRBLOG("
SET DR=".07////"_X
DO ^DIE
KILL DA,DIE,DR
+13 DO ^XBFMK
+14 ;loop through AUPNPAT and generate all messages
+15 ;
+16 DO LOOP
+17 WRITE !?10,"NUMBER OF PATIENT ENTRIES PROCESSED = ",$JUSTIFY(BDWA("TOT"),5)
+18 WRITE !?10,"NUMBER OF REGISTRATION RECORDS (HL7 MESSAGES) TO SEND = ",$JUSTIFY(BDWAIN03,6)
+19 ;do trailer
+20 SET X=""
+21 SET X=$$DW1TRLR^BHLEVENT(90215,BDWIEN)
+22 SET ^BDWTMP(BDWIEDST,X)=""
+23 ;update log with trailer message number, etc
+24 SET DA=BDWIEN
SET DIE="^BDWRBLOG("
SET DR=".03///"_BDWA("TOT")_";.05///"_BDWAIN03_";.08////"_X
DO ^DIE
KILL DA,DIE,DR
+25 DO ^XBFMK
+26 SET DA=1
SET DR=".04////"_DT
SET DIE="^BDWSITE("
DO ^DIE
+27 DO ^XBFMK
+28 WRITE !!?17,"DW EXPORT HAS BEEN COMPLETED."
+29 SET DIR(0)="EO"
SET DIR("A")="Press return to continue"
KILL DA
DO ^DIR
KILL DIR
EXIT ;
+1 KILL DIADD,DLAYGO
+2 DO EN^XBVK("BDWA")
DO ^XBFMK
+3 QUIT
+4 ;
GIS ;-- check background jobs for gis
+1 SET BDWIEDST=$ORDER(^INRHD("B","HL IHS DW1 IE",0))
+2 WRITE !!,"Checking GIS Background Jobs..."
+3 NEW BDWGISI
+4 FOR BDWGISI="FORMAT CONTROLLER"
Begin DoDot:1
+5 NEW BDWGISS
+6 SET BDWGISS=$$CHK^BHLBCK(BDWGISI,0)
End DoDot:1
+7 QUIT
+8 ;
LOOP ;LOOP PATS
+1 NEW DFN,BDWADONE,BDWAP3,DX,DY,BDWASITE,BDWAN11,BDWADPT0,BDWAPAT0,T
+2 SET (BDWALDAT,DFN)=0
SET BDWAFDAT=9999999
SET BDWAP3=$PIECE(^AUPNPAT(0),U,3)
+3 SET DX=$X
SET DY=$Y+1
+4 SET X=0
FOR
SET X=$ORDER(^AUPNPAT(X))
IF X'=+X
QUIT
IF $DATA(^AUPNPAT(X,4))
FOR Y=1:1:5
SET $PIECE(^AUPNPAT(X,4),U,Y)=""
IF X>10000
IF '(X\10000)
WRITE "."
+5 WRITE !,"resetting DW AUDIT file"
+6 SET BDWDA=0
FOR
SET BDWDA=$ORDER(^AUPNDWAF(BDWDA))
IF BDWDA'=+BDWDA
QUIT
SET DA=BDWDA
SET DIK="^AUPNDWAF("
DO ^DIK
+7 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+8 IF '$DATA(^DPT(DFN))
QUIT
+9 ; merged pt
IF $PIECE(^DPT(DFN,0),U,19)
QUIT
+10 SET BDWA("TOT")=BDWA("TOT")+1
+11 ;quit if no ORF charts per Lisa P 4-30-04
IF '$$ORF(DFN)
QUIT
+12 SET (BDWADONE,BDWASITE)=0
+13 FOR
SET BDWASITE=$ORDER(^AUPNPAT(DFN,41,BDWASITE))
IF 'BDWASITE
QUIT
Begin DoDot:2
+14 ; deleted or merged patient
IF $LENGTH($PIECE(^AUPNPAT(DFN,41,BDWASITE,0),U,5))
IF "M"[$PIECE(^(0),U,5)
QUIT
+15 ;Q:"T"=$E($P(^AUPNPAT(DFN,41,BDWASITE,0),U,2)) ; Temp HRN
+16 KILL T
+17 SET BDWADPT0=$GET(^DPT(DFN,0))
SET BDWAPAT0=$GET(^AUPNPAT(DFN,0))
SET BDWAN11=$GET(^AUPNPAT(DFN,11))
+18 SET X=""
+19 SET X=$$DW1REG^BHLEVENT(DFN,1)
+20 SET ^BDWTMP(BDWIEDST,X)=""
+21 ; pt is done, one and only one time
SET BDWADONE=1
+22 SET BDWAIN03=BDWAIN03+1
+23 SET DA=DFN
SET DIE="^AUPNPAT("
SET DR=".41////"_DT_";.42////"_DT_";.44////"_DT
+24 IF $ORDER(^DPT(DFN,.01,0))
SET DR=DR_";.43////"_DT
+25 IF $DATA(^AUPNMCR(DFN))!($DATA(^AUPNPRVT(DFN)))!($ORDER(^AUPNMCD("B",DFN,0)))
SET DR=DR_";.45////"_DT
+26 DO ^DIE
KILL DIE,DA,DR,DIU,DIV,DIW,DIX
+27 QUIT
End DoDot:2
IF BDWADONE
QUIT
+28 QUIT
End DoDot:1
IF '(DFN#100)
IF '$DATA(ZTQUEUED)
XECUTE IOXY
WRITE "On IEN ",DFN," of ",BDWAP3," in ^AUPNPAT(..."
+29 QUIT
+30 ;
ORF(P) ;patient has ORF?
+1 IF '$GET(P)
QUIT 0
+2 NEW FLAG,D
+3 SET FLAG=0
+4 ;
+5 SET D=0
+6 FOR
SET D=$ORDER(^AUPNPAT(P,41,D))
IF +D=0
QUIT
Begin DoDot:1
+7 ;only want ORFs
IF $PIECE($GET(^AGFAC(D,0)),"^",21)'="Y"
QUIT
+8 ;found one
SET FLAG=1
+9 QUIT
End DoDot:1
+10 QUIT FLAG
