AMHEXTAP ; IHS/CMI/LAB - GENERATE TAPE OF MHSS TRANSACTIONS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
; 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="AMHSDATA",XBMED="F",XBNAR="MHSS FACILITY",XBTLE="MHSS DATA TRANSMISSION TO HQ"
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
;I $P(^AMHSITE(DUZ(2),0),U,7)="" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S AMH("QFLG")=4 Q
;
Q:AMH("QFLG")
I '$D(^AMHSDATA) W:'$D(ZTQUEUED) !!,"*** No MHSS transactions to send! ***" S AMH("QFLG")=28 Q
I '$D(^AMHSDATA(0)) W:'$D(ZTQUEUED) !!,"*** The Transaction process NEVER complete properly!!" S AMH("QFLG")=29 Q
L +^AMHSDATA: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")
;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,7)
;I AMH("DEF DEVICE")="" W:'$D(ZTQUEUED) !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$C(7),$C(7) S AMH("QFLG")=4 Q
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 ^AMHSDATA ;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
Q
AMHEXTAP ; IHS/CMI/LAB - GENERATE TAPE OF MHSS TRANSACTIONS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+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="AMHSDATA"
SET XBMED="F"
SET XBNAR="MHSS FACILITY"
SET XBTLE="MHSS DATA TRANSMISSION TO HQ"
+4 DO ^XBGSAVE
+5 IF XBFLG=-1
IF $GET(XBFLG(1))["uucp"
IF '$DATA(ZTQUEUED)
WRITE !,$CHAR(7),$CHAR(7),XBFLG(1)
GOTO COMP
+6 IF XBFLG=-1
SET AMH("QUIT")=""
IF '$DATA(ZTQUEUED)
WRITE !,$CHAR(7),$CHAR(7),XBFLG(1)
GOTO EOJ
+7 ;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 ;I $P(^AMHSITE(DUZ(2),0),U,7)="" W:'$D(ZTQUEUED) !!,"***No DEFAULT DEVICE value in Site file! ***" S AMH("QFLG")=4 Q
+4 ;
+5 IF AMH("QFLG")
QUIT
+6 IF '$DATA(^AMHSDATA)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** No MHSS transactions to send! ***"
SET AMH("QFLG")=28
QUIT
+7 IF '$DATA(^AMHSDATA(0))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** The Transaction process NEVER complete properly!!"
SET AMH("QFLG")=29
QUIT
+8 LOCK +^AMHSDATA:15
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Unable to lock transaction global! ***"
SET AMH("QFLG")=30
QUIT
+9 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
+10 KILL AMH("QUIT")
+11 ;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,7)
+12 ;I AMH("DEF DEVICE")="" W:'$D(ZTQUEUED) !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$C(7),$C(7) S AMH("QFLG")=4 Q
+13 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 ^AMHSDATA
+2 KILL AMHV("TX"),AMH("XX"),XBFLG,XBGL,XBMED,XBNAR,XBTLE
+3 KILL DIC,D,D0,DQ,DIR,DO
+4 LOCK
+5 QUIT
