ABMDFRDO ; IHS/ASDST/DMJ - Re-Print Selected Bills ; [ 10/11/2002 10:54 AM ]
;;2.5;IHS 3P BILLING SYSTEM;**2**;APR 05, 2002
;Original;TMD;02/21/96 12:13 PM
;
; IHS/ASDS/LSL - 06/29/00 - V2.4 Patch 2 - NOIS XAA-0600-200091 V2.4
; Modified to allow reprint of new export modes (13,15,17)
;
; IHS/ASDS/LSL - 05/04/01 - V2.4 Patch 5 - NOIS HQW-0401-100014
; Modified to allow reprint of all new electronic exports for
; UB-92's and HCFA-1500's regardless of when they are added.
; Check UB's only once in code instead of 3 times.
;
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("FORM")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)_U_$P($G(^ABMDEXP($P(^(0),U,6),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 ;
S:$P(ABMY("FORM"),U,2)["UB-92-E" ABMY("FORM")="11^UB-92"
S:$P(ABMY("FORM"),U,2)["HCFA-1500-E" ABMY("FORM")="14^HCFA-1500 Y2K"
I +ABMY("FORM")=2,$P($G(^ABMDPARM(DUZ(2),1,2)),9)=2 D G XIT:$D(DIRUT)
.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)
S ABMP("EXP")=+ABMY("FORM")
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="NPQ"
S %ZIS("B")=""
D ^%ZIS
G XIT:POP
I IO'=IO(0) D QUE2,HOME^%ZIS Q
I $D(IOPAR) S %ZIS("IOPAR")=IOPAR
U IO(0)
;W !!,"Printing..." ;*** TESTING - AEF *** COMMENTED OUT AND REPLACED BY LINE BELOW
I $E(IOST)="C" W !!,"Printing..." ;*** TESTING - AEF *** WRITE ONLY TO A TERMINAL SCREEN
S IOP=ION
D ^%ZIS
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") ; LSM/12-13-96
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 ; [ 10/11/2002 10:54 AM ]
+1 ;;2.5;IHS 3P BILLING SYSTEM;**2**;APR 05, 2002
+2 ;Original;TMD;02/21/96 12:13 PM
+3 ;
+4 ; IHS/ASDS/LSL - 06/29/00 - V2.4 Patch 2 - NOIS XAA-0600-200091 V2.4
+5 ; Modified to allow reprint of new export modes (13,15,17)
+6 ;
+7 ; IHS/ASDS/LSL - 05/04/01 - V2.4 Patch 5 - NOIS HQW-0401-100014
+8 ; Modified to allow reprint of all new electronic exports for
+9 ; UB-92's and HCFA-1500's regardless of when they are added.
+10 ; Check UB's only once in code instead of 3 times.
+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("FORM")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,6)_U_$PIECE($GET(^ABMDEXP($PIECE(^(0),U,6),0)),U)
+18 GOTO SEL
+19 ;
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 ;
+1 IF $PIECE(ABMY("FORM"),U,2)["UB-92-E"
SET ABMY("FORM")="11^UB-92"
+2 IF $PIECE(ABMY("FORM"),U,2)["HCFA-1500-E"
SET ABMY("FORM")="14^HCFA-1500 Y2K"
+3 IF +ABMY("FORM")=2
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,2)),9)=2
Begin DoDot:1
+4 WRITE !!,"Forms Previously Printed on Old HCFA-1500.",!!
+5 KILL DIR
+6 SET DIR(0)="Y"
+7 SET DIR("B")="Y"
+8 SET DIR("A")="Want to print the New Version of the HCFA-1500 (Y/N)"
+9 DO ^DIR
+10 IF Y
SET ABMY("FORM")=3_U_$PIECE(^ABMDEXP(3,0),U)
End DoDot:1
IF $DATA(DIRUT)
GOTO XIT
+11 SET ABMP("EXP")=+ABMY("FORM")
+12 WRITE !!?15,"(NOTE: "
+13 IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),1)),U,4)
WRITE "Plain Paper needs"
+14 IF '$TEST
WRITE $PIECE(ABMY("FORM"),U,2)," forms need"
+15 WRITE " to be loaded in the printer.)"
+16 WRITE !!
+17 SET %ZIS("A")="Output DEVICE: "
+18 SET %ZIS="NPQ"
+19 SET %ZIS("B")=""
+20 DO ^%ZIS
+21 IF POP
GOTO XIT
+22 IF IO'=IO(0)
DO QUE2
DO HOME^%ZIS
QUIT
+23 IF $DATA(IOPAR)
SET %ZIS("IOPAR")=IOPAR
+24 USE IO(0)
+25 ;W !!,"Printing..." ;*** TESTING - AEF *** COMMENTED OUT AND REPLACED BY LINE BELOW
+26 ;*** TESTING - AEF *** WRITE ONLY TO A TERMINAL SCREEN
IF $EXTRACT(IOST)="C"
WRITE !!,"Printing..."
+27 SET IOP=ION
+28 DO ^%ZIS
+29 GOTO ENT
+30 ;
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 ; LSM/12-13-96
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
