IBCOPR ;WISC/RFJ,BOISE/WRL - print dollar amts for pre-registration ;05 May 97 8:30 AM [7/22/03 11:59am]
;;2.0;INTEGRATED BILLING;**75,345,528,664,668**;21-MAR-94;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
;IA - 3336 (IB REFERENCING 433)
;ib
W !!,"This report will print bills and payments within the user selected"
W !,"date range that are associated to an insurance policy with a source"
W !,"of information equal to the user selected criteria."
;
N CT,DATEEND,DATESTRT,DATETYPE,ENDDATE,IBCNFSUM,IBCNESOI,IBCNOUT,IBCNSORT,Q,WIDTH,X,Y
;
DATETYPE ;
;Prompt for the type of date to report on.
S DIR(0)="S^B:Billed Date;C:Collected Date",DIR("B")=""
S DIR("A")="Report by (B)ill Date or by (C)ollected Date?"
S DIR("?")="Enter B or C"
S DIR("??")="^D BCHELP^IBCOPR"
D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G EXIT
S DATETYPE=Y K DIR,Y
;
DATESEL ;Select Start and End Date
;Get Start Date
S DIR(0)="DA^::EX",DIR("B")=$$FMTE^XLFDT($E(DT,1,5)_"01")
S DIR("A")="Starting "_$S(DATETYPE="B":"Billed",1:"Collected")_" Date: "
D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G EXIT
I Y>DT W !,"FUTURE DATES ARE NOT ALLOWED." G DATESEL
S DATESTRT=Y K DIR,Y
;
ENDDATE ;
;Get End Date
S DIR(0)="DA^::EX",DIR("B")=$$FMTE^XLFDT(DT)
S DIR("A")=" Ending "_$S(DATETYPE="B":"Billed",1:"Collected")_" Date: "
D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G EXIT
I Y>DT W !,"FUTURE DATES ARE NOT ALLOWED." G ENDDATE
I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE." G ENDDATE
S DATEEND=Y K DIR,Y
W !!?5,"*** Selected ",$S(DATETYPE="B":"Billed",1:"Collected")_" Date"," range from ",$$FMTE^XLFDT(DATESTRT)," to ",$$FMTE^XLFDT(DATEEND)," ***",!
;
; select Source of Information (SOI)
SOISEL ; Select one SOI (source of information) or ALL - File #355.12
S CT=0 W !,"Enter Sources of Information to include one at a time OR <RETURN> for ALL."
SOISEL1 S DIC(0)="AMEQ"
S Q="Include Source of Information"
I CT S Q="Also "_Q
S DIC("A")=$$FO^IBCNEUT1(Q_": ",36,"R")
S DIC="^IBE(355.12,"
D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT) G EXIT
; If nothing was selected (Y=-1), select ALL sources
I Y=-1 G SUMMARY:CT=1 S IBCNESOI="A" G SUMMARY
S IBCNESOI($P(Y,"^",1))=$P(Y,"^",2),IBCNESOI=$G(IBCNESOI)+1,CT=1 G SOISEL1
;
SUMMARY ; ask to print detailed or summary report
S DIR(0)="S^D:Detailed;S:Summary;",DIR("B")="Summary"
S DIR("A")="Print (D)etailed or (S)ummary report?"
W ! D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G EXIT
S IBCNFSUM=Y="S"
;
SORT ;Sort the detail report
S IBCNSORT=""
I 'IBCNFSUM D
. S DIR(0)="S^P:Patient;I:Insurance;B:Billed Amount;C:Collected Amount;D:Date;S:Source of Information"
. S DIR("B")="Source of Information"
. S DIR("A")="Sort the report by"
. W ! D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q
. S IBCNSORT=Y
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G EXIT
;
OUT ; select Excel or Report format
N %ZIS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y,ZTDESC,ZTRTN,ZTSAVE
W !
S DIR(0)="S^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) G EXIT
S IBCNOUT=Y
;
W !!,"If you selected a long report period it is"
W !,"recommended that this report be queued."
;
I 'IBCNFSUM W !!,"*** This report is 132 characters wide ***"
; select device
W ! S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTDESC="Source of Information Report",ZTRTN="DQ^IBCOPR"
. S ZTSAVE("DATE*")="",ZTSAVE("IBCN*")="",ZTSAVE("ZTREQ")="@"
. D ^%ZTLOAD K IO("Q"),ZTSK
;
I IBCNOUT="R" W !!,"<*> please wait <*>"
;
;^TMP($J,CLASS,SORT,SORTIEN)=DFN^SSN^BILLNO^INS^BILLDATE^BILLAMT
DQ ;Process Report (queue entry point)
N ARTRX,BILLIEN,DATE,TRXIEN
K ^TMP($J,"IBCOPR")
;
;AR Transactions to show on the report.
S ARTRX("PAYMENT (IN PART)")=""
S ARTRX("PAYMENT (IN FULL)")=""
;
;Collect Data based on the Bill Date
I DATETYPE="B" D G PRINT
. N DATE
. S DATE=DATESTRT-1
. F S DATE=$O(^DGCR(399,"APD3",DATE)) Q:'DATE!(DATE>DATEEND) D
.. N BILLIEN
.. S BILLIEN=""
.. F S BILLIEN=$O(^DGCR(399,"APD3",DATE,BILLIEN)) Q:(BILLIEN="") D
... N BILLDATA,CLMDATA
... D BILLDATA(BILLIEN,.BILLDATA,.SORT)
... I '$G(BILLDATA("SOI")) Q
... S TRXIEN="" F S TRXIEN=$O(^PRCA(433,"C",BILLIEN,TRXIEN)) Q:'TRXIEN D
.... D CLMDATA(TRXIEN,.CLMDATA)
... D SETTMP(.BILLDATA,.CLMDATA)
;
;Collect Data based on the Collection Date
N TYPE,TYPEIEN
S TYPE=""
F S TYPE=$O(ARTRX(TYPE)) Q:TYPE="" D
. S TYPEIEN=$O(^PRCA(430.3,"B",TYPE,""))
. S DATE=DATESTRT-1,ENDDATE=$$FMADD^XLFDT(DATEEND,30)
. F S DATE=$O(^PRCA(433,"AT",TYPEIEN,DATE)) Q:'DATE!(DATE>ENDDATE) D
.. S TRXIEN=0
.. F S TRXIEN=$O(^PRCA(433,"AT",TYPEIEN,DATE,TRXIEN)) Q:'TRXIEN D
... N BILLDATA,CLMDATA
... D CLMDATA(TRXIEN,.CLMDATA)
... I '$D(CLMDATA) Q
... D BILLDATA(CLMDATA(TRXIEN,"BILLNUM"),.BILLDATA)
... I '$D(BILLDATA("SOI")) Q
... D SETTMP(.BILLDATA,.CLMDATA)
;
PRINT ; Print the report
N IBEX,LINE,PAGE,RDATE,SORTBY,TAB
S RDATE=$$FMTE^XLFDT($$NOW^XLFDT),IBEX=0
I 'IBCNFSUM S SORTBY=$S(IBCNSORT="P":"Patient",IBCNSORT="I":"Insurance",IBCNSORT="B":"Billed Amount",IBCNSORT="C":"Collected Amount",IBCNSORT="D":$S(DATETYPE="B":"Bill ",1:"Collected ")_"Date",IBCNSORT="S":"Source of Information",1:"")
I IBCNOUT="E" D EXCEL^IBCOPR1
I IBCNOUT="R" D REPORT^IBCOPR1
I '$G(IBEX),($E(IOST,1,2)="C-") D PAUSE^VALM1
;
EXIT ; Exit routine
D ^%ZISC
K ^TMP($J,"IBCOPR")
Q
;
BILLDATA(BILLIEN,DATA,SORT) ;Get Billing Data
N ARRAY,BILLIENS,DFN,FLD,INS,INSCOIEN,INSIENS,SEQ,SOI
;
S BILLIENS=BILLIEN_","
;.01 - BILL NUMBER
;.02 - PATIENT NAME (DFN)
;.05 - BILL CLASSIFICATION
;.21 - CURRENT BILL PAYER SEQUENCE
;10 - AUTHORIZATION DATE (BILL DATE)
;16 - CANCEL BILL?
;201 - TOTAL CHARGES
D GETS^DIQ(399,BILLIENS,".01;.02;.05;.21;10;16;201","EI","ARRAY","ERROR")
;Get data from INSURANE TYPE subfile.
S DATA("BILLNUM")=$G(ARRAY(399,BILLIENS,.01,"E"))
S DATA("BILLAMT")=$G(ARRAY(399,BILLIENS,201,"I"))
S DATA("BILLDATE")=$G(ARRAY(399,BILLIENS,10,"I"))
S DATA("CANCEL")=$G(ARRAY(399,BILLIENS,16,"I"))
S DATA("CLASS")=$S($G(ARRAY(399,BILLIENS,.05,"I"))<3:1,1:3) ;Inpatient (1) or Outpatient (3)
S SEQ=$G(ARRAY(399,BILLIENS,.21,"I")),FLD=$S(SEQ="P":101,SEQ="S":102,1:103)
S (DATA("PATIENT"),DFN)=$G(ARRAY(399,BILLIENS,.02,"I"))
S INSCOIEN=$$GET1^DIQ(399,BILLIENS,FLD,"I") I 'INSCOIEN G BILLDATX
S INS=$O(^DPT(DFN,.312,"B",INSCOIEN,""))
;.09 - SSN
D GETS^DIQ(2,DFN_",",".09","EI","ARRAY","ERROR")
S INSIENS=INS_","_DFN_","
;.01 - Insurance Company
;1.09 - Source of Information
D GETS^DIQ(2.312,INSIENS,".01;1.09","EI","ARRAY","ERROR")
S SOI=$G(ARRAY(2.312,INSIENS,1.09,"I")) I SOI="" G BILLDATX
I ($G(IBCNESOI)'="A"),'$D(IBCNESOI(SOI)) G BILLDATX ;Quit if SOI not selected and not ALL
S DATA("SOI")=SOI
S DATA("SSN")=$E($G(ARRAY(2,DFN_",",.09,"E")),6,9)
S DATA("INSCO")=$G(ARRAY(2.312,INSIENS,.01,"I"))
I $D(^TMP($J,"IBCOPR","B",DATA("CLASS"),BILLIEN)) G BILLDATX
I DATA("CANCEL") Q ;Don't add to totals
;
BILLDATX ; Exit the Bill data gathering subroutine
Q
;
CLMDATA(CLMIEN,DATA) ; Get Data from Transaction file.
;
;Retrieve the following fields from the AR TRANSACTION FILE (#433)
;.03 - Bill Number
; 11 - Date
; 12 - Type
; 15 - Transaction Amount
;
N ARRAY,CLMIENS,TRXDATE,TRXTYPE
S CLMIENS=CLMIEN_","
D GETS^DIQ(433,CLMIENS,".03;11;12;15","EI","ARRAY","ERROR")
S TRXTYPE=$G(ARRAY(433,CLMIENS,12,"E")) I TRXTYPE="" G CLMDATAX
S TRXDATE=$G(ARRAY(433,CLMIENS,11,"I")) I (DATETYPE="C"),((TRXDATE<DATESTRT)!(TRXDATE>DATEEND)) G CLMDATAX
I '$D(ARTRX(TRXTYPE)) G CLMDATAX
S DATA(CLMIEN,"TRXAMT")=$G(ARRAY(433,CLMIENS,15,"I"))
S DATA(CLMIEN,"BILLNUM")=$G(ARRAY(433,CLMIENS,.03,"I"))
S DATA(CLMIEN,"TRXDATE")=TRXDATE
S DATA(CLMIEN,"TRXTYPE")=TRXTYPE
;
CLMDATAX ; Exit the Claim data gathering subroutine
Q
;
SETTMP(BILL,CLAIM) ; Set ^TMP($J,"IPCOPR") global with data for printing the report
;
; BILL - Data from Billing
; BILL("BILLAMT")=Bill Amount
; BILL("BILLDATE")=Bill Date
; BILL("BILLNUM")=Bill Number
; BILL("CANCEL")=1 if bill cancelled
; BILL("CLASS")=1 (inpatient) OR 3 (outpatient)
; BILL("INSCO")=Ins Co IEN
; BILL("PATIENT")=DFN
; BILL("SOI")=SOI IEN
; BILL("SSN")=Last 4 SSN
; CLAIM - Data from AR Transaction
; CLAIM(TRXIEN,"BILLNUM")=Bill IEN
; CLAIM(TRXIEN,"TRXDATE")=Transaction Date in FileMan format
; CLAIM(TRXIEN,"TRXTYPE")=Transaction Type
; CLAIM(TRXIEN,"TRXAMT")=Tranaction Amount
;
N STR,TOT,TRX
I DATETYPE="C" S TRX=$O(CLAIM("")),BILLIEN=$G(CLAIM(TRX,"BILLNUM")) I 'BILLIEN G SETTMPX
;
I '$D(CLAIM),$D(^TMP($J,"IBCOPR","B",BILLIEN)) G SETTMPX ;No change
;
I '$G(BILL("CANCEL")) D
. I '$D(^TMP($J,"IBCOPR","B",BILLIEN)) D
.. ;Grand Total
.. S TOT=$G(^TMP($J,"IBCOPR","T","BILLCNT"))+1,^("BILLCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","T","BILLAMT"))+BILL("BILLAMT"),^("BILLAMT")=TOT
.. ;
.. ;Total by class
.. S TOT=$G(^TMP($J,"IBCOPR","T",BILL("CLASS"),"BILLCNT"))+1,^("BILLCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","T",BILL("CLASS"),"BILLAMT"))+BILL("BILLAMT"),^("BILLAMT")=TOT
.. ;
.. I 'IBCNFSUM Q ;Only Summary report
.. ;
.. ;Total by class and SOI
.. S TOT=$G(^TMP($J,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"BILLCNT"))+1,^("BILLCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"BILLAMT"))+BILL("BILLAMT"),^("BILLAMT")=TOT
.. ;
.. ;Grand Total by SOI
.. S TOT=$G(^TMP($J,"IBCOPR","S","T",BILL("SOI"),"BILLCNT"))+1,^("BILLCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","S","T",BILL("SOI"),"BILLAMT"))+BILL("BILLAMT"),^("BILLAMT")=TOT
. ;
. I $D(CLAIM) S TRX="" F S TRX=$O(CLAIM(TRX)) Q:'TRX D
.. ;Grand Total
.. S TOT=$G(^TMP($J,"IBCOPR","T","CLMCNT"))+1,^("CLMCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","T","CLMAMT"))+CLAIM(TRX,"TRXAMT"),^("CLMAMT")=TOT
.. ;
.. ;Total by Class
.. S TOT=$G(^TMP($J,"IBCOPR","T",BILL("CLASS"),"CLMCNT"))+1,^("CLMCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","T",BILL("CLASS"),"CLMAMT"))+$G(CLAIM(TRX,"TRXAMT")),^("CLMAMT")=TOT
.. ;
.. I 'IBCNFSUM Q ;Only Summary report
.. ;
.. ;Total by class and SOI
.. S TOT=$G(^TMP($J,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"CLMCNT"))+1,^("CLMCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"CLMAMT"))+CLAIM(TRX,"TRXAMT"),^("CLMAMT")=TOT
.. ;
.. ; Total by SOI
.. S TOT=$G(^TMP($J,"IBCOPR","S","T",BILL("SOI"),"CLMCNT"))+1,^("CLMCNT")=TOT
.. S TOT=$G(^TMP($J,"IBCOPR","S","T",BILL("SOI"),"CLMAMT"))+CLAIM(TRX,"TRXAMT"),^("CLMAMT")=TOT
. S ^TMP($J,"IBCOPR","B",BILLIEN)=""
;
I 'IBCNFSUM D ; Only Detail Report
. N FPN,INSCO,PN,SOI,TRX
. S PN=$$GET1^DIQ(2,BILL("PATIENT")_",",.01),INSCO=$$GET1^DIQ(36,BILL("INSCO")_",",.01)
. S SOI=$$GET1^DIQ(355.12,BILL("SOI")_",",.01)
. S STR=PN ;Patient Name
. S STR=STR_U_BILL("SSN") ;SSN
. S STR=STR_U_$S(BILL("CANCEL"):"*",1:" ") ;Cancel
. S STR=STR_BILL("BILLNUM") ;Bill Number (concatenacted to Cancel)
. S STR=STR_U_INSCO ;Insurance Company
. S STR=STR_U_$G(BILL("BILLAMT")) ;Bill Amt
. S STR=STR_U_BILL("BILLDATE") ;Bill Date
. S $P(STR,U,10)=SOI ;SOI
. ;
. ; Only have Bill Data
. I '$D(CLAIM) D Q
.. S $P(STR,U,9)="N"
.. D SETLINE
. ;
. ; Process Collection Data
. S TRX=0
. F S TRX=$O(CLAIM(TRX)) Q:'TRX D
.. S FPN=$S($G(CLAIM(TRX,"TRXTYPE"))["FULL":"F",$G(CLAIM(TRX,"TRXTYPE"))["PART":"P",1:"N")
.. S $P(STR,U,7)=$G(CLAIM(TRX,"TRXAMT")) ;Collected Amt
.. S $P(STR,U,8)=$G(CLAIM(TRX,"TRXDATE")) ;Collected Date
.. S $P(STR,U,9)=FPN ;F/P/N
.. D SETLINE
;
SETTMPX ;Exit subroutine
Q
;
SETLINE ; Set up data line for detail report
;
N CNT,SORT
S SORT="" D
. I IBCNSORT="P" S SORT=PN Q
. I IBCNSORT="I" S SORT=INSCO Q
. I IBCNSORT="B" S SORT=BILL("BILLAMT") Q
. I IBCNSORT="C" S SORT=+$G(CLAIM(+$G(TRX),"TRXAMT")) Q
. I IBCNSORT="D" S SORT=$S(DATETYPE="B":BILL("BILLDATE"),1:$G(CLAIM(TRX,"TRXDATE"))) Q
. S SORT=SOI
S CNT=$G(^TMP($J,"IBCOPR","D",BILL("CLASS"),SORT))+1,^(SORT)=CNT,^(SORT,CNT)=STR
Q
;
BCHELP ;Help for DATETYPE field
W !!,"Enter 'B' for Bill Date - The date bills were generated"
W !,"or 'C' for Collected Date - The date money was collected for"
W !," a claim (may be partial or full).",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOPR 12784 printed Sep 23, 2025@19:54:49 Page 2
IBCOPR ;WISC/RFJ,BOISE/WRL - print dollar amts for pre-registration ;05 May 97 8:30 AM [7/22/03 11:59am]
+1 ;;2.0;INTEGRATED BILLING;**75,345,528,664,668**;21-MAR-94;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;IA - 3336 (IB REFERENCING 433)
+5 ;ib
+6 WRITE !!,"This report will print bills and payments within the user selected"
+7 WRITE !,"date range that are associated to an insurance policy with a source"
+8 WRITE !,"of information equal to the user selected criteria."
+9 ;
+10 NEW CT,DATEEND,DATESTRT,DATETYPE,ENDDATE,IBCNFSUM,IBCNESOI,IBCNOUT,IBCNSORT,Q,WIDTH,X,Y
+11 ;
DATETYPE ;
+1 ;Prompt for the type of date to report on.
+2 SET DIR(0)="S^B:Billed Date;C:Collected Date"
SET DIR("B")=""
+3 SET DIR("A")="Report by (B)ill Date or by (C)ollected Date?"
+4 SET DIR("?")="Enter B or C"
+5 SET DIR("??")="^D BCHELP^IBCOPR"
+6 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+7 SET DATETYPE=Y
KILL DIR,Y
+8 ;
DATESEL ;Select Start and End Date
+1 ;Get Start Date
+2 SET DIR(0)="DA^::EX"
SET DIR("B")=$$FMTE^XLFDT($EXTRACT(DT,1,5)_"01")
+3 SET DIR("A")="Starting "_$SELECT(DATETYPE="B":"Billed",1:"Collected")_" Date: "
+4 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+5 IF Y>DT
WRITE !,"FUTURE DATES ARE NOT ALLOWED."
GOTO DATESEL
+6 SET DATESTRT=Y
KILL DIR,Y
+7 ;
ENDDATE ;
+1 ;Get End Date
+2 SET DIR(0)="DA^::EX"
SET DIR("B")=$$FMTE^XLFDT(DT)
+3 SET DIR("A")=" Ending "_$SELECT(DATETYPE="B":"Billed",1:"Collected")_" Date: "
+4 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+5 IF Y>DT
WRITE !,"FUTURE DATES ARE NOT ALLOWED."
GOTO ENDDATE
+6 IF Y<DATESTRT
WRITE !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE."
GOTO ENDDATE
+7 SET DATEEND=Y
KILL DIR,Y
+8 WRITE !!?5,"*** Selected ",$SELECT(DATETYPE="B":"Billed",1:"Collected")_" Date"," range from ",$$FMTE^XLFDT(DATESTRT)," to ",$$FMTE^XLFDT(DATEEND)," ***",!
+9 ;
+10 ; select Source of Information (SOI)
SOISEL ; Select one SOI (source of information) or ALL - File #355.12
+1 SET CT=0
WRITE !,"Enter Sources of Information to include one at a time OR <RETURN> for ALL."
SOISEL1 SET DIC(0)="AMEQ"
+1 SET Q="Include Source of Information"
+2 IF CT
SET Q="Also "_Q
+3 SET DIC("A")=$$FO^IBCNEUT1(Q_": ",36,"R")
+4 SET DIC="^IBE(355.12,"
+5 DO ^DIC
KILL DIC
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXIT
+7 ; If nothing was selected (Y=-1), select ALL sources
+8 IF Y=-1
if CT=1
GOTO SUMMARY
SET IBCNESOI="A"
GOTO SUMMARY
+9 SET IBCNESOI($PIECE(Y,"^",1))=$PIECE(Y,"^",2)
SET IBCNESOI=$GET(IBCNESOI)+1
SET CT=1
GOTO SOISEL1
+10 ;
SUMMARY ; ask to print detailed or summary report
+1 SET DIR(0)="S^D:Detailed;S:Summary;"
SET DIR("B")="Summary"
+2 SET DIR("A")="Print (D)etailed or (S)ummary report?"
+3 WRITE !
DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+5 SET IBCNFSUM=Y="S"
+6 ;
SORT ;Sort the detail report
+1 SET IBCNSORT=""
+2 IF 'IBCNFSUM
Begin DoDot:1
+3 SET DIR(0)="S^P:Patient;I:Insurance;B:Billed Amount;C:Collected Amount;D:Date;S:Source of Information"
+4 SET DIR("B")="Source of Information"
+5 SET DIR("A")="Sort the report by"
+6 WRITE !
DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT
+8 SET IBCNSORT=Y
End DoDot:1
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+10 ;
OUT ; select Excel or Report format
+1 NEW %ZIS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y,ZTDESC,ZTRTN,ZTSAVE
+2 WRITE !
+3 SET DIR(0)="S^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
GOTO EXIT
+8 SET IBCNOUT=Y
+9 ;
+10 WRITE !!,"If you selected a long report period it is"
+11 WRITE !,"recommended that this report be queued."
+12 ;
+13 IF 'IBCNFSUM
WRITE !!,"*** This report is 132 characters wide ***"
+14 ; select device
+15 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+16 IF $DATA(IO("Q"))
Begin DoDot:1
+17 SET ZTDESC="Source of Information Report"
SET ZTRTN="DQ^IBCOPR"
+18 SET ZTSAVE("DATE*")=""
SET ZTSAVE("IBCN*")=""
SET ZTSAVE("ZTREQ")="@"
+19 DO ^%ZTLOAD
KILL IO("Q"),ZTSK
End DoDot:1
GOTO EXIT
+20 ;
+21 IF IBCNOUT="R"
WRITE !!,"<*> please wait <*>"
+22 ;
+23 ;^TMP($J,CLASS,SORT,SORTIEN)=DFN^SSN^BILLNO^INS^BILLDATE^BILLAMT
DQ ;Process Report (queue entry point)
+1 NEW ARTRX,BILLIEN,DATE,TRXIEN
+2 KILL ^TMP($JOB,"IBCOPR")
+3 ;
+4 ;AR Transactions to show on the report.
+5 SET ARTRX("PAYMENT (IN PART)")=""
+6 SET ARTRX("PAYMENT (IN FULL)")=""
+7 ;
+8 ;Collect Data based on the Bill Date
+9 IF DATETYPE="B"
Begin DoDot:1
+10 NEW DATE
+11 SET DATE=DATESTRT-1
+12 FOR
SET DATE=$ORDER(^DGCR(399,"APD3",DATE))
if 'DATE!(DATE>DATEEND)
QUIT
Begin DoDot:2
+13 NEW BILLIEN
+14 SET BILLIEN=""
+15 FOR
SET BILLIEN=$ORDER(^DGCR(399,"APD3",DATE,BILLIEN))
if (BILLIEN="")
QUIT
Begin DoDot:3
+16 NEW BILLDATA,CLMDATA
+17 DO BILLDATA(BILLIEN,.BILLDATA,.SORT)
+18 IF '$GET(BILLDATA("SOI"))
QUIT
+19 SET TRXIEN=""
FOR
SET TRXIEN=$ORDER(^PRCA(433,"C",BILLIEN,TRXIEN))
if 'TRXIEN
QUIT
Begin DoDot:4
+20 DO CLMDATA(TRXIEN,.CLMDATA)
End DoDot:4
+21 DO SETTMP(.BILLDATA,.CLMDATA)
End DoDot:3
End DoDot:2
End DoDot:1
GOTO PRINT
+22 ;
+23 ;Collect Data based on the Collection Date
+24 NEW TYPE,TYPEIEN
+25 SET TYPE=""
+26 FOR
SET TYPE=$ORDER(ARTRX(TYPE))
if TYPE=""
QUIT
Begin DoDot:1
+27 SET TYPEIEN=$ORDER(^PRCA(430.3,"B",TYPE,""))
+28 SET DATE=DATESTRT-1
SET ENDDATE=$$FMADD^XLFDT(DATEEND,30)
+29 FOR
SET DATE=$ORDER(^PRCA(433,"AT",TYPEIEN,DATE))
if 'DATE!(DATE>ENDDATE)
QUIT
Begin DoDot:2
+30 SET TRXIEN=0
+31 FOR
SET TRXIEN=$ORDER(^PRCA(433,"AT",TYPEIEN,DATE,TRXIEN))
if 'TRXIEN
QUIT
Begin DoDot:3
+32 NEW BILLDATA,CLMDATA
+33 DO CLMDATA(TRXIEN,.CLMDATA)
+34 IF '$DATA(CLMDATA)
QUIT
+35 DO BILLDATA(CLMDATA(TRXIEN,"BILLNUM"),.BILLDATA)
+36 IF '$DATA(BILLDATA("SOI"))
QUIT
+37 DO SETTMP(.BILLDATA,.CLMDATA)
End DoDot:3
End DoDot:2
End DoDot:1
+38 ;
PRINT ; Print the report
+1 NEW IBEX,LINE,PAGE,RDATE,SORTBY,TAB
+2 SET RDATE=$$FMTE^XLFDT($$NOW^XLFDT)
SET IBEX=0
+3 IF 'IBCNFSUM
SET SORTBY=$SELECT(IBCNSORT="P":"Patient",IBCNSORT="I":"Insurance",IBCNSORT="B":"Billed Amount",IBCNSORT="C":"Collected Amount",IBCNSORT="D":$SELECT(DATETYPE="B":"Bill ",1:"Collected ")_"Date",IBCNSORT="S":"Source of Information",1:"")
+4 IF IBCNOUT="E"
DO EXCEL^IBCOPR1
+5 IF IBCNOUT="R"
DO REPORT^IBCOPR1
+6 IF '$GET(IBEX)
IF ($EXTRACT(IOST,1,2)="C-")
DO PAUSE^VALM1
+7 ;
EXIT ; Exit routine
+1 DO ^%ZISC
+2 KILL ^TMP($JOB,"IBCOPR")
+3 QUIT
+4 ;
BILLDATA(BILLIEN,DATA,SORT) ;Get Billing Data
+1 NEW ARRAY,BILLIENS,DFN,FLD,INS,INSCOIEN,INSIENS,SEQ,SOI
+2 ;
+3 SET BILLIENS=BILLIEN_","
+4 ;.01 - BILL NUMBER
+5 ;.02 - PATIENT NAME (DFN)
+6 ;.05 - BILL CLASSIFICATION
+7 ;.21 - CURRENT BILL PAYER SEQUENCE
+8 ;10 - AUTHORIZATION DATE (BILL DATE)
+9 ;16 - CANCEL BILL?
+10 ;201 - TOTAL CHARGES
+11 DO GETS^DIQ(399,BILLIENS,".01;.02;.05;.21;10;16;201","EI","ARRAY","ERROR")
+12 ;Get data from INSURANE TYPE subfile.
+13 SET DATA("BILLNUM")=$GET(ARRAY(399,BILLIENS,.01,"E"))
+14 SET DATA("BILLAMT")=$GET(ARRAY(399,BILLIENS,201,"I"))
+15 SET DATA("BILLDATE")=$GET(ARRAY(399,BILLIENS,10,"I"))
+16 SET DATA("CANCEL")=$GET(ARRAY(399,BILLIENS,16,"I"))
+17 ;Inpatient (1) or Outpatient (3)
SET DATA("CLASS")=$SELECT($GET(ARRAY(399,BILLIENS,.05,"I"))<3:1,1:3)
+18 SET SEQ=$GET(ARRAY(399,BILLIENS,.21,"I"))
SET FLD=$SELECT(SEQ="P":101,SEQ="S":102,1:103)
+19 SET (DATA("PATIENT"),DFN)=$GET(ARRAY(399,BILLIENS,.02,"I"))
+20 SET INSCOIEN=$$GET1^DIQ(399,BILLIENS,FLD,"I")
IF 'INSCOIEN
GOTO BILLDATX
+21 SET INS=$ORDER(^DPT(DFN,.312,"B",INSCOIEN,""))
+22 ;.09 - SSN
+23 DO GETS^DIQ(2,DFN_",",".09","EI","ARRAY","ERROR")
+24 SET INSIENS=INS_","_DFN_","
+25 ;.01 - Insurance Company
+26 ;1.09 - Source of Information
+27 DO GETS^DIQ(2.312,INSIENS,".01;1.09","EI","ARRAY","ERROR")
+28 SET SOI=$GET(ARRAY(2.312,INSIENS,1.09,"I"))
IF SOI=""
GOTO BILLDATX
+29 ;Quit if SOI not selected and not ALL
IF ($GET(IBCNESOI)'="A")
IF '$DATA(IBCNESOI(SOI))
GOTO BILLDATX
+30 SET DATA("SOI")=SOI
+31 SET DATA("SSN")=$EXTRACT($GET(ARRAY(2,DFN_",",.09,"E")),6,9)
+32 SET DATA("INSCO")=$GET(ARRAY(2.312,INSIENS,.01,"I"))
+33 IF $DATA(^TMP($JOB,"IBCOPR","B",DATA("CLASS"),BILLIEN))
GOTO BILLDATX
+34 ;Don't add to totals
IF DATA("CANCEL")
QUIT
+35 ;
BILLDATX ; Exit the Bill data gathering subroutine
+1 QUIT
+2 ;
CLMDATA(CLMIEN,DATA) ; Get Data from Transaction file.
+1 ;
+2 ;Retrieve the following fields from the AR TRANSACTION FILE (#433)
+3 ;.03 - Bill Number
+4 ; 11 - Date
+5 ; 12 - Type
+6 ; 15 - Transaction Amount
+7 ;
+8 NEW ARRAY,CLMIENS,TRXDATE,TRXTYPE
+9 SET CLMIENS=CLMIEN_","
+10 DO GETS^DIQ(433,CLMIENS,".03;11;12;15","EI","ARRAY","ERROR")
+11 SET TRXTYPE=$GET(ARRAY(433,CLMIENS,12,"E"))
IF TRXTYPE=""
GOTO CLMDATAX
+12 SET TRXDATE=$GET(ARRAY(433,CLMIENS,11,"I"))
IF (DATETYPE="C")
IF ((TRXDATE<DATESTRT)!(TRXDATE>DATEEND))
GOTO CLMDATAX
+13 IF '$DATA(ARTRX(TRXTYPE))
GOTO CLMDATAX
+14 SET DATA(CLMIEN,"TRXAMT")=$GET(ARRAY(433,CLMIENS,15,"I"))
+15 SET DATA(CLMIEN,"BILLNUM")=$GET(ARRAY(433,CLMIENS,.03,"I"))
+16 SET DATA(CLMIEN,"TRXDATE")=TRXDATE
+17 SET DATA(CLMIEN,"TRXTYPE")=TRXTYPE
+18 ;
CLMDATAX ; Exit the Claim data gathering subroutine
+1 QUIT
+2 ;
SETTMP(BILL,CLAIM) ; Set ^TMP($J,"IPCOPR") global with data for printing the report
+1 ;
+2 ; BILL - Data from Billing
+3 ; BILL("BILLAMT")=Bill Amount
+4 ; BILL("BILLDATE")=Bill Date
+5 ; BILL("BILLNUM")=Bill Number
+6 ; BILL("CANCEL")=1 if bill cancelled
+7 ; BILL("CLASS")=1 (inpatient) OR 3 (outpatient)
+8 ; BILL("INSCO")=Ins Co IEN
+9 ; BILL("PATIENT")=DFN
+10 ; BILL("SOI")=SOI IEN
+11 ; BILL("SSN")=Last 4 SSN
+12 ; CLAIM - Data from AR Transaction
+13 ; CLAIM(TRXIEN,"BILLNUM")=Bill IEN
+14 ; CLAIM(TRXIEN,"TRXDATE")=Transaction Date in FileMan format
+15 ; CLAIM(TRXIEN,"TRXTYPE")=Transaction Type
+16 ; CLAIM(TRXIEN,"TRXAMT")=Tranaction Amount
+17 ;
+18 NEW STR,TOT,TRX
+19 IF DATETYPE="C"
SET TRX=$ORDER(CLAIM(""))
SET BILLIEN=$GET(CLAIM(TRX,"BILLNUM"))
IF 'BILLIEN
GOTO SETTMPX
+20 ;
+21 ;No change
IF '$DATA(CLAIM)
IF $DATA(^TMP($JOB,"IBCOPR","B",BILLIEN))
GOTO SETTMPX
+22 ;
+23 IF '$GET(BILL("CANCEL"))
Begin DoDot:1
+24 IF '$DATA(^TMP($JOB,"IBCOPR","B",BILLIEN))
Begin DoDot:2
+25 ;Grand Total
+26 SET TOT=$GET(^TMP($JOB,"IBCOPR","T","BILLCNT"))+1
SET ^("BILLCNT")=TOT
+27 SET TOT=$GET(^TMP($JOB,"IBCOPR","T","BILLAMT"))+BILL("BILLAMT")
SET ^("BILLAMT")=TOT
+28 ;
+29 ;Total by class
+30 SET TOT=$GET(^TMP($JOB,"IBCOPR","T",BILL("CLASS"),"BILLCNT"))+1
SET ^("BILLCNT")=TOT
+31 SET TOT=$GET(^TMP($JOB,"IBCOPR","T",BILL("CLASS"),"BILLAMT"))+BILL("BILLAMT")
SET ^("BILLAMT")=TOT
+32 ;
+33 ;Only Summary report
IF 'IBCNFSUM
QUIT
+34 ;
+35 ;Total by class and SOI
+36 SET TOT=$GET(^TMP($JOB,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"BILLCNT"))+1
SET ^("BILLCNT")=TOT
+37 SET TOT=$GET(^TMP($JOB,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"BILLAMT"))+BILL("BILLAMT")
SET ^("BILLAMT")=TOT
+38 ;
+39 ;Grand Total by SOI
+40 SET TOT=$GET(^TMP($JOB,"IBCOPR","S","T",BILL("SOI"),"BILLCNT"))+1
SET ^("BILLCNT")=TOT
+41 SET TOT=$GET(^TMP($JOB,"IBCOPR","S","T",BILL("SOI"),"BILLAMT"))+BILL("BILLAMT")
SET ^("BILLAMT")=TOT
End DoDot:2
+42 ;
+43 IF $DATA(CLAIM)
SET TRX=""
FOR
SET TRX=$ORDER(CLAIM(TRX))
if 'TRX
QUIT
Begin DoDot:2
+44 ;Grand Total
+45 SET TOT=$GET(^TMP($JOB,"IBCOPR","T","CLMCNT"))+1
SET ^("CLMCNT")=TOT
+46 SET TOT=$GET(^TMP($JOB,"IBCOPR","T","CLMAMT"))+CLAIM(TRX,"TRXAMT")
SET ^("CLMAMT")=TOT
+47 ;
+48 ;Total by Class
+49 SET TOT=$GET(^TMP($JOB,"IBCOPR","T",BILL("CLASS"),"CLMCNT"))+1
SET ^("CLMCNT")=TOT
+50 SET TOT=$GET(^TMP($JOB,"IBCOPR","T",BILL("CLASS"),"CLMAMT"))+$GET(CLAIM(TRX,"TRXAMT"))
SET ^("CLMAMT")=TOT
+51 ;
+52 ;Only Summary report
IF 'IBCNFSUM
QUIT
+53 ;
+54 ;Total by class and SOI
+55 SET TOT=$GET(^TMP($JOB,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"CLMCNT"))+1
SET ^("CLMCNT")=TOT
+56 SET TOT=$GET(^TMP($JOB,"IBCOPR","S",BILL("CLASS"),BILL("SOI"),"CLMAMT"))+CLAIM(TRX,"TRXAMT")
SET ^("CLMAMT")=TOT
+57 ;
+58 ; Total by SOI
+59 SET TOT=$GET(^TMP($JOB,"IBCOPR","S","T",BILL("SOI"),"CLMCNT"))+1
SET ^("CLMCNT")=TOT
+60 SET TOT=$GET(^TMP($JOB,"IBCOPR","S","T",BILL("SOI"),"CLMAMT"))+CLAIM(TRX,"TRXAMT")
SET ^("CLMAMT")=TOT
End DoDot:2
+61 SET ^TMP($JOB,"IBCOPR","B",BILLIEN)=""
End DoDot:1
+62 ;
+63 ; Only Detail Report
IF 'IBCNFSUM
Begin DoDot:1
+64 NEW FPN,INSCO,PN,SOI,TRX
+65 SET PN=$$GET1^DIQ(2,BILL("PATIENT")_",",.01)
SET INSCO=$$GET1^DIQ(36,BILL("INSCO")_",",.01)
+66 SET SOI=$$GET1^DIQ(355.12,BILL("SOI")_",",.01)
+67 ;Patient Name
SET STR=PN
+68 ;SSN
SET STR=STR_U_BILL("SSN")
+69 ;Cancel
SET STR=STR_U_$SELECT(BILL("CANCEL"):"*",1:" ")
+70 ;Bill Number (concatenacted to Cancel)
SET STR=STR_BILL("BILLNUM")
+71 ;Insurance Company
SET STR=STR_U_INSCO
+72 ;Bill Amt
SET STR=STR_U_$GET(BILL("BILLAMT"))
+73 ;Bill Date
SET STR=STR_U_BILL("BILLDATE")
+74 ;SOI
SET $PIECE(STR,U,10)=SOI
+75 ;
+76 ; Only have Bill Data
+77 IF '$DATA(CLAIM)
Begin DoDot:2
+78 SET $PIECE(STR,U,9)="N"
+79 DO SETLINE
End DoDot:2
QUIT
+80 ;
+81 ; Process Collection Data
+82 SET TRX=0
+83 FOR
SET TRX=$ORDER(CLAIM(TRX))
if 'TRX
QUIT
Begin DoDot:2
+84 SET FPN=$SELECT($GET(CLAIM(TRX,"TRXTYPE"))["FULL":"F",$GET(CLAIM(TRX,"TRXTYPE"))["PART":"P",1:"N")
+85 ;Collected Amt
SET $PIECE(STR,U,7)=$GET(CLAIM(TRX,"TRXAMT"))
+86 ;Collected Date
SET $PIECE(STR,U,8)=$GET(CLAIM(TRX,"TRXDATE"))
+87 ;F/P/N
SET $PIECE(STR,U,9)=FPN
+88 DO SETLINE
End DoDot:2
End DoDot:1
+89 ;
SETTMPX ;Exit subroutine
+1 QUIT
+2 ;
SETLINE ; Set up data line for detail report
+1 ;
+2 NEW CNT,SORT
+3 SET SORT=""
Begin DoDot:1
+4 IF IBCNSORT="P"
SET SORT=PN
QUIT
+5 IF IBCNSORT="I"
SET SORT=INSCO
QUIT
+6 IF IBCNSORT="B"
SET SORT=BILL("BILLAMT")
QUIT
+7 IF IBCNSORT="C"
SET SORT=+$GET(CLAIM(+$GET(TRX),"TRXAMT"))
QUIT
+8 IF IBCNSORT="D"
SET SORT=$SELECT(DATETYPE="B":BILL("BILLDATE"),1:$GET(CLAIM(TRX,"TRXDATE")))
QUIT
+9 SET SORT=SOI
End DoDot:1
+10 SET CNT=$GET(^TMP($JOB,"IBCOPR","D",BILL("CLASS"),SORT))+1
SET ^(SORT)=CNT
SET ^(SORT,CNT)=STR
+11 QUIT
+12 ;
BCHELP ;Help for DATETYPE field
+1 WRITE !!,"Enter 'B' for Bill Date - The date bills were generated"
+2 WRITE !,"or 'C' for Collected Date - The date money was collected for"
+3 WRITE !," a claim (may be partial or full).",!
+4 QUIT
