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

PRCAATR.m

Go to the documentation of this file.
  1. PRCAATR ;WASH-ISC@ALTOONA,PA/RGY - VIEW TRANSACTION FOR BILLS ;2/14/96 2:46 PM
  1. V ;;4.5;Accounts Receivable;**36,104,172,138,233,276,303,301,315,350,388**;Mar 20, 1995;Build 13
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; PRCAAPR cleans up DEBT, DTOUT
  1. EN1(BILL) ;ENTRY POINT FROM PRCAAPR
  1. NEW X,Y,COUNT,OUT,TRAN,SEL,PRCAATRX,PRCAIO,PRCAIOS,D0,PRCAQUE,POP,PRCAPRT,Y,ZTSK,PRCOUT,PRCA15,REJFLG
  1. NEW CSDATE1,CSDATE2,CSFLG
  1. I '$D(BILL) G Q
  1. I BILL'?1N.N!'$D(^PRCA(430,+BILL,0)) G Q
  1. ; PRCA*4.5*276
  1. S PRCOUT=$$COMP3^PRCAAPR(BILL) ; check for 1st and 3rd party payments
  1. I PRCOUT'="%" S PRCOUT=$$IBEEOBCK^PRCAAPR1(BILL)
  1. S PRCAPRT=1,PRCAIO=IO(0),PRCAIO(0)=IO(0),COUNT=0 K ^TMP("PRCAATR",$J)
  1. D HDR,DIS,^%ZISC
  1. Q K ^TMP("PRCAATR",$J),IO("Q") Q
  1. HDR ;Header
  1. D HDR^PRCAAPR1
  1. I $P($G(^PRCA(430,BILL,13)),"^") W !,"MEDICARE CONTRACTUAL ADJUSTMENT: ",$J($P($G(^PRCA(430,BILL,13)),"^"),0,2)
  1. I $P($G(^PRCA(430,BILL,13)),"^",2) W !,"UNREIMBURSED MEDICARE EXPENSE: ",$J($P($G(^PRCA(430,BILL,13)),"^",2),0,2)
  1. ; PRCA*4.5*303 - Adding reject indicator, 'x' to bill number when applicable
  1. S REJFLG=$$BILLREJ^IBJTU6($P($P($G(^PRCA(430,BILL,0)),"^"),"-",2)) ; IA# 6060
  1. ; PRCA*4.5*315
  1. S CSDATE1=$$GET1^DIQ(430,BILL,"DATE BILL REFERRED TO TCSP","I")
  1. S CSDATE2=$$GET1^DIQ(430,BILL,"ORIGINAL DATE REFERRED TO TCSP","I")
  1. S CSFLG=$S(CSDATE1'="":"x",CSDATE2'="":"y",1:"")
  1. ; PRCA*4.5*276 - attach EEOB indicator to bill number
  1. ; PRCA*4.5*350 - Re-Referred
  1. I +$G(^PRCA(430,BILL,15)) S PRCA15=^(15) I $P(PRCA15,U)]"" W !,"CS " W:$$RR^RCTCSPU(BILL) "Re-" W "Referred Date: " S Y=$P(PRCA15,U) D DD^%DT W Y ;prca*4.5*301
  1. S PRCA15=$G(^PRCA(430,BILL,15)) D
  1. .I $P(PRCA15,U,2)]"" W !,"CS Recall Reason: ",$E($$GET1^DIQ(430,BILL,154),1,31) W ?51,"CS Recall Date: " S Y=$P(PRCA15,U,3) D DD^%DT W Y Q ;prca*4.5*301
  1. .I $P(PRCA15,U,4)]"",$P(PRCA15,U,2)="" W !,"CS Recall Reason: ",$E($$GET1^DIQ(430,BILL,154),1,31) W ?51,"CS Recall Date: "
  1. ; PRCA*4.5*350 - remove this and put some data from it on next line
  1. ; W ! D PROFRJ^RCTCSJS1(BILL) ; Reject history ;prca*4.5*301
  1. W !,"Bill #: ",$G(PRCOUT)_CSFLG_$P(^PRCA(430,BILL,0),"^") D @($S($P(^(0),"^",9)'=+DEBT:"DEB",1:"CSREJ")) ; prca*4.5*315, PRCA*4.5*350
  1. I REJFLG W !,"Bill #: ",$G(PRCOUT)_$S(REJFLG:"c",1:"")_$P(^PRCA(430,BILL,0),"^") D @($S($P(^(0),"^",9)'=+DEBT:"DEB",1:"CSREJ")) ; PRCA*4.5*350
  1. W !!,"Bill #",?8,"Tr #",?20,"Type",?52,"Date",?70,"Amount"
  1. S X="",$P(X,"-",IOM)="" W !,X
  1. Q
  1. DIS ;Display transactions
  1. W !,?20,"Original Amount",?52,$$SLH^RCFN01($P(^PRCA(430,BILL,0),"^",10)),?65,$J($P(^(0),"^",3),11,2)
  1. I '$O(^PRCA(433,"C",BILL,0)) D
  1. . S X="",$P(X,"*",20)="" W !!,X," NO TRANSACTION INFORMATION AVAILABLE ",X
  1. RD . R !!,"Press return to continue: ",X:DTIME S:'$T DTOUT=1 S OUT=1
  1. . I X["?" W !!,"Press the return key to return to menu." G RD
  1. . Q
  1. F TRAN=0:0 S TRAN=$O(^PRCA(433,"C",BILL,TRAN)) Q:'TRAN!$D(OUT) D TLN
  1. S X=$G(^PRCA(430,BILL,7))
  1. I '$D(OUT) W !?65,"-----------",!,?64,"$",$J($P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5),11,2) D READ
  1. Q
  1. TLN ;Display a transaction
  1. N YR
  1. I $Y+5>IOSL,COUNT D READ G:$D(DTOUT)!$D(OUT) Q1 D HDR
  1. S COUNT=COUNT+1,X=$G(^PRCA(433,TRAN,1)),^TMP("PRCAATR",$J,COUNT)=TRAN
  1. W !,COUNT,$S($P(^PRCA(433,TRAN,0),"^",4)=1!$P(^(0),"^",10):"(I)",1:""),?8,TRAN,?20
  1. W $S($P($G(^PRCA(430.3,+$P(X,"^",2),0)),"^",3)=17:$P($G(^PRCA(433,TRAN,5)),"^",2),1:$P($G(^(0)),"^"))
  1. ; show decrease adjustments as negative (patch 4.5*172)
  1. I $P(X,"^",2)=35 S:$P(X,"^",5)>0 $P(X,"^",5)=-$P(X,"^",5)
  1. W ?52,$S(+X:$$SLH^RCFN01(+X),1:""),?65,$J($P(X,"^",5),11,2)
  1. ;
  1. Q1 Q
  1. READ ;Read a trans number
  1. I IO'=IO(0) G Q2
  1. ASK W !!,"Select 1-",COUNT,$S(PRCAPRT:" or 'P' to Print",1:" to print") W:TRAN " or return to continue" R ": ",X:DTIME I X["^"!'$T S:'$T DTOUT=1 S OUT=1 G Q2
  1. I PRCAPRT,X="P" S %ZIS="MQ" D ^%ZIS D S PRCAPRT=0,PRCAIO=IO,PRCAIO(0)=IO(0) G:'POP ASK K POP S OUT=1 G Q2
  1. . I $D(IO("S")) S PRCAIOS=ION D ^%ZISC
  1. . Q
  1. I X["?" W !!,"To see detailed information for a transaction number, enter the corresponding '#'",!,"next to the transaction. (Ex: 1 or 1,3)" G ASK
  1. I X="" S:TRAN="" OUT=1 G Q2
  1. S SEL=X
  1. F X=1:1:$L(SEL,",") S Y=$P(SEL,",",X) I Y'?1N.N!'$D(^TMP("PRCAATR",$J,+Y)) W *7," ??" G READ
  1. F PRCAATRX=1:1:$L(SEL,",") S Y=$P(SEL,",",PRCAATRX) D VT Q:$D(OUT)
  1. S OUT=1
  1. Q2 Q
  1. VT ;View a transaction
  1. N IOP,%ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTDTH
  1. S D0=$G(^TMP("PRCAATR",$J,+Y)) G:'D0 Q3
  1. I $D(IO("Q")) S ZTSAVE("D0")="",ZTSAVE("PRCAIO")=IO,ZTSAVE("PRCAIO(0)")=IO(0),ZTRTN="DQ^PRCAATR",ZTDESC="AR TRANS PROFILE",ZTDTH=$H D ^%ZTLOAD W !,"*** Trans # ",D0," REQUEST QUEUED ***" G Q3
  1. I IO'=IO(0) W !,"OK, Printing Transaction # ",D0," ..."
  1. I $D(PRCAIOS) S IOP=PRCAIOS D ^%ZIS
  1. U IO D DQ U IO(0)
  1. Q3 Q
  1. DQ ;
  1. W @IOF S X="",$P(X,"=",30)="" W !,X," TRANSACTION PROFILE ",X,!!
  1. K DXS D ^PRCATR3 K DXS S X=D0 D ENF^IBOLK
  1. RD1 I $E(IOST)="C" R !!,"PRESS <RETURN> TO CONTINUE: ",X:DTIME S:'$T DTOUT=1,OUT=1 I X["?" W !!,"Press return to view next transaction or to continue" G RD1
  1. Q
  1. DEB ;View debtor
  1. NEW PRCA
  1. S PRCA=$P(^PRCA(430,BILL,0),"^",9) I PRCA S PRCA=$P(^RCD(340,PRCA,0),"^") W " ",$P($G(@("^"_$P(PRCA,";",2)_+PRCA_",0)")),"^")
  1. Q
  1. CSREJ ; Show last reject ; PRCA*4.5*350
  1. N RJIEN,RJDT,RJCODE,RJZ,I
  1. S RJIEN=0,RJDT="",RJCODE=""
  1. F S RJDT=$O(^PRCA(430,BILL,18,"B",RJDT)) Q:RJDT="" Q:$O(^PRCA(430,BILL,18,"B",RJDT))=""
  1. Q:'RJDT
  1. F S RJIEN=$O(^PRCA(430,BILL,18,"B",RJDT,RJIEN)) Q:RJIEN="" Q:$O(^PRCA(430,BILL,18,"B",RJDT,RJIEN))=""
  1. Q:'RJIEN
  1. S RJZ=$G(^PRCA(430,BILL,18,RJIEN,0))
  1. F I=3:1:11 I $P(RJZ,"^",I)'="" S RJCODE=$P(RJZ,"^",I)
  1. Q:'RJCODE
  1. W " Last CS REJECT CODE: ",$P($G(^RC(348.5,RJCODE,0)),"^")
  1. W " Last CS REJECT DATE: ",$$FMTE^XLFDT(RJDT,"5Z")
  1. Q