BDW1BLR.m

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