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
