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

BCHEXTAP.m

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