AMHEXDI2.m

AMHEXDI2 ; IHS/CMI/LAB - OHPRD-TUCSON/EDE AMHDR SPECIFIC INITIALIZATION AUGUST 14, 1992 ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

START ;

 D INFORM^AMHEXDI3 ;      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^AMHEXDI3 ;      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(^AMHSDATA) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^AMHSDATA 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

 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

 ;

 W $C(7),$C(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last PCC 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

 ;

 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

 ;

 W $C(7),$C(7),!!,"PCC Data Transmission is currently running!!"

 Q

QERR ;

 S AMH("QFLG")=16

 ;

 W !!,$C(7),$C(7),"PCC Data Transmission is already queued to run!!"

 Q

FERR ;

 S AMH("QFLG")=17

 ;

 W !!,$C(7),$C(7),"The last PCC 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

 ;

 S AMHV("R DATE")=AMH("RUN BEGIN")-1

 S AMHV("R DATE")=$O(^AMHREC("AEX",AMHV("R DATE")))

 I AMHV("R DATE")=""!(AMHV("R DATE")>AMH("RUN END")) W:'$D(ZTQUEUED) !!,"*** No MHSS RECORDs within range! ***" S AMH("QFLG")=22 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 ^AMHSDATA ;TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS

 Q

AMHEXDI2  ; 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^AMHEXDI3

 +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^AMHEXDI3

 +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(^AMHSDATA)

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"*** WARNING *** ^AMHSDATA 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        QUIT 

 +5       ;

 +6       ;

 +7       ;

 +8       ;

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        SET X=$SELECT(AMH("LAST LOG")&($DATA(^AMHXLOG(AMH("LAST LOG")))):AMH("LAST LOG"),1:0)

           FOR 

               SET X=$ORDER(^AMHXLOG(X))

               IF X'=+X

                   QUIT 

               SET 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        WRITE $CHAR(7),$CHAR(7),!!,"*****ERROR ENCOUNTERED*****",!,"The last PCC Data Export never successfully completed to end of job!!!",!,"This must be resolved before any other exports can be done.",!

 +4        QUIT 

PERR      ;

 +1        SET AMH("QFLG")=14

 +2       ;

 +3        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).",!

 +4        WRITE !,"You must execute the menu option called 'OUTP (OUTPUT)' before any further",!,"processing."

 +5        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.",!

 +6        QUIT 

RERR      ;

 +1        SET AMH("QFLG")=15

 +2       ;

 +3        WRITE $CHAR(7),$CHAR(7),!!,"PCC Data Transmission is currently running!!"

 +4        QUIT 

QERR      ;

 +1        SET AMH("QFLG")=16

 +2       ;

 +3        WRITE !!,$CHAR(7),$CHAR(7),"PCC Data Transmission is already queued to run!!"

 +4        QUIT 

FERR      ;

 +1        SET AMH("QFLG")=17

 +2       ;

 +3        WRITE !!,$CHAR(7),$CHAR(7),"The last PCC Export failed and has never been reset.",!,"See your site manager for assistence",!

 +4        QUIT 

 +5       ;

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        SET AMHV("R DATE")=AMH("RUN BEGIN")-1

 +7        SET AMHV("R DATE")=$ORDER(^AMHREC("AEX",AMHV("R DATE")))

 +8        IF AMHV("R DATE")=""!(AMHV("R DATE")>AMH("RUN END"))

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"*** No MHSS RECORDs within range! ***"

               SET AMH("QFLG")=22

               QUIT 

 +9        QUIT 

 +10      ;

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 ^AMHSDATA

 +8        QUIT