BCHEXDI2 ; IHS/CMI/LAB - Export initialization ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
;IHS/TUCSON/LAB - modified this to not error out if this is the
;first export and old data exists patch 1 06/03/97
;
;
START ;
D INFORM^BCHEXDI3 ; Let operator know what is going on.
D GETLOG ; Get last log entry and display data.
Q:BCH("QFLG")
D CHKOLD
Q:BCH("QFLG")
D CURRUN^BCHEXDI3 ; Compute run dates for current run.
Q:BCH("QFLG")
D CHKCHR ; Check CHR RECORD xref for date range
Q:BCH("QFLG")
D CONFIRM ; Get ok from operator.
Q:BCH("QFLG")
D GENLOG ; Generate new log entry.
Q
;
CHKOLD ;EP - CHECK FOR DATA LEFT BY OLD RUN
I $D(^BCHRDATA) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^BCHRDATA global exists from a previous GEN or REDO!!" S BCH("QFLG")=32
I $D(^TMP("BCHDR")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^TMP nodes exist from previous GEN!!," S BCH("QFLG")=10
I $D(^TMP("BCHREDO")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^TMP nodes exist from previous REDO!!" S BCH("QFLG")=11
Q
;
;
;
;
GETLOG ;EP GET LAST LOG ENTRY
S (X,BCH("LAST LOG"))=$P(^BCHXLOG(0),U,3) F S X=$O(^BCHXLOG(X)) Q:X'=+X S BCH("LAST LOG")=X
S X=$S(BCH("LAST LOG")&($D(^BCHXLOG(BCH("LAST LOG")))):BCH("LAST LOG"),1:0) F S X=$O(^BCHXLOG(X)) Q:X'=+X S BCH("LAST LOG")=X
Q:'BCH("LAST LOG")
D DISPLOG
Q:$P(^BCHXLOG(BCH("LAST LOG"),0),U,15)="C"
D ERROR
Q
ERROR ;
S BCH("QFLG")=12
S BCH("PREV STATUS")=$P(^BCHXLOG(BCH("LAST LOG"),0),U,15)
I BCH("PREV STATUS")="" D EERR Q
D @(BCH("PREV STATUS")_"ERR") Q
Q
EERR ;
S BCH("QFLG")=13
;
Q:$D(ZTQUEUED)
W $C(7),$C(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last CHR Data Export never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!
Q
PERR ;
S BCH("QFLG")=14
;
Q:$D(ZTQUEUED)
W !!,$C(7),$C(7),"*****ERROR ENCOUNTERED*****",!,"Whoa! The Transaction global from the previous run was NEVER successfully",!,"written to an output device (unix uucppublic file, cartridge, diskette).",!
W !,"You must execute the menu option called 'OUTP' before any further processing.",!,"You may also need to determine whether or not the transaction global for ",!,"LOG ENTRY ",BCH("LAST LOG")," was ever received by your Area Office.",!
Q
RERR ;
S BCH("QFLG")=15
;
Q:$D(ZTQUEUED)
W $C(7),$C(7),!!,"CHR Data Transmission is currently running!!"
Q
QERR ;
S BCH("QFLG")=16
;
Q:$D(ZTQUEUED)
W !!,$C(7),$C(7),"CHR Data Transmission is already queued to run!!"
Q
FERR ;
S BCH("QFLG")=17
;
Q:$D(ZTQUEUED)
W !!,$C(7),$C(7),"The last CHR Export failed and has never been reset.",!,"See your site manager for assistence",!
Q
;
DISPLOG ; DISPLAY LAST LOG DATA
S Y=$P(^BCHXLOG(BCH("LAST LOG"),0),U) X ^DD("DD") S BCH("LAST BEGIN")=Y S Y=$P(^BCHXLOG(BCH("LAST LOG"),0),U,2) X ^DD("DD") S BCH("LAST END")=Y
Q:$D(ZTQUEUED)
W !!,"Last run was for ",BCH("LAST BEGIN")," through ",BCH("LAST END"),"."
Q
;
;
CHKCHR ; CHECK CHR RECORD "AEX" XREF
S BCHR("R DATE")=0
S BCHR("R DATE")=$O(^BCHR("AEX",BCHR("R DATE")))
I $D(BCH("FIRST RUN")) D CHKCR Q:BCH("QFLG") ;IHS/TUCSON/LAB - patch 2 - 06/03/97 - added this line
S BCHR("R DATE")=$O(^BCHR("AEX",0))
I BCHR("R DATE"),BCHR("R DATE")<BCH("RUN BEGIN") W:'$D(ZTQUEUED) !!,"*** Cross-references exist prior to beginning of date range! ***" S BCH("QFLG")=21 Q
;
S BCHR("R DATE")=BCH("RUN BEGIN")-1
S BCHR("R DATE")=$O(^BCHR("AEX",BCHR("R DATE")))
I BCHR("R DATE")=""!(BCHR("R DATE")>BCH("RUN END")) W:'$D(ZTQUEUED) !!,"*** No CHR RECORDs within range! ***" S BCH("QFLG")=22 Q
Q
;
CONFIRM ; SEE IF THEY REALLY WANT TO DO THIS
Q:$D(ZTQUEUED)
W !,"The location for this run is ",$P(^DIC(4,DUZ(2),0),U),"."
CFLP ;
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" K DA D ^DIR K DIR
I $D(DIRUT) S BCH("QFLG")=99
I 'Y S BCH("QFLG")=99
Q
;
GENLOG ; GENERATE NEW LOG ENTRY
W:'$D(ZTQUEUED) !,"Generating New Log entry.."
S BCH("BATCH")=$P(^BCHSITE(DUZ(2),0),U,11)+1
S Y=BCH("RUN BEGIN") X ^DD("DD") S X=""""_Y_"""",DIC="^BCHXLOG(",DIC(0)="L",DLAYGO=90002.91,DIC("DR")=".02////"_BCH("RUN END")_";.09///`"_DUZ(2)_";.11///"_BCH("BATCH")
D ^DIC K DIC,DLAYGO,DR
I Y<0 S BCH("QFLG")=23 Q
S BCH("RUN LOG")=+Y
K ^BCHRDATA ;TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
;UNSUBSCRIPTED VARIABLES KILLED - THESE ARE CMB STANDARD DEFINED SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER
Q
CHKCR ;
;IHS/TUCSON/LAB - patch 2 - 06/03/97 - added this sub-routine
S Y=BCH("RUN BEGIN") X ^DD("DD") S Z=Y
I BCHR("R DATE"),BCHR("R DATE")<BCH("RUN BEGIN") D CHKCR1
Q
CHKCR1 ;
W !!,"There are cross references entries for visits prior to the date of ",Z,".",!
S DIR(0)="Y",DIR("A")="Are you SURE that the CHR data should export as of "_Z K DA D ^DIR K DIR
I $D(DIRUT) S BCH("QFLG")=99 Q
I 'Y W !,"BYE.." S BCH("QFLG")=99 Q
D DELCR
Q
DELCR ;
W !!,"I will now clean up that cross reference.... Please be patient..."
S BCH("DATE")=0,X=BCH("RUN BEGIN")-1 F S BCH("DATE")=$O(^BCHR("AEX",BCH("DATE"))) Q:BCH("DATE")=""!(BCH("DATE")>X) W "." K ^BCHR("AEX",BCH("DATE"))
W !,"OK ALL DONE",!
Q
BCHEXDI2 ; IHS/CMI/LAB - Export initialization ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 ;IHS/TUCSON/LAB - modified this to not error out if this is the
+4 ;first export and old data exists patch 1 06/03/97
+5 ;
+6 ;
START ;
+1 ; Let operator know what is going on.
DO INFORM^BCHEXDI3
+2 ; Get last log entry and display data.
DO GETLOG
+3 IF BCH("QFLG")
QUIT
+4 DO CHKOLD
+5 IF BCH("QFLG")
QUIT
+6 ; Compute run dates for current run.
DO CURRUN^BCHEXDI3
+7 IF BCH("QFLG")
QUIT
+8 ; Check CHR RECORD xref for date range
DO CHKCHR
+9 IF BCH("QFLG")
QUIT
+10 ; Get ok from operator.
DO CONFIRM
+11 IF BCH("QFLG")
QUIT
+12 ; Generate new log entry.
DO GENLOG
+13 QUIT
+14 ;
CHKOLD ;EP - CHECK FOR DATA LEFT BY OLD RUN
+1 IF $DATA(^BCHRDATA)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^BCHRDATA global exists from a previous GEN or REDO!!"
SET BCH("QFLG")=32
+2 IF $DATA(^TMP("BCHDR"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^TMP nodes exist from previous GEN!!,"
SET BCH("QFLG")=10
+3 IF $DATA(^TMP("BCHREDO"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^TMP nodes exist from previous REDO!!"
SET BCH("QFLG")=11
+4 QUIT
+5 ;
+6 ;
+7 ;
+8 ;
GETLOG ;EP GET LAST LOG ENTRY
+1 SET (X,BCH("LAST LOG"))=$PIECE(^BCHXLOG(0),U,3)
FOR
SET X=$ORDER(^BCHXLOG(X))
IF X'=+X
QUIT
SET BCH("LAST LOG")=X
+2 SET X=$SELECT(BCH("LAST LOG")&($DATA(^BCHXLOG(BCH("LAST LOG")))):BCH("LAST LOG"),1:0)
FOR
SET X=$ORDER(^BCHXLOG(X))
IF X'=+X
QUIT
SET BCH("LAST LOG")=X
+3 IF 'BCH("LAST LOG")
QUIT
+4 DO DISPLOG
+5 IF $PIECE(^BCHXLOG(BCH("LAST LOG"),0),U,15)="C"
QUIT
+6 DO ERROR
+7 QUIT
ERROR ;
+1 SET BCH("QFLG")=12
+2 SET BCH("PREV STATUS")=$PIECE(^BCHXLOG(BCH("LAST LOG"),0),U,15)
+3 IF BCH("PREV STATUS")=""
DO EERR
QUIT
+4 DO @(BCH("PREV STATUS")_"ERR")
QUIT
+5 QUIT
EERR ;
+1 SET BCH("QFLG")=13
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE $CHAR(7),$CHAR(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last CHR Data Export never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!
+5 QUIT
PERR ;
+1 SET BCH("QFLG")=14
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE !!,$CHAR(7),$CHAR(7),"*****ERROR ENCOUNTERED*****",!,"Whoa! The Transaction global from the previous run was NEVER successfully",!,"written to an output device (unix uucppublic file, cartridge, diskette).",!
+5 WRITE !,"You must execute the menu option called 'OUTP' before any further processing.",!,"You may also need to determine whether or not the transaction global for ",!,"LOG ENTRY ",BCH("LAST LOG")," was ever received by your Area Office.",!
+6 QUIT
RERR ;
+1 SET BCH("QFLG")=15
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE $CHAR(7),$CHAR(7),!!,"CHR Data Transmission is currently running!!"
+5 QUIT
QERR ;
+1 SET BCH("QFLG")=16
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE !!,$CHAR(7),$CHAR(7),"CHR Data Transmission is already queued to run!!"
+5 QUIT
FERR ;
+1 SET BCH("QFLG")=17
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE !!,$CHAR(7),$CHAR(7),"The last CHR Export failed and has never been reset.",!,"See your site manager for assistence",!
+5 QUIT
+6 ;
DISPLOG ; DISPLAY LAST LOG DATA
+1 SET Y=$PIECE(^BCHXLOG(BCH("LAST LOG"),0),U)
XECUTE ^DD("DD")
SET BCH("LAST BEGIN")=Y
SET Y=$PIECE(^BCHXLOG(BCH("LAST LOG"),0),U,2)
XECUTE ^DD("DD")
SET BCH("LAST END")=Y
+2 IF $DATA(ZTQUEUED)
QUIT
+3 WRITE !!,"Last run was for ",BCH("LAST BEGIN")," through ",BCH("LAST END"),"."
+4 QUIT
+5 ;
+6 ;
CHKCHR ; CHECK CHR RECORD "AEX" XREF
+1 SET BCHR("R DATE")=0
+2 SET BCHR("R DATE")=$ORDER(^BCHR("AEX",BCHR("R DATE")))
+3 ;IHS/TUCSON/LAB - patch 2 - 06/03/97 - added this line
IF $DATA(BCH("FIRST RUN"))
DO CHKCR
IF BCH("QFLG")
QUIT
+4 SET BCHR("R DATE")=$ORDER(^BCHR("AEX",0))
+5 IF BCHR("R DATE")
IF BCHR("R DATE")<BCH("RUN BEGIN")
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Cross-references exist prior to beginning of date range! ***"
SET BCH("QFLG")=21
QUIT
+6 ;
+7 SET BCHR("R DATE")=BCH("RUN BEGIN")-1
+8 SET BCHR("R DATE")=$ORDER(^BCHR("AEX",BCHR("R DATE")))
+9 IF BCHR("R DATE")=""!(BCHR("R DATE")>BCH("RUN END"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** No CHR RECORDs within range! ***"
SET BCH("QFLG")=22
QUIT
+10 QUIT
+11 ;
CONFIRM ; SEE IF THEY REALLY WANT TO DO THIS
+1 IF $DATA(ZTQUEUED)
QUIT
+2 WRITE !,"The location for this run is ",$PIECE(^DIC(4,DUZ(2),0),U),"."
CFLP ;
+1 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
SET BCH("QFLG")=99
+3 IF 'Y
SET BCH("QFLG")=99
+4 QUIT
+5 ;
GENLOG ; GENERATE NEW LOG ENTRY
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating New Log entry.."
+2 SET BCH("BATCH")=$PIECE(^BCHSITE(DUZ(2),0),U,11)+1
+3 SET Y=BCH("RUN BEGIN")
XECUTE ^DD("DD")
SET X=""""_Y_""""
SET DIC="^BCHXLOG("
SET DIC(0)="L"
SET DLAYGO=90002.91
SET DIC("DR")=".02////"_BCH("RUN END")_";.09///`"_DUZ(2)_";.11///"_BCH("BATCH")
+4 DO ^DIC
KILL DIC,DLAYGO,DR
+5 IF Y<0
SET BCH("QFLG")=23
QUIT
+6 SET BCH("RUN LOG")=+Y
+7 ;TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
KILL ^BCHRDATA
+8 ;UNSUBSCRIPTED VARIABLES KILLED - THESE ARE CMB STANDARD DEFINED SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER
+9 QUIT
CHKCR ;
+1 ;IHS/TUCSON/LAB - patch 2 - 06/03/97 - added this sub-routine
+2 SET Y=BCH("RUN BEGIN")
XECUTE ^DD("DD")
SET Z=Y
+3 IF BCHR("R DATE")
IF BCHR("R DATE")<BCH("RUN BEGIN")
DO CHKCR1
+4 QUIT
CHKCR1 ;
+1 WRITE !!,"There are cross references entries for visits prior to the date of ",Z,".",!
+2 SET DIR(0)="Y"
SET DIR("A")="Are you SURE that the CHR data should export as of "_Z
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BCH("QFLG")=99
QUIT
+4 IF 'Y
WRITE !,"BYE.."
SET BCH("QFLG")=99
QUIT
+5 DO DELCR
+6 QUIT
DELCR ;
+1 WRITE !!,"I will now clean up that cross reference.... Please be patient..."
+2 SET BCH("DATE")=0
SET X=BCH("RUN BEGIN")-1
FOR
SET BCH("DATE")=$ORDER(^BCHR("AEX",BCH("DATE")))
IF BCH("DATE")=""!(BCH("DATE")>X)
QUIT
WRITE "."
KILL ^BCHR("AEX",BCH("DATE"))
+3 WRITE !,"OK ALL DONE",!
+4 QUIT
