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
