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

BDWRDRI2.m

Go to the documentation of this file. 
  1. BDWRDRI2 ; IHS/CMI/LAB - INIT FOR DW EXPORT ;
  1.  ;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
  1.  ;IHS/CMI/LAB - patch 1 XTMP
  1.  ;
  1. START ;
  1.  D INFORM ;      Let operator know what is going on.
  1.  D GETLOG ;      Get last log entry and display data.
  1.  Q:BDW("QFLG")
  1.  D CHKOLD
  1.  Q:BDW("QFLG")
  1.  D CURRUN ;      Compute run dates for current run.
  1.  Q:BDW("QFLG")
  1.  D CHKVISIT ;    Check VISIT xref for date range
  1.  Q:BDW("QFLG")
  1.  D CONFIRM ;     Get ok from operator.
  1.  Q:BDW("QFLG")
  1.  D GENLOG ;      Generate new log entry.
  1.  Q
  1.  ;
  1. CHKOLD ;EP - CHECK FOR DATA LEFT BY OLD RUN
  1.  I $D(^XTMP("BDWDR")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!!," S BDW("QFLG")=10
  1.  I $D(^XTMP("BDWREDO")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous REDO!!" S BDW("QFLG")=11
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. GETLOG ;EP GET LAST LOG ENTRY
  1.  S (X,BDW("LAST LOG"))=0 F  S X=$O(^BDWXLOG(X)) Q:X'=+X  I $P(^BDWXLOG(X,0),U,7)="R" S BDW("LAST LOG")=X
  1.  Q:'BDW("LAST LOG")
  1.  D DISPLOG
  1.  Q:$P(^BDWXLOG(BDW("LAST LOG"),0),U,15)="C"
  1.  D ERROR
  1.  Q
  1. ERROR ;
  1.  S BDW("QFLG")=12
  1.  S BDW("PREV STATUS")=$P(^BDWXLOG(BDW("LAST LOG"),0),U,15)
  1.  I BDW("PREV STATUS")="" D EERR Q
  1.  D @(BDW("PREV STATUS")_"ERR") Q
  1.  Q
  1. EERR ;
  1.  S BDW("QFLG")=13
  1.  ;
  1.  Q:$D(ZTQUEUED)
  1.  W $C(7),$C(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last Data Export never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!
  1.  Q
  1. RERR ;
  1.  S BDW("QFLG")=15
  1.  ;
  1.  Q:$D(ZTQUEUED)
  1.  W $C(7),$C(7),!!,"Data Warehouse Transmission is currently running!!"
  1.  Q
  1. QERR ;
  1.  S BDW("QFLG")=16
  1.  ;
  1.  Q:$D(ZTQUEUED)
  1.  W !!,$C(7),$C(7),"Data Warehouse Transmission is already queued to run!!"
  1.  Q
  1. FERR ;
  1.  S BDW("QFLG")=17
  1.  ;
  1.  Q:$D(ZTQUEUED)
  1.  W !!,$C(7),$C(7),"The last DATA WAREHOUSE Export failed and has never been reset.",!,"See your site manager for assistence",!
  1.  Q
  1.  ;
  1. DISPLOG ; DISPLAY LAST LOG DATA
  1.  S Y=$P(^BDWXLOG(BDW("LAST LOG"),0),U) X ^DD("DD") S BDW("LAST BEGIN")=Y S Y=$P(^BDWXLOG(BDW("LAST LOG"),0),U,2) X ^DD("DD") S BDW("LAST END")=Y
  1.  Q:$D(ZTQUEUED)
  1.  W !!,"Last run was for ",BDW("LAST BEGIN")," through ",BDW("LAST END"),"."
  1.  Q
  1.  ;
  1.  ;
  1. CHKVISIT ;EP CHECK VISIT "ADWO" XREF
  1.  S BDWV("V DATE")=0
  1.  S BDWV("V DATE")=$O(^AUPNVSIT("ADWO",BDWV("V DATE")))
  1.  S BDWV("V DATE")=$O(^AUPNVSIT("ADWO",0))
  1.  I BDWV("V DATE"),BDWV("V DATE")<BDW("RUN BEGIN") W:'$D(ZTQUEUED) !!,"*** Cross-references exist prior to beginning of date range! ***" S BDW("QFLG")=21 Q
  1.  ;
  1.  S BDWV("V DATE")=BDW("RUN BEGIN")-1
  1.  S BDWV("V DATE")=$O(^AUPNVSIT("ADWO",BDWV("V DATE")))
  1.  ;I BDWV("V DATE")=""!(BDWV("V DATE")>BDW("RUN END")) W:'$D(ZTQUEUED) !!,"*** No VISITs within range! ***" S BDW("QFLG")=22 Q
  1.  Q
  1.  ;
  1. CONFIRM ;EP SEE IF THEY REALLY WANT TO DO THIS
  1.  Q:$D(ZTQUEUED)
  1.  W !,"The location for this run is ",$P(^DIC(4,DUZ(2),0),U),".",!
  1. CFLP  ;
  1.  S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" K DA D ^DIR K DIR
  1.  I 'Y S BDW("QFLG")=99
  1.  Q
  1.  ;
  1. GENLOG ; GENERATE NEW LOG ENTRY
  1.  D ^XBFMK K DIADD
  1.  W:'$D(ZTQUEUED) !,"Generating New Log entry.."
  1.  S Y=BDW("RUN BEGIN") X ^DD("DD") S X=""""_Y_"""",DIC="^BDWXLOG(",DIC(0)="L",DLAYGO=90213,DIC("DR")=".02////"_BDW("RUN END")_";.07////R;.09///`"_DUZ(2)_";8801////"_DUZ,DIADD=1
  1.  D ^DIC K DIC,DLAYGO,DR,DIADD
  1.  I Y<0 S BDW("QFLG")=23 D ^XBFMK Q
  1.  S BDW("RUN LOG")=+Y
  1.  D ^XBFMK
  1.  Q
  1. INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN
  1.  Q:$D(ZTQUEUED)
  1.  W !!,"This routine will generate IHS Data Warehouse HL7 messages"
  1.  W !,"for visits posted between a specified range of dates.  You may ""^"" out at any",!,"prompt and will be ask to confirm your entries prior to generating transactions."
  1.  Q
  1.  ;
  1. CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN
  1.  S BDW("RUN BEGIN")=""
  1.  I BDW("LAST LOG") S X1=$P(^BDWXLOG(BDW("LAST LOG"),0),U,2),X2=1 D C^%DTC S BDW("RUN BEGIN")=X,Y=X D DD^%DT
  1.  I BDW("RUN BEGIN")="" D FIRSTRUN
  1.  Q:BDW("QFLG")
  1.  S Y=$$FMADD^XLFDT(DT,-1)
  1.  I Y<BDW("RUN BEGIN") W:'$D(ZTQUEUED) !!,"  Ending date cannot be before beginning date!  There is no new date to send.",$C(7) S BDW("QFLG")=18 Q
  1.  S BDW("RUN END")=Y
  1.  S Y=BDW("RUN BEGIN") X ^DD("DD") S BDW("X")=Y
  1.  S Y=BDW("RUN END") X ^DD("DD") S BDW("Y")=Y
  1.  W:'$D(ZTQUEUED) !!,"The inclusive dates for this run are ",BDW("X")," through ",BDW("Y"),"."
  1.  K %,%H,%I,BDW("RDFN"),BDW("X"),BDW("Y"),BDW("LAST LOG"),BDW("LAST BEGIN"),BDW("Z"),BDW("DATE")
  1.  Q
  1.  ;
  1. FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)
  1.  I $D(ZTQUEUED),$D(BDWO("SCHEDULED")) S BDW("QFLG")=12 Q
  1.  W !!,"No log entry.  First run ever assumed (excluding date range re-exports).",!
  1.  S BDW("RUN BEGIN")=$O(^AUPNVSIT("ADWO",0))
  1.  I BDW("RUN BEGIN")="" S BDW("RUN BEGIN")=$$FMADD^XLFDT($P(^BDWSITE(1,0),U,4),1)
  1.  S BDW("FIRST RUN")=1
  1.  Q
  1.  ;
  1.  ;
  1. ERRBULL ;ENTRY POINT - ERROR BULLETIN
  1.  S BDW("QFLG1")=$O(^BDWERRC("B",BDW("QFLG"),"")),BDW("QFLG DES")=$P(^BDWERRC(BDW("QFLG1"),0),U,2)
  1.  S XMB(2)=BDW("QFLG"),XMB(3)=BDW("QFLG DES")
  1.  S XMB(4)=$S($D(BDW("RUN LOG")):BDW("RUN LOG"),1:"< NONE >")
  1.  I '$D(BDW("RUN BEGIN")) S XMB(5)="<UNKNOWN>" G ERRBULL1
  1.  S Y=BDW("RUN BEGIN") D DD^%DT S XMB(5)=Y
  1. ERRBULL1 S Y=DT D DD^%DT S XMB(1)=Y,XMB="BDW DW TRANSMISSION ERROR"
  1.  S XMDUZ=.5 D ^XMB
  1.  K XMB,XM1,XMA,XMDT,XMM,BDW("QFLG1"),BDW("QFLG DES"),XMDUZ
  1.  Q