- RCDPRTP ;ALB/LDB-CLAIMS MATCHING REPORT ;1/11/01 2:03 PM
- ;;4.5;Accounts Receivable;**151,186,315,339,338**;Mar 20, 1995;Build 69
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- EN ;
- N DATEEND,DATESTRT,DIC,DIR,DIRUT,POP,RCBILL,RCDEBT,RCDFN,RCPT,RCSORT,RCQUIT,%ZIS,ZTDESC,ZTSAVE,ZTRTN,Y,RCAN,DIOEND,ZTIO,RCTYPE
- W !
- K DIRUT S DIR(0)="S^1:Patient;2:Bill Number;3:Payment dates;4:Receipt Number;5:Care Types",DIR("A")="Sort by" D ^DIR K DIR Q:$D(DIRUT)
- S RCSORT=Y,RCQUIT=""
- D @RCSORT Q:RCQUIT W !
- K DIRUT S DIR(0)="Y",DIR("A")="Include cancelled bills",DIR("B")="NO" D ^DIR S RCAN=+Y Q:$D(DIRUT)
- ;
- ; if user wants Excel output, then call the device question for Excel and then quit
- I $$FORMAT^RCDPRTP0(.RCEXCEL) D DEVICE^RCDPRTP0 Q ; exit point for Excel output
- Q:RCQUIT
- ;
- ; At this point, the user wants non-Excel output. Ask device question for non-Excel output.
- W !!,"This report requires 132 columns.",!!
- K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
- I $D(IO("Q")) D Q
- .S ZTDESC="Claims Matching Report",ZTRTN="DQ^RCDPRTP"
- .S ZTSAVE("RCSORT")=""
- . I RCSORT=1 S ZTSAVE("RCDEBT")="",ZTSAVE("RCDFN")="",ZTSAVE("RCTYPE*")=""
- . I RCSORT=2 S ZTSAVE("RCBILL")="",ZTSAVE("RCDFN")="",ZTSAVE("RCDEBT")=""
- . I RCSORT=4 S ZTSAVE("RCPT")=""
- . I RCSORT=5 S ZTSAVE("RCTYPE*")=""
- . S ZTSAVE("RCAN")="",ZTSAVE("ZTREQ")="@",ZTSAVE("^TMP(""RCDPRTPB"",$J,")=""
- . S ZTSAVE("DATEEND")="",ZTSAVE("DATESTRT")="",ZTSAVE("RCQUIT")="",ZTSAVE("RCSORT")="",ZTSAVE("RCEXCEL")=""
- . S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
- . S DIOEND="K ^TMP(""RCDPRTPB"",$J)"
- .D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"Task# ",ZTSK
- W !!,?20,"<*> please wait <*>"
- DQ ; queued report starts here
- U IO
- K ^TMP("RCDPRTPB",$J),^TMP("IBRBT",$J),^TMP("IBRBF",$J)
- N DAT,RCBIL,RCBIL0,RCNAM,RCPAY,RCPAY1,RCREC,RCREC1,RCRECTDA,RCSSN,RCTYP
- D @($S(RCSORT=1:"PAT",RCSORT=2:"BILL",RCSORT=3:"DATE",RCSORT=4:"REC",RCSORT=5:"TYPE")_"^RCDPRTP0")
- Q:RCQUIT
- D EN^RCDPRTP1
- W !!,?20,"<End of report>",!
- K DATESTRT,DATEEND,^TMP("RCDPRTPB",$J),RCTYPE
- D ^%ZISC
- Q
- ;
- 1 ;
- S DIC(0)="QEAMZ",DIC=340,DIC("S")="I ^RCD(340,+Y,0)[""DPT""",DIC("A")="Patient name: " D ^DIC I Y<0 S RCQUIT=1 Q
- S RCDEBT=+Y,RCDFN=+$P(Y,"^",2)
- D TYPEPIC^RCDPRTP0(.RCTYPE) I '$D(RCTYPE) S RCQUIT=1 Q
- D DATESEL^RCRJRTRA("Payment")
- I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
- Q
- ;
- 3 ;
- D DATESEL^RCRJRTRA("Payment")
- I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
- Q
- ;
- 2 ;
- N DIC,DUOUT
- K ^TMP("IBRBF",$J)
- S DIC(0)="QEAM",DIC=430,DIC("S")="I $$SCRNARCT^RCDPRTP($P(^(0),U,2))" D ^DIC I Y<0 S RCQUIT=1 Q
- S RCBILL=+Y,RCDFN=$P($G(^PRCA(430,+RCBILL,0)),"^",7) Q:'RCDFN
- S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0))
- I (RCDFN="")!(RCDEBT="") W !,"This bill has no matching first party bills." G 2
- D RELBILL^IBRFN(RCBILL)
- I '$O(^TMP("IBRBF",$J,RCBILL,0)) W !,"This bill has no matching first party debts." K ^TMP("IBRBF",$J) G 2
- K ^TMP("IBRBF",$J)
- Q
- ;
- 4 ;
- N DIC,X,Y
- S DIC(0)="QEAM",DIC=344 D ^DIC I Y<0 S RCQUIT=1 Q
- S RCPT=$P(Y,"^",2)
- Q
- ;
- 5 ; Select care type - added in patch 315
- D TYPEPIC^RCDPRTP0(.RCTYPE) I '$D(RCTYPE) S RCQUIT=1 Q
- Q:RCQUIT
- D DATESEL^RCRJRTRA("Payment")
- I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
- Q
- ;
- EXIT ;
- K DATESTRT,DATEEND,RCEXCEL,^TMP("RCDPRTPB",$J),^TMP("IBRBT",$J)
- K ^TMP("IBRBT1",$J),^TMP("IBRBF",$J),^TMP("IBRBF1",$J),RCTYPE
- Q
- ;
- ;PRCA*4.5*338 - update AR Cat screen to include FEE and CC Reimb Ins Types
- SCRNARCT(RCARCT) ;
- ;
- Q:RCARCT=9 1 ;Allow Reimb Insurance
- Q:RCARCT=45 1 ;Allow FEE Reimb Insurance
- I RCARCT>47,(RCARCT<52) Q 1 ;Allow CC Reimb Insurances
- Q 0 ;Disallow everything else
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRTP 3721 printed Feb 18, 2025@23:12:46 Page 2
- RCDPRTP ;ALB/LDB-CLAIMS MATCHING REPORT ;1/11/01 2:03 PM
- +1 ;;4.5;Accounts Receivable;**151,186,315,339,338**;Mar 20, 1995;Build 69
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- EN ;
- +1 NEW DATEEND,DATESTRT,DIC,DIR,DIRUT,POP,RCBILL,RCDEBT,RCDFN,RCPT,RCSORT,RCQUIT,%ZIS,ZTDESC,ZTSAVE,ZTRTN,Y,RCAN,DIOEND,ZTIO,RCTYPE
- +2 WRITE !
- +3 KILL DIRUT
- SET DIR(0)="S^1:Patient;2:Bill Number;3:Payment dates;4:Receipt Number;5:Care Types"
- SET DIR("A")="Sort by"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- +4 SET RCSORT=Y
- SET RCQUIT=""
- +5 DO @RCSORT
- if RCQUIT
- QUIT
- WRITE !
- +6 KILL DIRUT
- SET DIR(0)="Y"
- SET DIR("A")="Include cancelled bills"
- SET DIR("B")="NO"
- DO ^DIR
- SET RCAN=+Y
- if $DATA(DIRUT)
- QUIT
- +7 ;
- +8 ; if user wants Excel output, then call the device question for Excel and then quit
- +9 ; exit point for Excel output
- IF $$FORMAT^RCDPRTP0(.RCEXCEL)
- DO DEVICE^RCDPRTP0
- QUIT
- +10 if RCQUIT
- QUIT
- +11 ;
- +12 ; At this point, the user wants non-Excel output. Ask device question for non-Excel output.
- +13 WRITE !!,"This report requires 132 columns.",!!
- +14 KILL IOP,IO("Q")
- SET %ZIS="MQ"
- SET %ZIS("B")=""
- DO ^%ZIS
- if POP
- QUIT
- +15 IF $DATA(IO("Q"))
- Begin DoDot:1
- +16 SET ZTDESC="Claims Matching Report"
- SET ZTRTN="DQ^RCDPRTP"
- +17 SET ZTSAVE("RCSORT")=""
- +18 IF RCSORT=1
- SET ZTSAVE("RCDEBT")=""
- SET ZTSAVE("RCDFN")=""
- SET ZTSAVE("RCTYPE*")=""
- +19 IF RCSORT=2
- SET ZTSAVE("RCBILL")=""
- SET ZTSAVE("RCDFN")=""
- SET ZTSAVE("RCDEBT")=""
- +20 IF RCSORT=4
- SET ZTSAVE("RCPT")=""
- +21 IF RCSORT=5
- SET ZTSAVE("RCTYPE*")=""
- +22 SET ZTSAVE("RCAN")=""
- SET ZTSAVE("ZTREQ")="@"
- SET ZTSAVE("^TMP(""RCDPRTPB"",$J,")=""
- +23 SET ZTSAVE("DATEEND")=""
- SET ZTSAVE("DATESTRT")=""
- SET ZTSAVE("RCQUIT")=""
- SET ZTSAVE("RCSORT")=""
- SET ZTSAVE("RCEXCEL")=""
- +24 SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
- +25 SET DIOEND="K ^TMP(""RCDPRTPB"",$J)"
- +26 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL IO("Q")
- WRITE !,"Task# ",ZTSK
- End DoDot:1
- QUIT
- +27 WRITE !!,?20,"<*> please wait <*>"
- DQ ; queued report starts here
- +1 USE IO
- +2 KILL ^TMP("RCDPRTPB",$JOB),^TMP("IBRBT",$JOB),^TMP("IBRBF",$JOB)
- +3 NEW DAT,RCBIL,RCBIL0,RCNAM,RCPAY,RCPAY1,RCREC,RCREC1,RCRECTDA,RCSSN,RCTYP
- +4 DO @($SELECT(RCSORT=1:"PAT",RCSORT=2:"BILL",RCSORT=3:"DATE",RCSORT=4:"REC",RCSORT=5:"TYPE")_"^RCDPRTP0")
- +5 if RCQUIT
- QUIT
- +6 DO EN^RCDPRTP1
- +7 WRITE !!,?20,"<End of report>",!
- +8 KILL DATESTRT,DATEEND,^TMP("RCDPRTPB",$JOB),RCTYPE
- +9 DO ^%ZISC
- +10 QUIT
- +11 ;
- 1 ;
- +1 SET DIC(0)="QEAMZ"
- SET DIC=340
- SET DIC("S")="I ^RCD(340,+Y,0)[""DPT"""
- SET DIC("A")="Patient name: "
- DO ^DIC
- IF Y<0
- SET RCQUIT=1
- QUIT
- +2 SET RCDEBT=+Y
- SET RCDFN=+$PIECE(Y,"^",2)
- +3 DO TYPEPIC^RCDPRTP0(.RCTYPE)
- IF '$DATA(RCTYPE)
- SET RCQUIT=1
- QUIT
- +4 DO DATESEL^RCRJRTRA("Payment")
- +5 IF '$GET(DATESTRT)!('$GET(DATEEND))
- SET RCQUIT=1
- +6 QUIT
- +7 ;
- 3 ;
- +1 DO DATESEL^RCRJRTRA("Payment")
- +2 IF '$GET(DATESTRT)!('$GET(DATEEND))
- SET RCQUIT=1
- +3 QUIT
- +4 ;
- 2 ;
- +1 NEW DIC,DUOUT
- +2 KILL ^TMP("IBRBF",$JOB)
- +3 SET DIC(0)="QEAM"
- SET DIC=430
- SET DIC("S")="I $$SCRNARCT^RCDPRTP($P(^(0),U,2))"
- DO ^DIC
- IF Y<0
- SET RCQUIT=1
- QUIT
- +4 SET RCBILL=+Y
- SET RCDFN=$PIECE($GET(^PRCA(430,+RCBILL,0)),"^",7)
- if 'RCDFN
- QUIT
- +5 SET RCDEBT=$ORDER(^RCD(340,"B",RCDFN_";DPT(",0))
- +6 IF (RCDFN="")!(RCDEBT="")
- WRITE !,"This bill has no matching first party bills."
- GOTO 2
- +7 DO RELBILL^IBRFN(RCBILL)
- +8 IF '$ORDER(^TMP("IBRBF",$JOB,RCBILL,0))
- WRITE !,"This bill has no matching first party debts."
- KILL ^TMP("IBRBF",$JOB)
- GOTO 2
- +9 KILL ^TMP("IBRBF",$JOB)
- +10 QUIT
- +11 ;
- 4 ;
- +1 NEW DIC,X,Y
- +2 SET DIC(0)="QEAM"
- SET DIC=344
- DO ^DIC
- IF Y<0
- SET RCQUIT=1
- QUIT
- +3 SET RCPT=$PIECE(Y,"^",2)
- +4 QUIT
- +5 ;
- 5 ; Select care type - added in patch 315
- +1 DO TYPEPIC^RCDPRTP0(.RCTYPE)
- IF '$DATA(RCTYPE)
- SET RCQUIT=1
- QUIT
- +2 if RCQUIT
- QUIT
- +3 DO DATESEL^RCRJRTRA("Payment")
- +4 IF '$GET(DATESTRT)!('$GET(DATEEND))
- SET RCQUIT=1
- +5 QUIT
- +6 ;
- EXIT ;
- +1 KILL DATESTRT,DATEEND,RCEXCEL,^TMP("RCDPRTPB",$JOB),^TMP("IBRBT",$JOB)
- +2 KILL ^TMP("IBRBT1",$JOB),^TMP("IBRBF",$JOB),^TMP("IBRBF1",$JOB),RCTYPE
- +3 QUIT
- +4 ;
- +5 ;PRCA*4.5*338 - update AR Cat screen to include FEE and CC Reimb Ins Types
- SCRNARCT(RCARCT) ;
- +1 ;
- +2 ;Allow Reimb Insurance
- if RCARCT=9
- QUIT 1
- +3 ;Allow FEE Reimb Insurance
- if RCARCT=45
- QUIT 1
- +4 ;Allow CC Reimb Insurances
- IF RCARCT>47
- IF (RCARCT<52)
- QUIT 1
- +5 ;Disallow everything else
- QUIT 0