ABMDRTX2.m

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