AMHEYDI2 ; IHS/CMI/LAB - OHPRD-TUCSON/EDE AMHDR SPECIFIC INITIALIZATION AUGUST 14, 1992 ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;
D INFORM^AMHEYDI3 ; Let operator know what is going on.
D GETLOG ; Get last log entry and display data.
Q:AMH("QFLG")
D CHKOLD
Q:AMH("QFLG")
D CURRUN^AMHEYDI3 ; Compute run dates for current run.
Q:AMH("QFLG")
D CHKMHSS ; Check MHSS RECORD xref for date range
Q:AMH("QFLG")
D CONFIRM ; Get ok from operator.
Q:AMH("QFLG")
D GENLOG ; Generate new log entry.
Q
;
CHKOLD ;EP - CHECK FOR DATA LEFT BY OLD RUN
I $D(^BHSXDATA) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^BHSXDATA global exists from a previous GEN or REDO!!" S AMH("QFLG")=32
I $D(^XTMP("AMHDR")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!!," S AMH("QFLG")=10
I $D(^XTMP("AMHREDO")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous REDO!!" S AMH("QFLG")=11
I $D(^XTMP("AMHSF")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!!" S AMH("QFLG")=11
Q
;
;
GETLOG ;EP GET LAST LOG ENTRY
S (X,AMH("LAST LOG"))=$P(^AMHXLOG(0),U,3) F S X=$O(^AMHXLOG(X)) Q:X'=+X S AMH("LAST LOG")=X
;S X=$S(AMH("LAST LOG")&($D(^AMHXLOG(AMH("LAST LOG")))):AMH("LAST LOG"),1:0) F S X=$O(^AMHXLOG(X)) Q:X'=+X S AMH("LAST LOG")=X
Q:'AMH("LAST LOG")
D DISPLOG
Q:$P(^AMHXLOG(AMH("LAST LOG"),0),U,15)="C"
D ERROR
Q
ERROR ;
S AMH("QFLG")=12
S AMH("PREV STATUS")=$P(^AMHXLOG(AMH("LAST LOG"),0),U,15)
I AMH("PREV STATUS")="" D EERR Q
D @(AMH("PREV STATUS")_"ERR") Q
Q
EERR ;
S AMH("QFLG")=13
;
Q:$D(ZTQUEUED)
W $C(7),$C(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last BH Data Export never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!
Q
PERR ;
S AMH("QFLG")=14
;
Q:$D(ZTQUEUED)
W !!,$C(7),$C(7),"*****ERROR ENCOUNTERED*****",!,"Whoa! The Transaction global from the previous run was NEVER successfully",!,"written to an output device (unix uucppublic file, cartridge, diskette).",!
W !,"You must execute the menu option called 'OUTP (OUTPUT)' before any further",!,"processing."
W !,"You may also need to determine whether or not the transaction global for ",!,"LOG ENTRY ",AMH("LAST LOG")," was ever received by your Area Office.",!
Q
RERR ;
S AMH("QFLG")=15
;
Q:$D(ZTQUEUED)
W $C(7),$C(7),!!,"BH Data Transmission is currently running!!"
Q
QERR ;
S AMH("QFLG")=16
;
Q:$D(ZTQUEUED)
W !!,$C(7),$C(7),"BH Data Transmission is already queued to run!!"
Q
FERR ;
S AMH("QFLG")=17
;
Q:$D(ZTQUEUED)
W !!,$C(7),$C(7),"The last BH Export failed and has never been reset.",!,"See your site manager for assistence",!
Q
;
DISPLOG ; DISPLAY LAST LOG DATA
S Y=$P(^AMHXLOG(AMH("LAST LOG"),0),U) X ^DD("DD") S AMH("LAST BEGIN")=Y S Y=$P(^AMHXLOG(AMH("LAST LOG"),0),U,2) X ^DD("DD") S AMH("LAST END")=Y
Q:$D(ZTQUEUED)
W !!,"Last run was for ",AMH("LAST BEGIN")," through ",AMH("LAST END"),"."
Q
;
;
CHKMHSS ; CHECK MHSS RECORD "AEX" XREF
S AMHV("R DATE")=0
S AMHV("R DATE")=$O(^AMHREC("AEX",AMHV("R DATE")))
S AMHV("R DATE")=$O(^AMHREC("AEX",0))
I AMHV("R DATE"),AMHV("R DATE")<AMH("RUN BEGIN") W:'$D(ZTQUEUED) !!,"*** Cross-references exist prior to beginning of date range! ***" S AMH("QFLG")=21 Q
;
Q
;
CONFIRM ; SEE IF THEY REALLY WANT TO DO THIS
Q:$D(ZTQUEUED)
W !,"The location for this run is ",$P(^DIC(4,DUZ(2),0),U),"."
CFLP ;
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" K DA D ^DIR K DIR
I $D(DIRUT)!('Y) S AMH("QFLG")=99 Q
Q
;
GENLOG ; GENERATE NEW LOG ENTRY
W:'$D(ZTQUEUED) !,"Generating New Log entry.."
K DIC,DA,DR,DLAYGO,DINUM,DD,X
S Y=AMH("RUN BEGIN") X ^DD("DD") S X=""""_Y_"""",DIC="^AMHXLOG(",DIC(0)="L",DLAYGO=9002014,DIC("DR")=".02////"_AMH("RUN END")_";.09///`"_DUZ(2)
D ^DIC K DIC,DLAYGO,DR
I Y<0 S AMH("QFLG")=23 Q
S AMH("RUN LOG")=+Y
K ^BHSXDATA ;TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
Q
AMHEYDI2 ; IHS/CMI/LAB - OHPRD-TUCSON/EDE AMHDR SPECIFIC INITIALIZATION AUGUST 14, 1992 ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;
+1 ; Let operator know what is going on.
DO INFORM^AMHEYDI3
+2 ; Get last log entry and display data.
DO GETLOG
+3 IF AMH("QFLG")
QUIT
+4 DO CHKOLD
+5 IF AMH("QFLG")
QUIT
+6 ; Compute run dates for current run.
DO CURRUN^AMHEYDI3
+7 IF AMH("QFLG")
QUIT
+8 ; Check MHSS RECORD xref for date range
DO CHKMHSS
+9 IF AMH("QFLG")
QUIT
+10 ; Get ok from operator.
DO CONFIRM
+11 IF AMH("QFLG")
QUIT
+12 ; Generate new log entry.
DO GENLOG
+13 QUIT
+14 ;
CHKOLD ;EP - CHECK FOR DATA LEFT BY OLD RUN
+1 IF $DATA(^BHSXDATA)
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^BHSXDATA global exists from a previous GEN or REDO!!"
SET AMH("QFLG")=32
+2 IF $DATA(^XTMP("AMHDR"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!!,"
SET AMH("QFLG")=10
+3 IF $DATA(^XTMP("AMHREDO"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^XTMP nodes exist from previous REDO!!"
SET AMH("QFLG")=11
+4 IF $DATA(^XTMP("AMHSF"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!!"
SET AMH("QFLG")=11
+5 QUIT
+6 ;
+7 ;
GETLOG ;EP GET LAST LOG ENTRY
+1 SET (X,AMH("LAST LOG"))=$PIECE(^AMHXLOG(0),U,3)
FOR
SET X=$ORDER(^AMHXLOG(X))
IF X'=+X
QUIT
SET AMH("LAST LOG")=X
+2 ;S X=$S(AMH("LAST LOG")&($D(^AMHXLOG(AMH("LAST LOG")))):AMH("LAST LOG"),1:0) F S X=$O(^AMHXLOG(X)) Q:X'=+X S AMH("LAST LOG")=X
+3 IF 'AMH("LAST LOG")
QUIT
+4 DO DISPLOG
+5 IF $PIECE(^AMHXLOG(AMH("LAST LOG"),0),U,15)="C"
QUIT
+6 DO ERROR
+7 QUIT
ERROR ;
+1 SET AMH("QFLG")=12
+2 SET AMH("PREV STATUS")=$PIECE(^AMHXLOG(AMH("LAST LOG"),0),U,15)
+3 IF AMH("PREV STATUS")=""
DO EERR
QUIT
+4 DO @(AMH("PREV STATUS")_"ERR")
QUIT
+5 QUIT
EERR ;
+1 SET AMH("QFLG")=13
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE $CHAR(7),$CHAR(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last BH Data Export never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!
+5 QUIT
PERR ;
+1 SET AMH("QFLG")=14
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE !!,$CHAR(7),$CHAR(7),"*****ERROR ENCOUNTERED*****",!,"Whoa! The Transaction global from the previous run was NEVER successfully",!,"written to an output device (unix uucppublic file, cartridge, diskette).",!
+5 WRITE !,"You must execute the menu option called 'OUTP (OUTPUT)' before any further",!,"processing."
+6 WRITE !,"You may also need to determine whether or not the transaction global for ",!,"LOG ENTRY ",AMH("LAST LOG")," was ever received by your Area Office.",!
+7 QUIT
RERR ;
+1 SET AMH("QFLG")=15
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE $CHAR(7),$CHAR(7),!!,"BH Data Transmission is currently running!!"
+5 QUIT
QERR ;
+1 SET AMH("QFLG")=16
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE !!,$CHAR(7),$CHAR(7),"BH Data Transmission is already queued to run!!"
+5 QUIT
FERR ;
+1 SET AMH("QFLG")=17
+2 ;
+3 IF $DATA(ZTQUEUED)
QUIT
+4 WRITE !!,$CHAR(7),$CHAR(7),"The last BH Export failed and has never been reset.",!,"See your site manager for assistence",!
+5 QUIT
+6 ;
DISPLOG ; DISPLAY LAST LOG DATA
+1 SET Y=$PIECE(^AMHXLOG(AMH("LAST LOG"),0),U)
XECUTE ^DD("DD")
SET AMH("LAST BEGIN")=Y
SET Y=$PIECE(^AMHXLOG(AMH("LAST LOG"),0),U,2)
XECUTE ^DD("DD")
SET AMH("LAST END")=Y
+2 IF $DATA(ZTQUEUED)
QUIT
+3 WRITE !!,"Last run was for ",AMH("LAST BEGIN")," through ",AMH("LAST END"),"."
+4 QUIT
+5 ;
+6 ;
CHKMHSS ; CHECK MHSS RECORD "AEX" XREF
+1 SET AMHV("R DATE")=0
+2 SET AMHV("R DATE")=$ORDER(^AMHREC("AEX",AMHV("R DATE")))
+3 SET AMHV("R DATE")=$ORDER(^AMHREC("AEX",0))
+4 IF AMHV("R DATE")
IF AMHV("R DATE")<AMH("RUN BEGIN")
IF '$DATA(ZTQUEUED)
WRITE !!,"*** Cross-references exist prior to beginning of date range! ***"
SET AMH("QFLG")=21
QUIT
+5 ;
+6 QUIT
+7 ;
CONFIRM ; SEE IF THEY REALLY WANT TO DO THIS
+1 IF $DATA(ZTQUEUED)
QUIT
+2 WRITE !,"The location for this run is ",$PIECE(^DIC(4,DUZ(2),0),U),"."
CFLP ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)!('Y)
SET AMH("QFLG")=99
QUIT
+3 QUIT
+4 ;
GENLOG ; GENERATE NEW LOG ENTRY
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating New Log entry.."
+2 KILL DIC,DA,DR,DLAYGO,DINUM,DD,X
+3 SET Y=AMH("RUN BEGIN")
XECUTE ^DD("DD")
SET X=""""_Y_""""
SET DIC="^AMHXLOG("
SET DIC(0)="L"
SET DLAYGO=9002014
SET DIC("DR")=".02////"_AMH("RUN END")_";.09///`"_DUZ(2)
+4 DO ^DIC
KILL DIC,DLAYGO,DR
+5 IF Y<0
SET AMH("QFLG")=23
QUIT
+6 SET AMH("RUN LOG")=+Y
+7 ;TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
KILL ^BHSXDATA
+8 QUIT
