Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARRCXL2

BARRCXL2.m

Go to the documentation of this file. 
  1. BARRCXL2 ; IHS/SD/LSL - Cancelled Bills Report - Print ;08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,19**;OCT 26, 2005
  1.  ;
  1.  ; IHS/SD/LSL - 03/10/03 - Routine created
  1.  ;      Called by BARRCXL
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892;
  1.  ; BAR*1.8*19 IHS/SD/PKD 5/12/10 - Added Cancelling Official to ^TMP indexing
  1.  ;                                 Report rewritten
  1.  ;    Moved orig code to the end of routine
  1.  ; ^TMP($J,"BAR-CXL",BARBCANC,   Mirrors 3PB rpt
  1.  Q
  1.  ; *************************
  1.  ;
  1. PRINT ; EP
  1.  ; Print
  1.  ; BAR*1.8*19 IHS/SD/PKD 5/12/10
  1.  N BARLOC,BARACCT,BARPAT,BARBILL,BARBAMT,BARBAL,BARBCANC
  1.  K BAR("D")
  1.  S BAR("PG")=0
  1.  I BARY("RTYP")=1 D DETAIL Q
  1.  E  D SUMMARY
  1.  Q
  1.  ;
  1. DETAIL ;
  1.  ; BAR*1.8*19 IHS/SD/PKD 5/12/10 
  1.  S BAR("COL")="W !?25,""Active"",?42,""Claim"",?53,""Visit"""
  1.  S BAR("COL")=BAR("COL")_",!?2,""Patient"",?18,""HRN"",?25,""Insurer"",?42,""Number"",?53,""Date"",?66,""Reason"""
  1.  S BAR("COL")=BAR("COL")_",!,?39,""# BILLS"",?51,""AMT BILLED"",?70,""BALANCE"""
  1.  D HDB^BARRPSRB  ; Print HIPAA etc
  1.  I '$D(^TMP($J,"BAR-CXL")) D  Q           ; No data - quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ;
  1. CASHIER ;
  1.  S BARBCANC=""  ; CANCELLING OFFICIAL
  1.  F  S BARBCANC=$O(^TMP($J,"BAR-CXL",BARBCANC)) Q:BARBCANC=""!($G(BAR("F1")))  D DETCANC
  1.  Q:$G(BAR("F1"))
  1.  D SUMTOT  ; REPORT TOTALS
  1.  Q
  1.  ;
  1. DETCANC  ;For each Cancelling Official (detail) do ...
  1.  W !,"Cancelling Official:  "
  1.  W $S(BARBCANC'=0:$P(^VA(200,BARBCANC,0),"^"),1:"Unknown Cancelling Official")
  1.  S BARLOC=""
  1.  F  S BARLOC=$O(^TMP($J,"BAR-CXL",BARBCANC,BARLOC)) Q:BARLOC=""!($G(BAR("F1")))  D DETLOC
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=^TMP($J,"BAR-CXL",BARBCANC)
  1.  W "Cancelling Official Subtotal: "  ;,$J(+^TMP($J,"BAR-CXL",BARBCANC),10),!
  1.  D TOTALS
  1.  Q
  1.  ; *****************************
  1.  ;
  1. DETLOC ;
  1.  ; For each visit location (detail)
  1.  Q:$G(BAR("F1"))
  1.  W !?5,"VISIT Location: ",BARLOC
  1.  N BAR3SORT S BAR3SORT=""	 ; 3RD SORT EITHER VISIT TYP or CLINIC
  1.  F  S BAR3SORT=$O(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT)) Q:BAR3SORT=""!($G(BAR("F1")))  D DETPAT
  1.  Q:$G(BAR("F1"))
  1.  D SUMLTOT  ; DETAIL LOCATION TOTAL
  1.  Q
  1.  ; ******************************
  1. DETPAT ;
  1.  ; For each patient w/in AR Account w/in Visit location (detail) do...
  1.  I BARY("SORT")="V" W !?10,"Visit Type: ",$P(^ABMDVTYP(BAR3SORT,0),U)
  1.  I BARY("SORT")="C" W !,?10,"Clinic: ",$P(^DIC(40.7,BAR3SORT,0),U)
  1.  S BARPAT=""
  1.  F  S BARPAT=$O(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT,BARPAT)) Q:BARPAT=""!($G(BAR("F1")))  D DETBILL
  1.  Q:$G(BAR("F1"))
  1.  W !,?16 D SUMACCT  ;  Visit Type or Clinic subtotals
  1.  Q
  1.  ; *******************************
  1. DETBILL ;
  1.  ; For each bill w/in Patient w/in AR Account w/in
  1.  N HRN,DOS,BARBREAS
  1.  S (BARBILL,HRN,DOS)=""
  1.  F  S BARBILL=$O(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT,BARPAT,BARBILL)) Q:BARBILL=""!($G(BAR("F1")))  D
  1.  . S MORE=$G(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT,BARPAT,BARBILL,"MORE"))
  1.  . S BARACCT=$P(MORE,U),DOS=$P(MORE,U,2),HRN=$P(MORE,U,3),BARBREAS=$P(MORE,U,4)
  1.  . S Y=DOS D DD^%DT S DOS=Y
  1.  . D DETLINE
  1.  Q
  1.  ; *****************************
  1.  ;
  1. DETLINE ; BAR*1.8*19 IHS/SD/PKD 5/12/10
  1.  ; Report mainline for detail report
  1.  Q:$G(BAR("F1"))
  1.  I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT,BARPAT,BARBILL))
  1.  W !,$E(BARPAT,1,17)  ;Patient Name
  1.  W ?18,HRN
  1.  W ?25,$E(BARACCT,1,14)
  1.  W ?41,$P(BARBILL,"-",1,2)  ; Just the bill, not the HRN
  1.  W ?52,DOS
  1.  I BARBREAS W ?65,$E(^ABMCBILR(BARBREAS,0),1,15)
  1.  E  W ?65,$E(BARBREAS,1,15)
  1.  Q
  1.  ; ********************************
  1.  ;
  1. SUMMARY ;
  1.  ; Print Summary Report
  1.  Q:$G(BAR("F1"))
  1.  S BARDASH="W !?52,""-------- SUMMARY"
  1.  S BAREQUAL="W !?52,""======="""
  1.  S BAR("COL")="W !,""A/R ACCOUNT"",?39,""# BILLS"",?51,""AMT BILLED"",?70,""BALANCE"""
  1.  D HDB^BARRPSRB
  1.  I '$D(^TMP($J,"BAR-CXL")) D  Q           ; No data - quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ;
  1. SUBCSH  ;
  1.  Q:$G(BAR("F1"))
  1.  S BARBCANC="" F  S BARBCANC=$O(^TMP($J,"BAR-CXL",BARBCANC)) Q:BARBCANC=""!($G(BAR("F1")))  D
  1.  . D SUBHD  ;  Print CancOff'cl Name
  1.  . S BARLOC=""
  1.  . F  S BARLOC=$O(^TMP($J,"BAR-CXL",BARBCANC,BARLOC)) Q:BARLOC=""!($G(BAR("F1")))  D SUMLOC
  1.  . S BARTMP=^TMP($J,"BAR-CXL",BARBCANC)
  1.  . W "Cancelling Official Subtotal: "  ;,$J(+^TMP($J,"BAR-CXL",BARBCANC),10),!
  1.  . Q:$G(BAR("F1"))  D TOTALS
  1.  Q:$G(BAR("F1"))
  1.  D SUMTOT
  1.  Q
  1.  ; *********************************
  1.  ;
  1. SUMLOC ;
  1.  ; For Each Visit Location (Summary) do..
  1.  Q:$G(BAR("F1"))
  1.  W !?5,"VISIT Location: ",BARLOC,!
  1.  S BAR3SORT=""  ; Visit Type or Clinic is 3rd sort
  1.  F  S BAR3SORT=$O(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT)) Q:BAR3SORT=""!($G(BAR("F1")))  D SUMACCT
  1.  Q:$G(BAR("F1"))
  1.  D SUMLTOT
  1.  Q
  1.  ; **********************************
  1.  ;
  1. SUMACCT ;
  1.  ; For each AR Account w/in Visit Location (Summary) do...
  1.  Q:$G(BAR("F1"))
  1.  I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BAR3SORT))
  1.  ; Remove Re-Printing of Visit type or clinic
  1.  ;N SUBNM,SUBCT
  1.  ;I BARY("SORT")="V" S SUBNM=$P(^ABMDVTYP(BAR3SORT,0),U)
  1.  ;. Q:BARY("RTYP")=1  W !,"Visit Type: " 
  1.  ;I BARY("SORT")="C" S SUBNM=$P(^DIC(40.7,BAR3SORT,0),U)
  1.  ;. Q:BARY("RTYP")=1  W !,"Clinic: " 
  1.  ;S SUBCT=39-$L(SUBNM) 
  1.  ;I BARY("RTYP")=1 W:$L(SUBNM)>26 !,?SUBCT ; drop a line if VstTy or Clnc Name>26
  1.  ;W SUBNM
  1.  N BARDSH S $P(BARDSH,"-",7)=""
  1.  W ?40,BARDSH,?50,BARDSH,BARDSH,?64,BARDSH,BARDSH,!
  1.  D TOTALS
  1.  Q
  1.  ; *********************************
  1. SUMLTOT ;
  1.  ; Visit location total (Summary) Report
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-CXL",BARBCANC,BARLOC))
  1.  W !,?2," ** VISIT Location Subtotal"
  1.  D TOTALS
  1.  Q
  1.  ; **********************************
  1. SUMTOT ;
  1.  ; Report Total (Summary)
  1.  ; BAR*1.8*19 IHS/SD/PKD 5/12/10 remove Amt & Bal from totals
  1.  Q:$G(BAR("F1"))
  1.  S BARTMP=$G(^TMP($J,"BAR-CXL"))
  1.  W !,"*** REPORT TOTAL"
  1.  D TOTALS
  1.  Q
  1.  ; ***********************************
  1. TOTALS  ;
  1.  Q:$G(BAR("F1"))
  1.  W ?39,$J($FN($P(BARTMP,U),","),7)              ; Bill count
  1.  W ?49,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  W ?63,$J($FN($P(BARTMP,U,3),",",2),13),!     ; Bill Balance
  1.  Q
  1.  ;
  1. SUBHD  ; 
  1.  Q:$G(BAR("F1"))
  1.  W !,"Cancelling Official: "
  1.  W $S(BARBCANC'=0:$P(^VA(200,BARBCANC,0),"^"),1:"Unknown Cancelling Official")
  1.  Q
  1.  ;  END OF REWRITTEN CODE BAR*1.8*19 PKD
  1.  ; *********************************
  1.  ; *********************************
  1.  ;Pre-Patch 19 totals BELOW  BAR*1.8*19 IHS/SD/PKD 6/1/10
  1.  ; *********************************
  1.  ; *********************************
  1.  ;PRINT ; EP
  1.  ; Print
  1.  ;N BARLOC,BARACCT,BARPAT,BARBILL,BARBAMT,BARBAL
  1.  ;K BAR("D")
  1.  ;S BAR("PG")=0
  1.  ;I BARY("RTYP")=1 D DETAIL Q
  1.  ;E  D SUMMARY
  1.  ;Q
  1.  ; *********************************************************************
  1.  ;
  1.  ;DETAIL ;
  1.  ;S BARDASH="W ?38,""-------------"",?63,""----------------"""
  1.  ;S BAREQUAL="W !?38,""============="",?63,""================"""
  1.  ;S BAR("COL")="W !?3,""BILL"",?19,""PATIENT NAME"",?41,""AMT BILLED"",?55,""DOS"",?72,""BALANCE"""
  1.  ;D HDB^BARRPSRB
  1.  ;I '$D(^TMP($J,"BAR-CXL")) D  Q           ; No data - quit
  1.  .; W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . ;D EOP^BARUTL(0)
  1.  ;
  1.  ;S BARLOC=""
  1.  ;F  S BARLOC=$O(^TMP($J,"BAR-CXL",BARLOC)) Q:BARLOC=""  D DETLOC Q:$G(BAR("F1"))
  1.  ;D DETTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETLOC ;
  1.  ; For each visit location (detail) do...
  1.  ;W !?5,"VISIT Location: ",BARLOC
  1.  ;S BARACCT=""
  1.  ;F  S BARACCT=$O(^TMP($J,"BAR-CXL",BARLOC,BARACCT)) Q:BARACCT=""  D DETACCT Q:$G(BAR("F1"))
  1.  ;D DETLTOT
  1.  ;Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETACCT ;
  1.  ; For each AR Account w/in Visit Location (detail) do...
  1.  ;W !?10,"A/R Account: ",BARACCT,!
  1.  ;S BARDOS=0
  1.  ;F  S BARDOS=$O(^TMP($J,"BAR-CXL",BARLOC,BARACCT,BARDOS)) Q:'+BARDOS  D DETPAT Q:$G(BAR("F1"))
  1.  ;D DETATOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETPAT ;
  1.  ; For each patient w/in AR Account w/in Visit location (detail) do...
  1.  ;S BARPAT=""
  1.  ;F  S BARPAT=$O(^TMP($J,"BAR-CXL",BARLOC,BARACCT,BARDOS,BARPAT)) Q:BARPAT=""  D DETBILL Q:$G(BAR("F1"))
  1.  ;Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETBILL ;
  1.  ; For each bill w/in Patient w/in AR Account w/in
  1.  ; Visit Location (detail) do...
  1.  ;S BARBILL=""
  1.  ;F  S BARBILL=$O(^TMP($J,"BAR-CXL",BARLOC,BARACCT,BARDOS,BARPAT,BARBILL)) Q:BARBILL=""  D DETLINE Q:$G(BAR("F1"))
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETLINE ;
  1.  ; Report mainline for detail report
  1.  ;I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL",BARLOC,BARACCT,BARDOS,BARPAT,BARBILL))
  1.  ;W !,$E(BARBILL,1,18)                         ; AR Bill
  1.  ;W ?19,$E(BARPAT,1,18)                        ; Patient
  1.  ;W ?38,$J($FN($P(BARTMP,U),",",2),13)         ; Billed Amount
  1.  ;W ?52,$$SDT^BARDUTL(BARDOS)
  1.  ;W ?63,$J($FN($P(BARTMP,U,2),",",2),16)       ; Bill Balance
  1.  ;Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETATOT ;
  1.  ; AR Account Total for Detail Report
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL",BARLOC,BARACCT))
  1.  ;W !
  1.  ;X BARDASH
  1.  ;W !?38,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  ;W ?52,"(",$P(BARTMP,U)," bills)"             ; Bill count
  1.  ;W ?63,$J($FN($P(BARTMP,U,3),",",2),16),!     ; Bill Balance
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETLTOT ;
  1.  ; Visit location total for Detail Report
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL",BARLOC))
  1.  ;X BARDASH
  1.  ;W !?5," ** VISIT Location Subtotal"
  1.  ;W ?38,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  ;W ?52,"(",$P(BARTMP,U)," bills)"             ; Bill count
  1.  ;W ?63,$J($FN($P(BARTMP,U,3),",",2),16),!     ; Bill Balance
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;DETTOT ;
  1.  ; Report total for detail report
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL"))
  1.  ;X BAREQUAL
  1.  ;W !?5,"*** REPORT TOTAL"
  1.  ;W ?38,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  ;W ?52,"(",$P(BARTMP,U)," bills)"             ; Bill count
  1.  ;W ?63,$J($FN($P(BARTMP,U,3),",",2),16)       ; Bill Balance
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;SUMMARY ;
  1.  ; Print Summary Report
  1.  ;S BARDASH="W !?32,""-------  -------------   ----------------"""
  1.  ;S BAREQUAL="W !?32,""=======  =============   ================"""
  1.  ;S BAR("COL")="W !,""A/R ACCOUNT"",?32,""# BILLS"",?44,""AMT BILLED"",?66,""BALANCE"""
  1.  ;D HDB^BARRPSRB
  1.  ;I '$D(^TMP($J,"BAR-CXL")) D  Q           ; No data - quit
  1.  ;. W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  ;. D EOP^BARUTL(0)
  1.  ;
  1.  ;S BARLOC=""
  1.  ;F  S BARLOC=$O(^TMP($J,"BAR-CXL",BARLOC)) Q:BARLOC=""  D SUMLOC Q:$G(BAR("F1"))
  1.  ;D SUMTOT
  1.  ;Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;SUMLOC ;
  1.  ; For Each Visit Location (Summary) do...
  1.  ;W !?5,"VISIT Location: ",BARLOC,!
  1.  ;S BARACCT=""
  1.  ;F  S BARACCT=$O(^TMP($J,"BAR-CXL",BARLOC,BARACCT)) Q:BARACCT=""  D SUMACCT Q:$G(BAR("F1"))
  1.  ;D SUMLTOT
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;SUMACCT ;
  1.  ; For each AR Account w/in Visit Location (Summary) do...
  1.  ;I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL",BARLOC,BARACCT))
  1.  ;W !,$E(BARACCT,1,30)
  1.  ;W ?32,$J($FN($P(BARTMP,U),","),7)              ; Bill count
  1.  ;W ?41,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  ;W ?57,$J($FN($P(BARTMP,U,3),",",2),16)       ; Bill Balance
  1.  ;Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;SUMLTOT ;
  1.  ; Visit location total (Summary) Report
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL",BARLOC))
  1.  ;X BARDASH
  1.  ;W !," ** VISIT Location Subtotal"
  1.  ;W ?32,$J($FN($P(BARTMP,U),","),7)               ; Bill count
  1.  ;W ?41,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  ;W ?57,$J($FN($P(BARTMP,U,3),",",2),16),!     ; Bill Balance
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1.  ;SUMTOT ;
  1.  ; Report Total (Summary)
  1.  ;S BARTMP=$G(^TMP($J,"BAR-CXL"))
  1.  ;X BAREQUAL
  1.  ;W !,"*** REPORT TOTAL"
  1.  ;W ?32,$J($FN($P(BARTMP,U),","),7)              ; Bill count
  1.  ;W ?41,$J($FN($P(BARTMP,U,2),",",2),13)         ; Billed Amount
  1.  ;W ?57,$J($FN($P(BARTMP,U,3),",",2),16)       ; Bill Balance
  1.  Q