- ABMDRAL1 ; IHS/ASDST/DMJ - Bills Listing-80 Width ;
- ;;2.6;IHS 3P BILLING SYSTEM;**9,14,21**;NOV 12, 2009;Build 379
- ;Original;TMD;
- ; IHS/SD/SDR - 2.6*9 = HEAT35406 - Correction to itemized report
- ;IHS/SD/SDR - 2.6*21 - HEAT112271 - Changed PAID to POSTED. It looks for an entry in the 3P multiple, not
- ; specifically for a pymt.
- ;
- PRINT ;EP for printing data
- D ^ABMDRHD ;abm*2.6*9 HEAT35406
- S ABM("PG")=0 D HDB
- S (ABM("CNT1"),ABM("CNT2"),ABM("CNT"),ABM("TOT1"),ABM("TOT2"),ABM("TOT"),ABM("PD"),ABM("PDT1"),ABM("PDT2"),ABM("PDT"))=0,(ABM("A"),ABM("L"),ABM("V"))=""
- S ABM("Z")="TMP(""ABM-AL"","_$J,ABM="^"_ABM("Z")_")" I '$D(@ABM) G XIT
- F S ABM=$Q(@ABM) Q:ABM'[ABM("Z") D G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- .I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D SUBHD W " (cont)"
- .S ABM("T")=$P(ABM,"ABM-A",2),ABM("TXT")=$P($P(ABM("T"),",",3,99),"""",2,99)
- .S ABM("C")=$G(^ABMDBILL(DUZ(2),+$P(ABM("TXT"),U,5),0)) Q:ABM("C")="" S ABM("T")=+^(2),ABM("D")=$P($G(^(1)),U,7) S:ABM("D")]"" ABM("D")=+$G(^ABMDTXST(DUZ(2),ABM("D"),0))
- .I ABM("L")'=$P(ABM("TXT"),U) D SUB:ABM("L")]"",SUBHD S ABM("V")=""
- .S ABM("L")=$P(ABM("TXT"),U)
- .I ABM("V")'=$P(ABM("TXT"),U,2) D SUB2:ABM("V")]"" W:ABM("V")]"" ! W !?7,$S(ABMY("SORT")="C":" Clinic: "_$P(^DIC(40.7,$P(ABM("TXT"),U,2),0),U),1:"Visit Type: "_$P(^ABMDVTYP($P(ABM("TXT"),U,2),0),U))
- .S ABM("V")=$P(ABM("TXT"),U,2)
- .D WRT
- D SUB,TOT G XIT
- ;
- WRT W ! W:ABM("I")'=$P(ABM("C"),U,8) $E($P(^AUTNINS($P(ABM("C"),U,8),0),U),1,18) S ABM("I")=$P(ABM("C"),U,8)
- W ?20,$P(ABM("C"),U)
- W ?28,$S($D(^AUPNPAT($P(ABM("C"),U,5),41,$P(ABM("C"),U,3),0)):$P(^(0),U,2),$D(^AUPNPAT($P(ABM("C"),U,5),41,DUZ(2),0)):$P(^(0),U,2),1:"")
- W:ABM("D")]"" ?35,$$SDT^ABMDUTL(ABM("D"))
- W ?46,$J($FN(ABM("T"),",",2),10)
- S ABM("PD")=0 F ABM(0)=1:1 S ABM("PD")=$O(^ABMDBILL(DUZ(2),+$P(ABM("TXT"),U,5),3,ABM("PD"))) Q:'ABM("PD") S ABM("PDD")=$P(^(ABM("PD"),0),U),ABM("PD0")=$P(^(0),U,2) D
- .I $G(ABMY("DT"))="P",ABM("PDD")<ABMY("DT",1)!(ABM("PDD")>ABMY("DT",2)) S ABM(0)=ABM(0)-1 Q
- .W:ABM(0)>1 !
- .W ?58,$$SDT^ABMDUTL(ABM("PDD"))
- .W ?69,$J($FN(ABM("PD0"),",",2),10)
- .S ABM("PDT1")=ABM("PDT1")+ABM("PD0"),ABM("PDT2")=ABM("PDT2")+ABM("PD0"),ABM("PDT")=ABM("PDT")+ABM("PD0")
- .I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D SUBHD W " (cont)",!
- S ABM("CNT1")=ABM("CNT1")+1,ABM("CNT2")=ABM("CNT2")+1,ABM("CNT")=ABM("CNT")+1,ABM("TOT")=ABM("TOT")+ABM("T")
- S ABM("TOT1")=ABM("TOT1")+ABM("T"),ABM("TOT2")=ABM("TOT2")+ABM("T")
- Q
- ;
- TOT Q:ABM("CNT")=0
- W !?20,"======",?46,"==========",?69,"==========",!?3,"GRAND TOTAL:",?20,ABM("CNT"),?46,$J($FN(ABM("TOT"),",",2),10),?69,$J($FN(ABM("PDT"),",",2),10)
- S ABM("TOT")=0,ABM("PDT")=0
- Q
- ;
- HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- HDB S ABM("PG")=ABM("PG")+1,ABM("I")="" D WHD^ABMDRHD
- W !,?20,"Claim",?36,"Export",?50,"Billed",?60,"Date",?72,"Paid"
- ;W !?5,"Insurer",?20,"Number",?29,"HRN",?36,"Date",?50,"Amount",?60,"Paid",?71,"Amount" ;abm*2.6*21 IHS/SD/SDR HEAT112271
- W !?5,"Insurer",?20,"Number",?29,"HRN",?36,"Date",?50,"Amount",?60,"Posted",?71,"Amount" ;abm*2.6*21 IHS/SD/SDR HEAT112271
- S $P(ABM("LINE"),"-",80)="" W !,ABM("LINE") K ABM("LINE")
- Q
- ;
- SUBHD W:ABM("L")'="" ! W !?3,"Visit Location: ",$P(^DIC(4,$P(ABM("C"),U,3),0),U)
- Q
- ;
- SUB2 Q:'ABM("CNT2")
- W !?20,"------",?46,"----------",?69,"----------"
- W !?5,"Sub-total:",?20,ABM("CNT2"),?46,$J($FN(ABM("TOT2"),",",2),10),?69,$J($FN(ABM("PDT2"),",",2),10)
- S ABM("CNT2")=0,ABM("TOT2")=0,ABM("I")="",ABM("PDT2")=0
- Q
- ;
- SUB Q:'ABM("CNT1") D SUB2:ABM("CNT1")'=ABM("CNT2")
- W !?20,"------",?46,"----------",?69,"----------"
- W !?9,"Total:",?20,ABM("CNT1"),?46,$J($FN(ABM("TOT1"),",",2),10),?69,$J($FN(ABM("PDT1"),",",2),10)
- S (ABM("CNT1"),ABM("TOT1"),ABM("CNT2"),ABM("TOT2"),ABM("PDT1"),ABM("PDT2"))=0,ABM("I")=""
- Q
- ;
- XIT Q
- ABMDRAL1 ; IHS/ASDST/DMJ - Bills Listing-80 Width ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;**9,14,21**;NOV 12, 2009;Build 379
- +2 ;Original;TMD;
- +3 ; IHS/SD/SDR - 2.6*9 = HEAT35406 - Correction to itemized report
- +4 ;IHS/SD/SDR - 2.6*21 - HEAT112271 - Changed PAID to POSTED. It looks for an entry in the 3P multiple, not
- +5 ; specifically for a pymt.
- +6 ;
- PRINT ;EP for printing data
- +1 ;abm*2.6*9 HEAT35406
- DO ^ABMDRHD
- +2 SET ABM("PG")=0
- DO HDB
- +3 SET (ABM("CNT1"),ABM("CNT2"),ABM("CNT"),ABM("TOT1"),ABM("TOT2"),ABM("TOT"),ABM("PD"),ABM("PDT1"),ABM("PDT2"),ABM("PDT"))=0
- SET (ABM("A"),ABM("L"),ABM("V"))=""
- +4 SET ABM("Z")="TMP(""ABM-AL"","_$JOB
- SET ABM="^"_ABM("Z")_")"
- IF '$DATA(@ABM)
- GOTO XIT
- +5 FOR
- SET ABM=$QUERY(@ABM)
- IF ABM'[ABM("Z")
- QUIT
- Begin DoDot:1
- +6 IF $Y>(IOSL-5)
- DO HD
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- DO SUBHD
- WRITE " (cont)"
- +7 SET ABM("T")=$PIECE(ABM,"ABM-A",2)
- SET ABM("TXT")=$PIECE($PIECE(ABM("T"),",",3,99),"""",2,99)
- +8 SET ABM("C")=$GET(^ABMDBILL(DUZ(2),+$PIECE(ABM("TXT"),U,5),0))
- IF ABM("C")=""
- QUIT
- SET ABM("T")=+^(2)
- SET ABM("D")=$PIECE($GET(^(1)),U,7)
- IF ABM("D")]""
- SET ABM("D")=+$GET(^ABMDTXST(DUZ(2),ABM("D"),0))
- +9 IF ABM("L")'=$PIECE(ABM("TXT"),U)
- IF ABM("L")]""
- DO SUB
- DO SUBHD
- SET ABM("V")=""
- +10 SET ABM("L")=$PIECE(ABM("TXT"),U)
- +11 IF ABM("V")'=$PIECE(ABM("TXT"),U,2)
- IF ABM("V")]""
- DO SUB2
- IF ABM("V")]""
- WRITE !
- WRITE !?7,$SELECT(ABMY("SORT")="C":" Clinic: "_$PIECE(^DIC(40.7,$PIECE(ABM("TXT"),U,2),0),U),1:"Visit Type: "_$PIECE(^ABMDVTYP($PIECE(ABM("TXT"),U,2),0),U))
- +12 SET ABM("V")=$PIECE(ABM("TXT"),U,2)
- +13 DO WRT
- End DoDot:1
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- GOTO XIT
- +14 DO SUB
- DO TOT
- GOTO XIT
- +15 ;
- WRT WRITE !
- IF ABM("I")'=$PIECE(ABM("C"),U,8)
- WRITE $EXTRACT($PIECE(^AUTNINS($PIECE(ABM("C"),U,8),0),U),1,18)
- SET ABM("I")=$PIECE(ABM("C"),U,8)
- +1 WRITE ?20,$PIECE(ABM("C"),U)
- +2 WRITE ?28,$SELECT($DATA(^AUPNPAT($PIECE(ABM("C"),U,5),41,$PIECE(ABM("C"),U,3),0)):$PIECE(^(0),U,2),$DATA(^AUPNPAT($PIECE(ABM("C"),U,5),41,DUZ(2),0)):$PIECE(^(0),U,2),1:"")
- +3 IF ABM("D")]""
- WRITE ?35,$$SDT^ABMDUTL(ABM("D"))
- +4 WRITE ?46,$JUSTIFY($FNUMBER(ABM("T"),",",2),10)
- +5 SET ABM("PD")=0
- FOR ABM(0)=1:1
- SET ABM("PD")=$ORDER(^ABMDBILL(DUZ(2),+$PIECE(ABM("TXT"),U,5),3,ABM("PD")))
- IF 'ABM("PD")
- QUIT
- SET ABM("PDD")=$PIECE(^(ABM("PD"),0),U)
- SET ABM("PD0")=$PIECE(^(0),U,2)
- Begin DoDot:1
- +6 IF $GET(ABMY("DT"))="P"
- IF ABM("PDD")<ABMY("DT",1)!(ABM("PDD")>ABMY("DT",2))
- SET ABM(0)=ABM(0)-1
- QUIT
- +7 IF ABM(0)>1
- WRITE !
- +8 WRITE ?58,$$SDT^ABMDUTL(ABM("PDD"))
- +9 WRITE ?69,$JUSTIFY($FNUMBER(ABM("PD0"),",",2),10)
- +10 SET ABM("PDT1")=ABM("PDT1")+ABM("PD0")
- SET ABM("PDT2")=ABM("PDT2")+ABM("PD0")
- SET ABM("PDT")=ABM("PDT")+ABM("PD0")
- +11 IF $Y>(IOSL-5)
- DO HD
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- DO SUBHD
- WRITE " (cont)",!
- End DoDot:1
- +12 SET ABM("CNT1")=ABM("CNT1")+1
- SET ABM("CNT2")=ABM("CNT2")+1
- SET ABM("CNT")=ABM("CNT")+1
- SET ABM("TOT")=ABM("TOT")+ABM("T")
- +13 SET ABM("TOT1")=ABM("TOT1")+ABM("T")
- SET ABM("TOT2")=ABM("TOT2")+ABM("T")
- +14 QUIT
- +15 ;
- TOT IF ABM("CNT")=0
- QUIT
- +1 WRITE !?20,"======",?46,"==========",?69,"==========",!?3,"GRAND TOTAL:",?20,ABM("CNT"),?46,$JUSTIFY($FNUMBER(ABM("TOT"),",",2),10),?69,$JUSTIFY($FNUMBER(ABM("PDT"),",",2),10)
- +2 SET ABM("TOT")=0
- SET ABM("PDT")=0
- +3 QUIT
- +4 ;
- HD DO PAZ^ABMDRUTL
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- HDB SET ABM("PG")=ABM("PG")+1
- SET ABM("I")=""
- DO WHD^ABMDRHD
- +1 WRITE !,?20,"Claim",?36,"Export",?50,"Billed",?60,"Date",?72,"Paid"
- +2 ;W !?5,"Insurer",?20,"Number",?29,"HRN",?36,"Date",?50,"Amount",?60,"Paid",?71,"Amount" ;abm*2.6*21 IHS/SD/SDR HEAT112271
- +3 ;abm*2.6*21 IHS/SD/SDR HEAT112271
- WRITE !?5,"Insurer",?20,"Number",?29,"HRN",?36,"Date",?50,"Amount",?60,"Posted",?71,"Amount"
- +4 SET $PIECE(ABM("LINE"),"-",80)=""
- WRITE !,ABM("LINE")
- KILL ABM("LINE")
- +5 QUIT
- +6 ;
- SUBHD IF ABM("L")'=""
- WRITE !
- WRITE !?3,"Visit Location: ",$PIECE(^DIC(4,$PIECE(ABM("C"),U,3),0),U)
- +1 QUIT
- +2 ;
- SUB2 IF 'ABM("CNT2")
- QUIT
- +1 WRITE !?20,"------",?46,"----------",?69,"----------"
- +2 WRITE !?5,"Sub-total:",?20,ABM("CNT2"),?46,$JUSTIFY($FNUMBER(ABM("TOT2"),",",2),10),?69,$JUSTIFY($FNUMBER(ABM("PDT2"),",",2),10)
- +3 SET ABM("CNT2")=0
- SET ABM("TOT2")=0
- SET ABM("I")=""
- SET ABM("PDT2")=0
- +4 QUIT
- +5 ;
- SUB IF 'ABM("CNT1")
- QUIT
- IF ABM("CNT1")'=ABM("CNT2")
- DO SUB2
- +1 WRITE !?20,"------",?46,"----------",?69,"----------"
- +2 WRITE !?9,"Total:",?20,ABM("CNT1"),?46,$JUSTIFY($FNUMBER(ABM("TOT1"),",",2),10),?69,$JUSTIFY($FNUMBER(ABM("PDT1"),",",2),10)
- +3 SET (ABM("CNT1"),ABM("TOT1"),ABM("CNT2"),ABM("TOT2"),ABM("PDT1"),ABM("PDT2"))=0
- SET ABM("I")=""
- +4 QUIT
- +5 ;
- XIT QUIT
