ABMDTX2.m

ABMDTX2 ; IHS/ASDST/DMJ - PT 3 OF CLAIM EXPORT PROGRAM ; 

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

 ;IHS/ADC/KML - 03/16/98 - return global reference name 

 ;              from ^TMP to ^ABPVDATA 

 ;IHS/ADC/LSL - 03/24/98 - Also add if bill is cancelled don't

 ;              send out or mark as transferred.

 ;

START K ^ABPVDATA ; transient global

 I '$D(ABMP("AUTO")) U IO(0) W !!,"Generating Private Insurance Claim Export Records:  ",!

 S ABM("CNT")=0

 D ^ABMDTX3

 S ^ABPVDATA(0)=$P(^AUTTLOC(DUZ(2),0),U,10)_U_$P(^DIC(4,DUZ(2),0),U)_U_$S(ABM("REDO"):ABM("ADFN"),1:DT)_U_ABM("FDT")_U_ABM("EDT")_U_ABM("LREC")_U_(ABM("CNT")/2)

 S ABM("REC")=^ABPVDATA(0)

 I '$D(ABMP("AUTO")) U IO(0) W $$EN^ABMVDF("IOF") D HEADER U IO

 S ABMJDT=$$JDT^XBFUNC(DT)            ; Todays julian date

 S XBFN="ABPV"_$P(ABM("REC"),U)_"."_ABMJDT  ; File name

 S ABM("IO")=IO,ABM("IO0")=IO(0),XBGL="ABPVDATA",XBTLE="3P AO EXPORT"

 I $P($G(^ABMDPARM(DUZ(2),1,2)),U,2),'$D(ABMP("AUTO")) S XBMED=$P(^(2),U,2)

 D ^XBGSAVE S IO=ABM("IO"),IO(0)=ABM("IO0") I XBFLG S ABM("XIT")=6 Q

 S DIE="^ABMDAOTX(DUZ(2),",DA=ABM("ADFN"),DR=".02////"_(ABM("CNT")/2)_";.04////"_ABM("AMT") D ^ABMDDIE

 S ABM("TDFN")=0 F  S ABM("TDFN")=$O(^TMP("ABMDTX",$J,"EXP",ABM("TDFN"))) Q:'ABM("TDFN")  D

 .S DA=ABM("TDFN"),DIE="^ABMDTXST(DUZ(2),",DR=".06////"_DT_";.07///@" D ^ABMDDIE

 S ABM("BDFN")=0 F  S ABM("BDFN")=$O(^TMP("ABMDTX",$J,ABM("BDFN"))) Q:'ABM("BDFN")  D

 .S DIE="^ABMDBILL(DUZ(2),",DA=ABM("BDFN")

 .S DR=".18////"_ABM("ADFN")_";.16///@" D ^ABMDDIE

 .Q:$P(^ABMDBILL(DUZ(2),ABM("BDFN"),0),"^",4)="C"

 .Q:$P(^ABMDBILL(DUZ(2),ABM("BDFN"),0),"^",4)="X"  ;Don't send cancelled bills. 

 .S DR=".04////T" D ^ABMDDIE

 Q:$D(ABMP("AUTO"))  Q:'$G(ABMP("TLIST"))

 W !!,"Printing Area Office Tracking System Transmittal List....."

 D OPEN^ABMDTX I $G(POP) S ABM("XIT")=1 Q

 U IO D WRT^ABMDTX0

 I $D(ABM("PRINT",16)) D 10^ABMDR16

 W $$EN^ABMVDF("IOF") D HEADER

 Q

 ;

HEADER F I=1:1:70 W "*"

 W !,"*",?12,"BILLING CLAIM EXPORT REPORT",?69,"*",!

 S X="FOR "_$P(^DIC(4,DUZ(2),0),U,1) W "*",?70-$L(X)/2,X,?69,"*",!

 S Y=$S(ABM("REDO"):ABM("ADFN"),1:DT) X ^DD("DD") W "*",?70-$L(Y)/2,Y,?69,"*",! F I=1:1:70 W "*"

 W !!?10,"FACILITY CODE = ",?40,$P(ABM("REC"),U,1)

 W !,?10,"DATE EXPORT CREATED = " S Y=$P(ABM("REC"),U,3) X ^DD("DD") W ?40,Y

 W !,?10,"BEGINNING CLAIM DATE = " S Y=$P(ABM("REC"),U,4) X ^DD("DD") W ?40,Y

 W !,?10,"ENDING CLAIM DATE = " S Y=$P(ABM("REC"),U,5) X ^DD("DD") W ?40,Y

 W !,?10,"NUMBER OF CLAIM RECORDS = ",?40,$P(ABM("REC"),U,7),!!

 F I=1:1:70 W "*"

 Q

ABMDTX2   ; IHS/ASDST/DMJ - PT 3 OF CLAIM EXPORT PROGRAM ; 

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

 +2       ;IHS/ADC/KML - 03/16/98 - return global reference name 

 +3       ;              from ^TMP to ^ABPVDATA 

 +4       ;IHS/ADC/LSL - 03/24/98 - Also add if bill is cancelled don't

 +5       ;              send out or mark as transferred.

 +6       ;

START     ; transient global

           KILL ^ABPVDATA

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

               USE IO(0)

               WRITE !!,"Generating Private Insurance Claim Export Records:  ",!

 +2        SET ABM("CNT")=0

 +3        DO ^ABMDTX3

 +4        SET ^ABPVDATA(0)=$PIECE(^AUTTLOC(DUZ(2),0),U,10)_U_$PIECE(^DIC(4,DUZ(2),0),U)_U_$SELECT(ABM("REDO"):ABM("ADFN"),1:DT)_U_ABM("FDT")_U_ABM("EDT")_U_ABM("LREC")_U_(ABM("CNT")/2)

 +5        SET ABM("REC")=^ABPVDATA(0)

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

               USE IO(0)

               WRITE $$EN^ABMVDF("IOF")

               DO HEADER

               USE IO

 +7       ; Todays julian date

           SET ABMJDT=$$JDT^XBFUNC(DT)

 +8       ; File name

           SET XBFN="ABPV"_$PIECE(ABM("REC"),U)_"."_ABMJDT

 +9        SET ABM("IO")=IO

           SET ABM("IO0")=IO(0)

           SET XBGL="ABPVDATA"

           SET XBTLE="3P AO EXPORT"

 +10       IF $PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,2)

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

                   SET XBMED=$PIECE(^(2),U,2)

 +11       DO ^XBGSAVE

           SET IO=ABM("IO")

           SET IO(0)=ABM("IO0")

           IF XBFLG

               SET ABM("XIT")=6

               QUIT 

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

           SET DA=ABM("ADFN")

           SET DR=".02////"_(ABM("CNT")/2)_";.04////"_ABM("AMT")

           DO ^ABMDDIE

 +13       SET ABM("TDFN")=0

           FOR 

               SET ABM("TDFN")=$ORDER(^TMP("ABMDTX",$JOB,"EXP",ABM("TDFN")))

               IF 'ABM("TDFN")

                   QUIT 

               Begin DoDot:1

 +14               SET DA=ABM("TDFN")

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

                   SET DR=".06////"_DT_";.07///@"

                   DO ^ABMDDIE

               End DoDot:1

 +15       SET ABM("BDFN")=0

           FOR 

               SET ABM("BDFN")=$ORDER(^TMP("ABMDTX",$JOB,ABM("BDFN")))

               IF 'ABM("BDFN")

                   QUIT 

               Begin DoDot:1

 +16               SET DIE="^ABMDBILL(DUZ(2),"

                   SET DA=ABM("BDFN")

 +17               SET DR=".18////"_ABM("ADFN")_";.16///@"

                   DO ^ABMDDIE

 +18               IF $PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),0),"^",4)="C"

                       QUIT 

 +19      ;Don't send cancelled bills. 

                   IF $PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),0),"^",4)="X"

                       QUIT 

 +20               SET DR=".04////T"

                   DO ^ABMDDIE

               End DoDot:1

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

               QUIT 

           IF '$GET(ABMP("TLIST"))

               QUIT 

 +22       WRITE !!,"Printing Area Office Tracking System Transmittal List....."

 +23       DO OPEN^ABMDTX

           IF $GET(POP)

               SET ABM("XIT")=1

               QUIT 

 +24       USE IO

           DO WRT^ABMDTX0

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

               DO 10^ABMDR16

 +26       WRITE $$EN^ABMVDF("IOF")

           DO HEADER

 +27       QUIT 

 +28      ;

HEADER     FOR I=1:1:70

               WRITE "*"

 +1        WRITE !,"*",?12,"BILLING CLAIM EXPORT REPORT",?69,"*",!

 +2        SET X="FOR "_$PIECE(^DIC(4,DUZ(2),0),U,1)

           WRITE "*",?70-$LENGTH(X)/2,X,?69,"*",!

 +3        SET Y=$SELECT(ABM("REDO"):ABM("ADFN"),1:DT)

           XECUTE ^DD("DD")

           WRITE "*",?70-$LENGTH(Y)/2,Y,?69,"*",!

           FOR I=1:1:70

               WRITE "*"

 +4        WRITE !!?10,"FACILITY CODE = ",?40,$PIECE(ABM("REC"),U,1)

 +5        WRITE !,?10,"DATE EXPORT CREATED = "

           SET Y=$PIECE(ABM("REC"),U,3)

           XECUTE ^DD("DD")

           WRITE ?40,Y

 +6        WRITE !,?10,"BEGINNING CLAIM DATE = "

           SET Y=$PIECE(ABM("REC"),U,4)

           XECUTE ^DD("DD")

           WRITE ?40,Y

 +7        WRITE !,?10,"ENDING CLAIM DATE = "

           SET Y=$PIECE(ABM("REC"),U,5)

           XECUTE ^DD("DD")

           WRITE ?40,Y

 +8        WRITE !,?10,"NUMBER OF CLAIM RECORDS = ",?40,$PIECE(ABM("REC"),U,7),!!

 +9        FOR I=1:1:70

               WRITE "*"

 +10       QUIT