- 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