ABMDLBL.m

ABMDLBL ; IHS/ASDST/DMJ - Print Selected Insurer Labels ;  

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

 ;Original;TMD;

 ;

SEL ;

 K ABM

 S (ABM("TM"),ABM("LM"))=0

 ;

 W !!,"PRINT MAILING LABELS FOR:"

 K DIR

 S DIR(0)="SO^1:SELECTIVE INSURERS;2:ALL INSURERS FOR AN EXPORT BATCH"

 S DIR("A")="Select Desired Option"

 D ^DIR

 K DIR

 G XIT:$D(DIROUT)!$D(DIRUT)

 S ABM("DO")=$S(Y=1:"SELI",1:"SELB")

 D @ABM("DO")

 I '$D(ABM("INS")) G XIT

 ;

 W !

 K DIR

 S DIR(0)="NO^1:50"

 S DIR("A")="Enter Desired Number of Labels Printed Per Insurer"

 S DIR("B")=1

 D ^DIR

 K DIR

 G XIT:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)

 S ABM("COPIES")=Y

 ;

 W !

 K DIR

 S DIR(0)="NO^4:8"

 S DIR("A")="Enter the Number of Lines per Label"

 S DIR("B")=6

 D ^DIR

 K DIR

 G XIT:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)

 S ABM("LINES")=Y

 ;

 W !!?15,"(NOTE: Mailing Labels need to be loaded in the printer.)"

 ;

ZIS ;

 W !!

 S %ZIS("A")="Output DEVICE: "

 S %ZIS="QP"

 S %ZIS("B")=""

 D ^%ZIS

 G:POP XIT

 I '$D(IO("Q")) D ^ABMDLBLA G LBL

 ;

QUE2 ;

 K IO("Q")

 I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS

 S ZTRTN="ENT^ABMDLBL"

 S ZTDESC="3P Print of Insurer Labels."

 F ABM="ABM(" S ZTSAVE(ABM)=""

 D ^%ZTLOAD

 G SEL

 ;

ENT ;EP - Entry Point for Taskman

 S ABM("Q")=""

 ;

LBL ;

 I '$D(IO("S")) U IO

 E  X ABM("OPEN")

 ;

MARG ;

 S ABM("LM")=$P($G(^ABMDPARM(DUZ(2),1,0)),"^",11),ABM("TM")=$P(^(0),"^",12)

 W $$EN^ABMVDF("IOF")

 I +ABM("TM") F ABM=1:1:ABM("TM") W !

 ;

GET ;Loop through ABM("INS") array

 S (ABM("I"),ABM("J"))=0

 F  S ABM("I")=$O(ABM("INS",ABM("I"))) Q:ABM("I")=""  D

 . F ABM("K")=1:1 S ABM("J")=$O(ABM("INS",ABM("I"),ABM("J"))) Q:'ABM("J")  D BADDR^ABMDLBL1,PRNT

 I IO'=IO(0)!$D(IO("S")) W $$EN^ABMVDF("IOF")

 D ^%ZISC

 I '$D(ABM("Q")) G SEL

 D:$D(ZTQUEUED) KILL^%ZTLOAD

 ;

XIT ;

 K ABM

 Q

 ;

PRNT ;

 I $D(ABM("IP",ABM("I"))),ABM("IP",ABM("I"))#20'=0,ABM("I")'["NON-BENEFICIARY PATIENT" Q

 S ABM("IP",ABM("I"))=ABM("K")

 F ABM("C")=1:1:ABM("COPIES") F ABM("L")=1:1:ABM("LINES")+1 W !?ABM("LM"),$P(ABM("ADD"),U,ABM("L"))

 Q

 ;

SELI ;

 K DIC

 S ABM("C")=0

 S DIC="^AUTNINS("

 S DIC(0)="QEAM"

 W !

 F ABM=1:1 D  Q:X=""!$D(DUOUT)!$D(DTOUT)

 . W !

SELO . S ABM("E")=$E(ABM,$L(ABM))

 . S DIC("A")="Select "_ABM_$S(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" INSURER: "

 . S DIC(0)="QEAM"

 . D ^DIC

 . Q:X=""!$D(DUOUT)!$D(DTOUT)

 . I +Y<1 G SELO

 . S ABM("INS",$P(^AUTNINS(+Y,0),U)_"-"_+Y,1)=""

 K DIC

 Q

 ;

SELB ;

 W !

 K DIR

 S DIR(0)="YO"

 S DIR("A")="Print Labels for all EXPORT BATCHES that havn't been Previously Printed"

 S DIR("B")="N"

 S DIR("?")="Answer 'YES' if it is desired to print mailing labels for those Insurers associated with the Export Batches that labels have not been previously printed."

 D ^DIR

 K DIR

 Q:$D(DIRUT)

 G SELBE:'Y

 S ABM("M")=0

 F  S ABM("M")=$O(^ABMDTXST(DUZ(2),"AM",1,ABM("M"))) Q:'ABM("M")  D

 . S (DA,ABM("BAT"))=ABM("M")

 . S DIE="^ABMDTXST(DUZ(2),"

 . S DR=".07///@"

 . D ^ABMDDIE,BATCH

 Q

 ;

SELBE ;

 W !!

 K DIC

 S ABM("C")=0

 S DIC="^ABMDTXST(DUZ(2),"

 S DIC(0)="QEAM"

 S ABM("M")=1

 ;

SELBO ;

 S ABM("E")=$E(ABM("M"),$L(ABM("M")))

 S DIC("A")="Select "_ABM("M")_$S(ABM("M")>3&(ABM("M")<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" EXPORT BATCH (NUMBER or DATE): "

 D ^DIC

 Q:X=""!$D(DUOUT)!$D(DTOUT)

 I +Y<1 G SELBO

 S ABM("M")=ABM("M")+1

 S ABM("BAT")=+Y

 D BATCH

 G SELBO

 ;

BATCH ;LOOP THROUGH EXPORT BATCH

 S ABM("NBP")=$O(^AUTNINS("B","NON-BENEFICIARY PATIENT",0))

 S ABM=""

 F  S ABM=$O(^ABMDBILL(DUZ(2),"AX",ABM("BAT"),ABM)) Q:'ABM  D

 . S ABM("I")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,8)

 . I $D(^AUTNINS(ABM("I"),0)) D

 . . S ABM("INS",$P(^AUTNINS(ABM("I"),0),U)_"-"_ABM("I"),ABM)=$S(ABM("NBP")=ABM("I"):$P(^ABMDBILL(DUZ(2),ABM,0),"^",5),1:"")

 Q

ABMDLBL   ; IHS/ASDST/DMJ - Print Selected Insurer Labels ;  

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

 +2       ;Original;TMD;

 +3       ;

SEL       ;

 +1        KILL ABM

 +2        SET (ABM("TM"),ABM("LM"))=0

 +3       ;

 +4        WRITE !!,"PRINT MAILING LABELS FOR:"

 +5        KILL DIR

 +6        SET DIR(0)="SO^1:SELECTIVE INSURERS;2:ALL INSURERS FOR AN EXPORT BATCH"

 +7        SET DIR("A")="Select Desired Option"

 +8        DO ^DIR

 +9        KILL DIR

 +10       IF $DATA(DIROUT)!$DATA(DIRUT)

               GOTO XIT

 +11       SET ABM("DO")=$SELECT(Y=1:"SELI",1:"SELB")

 +12       DO @ABM("DO")

 +13       IF '$DATA(ABM("INS"))

               GOTO XIT

 +14      ;

 +15       WRITE !

 +16       KILL DIR

 +17       SET DIR(0)="NO^1:50"

 +18       SET DIR("A")="Enter Desired Number of Labels Printed Per Insurer"

 +19       SET DIR("B")=1

 +20       DO ^DIR

 +21       KILL DIR

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

               GOTO XIT

 +23       SET ABM("COPIES")=Y

 +24      ;

 +25       WRITE !

 +26       KILL DIR

 +27       SET DIR(0)="NO^4:8"

 +28       SET DIR("A")="Enter the Number of Lines per Label"

 +29       SET DIR("B")=6

 +30       DO ^DIR

 +31       KILL DIR

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

               GOTO XIT

 +33       SET ABM("LINES")=Y

 +34      ;

 +35       WRITE !!?15,"(NOTE: Mailing Labels need to be loaded in the printer.)"

 +36      ;

ZIS       ;

 +1        WRITE !!

 +2        SET %ZIS("A")="Output DEVICE: "

 +3        SET %ZIS="QP"

 +4        SET %ZIS("B")=""

 +5        DO ^%ZIS

 +6        IF POP

               GOTO XIT

 +7        IF '$DATA(IO("Q"))

               DO ^ABMDLBLA

               GOTO LBL

 +8       ;

QUE2      ;

 +1        KILL IO("Q")

 +2        IF IO=IO(0)

               WRITE !,"Cannot Queue to Screen or Slave Printer!",!

               GOTO ZIS

 +3        SET ZTRTN="ENT^ABMDLBL"

 +4        SET ZTDESC="3P Print of Insurer Labels."

 +5        FOR ABM="ABM("

               SET ZTSAVE(ABM)=""

 +6        DO ^%ZTLOAD

 +7        GOTO SEL

 +8       ;

ENT       ;EP - Entry Point for Taskman

 +1        SET ABM("Q")=""

 +2       ;

LBL       ;

 +1        IF '$DATA(IO("S"))

               USE IO

 +2       IF '$TEST

               XECUTE ABM("OPEN")

 +3       ;

MARG      ;

 +1        SET ABM("LM")=$PIECE($GET(^ABMDPARM(DUZ(2),1,0)),"^",11)

           SET ABM("TM")=$PIECE(^(0),"^",12)

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

 +3        IF +ABM("TM")

               FOR ABM=1:1:ABM("TM")

                   WRITE !

 +4       ;

GET       ;Loop through ABM("INS") array

 +1        SET (ABM("I"),ABM("J"))=0

 +2        FOR 

               SET ABM("I")=$ORDER(ABM("INS",ABM("I")))

               IF ABM("I")=""

                   QUIT 

               Begin DoDot:1

 +3                FOR ABM("K")=1:1

                       SET ABM("J")=$ORDER(ABM("INS",ABM("I"),ABM("J")))

                       IF 'ABM("J")

                           QUIT 

                       DO BADDR^ABMDLBL1

                       DO PRNT

               End DoDot:1

 +4        IF IO'=IO(0)!$DATA(IO("S"))

               WRITE $$EN^ABMVDF("IOF")

 +5        DO ^%ZISC

 +6        IF '$DATA(ABM("Q"))

               GOTO SEL

 +7        IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +8       ;

XIT       ;

 +1        KILL ABM

 +2        QUIT 

 +3       ;

PRNT      ;

 +1        IF $DATA(ABM("IP",ABM("I")))

               IF ABM("IP",ABM("I"))#20'=0

                   IF ABM("I")'["NON-BENEFICIARY PATIENT"

                       QUIT 

 +2        SET ABM("IP",ABM("I"))=ABM("K")

 +3        FOR ABM("C")=1:1:ABM("COPIES")

               FOR ABM("L")=1:1:ABM("LINES")+1

                   WRITE !?ABM("LM"),$PIECE(ABM("ADD"),U,ABM("L"))

 +4        QUIT 

 +5       ;

SELI      ;

 +1        KILL DIC

 +2        SET ABM("C")=0

 +3        SET DIC="^AUTNINS("

 +4        SET DIC(0)="QEAM"

 +5        WRITE !

 +6        FOR ABM=1:1

               Begin DoDot:1

 +7                WRITE !

SELO               SET ABM("E")=$EXTRACT(ABM,$LENGTH(ABM))

 +1                SET DIC("A")="Select "_ABM_$SELECT(ABM>3&(ABM<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" INSURER: "

 +2                SET DIC(0)="QEAM"

 +3                DO ^DIC

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

                       QUIT 

 +5                IF +Y<1

                       GOTO SELO

 +6                SET ABM("INS",$PIECE(^AUTNINS(+Y,0),U)_"-"_+Y,1)=""

               End DoDot:1

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

                   QUIT 

 +7        KILL DIC

 +8        QUIT 

 +9       ;

SELB      ;

 +1        WRITE !

 +2        KILL DIR

 +3        SET DIR(0)="YO"

 +4        SET DIR("A")="Print Labels for all EXPORT BATCHES that havn't been Previously Printed"

 +5        SET DIR("B")="N"

 +6        SET DIR("?")="Answer 'YES' if it is desired to print mailing labels for those Insurers associated with the Export Batches that labels have not been previously printed."

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF $DATA(DIRUT)

               QUIT 

 +10       IF 'Y

               GOTO SELBE

 +11       SET ABM("M")=0

 +12       FOR 

               SET ABM("M")=$ORDER(^ABMDTXST(DUZ(2),"AM",1,ABM("M")))

               IF 'ABM("M")

                   QUIT 

               Begin DoDot:1

 +13               SET (DA,ABM("BAT"))=ABM("M")

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

 +15               SET DR=".07///@"

 +16               DO ^ABMDDIE

                   DO BATCH

               End DoDot:1

 +17       QUIT 

 +18      ;

SELBE     ;

 +1        WRITE !!

 +2        KILL DIC

 +3        SET ABM("C")=0

 +4        SET DIC="^ABMDTXST(DUZ(2),"

 +5        SET DIC(0)="QEAM"

 +6        SET ABM("M")=1

 +7       ;

SELBO     ;

 +1        SET ABM("E")=$EXTRACT(ABM("M"),$LENGTH(ABM("M")))

 +2        SET DIC("A")="Select "_ABM("M")_$SELECT(ABM("M")>3&(ABM("M")<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" EXPORT BATCH (NUMBER or DATE): "

 +3        DO ^DIC

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

               QUIT 

 +5        IF +Y<1

               GOTO SELBO

 +6        SET ABM("M")=ABM("M")+1

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

 +8        DO BATCH

 +9        GOTO SELBO

 +10      ;

BATCH     ;LOOP THROUGH EXPORT BATCH

 +1        SET ABM("NBP")=$ORDER(^AUTNINS("B","NON-BENEFICIARY PATIENT",0))

 +2        SET ABM=""

 +3        FOR 

               SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",ABM("BAT"),ABM))

               IF 'ABM

                   QUIT 

               Begin DoDot:1

 +4                SET ABM("I")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,8)

 +5                IF $DATA(^AUTNINS(ABM("I"),0))

                       Begin DoDot:2

 +6                        SET ABM("INS",$PIECE(^AUTNINS(ABM("I"),0),U)_"-"_ABM("I"),ABM)=$SELECT(ABM("NBP")=ABM("I"):$PIECE(^ABMDBILL(DUZ(2),ABM,0),"^",5),1:"")

                       End DoDot:2

               End DoDot:1

 +7        QUIT