ABMDRTX1 ; IHS/ASDST/DMJ - Print Transmittal Report ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;03/25/96 11:29 AM
;
; IHS/SD/SDR - v2.5 p13 - NO IM
;
Q:$D(DUOUT)!$D(DTOUT)
G:$D(IO("Q")) QUE
I IO'=IO(0),$E(IOST)'="C",'$D(IO("S")),$P($G(^ABMDPARM(DUZ(2),1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! G QUE
;
PRQUE ;EP - Entry Point for Taskman
K ^TMP("ABM-TX",$J)
S ABM("HD",0)="TRANSMITTAL LIST "
S ABM("HD")="(Export No: "
S ABM("PG")=0
S ABM=0
F ABM("I")=1:1 S ABM=$O(ABM("DFN",ABM)) Q:'ABM D
.I ABM("I")=1 S ABM("HD")=ABM("HD")_ABM Q
.S ABM("HD")=ABM("HD")_","_ABM
S ABM("HD")=ABM("HD")_")"
S ABM("DFN")=0
F S ABM("DFN")=$O(ABM("DFN",ABM("DFN"))) Q:'ABM("DFN") D
.S ABM=""
.F S ABM=$O(^ABMDBILL(DUZ(2),"AX",ABM("DFN"),ABM)) Q:'ABM D DATA
G WRT
;
DATA ;
Q:'$D(^ABMDBILL(DUZ(2),ABM,0))
S ABMBILL0=$G(^ABMDBILL(DUZ(2),ABM,0))
S ABM("L")=$P(ABMBILL0,U,3)
S ABM("V")=$P(ABMBILL0,U,7)
S ABM("P")=$P(ABMBILL0,U,5)
Q:ABM("L")=""!(ABM("V")="")!(ABM("P")="")
S ^TMP("ABM-TX",$J,$P(^DIC(4,ABM("L"),0),U)_U_ABM("V")_U_$P(^DPT(ABM("P"),0),U)_U_ABM)=""
Q
;
WRT ;
S IOP=ABM("IOP")
D ^%ZIS
Q:$G(POP)
U IO
D HD
S (ABM("TOT"),ABM("CNT"),ABM("SUBTOT"),ABM("SUBCNT"))=0
S (ABM("L"),ABM("V"))=""
S ABM("A")="^TMP(""ABM-TX"","_$J
S ABM=ABM("A")_")"
I '$D(@ABM) G XIT
F S ABM=$Q(@ABM) Q:ABM'[ABM("A")_"," D G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.I $Y>(IOSL-7),$E(IOST)="C",'$D(IO("S")) K DIR S DIR(0)="E" D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D HD,LOC W " (cont)"
.I $Y>(IOSL-6) D HD,LOC W " (cont)"
.S ABM("T")=$P($P(ABM,",",3,99),"""",2)
.I ABM("L")'=$P(ABM("T"),U) D SUB,LOC
.S ABM("L")=$P(ABM("T"),U)
.I ABM("V")'=$P(ABM("T"),U,2) D SUB W !,$P(^ABMDVTYP($P(ABM("T"),U,2),0),U)
.S ABM("V")=$P(ABM("T"),U,2)
.Q:'$D(^ABMDBILL(DUZ(2),$P(ABM("T"),U,4),0))
.W !?5,$E($P(ABM("T"),U,3),1,27),?34,$P(^ABMDBILL(DUZ(2),$P(ABM("T"),U,4),0),U)_$S($P(^ABMDBILL(DUZ(2),$P(ABM("T"),U,4),0),U,4)="X":"*",1:""),?43,$E($P(^AUTNINS($P(^(0),U,8),0),U),1,26)
.W ?70,$J($FN($P(^ABMDBILL(DUZ(2),$P(ABM("T"),U,4),2),U),",",2),10) S ABM("TOT")=ABM("TOT")+$P(^(2),U),ABM("SUBTOT")=ABM("SUBTOT")+$P(^(2),U)
.S ABM("CNT")=ABM("CNT")+1
.S ABM("SUBCNT")=ABM("SUBCNT")+1
D SUB
W !?34,"======",?70,"=========="
W !?10,"Total:",?34,$J($FN(ABM("CNT"),",",0),5),?68,$J($FN(ABM("TOT"),",",2),12)
W $$EN^ABMVDF("IOF")
G XIT
;
HD ;
I 'ABM("PG") D
.I $L(ABM("HD"))<35 S ABM("HD",0)=ABM("HD",0)_ABM("HD") Q
.S ABM("HD",1)=ABM("HD")
S ABM("PG")=ABM("PG")+1
D WHD^ABMDRHD
W !?5,"""*"" following the bill number denotes a bill that has been cancelled"
W !?35,"BILL",?75,"BILL"
W !?11,"PATIENT",?34,"NUMBER",?46,"ACTIVE INSURER",?73,"AMOUNT"
W !,"-------------------------------------------------------------------------------"
Q
;
LOC ;
W !!?15,"Visit Location: ",$P(ABM("T"),U)
Q
;
SUB ;
Q:'ABM("SUBTOT")
W !?34,"------",?70,"----------"
W !?17,"Subtotal:",?34,$J($FN(ABM("SUBCNT"),",",0),5),?68,$J($FN(ABM("SUBTOT"),",",2),12),!
S ABM("SUBCNT")=0
S ABM("SUBTOT")=0
Q
;
XIT ;
D POUT^ABMDRUTL,^%ZISC
K ^TMP("ABM-TX",$J)
Q
;
QUE ;
S ZTRTN="PRQUE^ABMDRTX1"
S ZTDESC="3P TRANSMITTAL REPORT"
D QUE^ABMDRUTL
G XIT
ABMDRTX1 ; IHS/ASDST/DMJ - Print Transmittal Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;03/25/96 11:29 AM
+3 ;
+4 ; IHS/SD/SDR - v2.5 p13 - NO IM
+5 ;
+6 IF $DATA">DATA(DUOUT)!$DATA">DATA(DTOUT)
QUIT
+7 IF $DATA(IO("Q"))
GOTO QUE
+8 IF IO'=IO(0)
IF $EXTRACT(IOST)'="C"
IF '$DATA(IO("S"))
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,13)="Y"
WRITE !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",!
GOTO QUE
+9 ;
PRQUE ;EP - Entry Point for Taskman
+1 KILL ^TMP("ABM-TX",$JOB)
+2 SET ABM("HD",0)="TRANSMITTAL LIST "
+3 SET ABM("HD")="(Export No: "
+4 SET ABM("PG")=0
+5 SET ABM=0
+6 FOR ABM("I")=1:1
SET ABM=$ORDER(ABM("DFN",ABM))
IF 'ABM
QUIT
Begin DoDot:1
+7 IF ABM("I")=1
SET ABM("HD")=ABM("HD")_ABM
QUIT
+8 SET ABM("HD")=ABM("HD")_","_ABM
End DoDot:1
+9 SET ABM("HD")=ABM("HD")_")"
+10 SET ABM("DFN")=0
+11 FOR
SET ABM("DFN")=$ORDER(ABM("DFN",ABM("DFN")))
IF 'ABM("DFN")
QUIT
Begin DoDot:1
+12 SET ABM=""
+13 FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",ABM("DFN"),ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:1
+14 GOTO WRT
+15 ;
DATA ;
+1 IF '$DATA(^ABMDBILL(DUZ(2),ABM,0))
QUIT
+2 SET ABMBILL0=$GET(^ABMDBILL(DUZ(2),ABM,0))
+3 SET ABM("L")=$PIECE(ABMBILL0,U,3)
+4 SET ABM("V")=$PIECE(ABMBILL0,U,7)
+5 SET ABM("P")=$PIECE(ABMBILL0,U,5)
+6 IF ABM("L")=""!(ABM("V")="")!(ABM("P")="")
QUIT
+7 SET ^TMP("ABM-TX",$JOB,$PIECE(^DIC(4,ABM("L"),0),U)_U_ABM("V")_U_$PIECE(^DPT(ABM("P"),0),U)_U_ABM)=""
+8 QUIT
+9 ;
WRT ;
+1 SET IOP=ABM("IOP")
+2 DO ^%ZIS
+3 IF $GET(POP)
QUIT
+4 USE IO
+5 DO HD
+6 SET (ABM("TOT"),ABM("CNT"),ABM("SUBTOT"),ABM("SUBCNT"))=0
+7 SET (ABM("L"),ABM("V"))=""
+8 SET ABM("A")="^TMP(""ABM-TX"","_$JOB
+9 SET ABM=ABM("A")_")"
+10 IF '$DATA(@ABM)
GOTO XIT
+11 FOR
SET ABM=$QUERY(@ABM)
IF ABM'[ABM("A")_","
QUIT
Begin DoDot:1
+12 IF $Y>(IOSL-7)
IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
DO HD
DO LOC
WRITE " (cont)"
+13 IF $Y>(IOSL-6)
DO HD
DO LOC
WRITE " (cont)"
+14 SET ABM("T")=$PIECE($PIECE(ABM,",",3,99),"""",2)
+15 IF ABM("L")'=$PIECE(ABM("T"),U)
DO SUB
DO LOC
+16 SET ABM("L")=$PIECE(ABM("T"),U)
+17 IF ABM("V")'=$PIECE(ABM("T"),U,2)
DO SUB
WRITE !,$PIECE(^ABMDVTYP($PIECE(ABM("T"),U,2),0),U)
+18 SET ABM("V")=$PIECE(ABM("T"),U,2)
+19 IF '$DATA(^ABMDBILL(DUZ(2),$PIECE(ABM("T"),U,4),0))
QUIT
+20 WRITE !?5,$EXTRACT($PIECE(ABM("T"),U,3),1,27),?34,$PIECE(^ABMDBILL(DUZ(2),$PIECE(ABM("T"),U,4),0),U)_$SELECT($PIECE(^ABMDBILL(DUZ(2),$PIECE(ABM("T"),U,4),0),U,4)="X":"*",1:""),?43,$EXTRACT($PIECE(^AUTNINS($PIECE(^(0),U,8),0),U),1,26)
+21 WRITE ?70,$JUSTIFY($FNUMBER($PIECE(^ABMDBILL(DUZ(2),$PIECE(ABM("T"),U,4),2),U),",",2),10)
SET ABM("TOT")=ABM("TOT")+$PIECE(^(2),U)
SET ABM("SUBTOT")=ABM("SUBTOT")+$PIECE(^(2),U)
+22 SET ABM("CNT")=ABM("CNT")+1
+23 SET ABM("SUBCNT")=ABM("SUBCNT")+1
End DoDot:1
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
GOTO XIT
+24 DO SUB
+25 WRITE !?34,"======",?70,"=========="
+26 WRITE !?10,"Total:",?34,$JUSTIFY($FNUMBER(ABM("CNT"),",",0),5),?68,$JUSTIFY($FNUMBER(ABM("TOT"),",",2),12)
+27 WRITE $$EN^ABMVDF("IOF")
+28 GOTO XIT
+29 ;
HD ;
+1 IF 'ABM("PG")
Begin DoDot:1
+2 IF $LENGTH(ABM("HD"))<35
SET ABM("HD",0)=ABM("HD",0)_ABM("HD")
QUIT
+3 SET ABM("HD",1)=ABM("HD")
End DoDot:1
+4 SET ABM("PG")=ABM("PG")+1
+5 DO WHD^ABMDRHD
+6 WRITE !?5,"""*"" following the bill number denotes a bill that has been cancelled"
+7 WRITE !?35,"BILL",?75,"BILL"
+8 WRITE !?11,"PATIENT",?34,"NUMBER",?46,"ACTIVE INSURER",?73,"AMOUNT"
+9 WRITE !,"-------------------------------------------------------------------------------"
+10 QUIT
+11 ;
LOC ;
+1 WRITE !!?15,"Visit Location: ",$PIECE(ABM("T"),U)
+2 QUIT
+3 ;
SUB ;
+1 IF 'ABM("SUBTOT")
QUIT
+2 WRITE !?34,"------",?70,"----------"
+3 WRITE !?17,"Subtotal:",?34,$JUSTIFY($FNUMBER(ABM("SUBCNT"),",",0),5),?68,$JUSTIFY($FNUMBER(ABM("SUBTOT"),",",2),12),!
+4 SET ABM("SUBCNT")=0
+5 SET ABM("SUBTOT")=0
+6 QUIT
+7 ;
XIT ;
+1 DO POUT^ABMDRUTL
DO ^%ZISC
+2 KILL ^TMP("ABM-TX",$JOB)
+3 QUIT
+4 ;
QUE ;
+1 SET ZTRTN="PRQUE^ABMDRTX1"
+2 SET ZTDESC="3P TRANSMITTAL REPORT"
+3 DO QUE^ABMDRUTL
+4 GOTO XIT
