BCHEXTAP ; IHS/CMI/LAB - GENERATE TAPE OF CHR TRANSACTIONS ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
;
;
START ;EP
S BCH("QFLG")=0
D GETLOG
I BCH("RUN LOG")="" K BCH("RUN LOG") Q
D EN
K BCH("RUN LOG"),BCHS,BCH
Q
EN ;ENTRY POINT
D BASICS ; Do basic initialization
I BCH("QFLG") D EOJ Q
D TAPE
D EOJ
Q
;
GETLOG ;
S BCH("RUN LOG")=""
S DIC("S")="I $P(^BCHXLOG(Y,0),U,15)=""P""",DIC="^BCHXLOG(",DIC(0)="AEMQ" D ^DIC K DIC,DA
I Y<0 Q
S BCH("RUN LOG")=+Y
Q
BASICS ; SET VARIABLES, LOCK GLOBAL, INSURE DATA
K BCH("QUIT")
D:'$D(DUZ(2))#2 ^XBKVAR
S BCH("QFLG")=0,BCH("TAPE COUNT")=0
CHKSITE ; CHECK SITE FILE
I '$D(^BCHSITE(DUZ(2),0)) W:'$D(ZTQUEUED) !!,"*** Site file has not been setup! ***" S BCH("QFLG")=1 Q
I '$D(^BCHSITE(DUZ(2))) W:'$D(ZTQUEUED) !!,"*** RUN LOCATION not in SITE file!" S BCH("QFLG")=2 Q
;I $P(^BCHSITE(DUZ(2),0),U,8)="" W:'$D(ZTQUEUED) !!,"**NO METHOD OF EXPORT TO HEADQUARTERS DEFINED" S BCH("QFLG")=5 Q
;I $P(^BCHSITE(DUZ(2),0),U,8)="A",$P(^BCHSITE(DUZ(2),0),U,7)="" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S BCH("QFLG")=4 Q
;
Q:BCH("QFLG")
I '$D(^BCHRDATA) W:'$D(ZTQUEUED) !!,"*** No CHR transactions to send! ***" S BCH("QFLG")=28 Q
I '$D(^BCHRDATA(0)) W:'$D(ZTQUEUED) !!,"*** The Transaction process NEVER complete properly!!" S BCH("QFLG")=29 Q
L +^BCHRDATA:15 E W:'$D(ZTQUEUED) !!,"*** Unable to lock transaction global! ***" S BCH("QFLG")=30 Q
I $P(^BCHXLOG(BCH("RUN LOG"),0),U,15)'="P" W:'$D(ZTQUEUED) !!,$C(7),$C(7),"The Transaction Generation process never successfully completed!!",!! S BCH("QFLG")=31 Q
K BCH("QUIT")
S BCH("DEF DEVICE")="F"
CONT Q:$D(ZTQUEUED)
Q
Q:$P(^BCHSITE(DUZ(2),0),U,8)="Y"
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S BCH("QFLG")=99,BCH("QUIT")="" Q
I 'Y W !,"Transactions are NOT being written to an output device",! S BCH("QUIT")="",BCH("QFLG")=99 Q
Q
;
N ;network mail transmission
;strip off 1st ^ piece
Q
S X=0 F S X=$O(^BCHRDATA(X)) Q:X'=+X S ^BCHRDATA(X)=$P(^BCHRDATA(X),U,2)
S XMSUB="CHR DATA FROM "_$E($P(^DIC(4,DUZ(2),0),U),1,40)
S XMY("FILERMASTER@CHR.OMIL.GOV")="" ;******************this must be set appropriately
S XMTEXT="^BCHRDATA(",ZTQUEUED=1
D ENT^XMPG
Q
A ;AIB SAVE
S XBGL="BCHRDATA",XBMED=BCH("DEF DEVICE"),XBNAR="CHR FACILITY",XBTLE="CHR DATA TRANSMISSION TO HQ",XBFLT=1 ;IHS/CMI/LAB - new format
S XBS1="BCHR AUTO SEND"
D ^XBGSAVE
;I XBFLG=-1 S BCH("QUIT")="" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G EOJ
;S G=1
;I XBFLG'=0 D
;. I XBFLG(1)="" W:'$D(ZTQUEUED) !!,"CHR file successfully created",!! S G=1
;. I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,"CHR file NOT successfully created",!! S G=0
;. W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to the IHS CHR system",!,"you will need to manually ftp it.",!
;. W:'$D(ZTQUEUED) !,XBFLG(1),!!
;I 'G S BCH("QUIT")=""
Q
UPDLOG ;
;update log file .15 with date
K DR,DIE,DA S DIE="^BCHXLOG(",DR=".15///C",DA=BCH("RUN LOG") D CALLDIE^BCHUTIL
D EOJ
Q
;
EOJ ;
I 'BCH("QFLG"),'$D(BCH("QUIT")) K ^BCHRDATA ;UNSUBSCRIPTED GLOBALS ARE CMB STANDARD SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER - MUST BE KILLED
K BCHV("TX"),BCH("XX"),XBFLG,XBGL,XBMED,XBNAR,XBTLE,XBFLT
K DIC,D,D0,DQ,DIR,DO
Q
TAPE ;EP COPY TRANSACTIONS TO TAPE
K BCH("QUIT")
D BASICS
S BCH("MODE")="A"
D @(BCH("MODE"))
I BCH("QFLG") D EOJ Q
D UPDLOG
Q
BCHEXTAP ; IHS/CMI/LAB - GENERATE TAPE OF CHR TRANSACTIONS ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 ;
+4 ;
START ;EP
+1 SET BCH("QFLG")=0
+2 DO GETLOG
+3 IF BCH("RUN LOG")=""
KILL BCH("RUN LOG")
QUIT
+4 DO EN
+5 KILL BCH("RUN LOG"),BCHS,BCH
+6 QUIT
EN ;ENTRY POINT
+1 ; Do basic initialization
DO BASICS
+2 IF BCH("QFLG")
DO EOJ
QUIT
+3 DO TAPE
+4 DO EOJ
+5 QUIT
+6 ;
GETLOG ;
+1 SET BCH("RUN LOG")=""
+2 SET DIC("S")="I $P(^BCHXLOG(Y,0),U,15)=""P"""
SET DIC="^BCHXLOG("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
+3 IF Y<0
QUIT
+4 SET BCH("RUN LOG")=+Y
+5 QUIT
BASICS ; SET VARIABLES, LOCK GLOBAL, INSURE DATA
+1 KILL BCH("QUIT")
+2 IF '$DATA(DUZ(2))#2
DO ^XBKVAR
+3 SET BCH("QFLG")=0
SET BCH("TAPE COUNT")=0
CHKSITE ; CHECK SITE FILE
+1 IF '$DATA(^BCHSITE(DUZ(2),0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Site file has not been setup! ***"
SET BCH("QFLG")=1
QUIT
+2 IF '$DATA(^BCHSITE(DUZ(2)))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** RUN LOCATION not in SITE file!"
SET BCH("QFLG")=2
QUIT
+3 ;I $P(^BCHSITE(DUZ(2),0),U,8)="" W:'$D(ZTQUEUED) !!,"**NO METHOD OF EXPORT TO HEADQUARTERS DEFINED" S BCH("QFLG")=5 Q
+4 ;I $P(^BCHSITE(DUZ(2),0),U,8)="A",$P(^BCHSITE(DUZ(2),0),U,7)="" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S BCH("QFLG")=4 Q
+5 ;
+6 IF BCH("QFLG")
QUIT
+7 IF '$DATA(^BCHRDATA)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** No CHR transactions to send! ***"
SET BCH("QFLG")=28
QUIT
+8 IF '$DATA(^BCHRDATA(0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** The Transaction process NEVER complete properly!!"
SET BCH("QFLG")=29
QUIT
+9 LOCK +^BCHRDATA:15
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Unable to lock transaction global! ***"
SET BCH("QFLG")=30
QUIT
+10 IF $PIECE(^BCHXLOG(BCH("RUN LOG"),0),U,15)'="P"
IF '$DATA(ZTQUEUED)
WRITE !!,$CHAR(7),$CHAR(7),"The Transaction Generation process never successfully completed!!",!!
SET BCH("QFLG")=31
QUIT
+11 KILL BCH("QUIT")
+12 SET BCH("DEF DEVICE")="F"
CONT IF $DATA(ZTQUEUED)
QUIT
+1 QUIT
+2 IF $PIECE(^BCHSITE(DUZ(2),0),U,8)="Y"
QUIT
+3 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET BCH("QFLG")=99
SET BCH("QUIT")=""
QUIT
+5 IF 'Y
WRITE !,"Transactions are NOT being written to an output device",!
SET BCH("QUIT")=""
SET BCH("QFLG")=99
QUIT
+6 QUIT
+7 ;
N ;network mail transmission
+1 ;strip off 1st ^ piece
+2 QUIT
+3 SET X=0
FOR
SET X=$ORDER(^BCHRDATA(X))
IF X'=+X
QUIT
SET ^BCHRDATA(X)=$PIECE(^BCHRDATA(X),U,2)
+4 SET XMSUB="CHR DATA FROM "_$EXTRACT($PIECE(^DIC(4,DUZ(2),0),U),1,40)
+5 ;******************this must be set appropriately
SET XMY("FILERMASTER@CHR.OMIL.GOV")=""
+6 SET XMTEXT="^BCHRDATA("
SET ZTQUEUED=1
+7 DO ENT^XMPG
+8 QUIT
A ;AIB SAVE
+1 ;IHS/CMI/LAB - new format
SET XBGL="BCHRDATA"
SET XBMED=BCH("DEF DEVICE")
SET XBNAR="CHR FACILITY"
SET XBTLE="CHR DATA TRANSMISSION TO HQ"
SET XBFLT=1
+2 SET XBS1="BCHR AUTO SEND"
+3 DO ^XBGSAVE
+4 ;I XBFLG=-1 S BCH("QUIT")="" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G EOJ
+5 ;S G=1
+6 ;I XBFLG'=0 D
+7 ;. I XBFLG(1)="" W:'$D(ZTQUEUED) !!,"CHR file successfully created",!! S G=1
+8 ;. I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,"CHR file NOT successfully created",!! S G=0
+9 ;. W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to the IHS CHR system",!,"you will need to manually ftp it.",!
+10 ;. W:'$D(ZTQUEUED) !,XBFLG(1),!!
+11 ;I 'G S BCH("QUIT")=""
+12 QUIT
UPDLOG ;
+1 ;update log file .15 with date
+2 KILL DR,DIE,DA
SET DIE="^BCHXLOG("
SET DR=".15///C"
SET DA=BCH("RUN LOG")
DO CALLDIE^BCHUTIL
+3 DO EOJ
+4 QUIT
+5 ;
EOJ ;
+1 ;UNSUBSCRIPTED GLOBALS ARE CMB STANDARD SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER - MUST BE KILLED
IF 'BCH("QFLG")
IF '$DATA(BCH("QUIT"))
KILL ^BCHRDATA
+2 KILL BCHV("TX"),BCH("XX"),XBFLG,XBGL,XBMED,XBNAR,XBTLE,XBFLT
+3 KILL DIC,D,D0,DQ,DIR,DO
+4 QUIT
TAPE ;EP COPY TRANSACTIONS TO TAPE
+1 KILL BCH("QUIT")
+2 DO BASICS
+3 SET BCH("MODE")="A"
+4 DO @(BCH("MODE"))
+5 IF BCH("QFLG")
DO EOJ
QUIT
+6 DO UPDLOG
+7 QUIT
