ABMDTX.m

ABMDTX ; IHS/ASDST/DMJ - EXPORT BILLS FROM FACILITY ;  

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

ENT K ABM S ABM("PG")=0,ABM("REDO")=0,ABM("XIT")=0

 I '$D(IO) S IOP="HOME" D ^%ZIS

 D AFFL

 I $D(ABMP("AUTO")) S ZTQUEUED="",XBMED="F" G AUTO

 W !! K DIR S DIR(0)="Y",DIR("A")="Do you wish to rerun a Previous Export",DIR("B")="N",DIR("?")="If a previous export was corrupted or lost and requires regeneration answer YES." D ^DIR K DIR

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("XIT")=5 G XIT

 I Y=1 S ABM("REDO")=1 D REDO G XIT:ABM("XIT")

 G AUTO

 ;--------------------------------------------------------------------

PRQUE ;TASKMAN ENTRY POINT

 S ABMP("AUTO")=1 D AFFL

 ;--------------------------------------------------------------------

AUTO D RECD:'ABM("REDO") G XIT:ABM("XIT")

 D ^ABMDTX0 I ABM("CNT")<1 S ABM("XIT")=9 G XIT

 D DEV:'$D(ABMP("AUTO")) G XIT:ABM("XIT")

 I $D(^TMP("ABMDTX",$J,"INS-ERR")) D ^ABMDTX1 S ABM("XIT")=8 G XIT

 D ^ABMDTX2

 G XIT

 ;--------------------------------------------------------------------

DEV W ! S DIR(0)="Y",DIR("A")="Generate a Transmittal List of the Records Exported (Y/N)",DIR("B")="Y" D ^DIR K DIR

 I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("XIT")=5 Q

 Q:'Y  S ABMP("TLIST")=1

 S ABM("LTYPE")="Transmittal"

DEV2 ;EP FROM ABMDTX1 (PRINT ERROR LIST)

 W ! S %ZIS="PN",%ZIS("B")="",%ZIS("A")="Print "_ABM("LTYPE")_" List on DEVICE: " D ^%ZIS I $G(POP) S ABM("XIT")=1 Q

 I IO=IO(0) W *7,!!,"This Report can not be Printed to the Screen, Please Select another Device." G DEV

 S ABM("IOP")=ION,IOP=ION D ^%ZIS I $G(POP) S ABM("XIT")=1 Q

 D ^ABMDR16 I $D(DTOUT)!$D(DUOUT) S ABM("XIT")=5

 D ^%ZISC

 Q

 ;--------------------------------------------------------------------

OPEN ;EP for Opening Device

 S IOP=ABM("IOP")_";132" D ^%ZIS I $G(POP) S ABM("XIT")=1 Q

 U IO W:$D(ABM("PRINT",16)) @ABM("PRINT",16)

 Q

 ;--------------------------------------------------------------------

RECD I $D(^ABMDAOTX(DUZ(2),DT,0)) D  Q

 .I $P(^ABMDAOTX(DUZ(2),DT,0),U,3)]""!'$P(^(0),U,2) S ABM("ADFN")=DT Q

 .S ABM("XIT")=2

 S DA=0,DIK="^ABMDAOTX(DUZ(2),"

 F  S DA=$O(^ABMDAOTX(DUZ(2),DA)) Q:'DA  I $P(^(DA,0),U,3)]"",'$P(^(0),U,2) D ^DIK

 ;I don't know where the unlock is for this lock

 L +(^AUTNINS,^ABMDAOTX):1

 I '$T S ABM("XIT")=3

 S DIC="^ABMDAOTX(DUZ(2),",(DINUM,X)=DT,DIC(0)="L" K DD,DO D FILE^DICN

 I +Y<1 S ABM("XIT")=4

 S ABM("ADFN")=+Y

 Q

 ;--------------------------------------------------------------------

REDO ;  EP

 W !! K DIC S DIC="^ABMDAOTX(DUZ(2),",DIC(0)="QEAM",DIC("A")="Select DATE EXPORTED to AREA OFFICE: "

 D ^DIC K DIC

 I $D(DTOUT)!$D(DUOUT)!(X="") S ABM("XIT")=5 Q

 G REDO:+Y<1

 I $P(^ABMDAOTX(DUZ(2),+Y,0),"^",3)'="" D

 .W !!,*7,$$EN^ABMVDF("RVN"),"EXPORT BATCH ERROR:",$$EN^ABMVDF("RVF")," ",$P(^ABMDAOTX(DUZ(2),+Y,0),"^",3)

 S ABM("ADFN")=+Y

 Q

 ;--------------------------------------------------------------------

XIT I $D(ABM("PRINT",16)) U IO D 10^ABMDR16 W $$EN^ABMVDF("IOF")

 D ^%ZISC

 I ABM("XIT") D ERR I 1

 E  I $P(^ABMDAOTX(DUZ(2),ABM("ADFN"),0),U,3)]"" S DIE="^ABMDAOTX(DUZ(2),",DA=ABM("ADFN"),DR=".03///@" D ^ABMDDIE

 I $D(ABMP("AUTO")),$D(ZTQUEUED) D KILL^%ZTLOAD

 L -(^AUTNINS,^ABMDAOTX)

 K ABM,ABMP,ABME,ABMV,^TMP("ABMDTX",$J),DIR,XBGL,XBTLE,XBMED,XBFLG,ZTQUEUED

 Q

 ;--------------------------------------------------------------------

QUE S ZTRTN="PRQUE^ABMDTX",ZTDESC="3P EXPORT TO AO TRACKING"

 D QUE^ABMDRUTL

 S ABM("XIT")=7

 Q

 ;--------------------------------------------------------------------

ERR S:ABM("XIT")=1 ABM="Printer not Selected or Unable to OPEN Printer."

 S:ABM("XIT")=2 ABM="Data was already exported to Area Office TODAY."

 S:ABM("XIT")=3 ABM="AREA OFFICE EXPORT File or INSURER File in Use."

 S:ABM("XIT")=4 ABM="Area Office Log Entry not created, Job Canceled."

 S:ABM("XIT")=5 ABM="Job Terminated as Requested or Timed Out."

 S:ABM("XIT")=6 ABM=$S($D(XBFLG(1)):XBFLG(1),1:"FILE not SAVED Error occurred during Export.")

 S:ABM("XIT")=7 ABM="Job Queued as Requested."

 S:ABM("XIT")=8 ABM="INSURER Errors Exist."

 S:ABM("XIT")=9 ABM="No Records Available for Export."

 S ABM(1)="***** "_ABM_" *****"

 I '$D(ABMP("AUTO")) W *7,!!?(40-($L(ABM(1))/2)),ABM(1),!!,"ABNORMAL END - THIS JOB HAS BEEN CANCELLED." K DIR S DIR(0)="E",DIR("A")="  (Press [RETURN] to Continue)" D ^DIR K DIR

 I $D(ABM("ADFN")),45'[ABM("XIT") S DIE="^ABMDAOTX(DUZ(2),",DA=ABM("ADFN"),DR=".03////"_ABM D ^ABMDDIE

 Q

 ;--------------------------------------------------------------------

AFFL S ABMP("AFFL")=1 Q:'$D(^ABMDPARM(DUZ(2),1,0))  S ABM("X")=$P(^(0),U)

 Q:'$D(^AUTTLOC(ABM("X"),0))  S ABM("LCD")=$P(^(0),U,7)

 S ABMP("AFFL")="",ABM("I")=0

 F  S ABM("I")=$O(^AUTTLOC(ABM("X"),11,ABM("I"))) Q:'ABM("I")  S ABM("IDT")=$S($P(^(ABM("I"),0),U,2)]"":$P(^(0),U,2),1:9999999) I DT>$P(^(0),U)&(DT<ABM("IDT")) S ABMP("AFFL")=$P(^(0),U,3)

 I ABMP("AFFL")="" S ABMP("AFFL")=1

 Q

ABMDTX    ; IHS/ASDST/DMJ - EXPORT BILLS FROM FACILITY ;  

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

ENT        KILL ABM

           SET ABM("PG")=0

           SET ABM("REDO")=0

           SET ABM("XIT")=0

 +1        IF '$DATA(IO)

               SET IOP="HOME"

               DO ^%ZIS

 +2        DO AFFL

 +3        IF $DATA(ABMP("AUTO"))

               SET ZTQUEUED=""

               SET XBMED="F"

               GOTO AUTO

 +4        WRITE !!

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to rerun a Previous Export"

           SET DIR("B")="N"

           SET DIR("?")="If a previous export was corrupted or lost and requires regeneration answer YES."

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET ABM("XIT")=5

               GOTO XIT

 +6        IF Y=1

               SET ABM("REDO")=1

               DO REDO

               IF ABM("XIT")

                   GOTO XIT

 +7        GOTO AUTO

 +8       ;--------------------------------------------------------------------

PRQUE     ;TASKMAN ENTRY POINT

 +1        SET ABMP("AUTO")=1

           DO AFFL

 +2       ;--------------------------------------------------------------------

AUTO       IF 'ABM("REDO")

               DO RECD

           IF ABM("XIT")

               GOTO XIT

 +1        DO ^ABMDTX0

           IF ABM("CNT")<1

               SET ABM("XIT")=9

               GOTO XIT

 +2        IF '$DATA(ABMP("AUTO"))

               DO DEV

           IF ABM("XIT")

               GOTO XIT

 +3        IF $DATA(^TMP("ABMDTX",$JOB,"INS-ERR"))

               DO ^ABMDTX1

               SET ABM("XIT")=8

               GOTO XIT

 +4        DO ^ABMDTX2

 +5        GOTO XIT

 +6       ;--------------------------------------------------------------------

DEV        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Generate a Transmittal List of the Records Exported (Y/N)"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

 +1        IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET ABM("XIT")=5

               QUIT 

 +2        IF 'Y

               QUIT 

           SET ABMP("TLIST")=1

 +3        SET ABM("LTYPE")="Transmittal"

DEV2      ;EP FROM ABMDTX1 (PRINT ERROR LIST)

 +1        WRITE !

           SET %ZIS="PN"

           SET %ZIS("B")=""

           SET %ZIS("A")="Print "_ABM("LTYPE")_" List on DEVICE: "

           DO ^%ZIS

           IF $GET(POP)

               SET ABM("XIT")=1

               QUIT 

 +2        IF IO=IO(0)

               WRITE *7,!!,"This Report can not be Printed to the Screen, Please Select another Device."

               GOTO DEV

 +3        SET ABM("IOP")=ION

           SET IOP=ION

           DO ^%ZIS

           IF $GET(POP)

               SET ABM("XIT")=1

               QUIT 

 +4        DO ^ABMDR16

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET ABM("XIT")=5

 +5        DO ^%ZISC

 +6        QUIT 

 +7       ;--------------------------------------------------------------------

OPEN      ;EP for Opening Device

 +1        SET IOP=ABM("IOP")_";132"

           DO ^%ZIS

           IF $GET(POP)

               SET ABM("XIT")=1

               QUIT 

 +2        USE IO

           IF $DATA(ABM("PRINT",16))

               WRITE @ABM("PRINT",16)

 +3        QUIT 

 +4       ;--------------------------------------------------------------------

RECD       IF $DATA(^ABMDAOTX(DUZ(2),DT,0))

               Begin DoDot:1

 +1                IF $PIECE(^ABMDAOTX(DUZ(2),DT,0),U,3)]""!'$PIECE(^(0),U,2)

                       SET ABM("ADFN")=DT

                       QUIT 

 +2                SET ABM("XIT")=2

               End DoDot:1

               QUIT 

 +3        SET DA=0

           SET DIK="^ABMDAOTX(DUZ(2),"

 +4        FOR 

               SET DA=$ORDER(^ABMDAOTX(DUZ(2),DA))

               IF 'DA

                   QUIT 

               IF $PIECE(^(DA,0),U,3)]""

                   IF '$PIECE(^(0),U,2)

                       DO ^DIK

 +5       ;I don't know where the unlock is for this lock

 +6        LOCK +(^AUTNINS,^ABMDAOTX):1

 +7        IF '$TEST

               SET ABM("XIT")=3

 +8        SET DIC="^ABMDAOTX(DUZ(2),"

           SET (DINUM,X)=DT

           SET DIC(0)="L"

           KILL DD,DO

           DO FILE^DICN

 +9        IF +Y<1

               SET ABM("XIT")=4

 +10       SET ABM("ADFN")=+Y

 +11       QUIT 

 +12      ;--------------------------------------------------------------------

REDO      ;  EP

 +1        WRITE !!

           KILL DIC

           SET DIC="^ABMDAOTX(DUZ(2),"

           SET DIC(0)="QEAM"

           SET DIC("A")="Select DATE EXPORTED to AREA OFFICE: "

 +2        DO ^DIC

           KILL DIC

 +3        IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")

               SET ABM("XIT")=5

               QUIT 

 +4        IF +Y<1

               GOTO REDO

 +5        IF $PIECE(^ABMDAOTX(DUZ(2),+Y,0),"^",3)'=""

               Begin DoDot:1

 +6                WRITE !!,*7,$$EN^ABMVDF("RVN"),"EXPORT BATCH ERROR:",$$EN^ABMVDF("RVF")," ",$PIECE(^ABMDAOTX(DUZ(2),+Y,0),"^",3)

               End DoDot:1

 +7        SET ABM("ADFN")=+Y

 +8        QUIT 

 +9       ;--------------------------------------------------------------------

XIT        IF $DATA(ABM("PRINT",16))

               USE IO

               DO 10^ABMDR16

               WRITE $$EN^ABMVDF("IOF")

 +1        DO ^%ZISC

 +2        IF ABM("XIT")

               DO ERR

               IF 1

 +3       IF '$TEST

               IF $PIECE(^ABMDAOTX(DUZ(2),ABM("ADFN"),0),U,3)]""

                   SET DIE="^ABMDAOTX(DUZ(2),"

                   SET DA=ABM("ADFN")

                   SET DR=".03///@"

                   DO ^ABMDDIE

 +4        IF $DATA(ABMP("AUTO"))

               IF $DATA(ZTQUEUED)

                   DO KILL^%ZTLOAD

 +5        LOCK -(^AUTNINS,^ABMDAOTX)

 +6        KILL ABM,ABMP,ABME,ABMV,^TMP("ABMDTX",$JOB),DIR,XBGL,XBTLE,XBMED,XBFLG,ZTQUEUED

 +7        QUIT 

 +8       ;--------------------------------------------------------------------

QUE        SET ZTRTN="PRQUE^ABMDTX"

           SET ZTDESC="3P EXPORT TO AO TRACKING"

 +1        DO QUE^ABMDRUTL

 +2        SET ABM("XIT")=7

 +3        QUIT 

 +4       ;--------------------------------------------------------------------

ERR        IF ABM("XIT")=1

               SET ABM="Printer not Selected or Unable to OPEN Printer."

 +1        IF ABM("XIT")=2

               SET ABM="Data was already exported to Area Office TODAY."

 +2        IF ABM("XIT")=3

               SET ABM="AREA OFFICE EXPORT File or INSURER File in Use."

 +3        IF ABM("XIT")=4

               SET ABM="Area Office Log Entry not created, Job Canceled."

 +4        IF ABM("XIT")=5

               SET ABM="Job Terminated as Requested or Timed Out."

 +5        IF ABM("XIT")=6

               SET ABM=$SELECT($DATA(XBFLG(1)):XBFLG(1),1:"FILE not SAVED Error occurred during Export.")

 +6        IF ABM("XIT")=7

               SET ABM="Job Queued as Requested."

 +7        IF ABM("XIT")=8

               SET ABM="INSURER Errors Exist."

 +8        IF ABM("XIT")=9

               SET ABM="No Records Available for Export."

 +9        SET ABM(1)="***** "_ABM_" *****"

 +10       IF '$DATA(ABMP("AUTO"))

               WRITE *7,!!?(40-($LENGTH(ABM(1))/2)),ABM(1),!!,"ABNORMAL END - THIS JOB HAS BEEN CANCELLED."

               KILL DIR

               SET DIR(0)="E"

               SET DIR("A")="  (Press [RETURN] to Continue)"

               DO ^DIR

               KILL DIR

 +11       IF $DATA(ABM("ADFN"))

               IF 45'[ABM("XIT")

                   SET DIE="^ABMDAOTX(DUZ(2),"

                   SET DA=ABM("ADFN")

                   SET DR=".03////"_ABM

                   DO ^ABMDDIE

 +12       QUIT 

 +13      ;--------------------------------------------------------------------

AFFL       SET ABMP("AFFL")=1

           IF '$DATA(^ABMDPARM(DUZ(2),1,0))

               QUIT 

           SET ABM("X")=$PIECE(^(0),U)

 +1        IF '$DATA(^AUTTLOC(ABM("X"),0))

               QUIT 

           SET ABM("LCD")=$PIECE(^(0),U,7)

 +2        SET ABMP("AFFL")=""

           SET ABM("I")=0

 +3        FOR 

               SET ABM("I")=$ORDER(^AUTTLOC(ABM("X"),11,ABM("I")))

               IF 'ABM("I")

                   QUIT 

               SET ABM("IDT")=$SELECT($PIECE(^(ABM("I"),0),U,2)]"":$PIECE(^(0),U,2),1:9999999)

               IF DT>$PIECE(^(0),U)&(DT<ABM("IDT"))

                   SET ABMP("AFFL")=$PIECE(^(0),U,3)

 +4        IF ABMP("AFFL")=""

               SET ABMP("AFFL")=1

 +5        QUIT