- BARRAMR3 ; IHS/SD/LSL - Aging management report ;
- ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
- ;
- ; IHS/ASDS/LSL - 09/26/00 - Routine created
- ; Summary print of Aging management report
- ;
- ; IHS/SD/LSL - 07/08/02 - V1.6 Patch 2
- ; Modified to print missing clinics and visit types
- Q
- ; *********************************************************************
- ;
- SUMM ; EP
- S BAR("COL")="W !,""A/R Account"",?32,""Bill Total"",?50,""Amount Billed"",?70,""Balance"""
- S:BAR("HD",0)["Bills" BAR("HD",0)="SUMMARY Bills"_$P(BAR("HD",0),"Bills",2,99)
- S:BAR("HD",0)["Aging" BAR("HD",0)="SUMMARY Aging"_$P(BAR("HD",0),"Aging",2,99)
- D HDB^BARRAMR2
- S (BAR("CNT"),BAR("AMT"),BAR("BAL"))=0
- I '$D(BAR("ST")) D Q
- . W !!!,"*** NO DATA TO PRINT ***"
- . D EOP^BARUTL(0)
- S (BAR("TCNT"),BAR("TAMT"),BAR("TBAL"))=0
- S (BAR(1),BAR("O1"),BAR("O2"))=""
- F S BAR(1)=$O(BAR("ST",BAR(1))) Q:BAR(1)=""!($G(BAR("F1"))) D
- . I BAR(1)'=BAR("O1") D HD1
- . S BAR(2)=""
- . F S BAR(2)=$O(BAR("ST",BAR(1),BAR(2))) Q:BAR(2)=""!($G(BAR("F1"))) D
- . . I BAR(2)'=BAR("O2") D HD2
- . . S BAR(3)=""
- . . F S BAR(3)=$O(BAR("ST",BAR(1),BAR(2),BAR(3))) Q:BAR(3)=""!($G(BAR("F1"))) D
- . . . I $Y>(IOSL-5) D HD^BARRAMR2 Q:$G(BAR("F1"))
- . . . S BAR("CNT")=$P(BAR("ST",BAR(1),BAR(2),BAR(3)),U)
- . . . S BAR("AMT")=$P(BAR("ST",BAR(1),BAR(2),BAR(3)),U,2)
- . . . S BAR("BAL")=$P(BAR("ST",BAR(1),BAR(2),BAR(3)),U,3)
- . . . W !,$E(BAR(3),1,30) ; A/R Account
- . . . W ?35,$J(BAR("CNT"),4) ; Bill count
- . . . W ?50,$J($FN(BAR("AMT"),",",2),13) ; Amt billed
- . . . W ?65,$J($FN(BAR("BAL"),",",2),13) ; Balance
- . . . S BAR("CNT1")=BAR("CNT1")+BAR("CNT") ; Count per loc
- . . . S BAR("AMT1")=BAR("AMT1")+BAR("AMT") ; Amt per loc
- . . . S BAR("BAL1")=BAR("BAL1")+BAR("BAL") ; Balance per loc
- . . . S BAR("CNT2")=BAR("CNT2")+BAR("CNT") ; Count per sort
- . . . S BAR("AMT2")=BAR("AMT2")+BAR("AMT") ; Amt per sort
- . . . S BAR("BAL2")=BAR("BAL2")+BAR("BAL") ; Balance per sort
- . . . S BAR("TCNT")=BAR("TCNT")+BAR("CNT") ; Grand Count
- . . . S BAR("TAMT")=BAR("TAMT")+BAR("AMT") ; Grand Amt
- . . . S BAR("TBAL")=BAR("TBAL")+BAR("BAL") ; Grand Balance
- . . Q:$G(BAR("F1"))
- . . W !?35,"-----",?50,"-------------",?65,"-------------"
- . . I BARY("SORT")="C" W !,"Clinic type subtotal"
- . . E W !," Visit type subtotal"
- . . W ?35,$J(BAR("CNT2"),4) ; Bill count
- . . W ?50,$J($FN(BAR("AMT2"),",",2),13) ; Amt billed
- . . W ?65,$J($FN(BAR("BAL2"),",",2),13) ; Balance
- . Q:$G(BAR("F1"))
- . W !?35,"-----",?50,"-------------",?65,"-------------"
- . W !,"Visit location total"
- . W ?35,$J(BAR("CNT1"),4) ; Bill count
- . W ?50,$J($FN(BAR("AMT1"),",",2),13) ; Amt billed
- . W ?65,$J($FN(BAR("BAL1"),",",2),13) ; Balance
- Q:$G(BAR("F1"))
- W !?35,"=====",?50,"=============",?65,"============="
- W !,"*** REPORT TOTAL ***"
- W ?35,$J(BAR("TCNT"),4) ; Bill count
- W ?50,$J($FN(BAR("TAMT"),",",2),13) ; Amt billed
- W ?65,$J($FN(BAR("TBAL"),",",2),13) ; Balance
- Q
- ; *********************************************************************
- ;
- HD1 ;
- W !!?5,"Visit Location: ",BAR(1)
- S BAR("O1")=BAR(1)
- S (BAR("CNT1"),BAR("AMT1"),BAR("BAL1"))=0
- Q
- ; *********************************************************************
- ;
- HD2 ;
- W !!?10
- I BARY("SORT")="C" D
- . W "Clinic: "
- . I BAR(2)=99999 W "NO CLINIC"
- . E W $P(^DIC(40.7,BAR(2),0),U)
- I BARY("SORT")="V" D
- . W "Visit Type: "
- . I BAR(2)=99999 W "NO VISIT TYPE"
- . E W $P(^ABMDVTYP(BAR(2),0),U)
- W !
- S BAR("O2")=BAR(2)
- S (BAR("CNT2"),BAR("AMT2"),BAR("BAL2"))=0
- Q
- BARRAMR3 ; IHS/SD/LSL - Aging management report ;
- +1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
- +2 ;
- +3 ; IHS/ASDS/LSL - 09/26/00 - Routine created
- +4 ; Summary print of Aging management report
- +5 ;
- +6 ; IHS/SD/LSL - 07/08/02 - V1.6 Patch 2
- +7 ; Modified to print missing clinics and visit types
- +8 QUIT
- +9 ; *********************************************************************
- +10 ;
- SUMM ; EP
- +1 SET BAR("COL")="W !,""A/R Account"",?32,""Bill Total"",?50,""Amount Billed"",?70,""Balance"""
- +2 IF BAR("HD",0)["Bills"
- SET BAR("HD",0)="SUMMARY Bills"_$PIECE(BAR("HD",0),"Bills",2,99)
- +3 IF BAR("HD",0)["Aging"
- SET BAR("HD",0)="SUMMARY Aging"_$PIECE(BAR("HD",0),"Aging",2,99)
- +4 DO HDB^BARRAMR2
- +5 SET (BAR("CNT"),BAR("AMT"),BAR("BAL"))=0
- +6 IF '$DATA(BAR("ST"))
- Begin DoDot:1
- +7 WRITE !!!,"*** NO DATA TO PRINT ***"
- +8 DO EOP^BARUTL(0)
- End DoDot:1
- QUIT
- +9 SET (BAR("TCNT"),BAR("TAMT"),BAR("TBAL"))=0
- +10 SET (BAR(1),BAR("O1"),BAR("O2"))=""
- +11 FOR
- SET BAR(1)=$ORDER(BAR("ST",BAR(1)))
- IF BAR(1)=""!($GET(BAR("F1")))
- QUIT
- Begin DoDot:1
- +12 IF BAR(1)'=BAR("O1")
- DO HD1
- +13 SET BAR(2)=""
- +14 FOR
- SET BAR(2)=$ORDER(BAR("ST",BAR(1),BAR(2)))
- IF BAR(2)=""!($GET(BAR("F1")))
- QUIT
- Begin DoDot:2
- +15 IF BAR(2)'=BAR("O2")
- DO HD2
- +16 SET BAR(3)=""
- +17 FOR
- SET BAR(3)=$ORDER(BAR("ST",BAR(1),BAR(2),BAR(3)))
- IF BAR(3)=""!($GET(BAR("F1")))
- QUIT
- Begin DoDot:3
- +18 IF $Y>(IOSL-5)
- DO HD^BARRAMR2
- IF $GET(BAR("F1"))
- QUIT
- +19 SET BAR("CNT")=$PIECE(BAR("ST",BAR(1),BAR(2),BAR(3)),U)
- +20 SET BAR("AMT")=$PIECE(BAR("ST",BAR(1),BAR(2),BAR(3)),U,2)
- +21 SET BAR("BAL")=$PIECE(BAR("ST",BAR(1),BAR(2),BAR(3)),U,3)
- +22 ; A/R Account
- WRITE !,$EXTRACT(BAR(3),1,30)
- +23 ; Bill count
- WRITE ?35,$JUSTIFY(BAR("CNT"),4)
- +24 ; Amt billed
- WRITE ?50,$JUSTIFY($FNUMBER(BAR("AMT"),",",2),13)
- +25 ; Balance
- WRITE ?65,$JUSTIFY($FNUMBER(BAR("BAL"),",",2),13)
- +26 ; Count per loc
- SET BAR("CNT1")=BAR("CNT1")+BAR("CNT")
- +27 ; Amt per loc
- SET BAR("AMT1")=BAR("AMT1")+BAR("AMT")
- +28 ; Balance per loc
- SET BAR("BAL1")=BAR("BAL1")+BAR("BAL")
- +29 ; Count per sort
- SET BAR("CNT2")=BAR("CNT2")+BAR("CNT")
- +30 ; Amt per sort
- SET BAR("AMT2")=BAR("AMT2")+BAR("AMT")
- +31 ; Balance per sort
- SET BAR("BAL2")=BAR("BAL2")+BAR("BAL")
- +32 ; Grand Count
- SET BAR("TCNT")=BAR("TCNT")+BAR("CNT")
- +33 ; Grand Amt
- SET BAR("TAMT")=BAR("TAMT")+BAR("AMT")
- +34 ; Grand Balance
- SET BAR("TBAL")=BAR("TBAL")+BAR("BAL")
- End DoDot:3
- +35 IF $GET(BAR("F1"))
- QUIT
- +36 WRITE !?35,"-----",?50,"-------------",?65,"-------------"
- +37 IF BARY("SORT")="C"
- WRITE !,"Clinic type subtotal"
- +38 IF '$TEST
- WRITE !," Visit type subtotal"
- +39 ; Bill count
- WRITE ?35,$JUSTIFY(BAR("CNT2"),4)
- +40 ; Amt billed
- WRITE ?50,$JUSTIFY($FNUMBER(BAR("AMT2"),",",2),13)
- +41 ; Balance
- WRITE ?65,$JUSTIFY($FNUMBER(BAR("BAL2"),",",2),13)
- End DoDot:2
- +42 IF $GET(BAR("F1"))
- QUIT
- +43 WRITE !?35,"-----",?50,"-------------",?65,"-------------"
- +44 WRITE !,"Visit location total"
- +45 ; Bill count
- WRITE ?35,$JUSTIFY(BAR("CNT1"),4)
- +46 ; Amt billed
- WRITE ?50,$JUSTIFY($FNUMBER(BAR("AMT1"),",",2),13)
- +47 ; Balance
- WRITE ?65,$JUSTIFY($FNUMBER(BAR("BAL1"),",",2),13)
- End DoDot:1
- +48 IF $GET(BAR("F1"))
- QUIT
- +49 WRITE !?35,"=====",?50,"=============",?65,"============="
- +50 WRITE !,"*** REPORT TOTAL ***"
- +51 ; Bill count
- WRITE ?35,$JUSTIFY(BAR("TCNT"),4)
- +52 ; Amt billed
- WRITE ?50,$JUSTIFY($FNUMBER(BAR("TAMT"),",",2),13)
- +53 ; Balance
- WRITE ?65,$JUSTIFY($FNUMBER(BAR("TBAL"),",",2),13)
- +54 QUIT
- +55 ; *********************************************************************
- +56 ;
- HD1 ;
- +1 WRITE !!?5,"Visit Location: ",BAR(1)
- +2 SET BAR("O1")=BAR(1)
- +3 SET (BAR("CNT1"),BAR("AMT1"),BAR("BAL1"))=0
- +4 QUIT
- +5 ; *********************************************************************
- +6 ;
- HD2 ;
- +1 WRITE !!?10
- +2 IF BARY("SORT")="C"
- Begin DoDot:1
- +3 WRITE "Clinic: "
- +4 IF BAR(2)=99999
- WRITE "NO CLINIC"
- +5 IF '$TEST
- WRITE $PIECE(^DIC(40.7,BAR(2),0),U)
- End DoDot:1
- +6 IF BARY("SORT")="V"
- Begin DoDot:1
- +7 WRITE "Visit Type: "
- +8 IF BAR(2)=99999
- WRITE "NO VISIT TYPE"
- +9 IF '$TEST
- WRITE $PIECE(^ABMDVTYP(BAR(2),0),U)
- End DoDot:1
- +10 WRITE !
- +11 SET BAR("O2")=BAR(2)
- +12 SET (BAR("CNT2"),BAR("AMT2"),BAR("BAL2"))=0
- +13 QUIT
