- 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
