ABMDFRDO ; IHS/ASDST/DMJ - Re-Print Selected Bills ;
;;2.6;IHS Third Party Billing System;**2,4,11,13**;NOV 12, 2009;Build 213
;Original;TMD;02/21/96 12:13 PM
;
; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105
; Added code to use ADA-2002 for 837D when printing
;
; IHS/SD/SDR - v2.5 p11 - NPI
; IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - added prompt for DATE to use when reprinting
;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35; Updated check to look for HCFA or CMS in the
; export name.
;
K ABMY,ABMP
S ABMP("XMIT")=0
S ABMY("TOT")="0^0^0"
W !!,"Re-Print Bills for:"
K DIR
S DIR(0)="SO^1:SELECTIVE BILL(S);2:ALL BILLS FOR AN EXPORT BATCH;3:UNPAID BILLS"
S DIR("A")="Select Desired Option"
D ^DIR
K DIR
G XIT:$D(DIRUT)!$D(DIROUT),SEL:Y=1,UNPD:Y=3
;
BATCH ;
W !
K DIC
S DIC="^ABMDTXST(DUZ(2),"
S DIC(0)="AEMQ"
S DIC("A")="Select EXPORT BATCH (Date): "
D ^DIC
K DIC("A")
G XIT:X=""!$D(DTOUT)!$D(DUOUT),BATCH:+Y<1
S (ABMY("BATCH"),ABMP("XMIT"))=+Y
I $P(^ABMDTXST(DUZ(2),+Y,0),U,2) S ABMY("FORM")=$P(^(0),U,2)_U_$P($G(^ABMDEXP($P(^(0),U,2),0)),U)
E S ABMY("FORM")=$S($P(^ABMDTXST(DUZ(2),ABMY("BATCH"),0),U,2)="U":1,1:2)_U_$S($P(^(0),U,2)="U":"UB-82",1:"HCFA-1500A")
G ZIS
;
SEL ;
W !!
K DIC
S DIC="^ABMDBILL(DUZ(2),"
S DIC(0)="QZEAM"
S ABMY=$G(ABMY)+1
S ABM("E")=$E(ABMY,$L(ABMY))
S DIC("A")="Select "_ABMY_$S(ABMY>3&(ABMY<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL to Re-Print: "
S DIC("S")="I $P(^(0),U)'=+^(0),""BTCP""[$P(^(0),""^"",4),$P(^(0),""^"",6)"
S:ABMY>1 DIC("S")=DIC("S")_",$P(ABMY(""FORM""),""^"",1)[$P(^(0),""^"",6)"
D BENT^ABMDBDIC
G XIT:$D(DUOUT)!$D(DTOUT)
I '$G(ABMP("BDFN")) G ZIS:ABMY>1,XIT
D CKMULT
I '$G(ABMP("BDFN")) S ABMY=ABMY-1 G SEL
S ABMY(ABMP("BDFN"))=""
G SEL:ABMY>1
S ABMY("EXP")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)
S ABMY("FORM")=ABMY("EXP")_"^"_$P($G(^ABMDEXP(ABMY("EXP"),0)),U)
G SEL
;
UNPD ;UN-PAID BILLS
D ^ABMDBRUN
S ABMY("TOT")="0^0^0"
W !!,"For the parameters specified, the"
W !," Number of Bills to Reprint: ",ABMP("CNT")
I '$O(ABMY(0)) W *7 G XIT
;
ZIS ;EP
I '$G(ABMY("EXP")) S ABMY("EXP")=+ABMY("FORM")
I $P($G(^ABMDEXP(ABMY("EXP"),1)),"^",5)="E" D
.K DIC,DIE,DIR,X,Y
.S DIR("A")="**Use the following export mode: "
.;I $P(ABMY("FORM"),U,2)["HCFA" D ;abm*2.6*13 exp mode 35
.I $P(ABMY("FORM"),U,2)["HCFA"!($P(ABMY("FORM"),U,2)["CMS") D ;abm*2.6*13 exp mode 35
..;start old code abm*2.6*13 export mode 35
..;S DIR("B")="1500 (08/05)"
..;S DIR(0)="S^3:1500 B;14:1500 Y2K;27:1500 (08/05)"
..;end old start new export mode 35
..S DIR("B")="1500 (02/12)"
..S DIR(0)="S^27:1500 (08/05);35:1500 (02/12)"
..;end new export mode 35
.I $P(ABMY("FORM"),U,2)["UB" D
..S DIR("B")="UB-04"
..S DIR(0)="S^11:UB-92;28:UB-04"
.I $P(ABMY("FORM"),U,2)["ADA" D
..;start old code abm*2.6*11 new ADA form
..;S DIR("B")="ADA-2006"
..;S DIR(0)="S^25:ADA-2002;29:ADA-2006"
..;end old code start new code
..S DIR("B")="ADA-2012"
..S DIR(0)="S^25:ADA-2002;29:ADA-2006;34:ADA-2012"
..;end new code
.D ^DIR K DIR
.;I $P(ABMY("FORM"),U,2)["HCFA" S ABMY("FORM")=$S(Y=3:"3^HCFA-1500B",Y=14:"14^HCFA-1500 Y2K",1:"27^HCFA 1500 (08/05)") ;abm*2.6*13 export mode 35
.I $P(ABMY("FORM"),U,2)["HCFA" S ABMY("FORM")=$S(Y=27:"27^HCFA 1500 (08/05)",1:"35^HCFA 1500 (02/12)") ;abm*2.6*13 export mode 35
.I $P(ABMY("FORM"),U,2)["UB" S ABMY("FORM")=$S(Y=11:"11^UB-92",1:"28^UB-04")
.;I $P(ABMY("FORM"),U,2)["ADA" S ABMY("FORM")=$S(Y=25:"25^ADA-2002",1:"29^ADA-2012") ;abm*2.6*11 new ADA form
.I $P(ABMY("FORM"),U,2)["ADA" S ABMY("FORM")=$S(Y=25:"25^ADA-2002",Y=29:"29^ADA-2006",1:"34^ADA-2012") ;abm*2.6*11 new ADA form I +ABMY("FORM")=2,$P($G(^ABMDPARM(DUZ(2),1,2)),9)=2 D G XIT:$D(DIRUT)
.;start old code abm*2.6*11
.;W !!,"Forms Previously Printed on Old HCFA-1500.",!!
.;K DIR
.;S DIR(0)="Y"
.;S DIR("B")="Y"
.;S DIR("A")="Want to print the New Version of the HCFA-1500 (Y/N)"
.;D ^DIR
.;I Y S ABMY("FORM")=3_U_$P(^ABMDEXP(3,0),U)
;end old code
S ABMP("EXP")=+ABMY("FORM")
;start new code abm*2.6*2 FIXPMS10006
D ^XBFMK
;S DIR(0)="S^T:TODAY'S DATE;O:ORIGINAL PRINT DATE" ;abm*2.6*11 HEAT81561
S DIR(0)="S^T:TODAY'S DATE;O:ORIGINAL PRINT DATE;A:APPROVAL DATE" ;abm*2.6*11 HEAT81561
S DIR("A")="Reprint using which date"
S DIR("B")="TODAY"
D ^DIR K DIR
;S ABMPDT=Y ;abm*2.6*4 HEAT17615
S ABMP("PRINTDT")=Y ;abm*2.6*4 HEAT17615
;end new code FIXPMS10006
W !!?15,"(NOTE: "
I $P($G(^ABMDEXP(ABMP("EXP"),1)),U,4) W "Plain Paper needs"
E W $P(ABMY("FORM"),U,2)," forms need"
W " to be loaded in the printer.)"
W !!
S %ZIS("A")="Output DEVICE: "
S %ZIS="PQ"
D ^%ZIS
G XIT:POP
I IO'=IO(0),IOT'="HFS" D Q
.D QUE2
.D HOME^%ZIS
U IO(0)
W:'$D(IO("S")) !!,"Printing..."
U IO
G ENT
;
QUE2 ;
I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS
S ZTRTN="TSK^ABMDFRDO"
S ZTDESC="3P Re-Print of Selective Bill."
F ABM="ZTRTN","ZTDESC","ABMP(","ABMY(" S ZTSAVE(ABM)=""
D ^%ZTLOAD
I $D(ZTSK) W !,"(Job Queued, Task Number: ",ZTSK,")"
G OUT
;
TSK ; Taskman Entry Point
S ABMP("Q")=""
;
ENT ;
I '$D(ABMY("BATCH")) D G OUT
.S ABMY=0
.F S ABMY=$O(ABMY(ABMY)) Q:'ABMY D
..S ABMP("BDFN")=ABMY
..D FORMS
S ABMY=0
F S ABMY=$O(^ABMDBILL(DUZ(2),"AX",ABMY("BATCH"),ABMY)) Q:'ABMY D
.; Quit if bill status is Reviewed, Approved, or Cancelled
.Q:"RAX"[$P($G(^ABMDBILL(DUZ(2),ABMY,0)),U,4)
.S ABMP("BDFN")=ABMY
.D FORMS
G OUT
;
FORMS ; Reprint Forms
K ABMP("PAYED")
I ABMP("EXP")>2 D @("ENT^ABMDF"_+ABMY("FORM")) Q
;
UB82 ;
I +ABMY("FORM")=1 D Q
.D ENT^ABMDF1,^ABMDF1X
.D:$D(ABMR)=10 UB82^ABMDF1
;
HCFA ;
D ENT^ABMDF2
I +$O(ABMR("")) S ABMR("MORE")=""
D ^ABMDF2X
D:+$O(ABMR("")) HCFA^ABMDF2
Q
;
OUT ;
D ^%ZISC
;
XIT ;
D WTOT^ABMDFUTL:$G(ABMY("TOT"))
K ABMP,ABMY,DIQ
Q
;
CKMULT ; check if form is used for multiple bills
I $P($G(^ABMDEXP($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),1)),U,3) D
.W !!,*7,"Bill Number "
.W $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
.W " was exported on a "
.W $P(^ABMDEXP($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),0),U)
.W " form. Since this form may"
.W !,"include multiple bills, a single bill can not be individually reprinted."
.W !,"Thus, to reprint the bill you must reprint the entire export batch."
.K ABMP("BDFN")
Q
ABMDFRDO ; IHS/ASDST/DMJ - Re-Print Selected Bills ;
+1 ;;2.6;IHS Third Party Billing System;**2,4,11,13**;NOV 12, 2009;Build 213
+2 ;Original;TMD;02/21/96 12:13 PM
+3 ;
+4 ; IHS/SD/SDR - v2.5 p8 - IM14693/IM16105
+5 ; Added code to use ADA-2002 for 837D when printing
+6 ;
+7 ; IHS/SD/SDR - v2.5 p11 - NPI
+8 ; IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - added prompt for DATE to use when reprinting
+9 ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35; Updated check to look for HCFA or CMS in the
+10 ; export name.
+11 ;
+12 KILL ABMY,ABMP
+13 SET ABMP("XMIT")=0
+14 SET ABMY("TOT")="0^0^0"
+15 WRITE !!,"Re-Print Bills for:"
+16 KILL DIR
+17 SET DIR(0)="SO^1:SELECTIVE BILL(S);2:ALL BILLS FOR AN EXPORT BATCH;3:UNPAID BILLS"
+18 SET DIR("A")="Select Desired Option"
+19 DO ^DIR
+20 KILL DIR
+21 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO XIT
IF Y=1
GOTO SEL
IF Y=3
GOTO UNPD
+22 ;
BATCH ;
+1 WRITE !
+2 KILL DIC
+3 SET DIC="^ABMDTXST(DUZ(2),"
+4 SET DIC(0)="AEMQ"
+5 SET DIC("A")="Select EXPORT BATCH (Date): "
+6 DO ^DIC
+7 KILL DIC("A")
+8 IF X=""!$DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
IF +Y<1
GOTO BATCH
+9 SET (ABMY("BATCH"),ABMP("XMIT"))=+Y
+10 IF $PIECE(^ABMDTXST(DUZ(2),+Y,0),U,2)
SET ABMY("FORM")=$PIECE(^(0),U,2)_U_$PIECE($GET(^ABMDEXP($PIECE(^(0),U,2),0)),U)
+11 IF '$TEST
SET ABMY("FORM")=$SELECT($PIECE(^ABMDTXST(DUZ(2),ABMY("BATCH"),0),U,2)="U":1,1:2)_U_$SELECT($PIECE(^(0),U,2)="U":"UB-82",1:"HCFA-1500A")
+12 GOTO ZIS
+13 ;
SEL ;
+1 WRITE !!
+2 KILL DIC
+3 SET DIC="^ABMDBILL(DUZ(2),"
+4 SET DIC(0)="QZEAM"
+5 SET ABMY=$GET(ABMY)+1
+6 SET ABM("E")=$EXTRACT(ABMY,$LENGTH(ABMY))
+7 SET DIC("A")="Select "_ABMY_$SELECT(ABMY>3&(ABMY<21):"th",ABM("E")=1:"st",ABM("E")=2:"nd",ABM("E")=3:"rd",1:"th")_" BILL to Re-Print: "
+8 SET DIC("S")="I $P(^(0),U)'=+^(0),""BTCP""[$P(^(0),""^"",4),$P(^(0),""^"",6)"
+9 IF ABMY>1
SET DIC("S")=DIC("S")_",$P(ABMY(""FORM""),""^"",1)[$P(^(0),""^"",6)"
+10 DO BENT^ABMDBDIC
+11 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+12 IF '$GET(ABMP("BDFN"))
IF ABMY>1
GOTO ZIS
GOTO XIT
+13 DO CKMULT
+14 IF '$GET(ABMP("BDFN"))
SET ABMY=ABMY-1
GOTO SEL
+15 SET ABMY(ABMP("BDFN"))=""
+16 IF ABMY>1
GOTO SEL
+17 SET ABMY("EXP")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)
+18 SET ABMY("FORM")=ABMY("EXP")_"^"_$PIECE($GET(^ABMDEXP(ABMY("EXP"),0)),U)
+19 GOTO SEL
+20 ;
UNPD ;UN-PAID BILLS
+1 DO ^ABMDBRUN
+2 SET ABMY("TOT")="0^0^0"
+3 WRITE !!,"For the parameters specified, the"
+4 WRITE !," Number of Bills to Reprint: ",ABMP("CNT")
+5 IF '$ORDER(ABMY(0))
WRITE *7
GOTO XIT
+6 ;
ZIS ;EP
+1 IF '$GET(ABMY("EXP"))
SET ABMY("EXP")=+ABMY("FORM")
+2 IF $PIECE($GET(^ABMDEXP(ABMY("EXP"),1)),"^",5)="E"
Begin DoDot:1
+3 KILL DIC,DIE,DIR,X,Y
+4 SET DIR("A")="**Use the following export mode: "
+5 ;I $P(ABMY("FORM"),U,2)["HCFA" D ;abm*2.6*13 exp mode 35
+6 ;abm*2.6*13 exp mode 35
IF $PIECE(ABMY("FORM"),U,2)["HCFA"!($PIECE(ABMY("FORM"),U,2)["CMS")
Begin DoDot:2
+7 ;start old code abm*2.6*13 export mode 35
+8 ;S DIR("B")="1500 (08/05)"
+9 ;S DIR(0)="S^3:1500 B;14:1500 Y2K;27:1500 (08/05)"
+10 ;end old start new export mode 35
+11 SET DIR("B")="1500 (02/12)"
+12 SET DIR(0)="S^27:1500 (08/05);35:1500 (02/12)"
+13 ;end new export mode 35
End DoDot:2
+14 IF $PIECE(ABMY("FORM"),U,2)["UB"
Begin DoDot:2
+15 SET DIR("B")="UB-04"
+16 SET DIR(0)="S^11:UB-92;28:UB-04"
End DoDot:2
+17 IF $PIECE(ABMY("FORM"),U,2)["ADA"
Begin DoDot:2
+18 ;start old code abm*2.6*11 new ADA form
+19 ;S DIR("B")="ADA-2006"
+20 ;S DIR(0)="S^25:ADA-2002;29:ADA-2006"
+21 ;end old code start new code
+22 SET DIR("B")="ADA-2012"
+23 SET DIR(0)="S^25:ADA-2002;29:ADA-2006;34:ADA-2012"
+24 ;end new code
End DoDot:2
+25 DO ^DIR
KILL DIR
+26 ;I $P(ABMY("FORM"),U,2)["HCFA" S ABMY("FORM")=$S(Y=3:"3^HCFA-1500B",Y=14:"14^HCFA-1500 Y2K",1:"27^HCFA 1500 (08/05)") ;abm*2.6*13 export mode 35
+27 ;abm*2.6*13 export mode 35
IF $PIECE(ABMY("FORM"),U,2)["HCFA"
SET ABMY("FORM")=$SELECT(Y=27:"27^HCFA 1500 (08/05)",1:"35^HCFA 1500 (02/12)")
+28 IF $PIECE(ABMY("FORM"),U,2)["UB"
SET ABMY("FORM")=$SELECT(Y=11:"11^UB-92",1:"28^UB-04")
+29 ;I $P(ABMY("FORM"),U,2)["ADA" S ABMY("FORM")=$S(Y=25:"25^ADA-2002",1:"29^ADA-2012") ;abm*2.6*11 new ADA form
+30 ;abm*2.6*11 new ADA form I +ABMY("FORM")=2,$P($G(^ABMDPARM(DUZ(2),1,2)),9)=2 D G XIT:$D(DIRUT)
IF $PIECE(ABMY("FORM"),U,2)["ADA"
SET ABMY("FORM")=$SELECT(Y=25:"25^ADA-2002",Y=29:"29^ADA-2006",1:"34^ADA-2012")
+31 ;start old code abm*2.6*11
+32 ;W !!,"Forms Previously Printed on Old HCFA-1500.",!!
+33 ;K DIR
+34 ;S DIR(0)="Y"
+35 ;S DIR("B")="Y"
+36 ;S DIR("A")="Want to print the New Version of the HCFA-1500 (Y/N)"
+37 ;D ^DIR
+38 ;I Y S ABMY("FORM")=3_U_$P(^ABMDEXP(3,0),U)
End DoDot:1
+39 ;end old code
+40 SET ABMP("EXP")=+ABMY("FORM")
+41 ;start new code abm*2.6*2 FIXPMS10006
+42 DO ^XBFMK
+43 ;S DIR(0)="S^T:TODAY'S DATE;O:ORIGINAL PRINT DATE" ;abm*2.6*11 HEAT81561
+44 ;abm*2.6*11 HEAT81561
SET DIR(0)="S^T:TODAY'S DATE;O:ORIGINAL PRINT DATE;A:APPROVAL DATE"
+45 SET DIR("A")="Reprint using which date"
+46 SET DIR("B")="TODAY"
+47 DO ^DIR
KILL DIR
+48 ;S ABMPDT=Y ;abm*2.6*4 HEAT17615
+49 ;abm*2.6*4 HEAT17615
SET ABMP("PRINTDT")=Y
+50 ;end new code FIXPMS10006
+51 WRITE !!?15,"(NOTE: "
+52 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),U,4)
WRITE "Plain Paper needs"
+53 IF '$TEST
WRITE $PIECE(ABMY("FORM"),U,2)," forms need"
+54 WRITE " to be loaded in the printer.)"
+55 WRITE !!
+56 SET %ZIS("A")="Output DEVICE: "
+57 SET %ZIS="PQ"
+58 DO ^%ZIS
+59 IF POP
GOTO XIT
+60 IF IO'=IO(0)
IF IOT'="HFS"
Begin DoDot:1
+61 DO QUE2
+62 DO HOME^%ZIS
End DoDot:1
QUIT
+63 USE IO(0)
+64 IF '$DATA(IO("S"))
WRITE !!,"Printing..."
+65 USE IO
+66 GOTO ENT
+67 ;
QUE2 ;
+1 IF IO=IO(0)
WRITE !,"Cannot Queue to Screen or Slave Printer!",!
GOTO ZIS
+2 SET ZTRTN="TSK^ABMDFRDO"
+3 SET ZTDESC="3P Re-Print of Selective Bill."
+4 FOR ABM="ZTRTN","ZTDESC","ABMP(","ABMY("
SET ZTSAVE(ABM)=""
+5 DO ^%ZTLOAD
+6 IF $DATA(ZTSK)
WRITE !,"(Job Queued, Task Number: ",ZTSK,")"
+7 GOTO OUT
+8 ;
TSK ; Taskman Entry Point
+1 SET ABMP("Q")=""
+2 ;
ENT ;
+1 IF '$DATA(ABMY("BATCH"))
Begin DoDot:1
+2 SET ABMY=0
+3 FOR
SET ABMY=$ORDER(ABMY(ABMY))
IF 'ABMY
QUIT
Begin DoDot:2
+4 SET ABMP("BDFN")=ABMY
+5 DO FORMS
End DoDot:2
End DoDot:1
GOTO OUT
+6 SET ABMY=0
+7 FOR
SET ABMY=$ORDER(^ABMDBILL(DUZ(2),"AX",ABMY("BATCH"),ABMY))
IF 'ABMY
QUIT
Begin DoDot:1
+8 ; Quit if bill status is Reviewed, Approved, or Cancelled
+9 IF "RAX"[$PIECE($GET(^ABMDBILL(DUZ(2),ABMY,0)),U,4)
QUIT
+10 SET ABMP("BDFN")=ABMY
+11 DO FORMS
End DoDot:1
+12 GOTO OUT
+13 ;
FORMS ; Reprint Forms
+1 KILL ABMP("PAYED")
+2 IF ABMP("EXP")>2
DO @("ENT^ABMDF"_+ABMY("FORM"))
QUIT
+3 ;
UB82 ;
+1 IF +ABMY("FORM")=1
Begin DoDot:1
+2 DO ENT^ABMDF1
DO ^ABMDF1X
+3 IF $DATA(ABMR)=10
DO UB82^ABMDF1
End DoDot:1
QUIT
+4 ;
HCFA ;
+1 DO ENT^ABMDF2
+2 IF +$ORDER(ABMR(""))
SET ABMR("MORE")=""
+3 DO ^ABMDF2X
+4 IF +$ORDER(ABMR(""))
DO HCFA^ABMDF2
+5 QUIT
+6 ;
OUT ;
+1 DO ^%ZISC
+2 ;
XIT ;
+1 IF $GET(ABMY("TOT"))
DO WTOT^ABMDFUTL
+2 KILL ABMP,ABMY,DIQ
+3 QUIT
+4 ;
CKMULT ; check if form is used for multiple bills
+1 IF $PIECE($GET(^ABMDEXP($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),1)),U,3)
Begin DoDot:1
+2 WRITE !!,*7,"Bill Number "
+3 WRITE $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
+4 WRITE " was exported on a "
+5 WRITE $PIECE(^ABMDEXP($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6),0),U)
+6 WRITE " form. Since this form may"
+7 WRITE !,"include multiple bills, a single bill can not be individually reprinted."
+8 WRITE !,"Thus, to reprint the bill you must reprint the entire export batch."
+9 KILL ABMP("BDFN")
End DoDot:1
+10 QUIT
