AMHEXD.m

AMHEXD ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ;

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

START ;

 Q

 I $D(ZTQUEUED) S AMHO("SCHEDULED")=""

 S AMHO("RUN")="NEW" ;      Let AMHEXDI know this is a new run.

 D ^AMHEXDI ;           Do initialization

 I $D(AMHO("QUEUE")) D EOJ W !!,"Okay, your request is queued!  Bye",! Q

 I AMH("QFLG")=99 D EOJ W !!,"Bye",!! Q

 I AMH("QFLG") D ABORT Q

DRIVER ;called from TSKMN+2

 S AMH("BT")=$H

 D NOW^%DTC S AMH("RUN START")=%,AMH("MAIN TX DATE")=$P(%,".") K %,%H,%I

 S DIE="^AMHXLOG(",DA=AMH("RUN LOG"),DR=".15///R"_";.03////"_AMH("RUN START") D CALLDIE^AMHLEIN

 I $D(Y) D ABORT Q

 S AMHCNT=$S('$D(ZTQUEUED):"X AMHCNT1  X AMHCNT2",1:"S AMHCNTR=AMHCNTR+1"),AMHCNT1="F AMHCNTL=1:1:$L(AMHCNTR)+1 W @AMHBS",AMHCNT2="S AMHCNTR=AMHCNTR+1 W AMHCNTR,"")"""

 D PROCESS ;            Generate trasactions

 I AMH("QFLG") D ABORT Q

 D ^AMHEXLOG ;                Update Log

 I AMH("QFLG") D ABORT Q

 D PURGE ;              Purge AEX xref entries

 D RUNTIME^AMHEXEOJ ;            Show run time

 L

 D TAPE ; Write transactions to tape

 I AMH("QFLG") D ABORT Q

 ;D:'$D(ZTQUEUED) CHKLOG ;             See if Log needs cleaning

 I '$D(ZTQUEUED) W !! S DIR(0)="E",DIR("A")="DONE  --  Press ENTER to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 D EOJ

 Q

 ;

PROCESS ;

 W:'$D(ZTQUEUED) !,"Generating transactions.  Counting records.  (1)"

 S AMHCNTR=0,AMH("CONTROL DATE")=AMH("RUN BEGIN")-1,AMH("T-INIT")="  ",AMH("POSTING DATE")="      "

 F  S AMH("CONTROL DATE")=$O(^AMHREC("AEX",AMH("CONTROL DATE"))) Q:AMH("CONTROL DATE")=""!(AMH("CONTROL DATE")>AMH("RUN END"))  D PROCESS2 Q:AMH("QFLG")

 Q

PROCESS2 ;

 S AMHR="" F  S AMHR=$O(^AMHREC("AEX",AMH("CONTROL DATE"),AMHR)) Q:AMHR=""  D PROCESS3 Q:AMH("QFLG")

 Q

PROCESS3 ;

 K AMHT,AMHV,AMHE

 D KILL^AUPNPAT

 Q:$D(^AMHXLOG(AMH("RUN LOG"),21,AMHR))

 S AMHV("TX GENERATED")=0,^XTMP("AMHDR",AMH("CONTROL DATE"),AMHR)="",^XTMP("AMHDR","MAIN TX",AMHR)=""

 X AMHCNT

 S AMHREC=^AMHREC(AMHR,0)

 S AMHV("R DATE")=+AMHREC\1

 K AMHE,AMHTX D RECORD^AMHEXD2

 D CNTBUILD

 D ^XBFMK

 S DA=AMH("RUN LOG"),DR="2101///""`"_AMHR_"""",DIE="^AMHXLOG("

 S DR(2,9002014.2101)=".02////"_AMHV("TX GENERATED")_";.03///"_$E(AMHTX)

 D CALLDIE^AMHLEIN

 Q

 ;

PURGE ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE

 W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"

 S AMHCNTR=0,AMHV("R DATE")=""

 F  S AMHV("R DATE")=$O(^XTMP("AMHDR",AMHV("R DATE"))) Q:AMHV("R DATE")'=+AMHV("R DATE")  D PURGE2

 K ^XTMP("AMHDR"),^XTMP("AMHDR")

 Q

PURGE2 ;

 S AMHR="" F  S AMHR=$O(^XTMP("AMHDR",AMHV("R DATE"),AMHR)) Q:AMHR=""  D RESET

 Q

 ;

RESET ; kill MHSS xref and set flag if tx 23 or 24 generated

 K ^AMHREC("AEX",AMHV("R DATE"),AMHR)

 I ^XTMP("AMHDR","MAIN TX",AMHR)]"" S DIE="^AMHREC(",DA=AMHR,DR=".24///"_^XTMP("AMHDR","MAIN TX",AMHR)_";.22///@" D CALLDIE^AMHLEIN

 X AMHCNT

 Q

 ;

 ;

CNTBUILD ;count and build tx

 I AMHE]"" S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1 D ^AMHEXERR Q

 S AMH("COUNT")=AMH("COUNT")+1

 S AMHV("TX GENERATED")=1,^XTMP("AMH"_$S(AMHO("RUN")="NEW":"DR",AMHO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",AMHR)=AMH("MAIN TX DATE")

 S AMH($E(AMHTX))=AMH($E(AMHTX))+1

 S ^AMHSDATA(AMH("COUNT"))="MH^"_AMHTX

 Q

TAPE ; COPY TRANSACTIONS TO TAPE

 ;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

 D EN^AMHEXTAP I $D(ZTQUEUED),AMH("QFLG") D ERRBULL^AMHEXDI3

 ;Q:AMH("DEF DEVICE")="F"

 ;Q:AMH("QFLG")

 ;Q:$D(ZTQUEUED)

 ;S DIR(0)="Y",DIR("A")="Do you want to write the MHSS transactions to an output device",DIR("B")="N" K DA D ^DIR K DIR

 ;Q:$D(DIRUT)

 ;Q:'Y

 ;I Y=1 S AMH("AMHTAPE")="" D EN^AMHEXTAP

 ;I AMH("QFLG")=99 S AMH("QFLG")=0

 Q

 ;

CHKLOG ; CHECK LOG FILE

 Q

 S AMH("X")=0 F AMH("I")=AMH("RUN LOG"):-1:1 Q:'$D(^AMHXLOG(AMH("I")))  I $O(^AMHXLOG(AMH("I"),21,0)) S AMH("X")=AMH("X")+1

 I AMH("X")>12 W !,"-->There are more than twelve generations of MHSS RECORDs stored in the LOG file.",!,"-->Time to do a purge."

 Q

 ;

ABORT ; ABNORMAL TERMINATION

 I $D(AMH("RUN LOG")) S AMH("QFLG1")=$O(^AMHDTER("B",AMH("QFLG"),"")),DA=AMH("RUN LOG"),DIE="^AMHXLOG(",DR=".15///F;.16////"_AMH("QFLG1")

 I $D(ZTQUEUED) D ERRBULL^AMHEXDI3,EOJ Q

 W !!,"Abnormal termination!!  QFLG=",AMH("QFLG")

 S DIR(0)="E",DIR("A")="DONE  --  Press ENTER to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 D EOJ

 Q

 ;

EOJ ; EOJ

 D ^AMHEXEOJ

 Q

AMHEXD    ; IHS/CMI/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ;

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

START     ;

 +1        QUIT 

 +2        IF $DATA(ZTQUEUED)

               SET AMHO("SCHEDULED")=""

 +3       ;      Let AMHEXDI know this is a new run.

           SET AMHO("RUN")="NEW"

 +4       ;           Do initialization

           DO ^AMHEXDI

 +5        IF $DATA(AMHO("QUEUE"))

               DO EOJ

               WRITE !!,"Okay, your request is queued!  Bye",!

               QUIT 

 +6        IF AMH("QFLG")=99

               DO EOJ

               WRITE !!,"Bye",!!

               QUIT 

 +7        IF AMH("QFLG")

               DO ABORT

               QUIT 

DRIVER    ;called from TSKMN+2

 +1        SET AMH("BT")=$HOROLOG

 +2        DO NOW^%DTC

           SET AMH("RUN START")=%

           SET AMH("MAIN TX DATE")=$PIECE(%,".")

           KILL %,%H,%I

 +3        SET DIE="^AMHXLOG("

           SET DA=AMH("RUN LOG")

           SET DR=".15///R"_";.03////"_AMH("RUN START")

           DO CALLDIE^AMHLEIN

 +4        IF $DATA(Y)

               DO ABORT

               QUIT 

 +5        SET AMHCNT=$SELECT('$DATA(ZTQUEUED):"X AMHCNT1  X AMHCNT2",1:"S AMHCNTR=AMHCNTR+1")

           SET AMHCNT1="F AMHCNTL=1:1:$L(AMHCNTR)+1 W @AMHBS"

           SET AMHCNT2="S AMHCNTR=AMHCNTR+1 W AMHCNTR,"")"""

 +6       ;            Generate trasactions

           DO PROCESS

 +7        IF AMH("QFLG")

               DO ABORT

               QUIT 

 +8       ;                Update Log

           DO ^AMHEXLOG

 +9        IF AMH("QFLG")

               DO ABORT

               QUIT 

 +10      ;              Purge AEX xref entries

           DO PURGE

 +11      ;            Show run time

           DO RUNTIME^AMHEXEOJ

 +12       LOCK 

 +13      ; Write transactions to tape

           DO TAPE

 +14       IF AMH("QFLG")

               DO ABORT

               QUIT 

 +15      ;D:'$D(ZTQUEUED) CHKLOG ;             See if Log needs cleaning

 +16       IF '$DATA(ZTQUEUED)

               WRITE !!

               SET DIR(0)="E"

               SET DIR("A")="DONE  --  Press ENTER to Continue"

               DO ^DIR

               KILL DIR

               IF $DATA(DUOUT)

                   SET DIRUT=1

 +17       DO EOJ

 +18       QUIT 

 +19      ;

PROCESS   ;

 +1        IF '$DATA(ZTQUEUED)

               WRITE !,"Generating transactions.  Counting records.  (1)"

 +2        SET AMHCNTR=0

           SET AMH("CONTROL DATE")=AMH("RUN BEGIN")-1

           SET AMH("T-INIT")="  "

           SET AMH("POSTING DATE")="      "

 +3        FOR 

               SET AMH("CONTROL DATE")=$ORDER(^AMHREC("AEX",AMH("CONTROL DATE")))

               IF AMH("CONTROL DATE")=""!(AMH("CONTROL DATE")>AMH("RUN END"))

                   QUIT 

               DO PROCESS2

               IF AMH("QFLG")

                   QUIT 

 +4        QUIT 

PROCESS2  ;

 +1        SET AMHR=""

           FOR 

               SET AMHR=$ORDER(^AMHREC("AEX",AMH("CONTROL DATE"),AMHR))

               IF AMHR=""

                   QUIT 

               DO PROCESS3

               IF AMH("QFLG")

                   QUIT 

 +2        QUIT 

PROCESS3  ;

 +1        KILL AMHT,AMHV,AMHE

 +2        DO KILL^AUPNPAT

 +3        IF $DATA(^AMHXLOG(AMH("RUN LOG"),21,AMHR))

               QUIT 

 +4        SET AMHV("TX GENERATED")=0

           SET ^XTMP("AMHDR",AMH("CONTROL DATE"),AMHR)=""

           SET ^XTMP("AMHDR","MAIN TX",AMHR)=""

 +5        XECUTE AMHCNT

 +6        SET AMHREC=^AMHREC(AMHR,0)

 +7        SET AMHV("R DATE")=+AMHREC\1

 +8        KILL AMHE,AMHTX

           DO RECORD^AMHEXD2

 +9        DO CNTBUILD

 +10       DO ^XBFMK

 +11       SET DA=AMH("RUN LOG")

           SET DR="2101///""`"_AMHR_""""

           SET DIE="^AMHXLOG("

 +12       SET DR(2,9002014.2101)=".02////"_AMHV("TX GENERATED")_";.03///"_$EXTRACT(AMHTX)

 +13       DO CALLDIE^AMHLEIN

 +14       QUIT 

 +15      ;

PURGE     ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE

 +1        IF '$DATA(ZTQUEUED)

               WRITE !,"Deleting cross-reference entries. (1)"

 +2        SET AMHCNTR=0

           SET AMHV("R DATE")=""

 +3        FOR 

               SET AMHV("R DATE")=$ORDER(^XTMP("AMHDR",AMHV("R DATE")))

               IF AMHV("R DATE")'=+AMHV("R DATE")

                   QUIT 

               DO PURGE2

 +4        KILL ^XTMP("AMHDR"),^XTMP("AMHDR")

 +5        QUIT 

PURGE2    ;

 +1        SET AMHR=""

           FOR 

               SET AMHR=$ORDER(^XTMP("AMHDR",AMHV("R DATE"),AMHR))

               IF AMHR=""

                   QUIT 

               DO RESET

 +2        QUIT 

 +3       ;

RESET     ; kill MHSS xref and set flag if tx 23 or 24 generated

 +1        KILL ^AMHREC("AEX",AMHV("R DATE"),AMHR)

 +2        IF ^XTMP("AMHDR","MAIN TX",AMHR)]""

               SET DIE="^AMHREC("

               SET DA=AMHR

               SET DR=".24///"_^XTMP("AMHDR","MAIN TX",AMHR)_";.22///@"

               DO CALLDIE^AMHLEIN

 +3        XECUTE AMHCNT

 +4        QUIT 

 +5       ;

 +6       ;

CNTBUILD  ;count and build tx

 +1        IF AMHE]""

               SET AMH("ERROR COUNT")=AMH("ERROR COUNT")+1

               DO ^AMHEXERR

               QUIT 

 +2        SET AMH("COUNT")=AMH("COUNT")+1

 +3        SET AMHV("TX GENERATED")=1

           SET ^XTMP("AMH"_$SELECT(AMHO("RUN")="NEW":"DR",AMHO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",AMHR)=AMH("MAIN TX DATE")

 +4        SET AMH($EXTRACT(AMHTX))=AMH($EXTRACT(AMHTX))+1

 +5        SET ^AMHSDATA(AMH("COUNT"))="MH^"_AMHTX

 +6        QUIT 

TAPE      ; COPY TRANSACTIONS TO TAPE

 +1       ;S AMH("DEF DEVICE")=$P(^AMHSITE(DUZ(2),0),U,7)

 +2       ;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

 +3        DO EN^AMHEXTAP

           IF $DATA(ZTQUEUED)

               IF AMH("QFLG")

                   DO ERRBULL^AMHEXDI3

 +4       ;Q:AMH("DEF DEVICE")="F"

 +5       ;Q:AMH("QFLG")

 +6       ;Q:$D(ZTQUEUED)

 +7       ;S DIR(0)="Y",DIR("A")="Do you want to write the MHSS transactions to an output device",DIR("B")="N" K DA D ^DIR K DIR

 +8       ;Q:$D(DIRUT)

 +9       ;Q:'Y

 +10      ;I Y=1 S AMH("AMHTAPE")="" D EN^AMHEXTAP

 +11      ;I AMH("QFLG")=99 S AMH("QFLG")=0

 +12       QUIT 

 +13      ;

CHKLOG    ; CHECK LOG FILE

 +1        QUIT 

 +2        SET AMH("X")=0

           FOR AMH("I")=AMH("RUN LOG"):-1:1

               IF '$DATA(^AMHXLOG(AMH("I")))

                   QUIT 

               IF $ORDER(^AMHXLOG(AMH("I"),21,0))

                   SET AMH("X")=AMH("X")+1

 +3        IF AMH("X")>12

               WRITE !,"-->There are more than twelve generations of MHSS RECORDs stored in the LOG file.",!,"-->Time to do a purge."

 +4        QUIT 

 +5       ;

ABORT     ; ABNORMAL TERMINATION

 +1        IF $DATA(AMH("RUN LOG"))

               SET AMH("QFLG1")=$ORDER(^AMHDTER("B",AMH("QFLG"),""))

               SET DA=AMH("RUN LOG")

               SET DIE="^AMHXLOG("

               SET DR=".15///F;.16////"_AMH("QFLG1")

 +2        IF $DATA(ZTQUEUED)

               DO ERRBULL^AMHEXDI3

               DO EOJ

               QUIT 

 +3        WRITE !!,"Abnormal termination!!  QFLG=",AMH("QFLG")

 +4        SET DIR(0)="E"

           SET DIR("A")="DONE  --  Press ENTER to Continue"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        DO EOJ

 +6        QUIT 

 +7       ;

EOJ       ; EOJ

 +1        DO ^AMHEXEOJ

 +2        QUIT