ABMDRTX2 ; IHS/ASDST/DMJ - Transmittal Report by Insurer ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;03/25/96 11:32 AM
;
; IHS/SD/SDR - v2.5 p13 - NO IM
;
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-TX2",$J)
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("I")=$P(ABMBILL0,U,8)
S ABM("P")=$P(ABMBILL0,U,5)
Q:ABM("L")=""!(ABM("I")="")!(ABM("P")="")
S ^TMP("ABM-TX2",$J,$P(^AUTNINS(ABM("I"),0),U)_U_$P(^DPT(ABM("P"),0),U)_U_$P(^DIC(4,ABM("L"),0),U)_U_ABM)=""
Q
;
WRT ;
S IOP=ABM("IOP")
D ^%ZIS
Q:$G(POP)
U IO
W $$EN^ABMVDF("IOF")
S ABM("PG")=0
S (ABM("TOT"),ABM("CNT"),ABM("SUBTOT"),ABM("SUBCNT"))=0
S (ABM("L"),ABM("I"))=""
S ABM("A")="TMP(""ABM-TX2"","_$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 W " (cont)"
.I $Y>(IOSL-6) D HD W " (cont)"
.S ABM("T")=$P(ABM,"ABM-T",2),ABM("T")=$P($P(ABM("T"),",",3,99),"""",2)
.I ABM("I")'=$P(ABM("T"),U) D SUB,PAZ:ABM("I")]"" Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D INS,HD
.S ABM("I")=$P(ABM("T"),U) W !
.I ABM("P")'=$P(ABM("T"),U,2) W $E($P(ABM("T"),U,2),1,27)
.S ABM("P")=$P(ABM("T"),U,2)
.W ?29,$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:"") W:+$G(^(7)) ?37,$$SDT^ABMDUTL(+^(7))
.W ?48,$E($P(^DIC(4,$P(^ABMDBILL(DUZ(2),$P(ABM("T"),U,4),0),U,3),0),U),1,20)
.W ?69,$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,PAZ,HD
W !?29,"------",?69,"----------"
W !?10,"Total:",?29,$FN(ABM("CNT"),",",0),?68,$J($FN(ABM("TOT"),",",2),11)
W $$EN^ABMVDF("IOF")
G XIT
;
HD ;
S ABM("PG")=ABM("PG")+1
S ABM("RTYP")=1
S ABM("HD",0)="TRANSMITTAL LIST for "_$P(^AUTNINS($P(^ABMDBILL(DUZ(2),$P(ABM("T"),U,4),0),U,8),0),U)
D WHD^ABMDRHD
W !?5,"""*"" following the bill number denotes a bill that has been cancelled"
W !?30,"Bill",?38,"Visit",?50,"Visit",?72,"Bill"
W !?5,"Patient",?29,"Number",?38,"Date",?49,"Location",?71,"Amount"
W !,"-------------------------------------------------------------------------------"
Q
;
PAZ ;
I '$D(IO("Q")),$E(IOST)="C",'$D(IO("S")) K DIR S DIR(0)="E" D ^DIR K DIR
Q
;
INS ;
S ABM("PG")=0
Q
;
SUB ;
Q:'ABM("SUBTOT")
W !?29,"------",?69,"----------"
W !?7,"Subtotal:",?29,$FN(ABM("SUBCNT"),",",0),?68,$J($FN(ABM("SUBTOT"),",",2),11),!
S ABM("SUBCNT")=0,ABM("SUBTOT")=0
Q
;
XIT ;
D POUT^ABMDRUTL,^%ZISC
K ^TMP("ABM-TX2",$J)
Q
;
QUE ;
S ZTRTN="PRQUE^ABMDRTX2"
S ZTDESC="3P TRANSMITTAL REPORT"
D QUE^ABMDRUTL
G XIT
ABMDRTX2 ; IHS/ASDST/DMJ - Transmittal Report by Insurer ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;03/25/96 11:32 AM
+3 ;
+4 ; IHS/SD/SDR - v2.5 p13 - NO IM
+5 ;
+6 IF $DATA(IO("Q"))
GOTO QUE
+7 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
PRQUE ;EP - Entry Point for Taskman
+1 KILL ^TMP("ABM-TX2",$JOB)
+2 SET ABM("DFN")=0
+3 FOR
SET ABM("DFN")=$ORDER(ABM("DFN",ABM("DFN")))
IF 'ABM("DFN")
QUIT
Begin DoDot:1
+4 SET ABM=""
+5 FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",ABM("DFN"),ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:1
+6 GOTO WRT
+7 ;
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("I")=$PIECE(ABMBILL0,U,8)
+5 SET ABM("P")=$PIECE(ABMBILL0,U,5)
+6 IF ABM("L")=""!(ABM("I")="")!(ABM("P")="")
QUIT
+7 SET ^TMP("ABM-TX2",$JOB,$PIECE(^AUTNINS(ABM("I"),0),U)_U_$PIECE(^DPT(ABM("P"),0),U)_U_$PIECE(^DIC(4,ABM("L"),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 WRITE $$EN^ABMVDF("IOF")
+6 SET ABM("PG")=0
+7 SET (ABM("TOT"),ABM("CNT"),ABM("SUBTOT"),ABM("SUBCNT"))=0
+8 SET (ABM("L"),ABM("I"))=""
+9 SET ABM("A")="TMP(""ABM-TX2"","_$JOB
+10 SET ABM="^"_ABM("A")_")"
+11 IF '$DATA(@ABM)
GOTO XIT
+12 FOR
SET ABM=$QUERY(@ABM)
IF ABM'[ABM("A")_","
QUIT
Begin DoDot:1
+13 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
WRITE " (cont)"
+14 IF $Y>(IOSL-6)
DO HD
WRITE " (cont)"
+15 SET ABM("T")=$PIECE(ABM,"ABM-T",2)
SET ABM("T")=$PIECE($PIECE(ABM("T"),",",3,99),"""",2)
+16 IF ABM("I")'=$PIECE(ABM("T"),U)
DO SUB
IF ABM("I")]""
DO PAZ
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
DO INS
DO HD
+17 SET ABM("I")=$PIECE(ABM("T"),U)
WRITE !
+18 IF ABM("P")'=$PIECE(ABM("T"),U,2)
WRITE $EXTRACT($PIECE(ABM("T"),U,2),1,27)
+19 SET ABM("P")=$PIECE(ABM("T"),U,2)
+20 WRITE ?29,$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:"")
IF +$GET(^(7))
WRITE ?37,$$SDT^ABMDUTL(+^(7))
+21 WRITE ?48,$EXTRACT($PIECE(^DIC(4,$PIECE(^ABMDBILL(DUZ(2),$PIECE(ABM("T"),U,4),0),U,3),0),U),1,20)
+22 WRITE ?69,$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)
+23 SET ABM("CNT")=ABM("CNT")+1
+24 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
+25 DO SUB
DO PAZ
DO HD
+26 WRITE !?29,"------",?69,"----------"
+27 WRITE !?10,"Total:",?29,$FNUMBER(ABM("CNT"),",",0),?68,$JUSTIFY($FNUMBER(ABM("TOT"),",",2),11)
+28 WRITE $$EN^ABMVDF("IOF")
+29 GOTO XIT
+30 ;
HD ;
+1 SET ABM("PG")=ABM("PG")+1
+2 SET ABM("RTYP")=1
+3 SET ABM("HD",0)="TRANSMITTAL LIST for "_$PIECE(^AUTNINS($PIECE(^ABMDBILL(DUZ(2),$PIECE(ABM("T"),U,4),0),U,8),0),U)
+4 DO WHD^ABMDRHD
+5 WRITE !?5,"""*"" following the bill number denotes a bill that has been cancelled"
+6 WRITE !?30,"Bill",?38,"Visit",?50,"Visit",?72,"Bill"
+7 WRITE !?5,"Patient",?29,"Number",?38,"Date",?49,"Location",?71,"Amount"
+8 WRITE !,"-------------------------------------------------------------------------------"
+9 QUIT
+10 ;
PAZ ;
+1 IF '$DATA(IO("Q"))
IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+2 QUIT
+3 ;
INS ;
+1 SET ABM("PG")=0
+2 QUIT
+3 ;
SUB ;
+1 IF 'ABM("SUBTOT")
QUIT
+2 WRITE !?29,"------",?69,"----------"
+3 WRITE !?7,"Subtotal:",?29,$FNUMBER(ABM("SUBCNT"),",",0),?68,$JUSTIFY($FNUMBER(ABM("SUBTOT"),",",2),11),!
+4 SET ABM("SUBCNT")=0
SET ABM("SUBTOT")=0
+5 QUIT
+6 ;
XIT ;
+1 DO POUT^ABMDRUTL
DO ^%ZISC
+2 KILL ^TMP("ABM-TX2",$JOB)
+3 QUIT
+4 ;
QUE ;
+1 SET ZTRTN="PRQUE^ABMDRTX2"
+2 SET ZTDESC="3P TRANSMITTAL REPORT"
+3 DO QUE^ABMDRUTL
+4 GOTO XIT
