AMHEYTAP ; IHS/CMI/LAB - GENERATE TAPE OF MHSS TRANSACTIONS ;
;;4.0;IHS BEHAVIORAL HEALTH;**3**;JUN 18, 2010;Build 10
;
;
; AMH("QFLG") values set by this routine:
; Value Meaning
; 0 All ok
; 1 Site file error (^AMHSCHK)
; 41 No MHSS transactions to send
; 30 Unable to lock transaction global
; 43 Device not ready or open error (^AMHOPEN)
; 44 Tape write error [DSM only]
; 45 Operator "^" or NULL out [DSM only] (^AMHOPEN)
; 46 Unable to determine Operating System
;
START ;
S AMH("QFLG")=0
D GETLOG
I AMH("RUN LOG")="" K AMH("RUN LOG") Q
D EN
K AMH("RUN LOG"),AMHS,AMH
Q
EN ;ENTRY POINT
D BASICS ; Do basic initialization
I AMH("QFLG") D EOJ Q
S XBGL="BHSXDATA",XBMED="F",XBNAR="BH FACILITY",XBTLE="BH DATA TRANSMISSION TO HQ"
K XBS1
S XBQ="N"
S Y=$P($G(^AMHSITE(DUZ(2),18)),U,10)
I Y="" S XBS1="AMH AUTO SEND",XBQ="Y"
I Y=1!(Y=3) S XBS1="AMH AUTO SEND"
I Y=2!(Y=3) S XBQ="Y"
D ^XBGSAVE
;I XBFLG=-1,$G(XBFLG(1))["uucp" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G COMP
;I XBFLG=-1 S AMH("QUIT")="" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G EOJ
;update log file .15 with date
COMP K DR,DIE,DA S DIE="^AMHXLOG(",DR=".15///C",DA=AMH("RUN LOG") D CALLDIE^AMHLEIN
D EOJ
Q
;
GETLOG ;
S AMH("RUN LOG")=""
S DIC("S")="I $P(^AMHXLOG(Y,0),U,15)=""P""",DIC="^AMHXLOG(",DIC(0)="AEMQ" D ^DIC K DIC,DA
I Y<0 Q
S AMH("RUN LOG")=+Y
Q
BASICS ; SET VARIABLES, LOCK GLOBAL, INSURE DATA
K AMH("QUIT")
D:'$D(DUZ(2))#2 ^XBKVAR
S AMH("QFLG")=0,AMH("TAPE COUNT")=0
CHKSITE ; CHECK SITE FILE
I '$D(^AMHSITE(DUZ(2),0)) W:'$D(ZTQUEUED) !!,"*** Site file has not been setup! ***" S AMH("QFLG")=1 Q
I '$D(^AMHSITE(DUZ(2))) W:'$D(ZTQUEUED) !!,"*** RUN LOCATION not in SITE file!" S AMH("QFLG")=2 Q
;
Q:AMH("QFLG")
I '$D(^BHSXDATA) W:'$D(ZTQUEUED) !!,"*** No MHSS transactions to send! ***" S AMH("QFLG")=28 Q
I '$D(^BHSXDATA(0)) W:'$D(ZTQUEUED) !!,"*** The Transaction process NEVER complete properly!!" S AMH("QFLG")=29 Q
L +^BHSXDATA:15 E W:'$D(ZTQUEUED) !!,"*** Unable to lock transaction global! ***" S AMH("QFLG")=30 Q
I $P(^AMHXLOG(AMH("RUN LOG"),0),U,15)'="P" W:'$D(ZTQUEUED) !!,$C(7),$C(7),"The Transaction Generation process never successfully completed!!",!! S AMH("QFLG")=31 Q
K AMH("QUIT")
W:'$D(ZTQUEUED) !,"The transactions will be written to a FILE"
CONT Q:$D(ZTQUEUED)
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT)!('Y) W !,"Transactions are NOT being written to an output device",! S AMH("QUIT")="",AMH("QFLG")=99 Q
Q
;
EOJ ;
I 'AMH("QFLG"),'$D(AMH("QUIT")) K ^BHSXDATA ;UNSUBSCRIPTED GLOBALS ARE CMB STANDARD SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER - MUST BE KILLED
K AMHV("TX"),AMH("XX"),XBFLG,XBGL,XBMED,XBNAR,XBTLE
K DIC,D,D0,DQ,DIR,DO
L -^BHSXDATA
Q
AMHEYTAP ; IHS/CMI/LAB - GENERATE TAPE OF MHSS TRANSACTIONS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**3**;JUN 18, 2010;Build 10
+2 ;
+3 ;
+4 ; AMH("QFLG") values set by this routine:
+5 ; Value Meaning
+6 ; 0 All ok
+7 ; 1 Site file error (^AMHSCHK)
+8 ; 41 No MHSS transactions to send
+9 ; 30 Unable to lock transaction global
+10 ; 43 Device not ready or open error (^AMHOPEN)
+11 ; 44 Tape write error [DSM only]
+12 ; 45 Operator "^" or NULL out [DSM only] (^AMHOPEN)
+13 ; 46 Unable to determine Operating System
+14 ;
START ;
+1 SET AMH("QFLG")=0
+2 DO GETLOG
+3 IF AMH("RUN LOG")=""
KILL AMH("RUN LOG")
QUIT
+4 DO EN
+5 KILL AMH("RUN LOG"),AMHS,AMH
+6 QUIT
EN ;ENTRY POINT
+1 ; Do basic initialization
DO BASICS
+2 IF AMH("QFLG")
DO EOJ
QUIT
+3 SET XBGL="BHSXDATA"
SET XBMED="F"
SET XBNAR="BH FACILITY"
SET XBTLE="BH DATA TRANSMISSION TO HQ"
+4 KILL XBS1
+5 SET XBQ="N"
+6 SET Y=$PIECE($GET(^AMHSITE(DUZ(2),18)),U,10)
+7 IF Y=""
SET XBS1="AMH AUTO SEND"
SET XBQ="Y"
+8 IF Y=1!(Y=3)
SET XBS1="AMH AUTO SEND"
+9 IF Y=2!(Y=3)
SET XBQ="Y"
+10 DO ^XBGSAVE
+11 ;I XBFLG=-1,$G(XBFLG(1))["uucp" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G COMP
+12 ;I XBFLG=-1 S AMH("QUIT")="" W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) G EOJ
+13 ;update log file .15 with date
COMP KILL DR,DIE,DA
SET DIE="^AMHXLOG("
SET DR=".15///C"
SET DA=AMH("RUN LOG")
DO CALLDIE^AMHLEIN
+1 DO EOJ
+2 QUIT
+3 ;
GETLOG ;
+1 SET AMH("RUN LOG")=""
+2 SET DIC("S")="I $P(^AMHXLOG(Y,0),U,15)=""P"""
SET DIC="^AMHXLOG("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
+3 IF Y<0
QUIT
+4 SET AMH("RUN LOG")=+Y
+5 QUIT
BASICS ; SET VARIABLES, LOCK GLOBAL, INSURE DATA
+1 KILL AMH("QUIT")
+2 IF '$DATA(DUZ(2))#2
DO ^XBKVAR
+3 SET AMH("QFLG")=0
SET AMH("TAPE COUNT")=0
CHKSITE ; CHECK SITE FILE
+1 IF '$DATA(^AMHSITE(DUZ(2),0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Site file has not been setup! ***"
SET AMH("QFLG")=1
QUIT
+2 IF '$DATA(^AMHSITE(DUZ(2)))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** RUN LOCATION not in SITE file!"
SET AMH("QFLG")=2
QUIT
+3 ;
+4 IF AMH("QFLG")
QUIT
+5 IF '$DATA(^BHSXDATA)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** No MHSS transactions to send! ***"
SET AMH("QFLG")=28
QUIT
+6 IF '$DATA(^BHSXDATA(0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** The Transaction process NEVER complete properly!!"
SET AMH("QFLG")=29
QUIT
+7 LOCK +^BHSXDATA:15
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Unable to lock transaction global! ***"
SET AMH("QFLG")=30
QUIT
+8 IF $PIECE(^AMHXLOG(AMH("RUN LOG"),0),U,15)'="P"
IF '$DATA(ZTQUEUED)
WRITE !!,$CHAR(7),$CHAR(7),"The Transaction Generation process never successfully completed!!",!!
SET AMH("QFLG")=31
QUIT
+9 KILL AMH("QUIT")
+10 IF '$DATA(ZTQUEUED)
WRITE !,"The transactions will be written to a FILE"
CONT IF $DATA(ZTQUEUED)
QUIT
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)!('Y)
WRITE !,"Transactions are NOT being written to an output device",!
SET AMH("QUIT")=""
SET AMH("QFLG")=99
QUIT
+3 QUIT
+4 ;
EOJ ;
+1 ;UNSUBSCRIPTED GLOBALS ARE CMB STANDARD SCRATCH GLOBALS FOR TRANSMITTING DATA TO DATA CENTER - MUST BE KILLED
IF 'AMH("QFLG")
IF '$DATA(AMH("QUIT"))
KILL ^BHSXDATA
+2 KILL AMHV("TX"),AMH("XX"),XBFLG,XBGL,XBMED,XBNAR,XBTLE
+3 KILL DIC,D,D0,DQ,DIR,DO
+4 LOCK -^BHSXDATA
+5 QUIT
