AMHEYTAP.m

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