source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAATR.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PRCAATR ;WASH-ISC@ALTOONA,PA/RGY-VIEW TRANSACTION FOR BILLS ;2/14/96 2:46 PM
2V ;;4.5;Accounts Receivable;**36,104,172,138**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN1(BILL) ;ENTRY POINT FROM PRCAAPR
5 NEW X,COUNT,OUT,TRAN,SEL,PRCAATRX,PRCAIO,PRCAIOS,D0,PRCAQUE,POP,PRCAPRT,Y,ZTSK
6 I '$D(BILL) G Q
7 I BILL'?1N.N!'$D(^PRCA(430,+BILL,0)) G Q
8 S PRCAPRT=1,PRCAIO=IO(0),PRCAIO(0)=IO(0),COUNT=0 K ^TMP("PRCAATR",$J)
9 D HDR,DIS,^%ZISC
10Q K ^TMP("PRCAATR",$J),IO("Q") Q
11HDR ;Header
12 D HDR^PRCAAPR1
13 I $P($G(^PRCA(430,BILL,13)),"^") W !,"MEDICARE CONTRACTUAL ADJUSTMENT: ",$J($P($G(^PRCA(430,BILL,13)),"^"),0,2)
14 I $P($G(^PRCA(430,BILL,13)),"^",2) W !,"UNREIMBURSED MEDICARE EXPENSE: ",$J($P($G(^PRCA(430,BILL,13)),"^",2),0,2)
15 W !,"Bill #: ",$P(^PRCA(430,BILL,0),"^") D:$P(^(0),"^",9)'=+DEBT DEB W !!,"#",?8,"Tr #",?17,"Type",?52,"Date",?68,"Amount"
16 S X="",$P(X,"-",IOM)="" W !,X
17 Q
18DIS ;Display transactions
19 W !,?17,"Original Amount",?52,$$SLH^RCFN01($P(^PRCA(430,BILL,0),"^",10)),?65,$J($P(^(0),"^",3),9,2)
20 I '$O(^PRCA(433,"C",BILL,0)) D
21 . S X="",$P(X,"*",20)="" W !!,X," NO TRANSACTION INFORMATION AVAILABLE ",X
22RD . R !!,"Press return to continue: ",X:DTIME S:'$T DTOUT=1 S OUT=1
23 . I X["?" W !!,"Press the return key to return to menu." G RD
24 . Q
25 F TRAN=0:0 S TRAN=$O(^PRCA(433,"C",BILL,TRAN)) Q:'TRAN!$D(OUT) D TLN
26 S X=$G(^PRCA(430,BILL,7))
27 I '$D(OUT) W !?65,"------",!,?64,"$",$J($P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5),9,2) D READ
28 Q
29TLN ;Display a transaction
30 N YR
31 I $Y+5>IOSL,COUNT D READ G:$D(DTOUT)!$D(OUT) Q1 D HDR
32 S COUNT=COUNT+1,X=$G(^PRCA(433,TRAN,1)),^TMP("PRCAATR",$J,COUNT)=TRAN
33 W !,COUNT,$S($P(^PRCA(433,TRAN,0),"^",4)=1!$P(^(0),"^",10):"(I)",1:""),?8,TRAN,?17
34 W $S($P($G(^PRCA(430.3,+$P(X,"^",2),0)),"^",3)=17:$P($G(^PRCA(433,TRAN,5)),"^",2),1:$P($G(^(0)),"^"))
35 ; show decrease adjustments as negative (patch 4.5*172)
36 I $P(X,"^",2)=35 S:$P(X,"^",5)>0 $P(X,"^",5)=-$P(X,"^",5)
37 W ?52,$S(+X:$$SLH^RCFN01(+X),1:""),?65,$J($P(X,"^",5),9,2)
38Q1 Q
39READ ;Read a trans number
40 I IO'=IO(0) G Q2
41ASK 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
42 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
43 . I $D(IO("S")) S PRCAIOS=ION D ^%ZISC
44 . Q
45 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
46 I X="" S:TRAN="" OUT=1 G Q2
47 S SEL=X
48 F X=1:1:$L(SEL,",") S Y=$P(SEL,",",X) I Y'?1N.N!'$D(^TMP("PRCAATR",$J,+Y)) W *7," ??" G READ
49 F PRCAATRX=1:1:$L(SEL,",") S Y=$P(SEL,",",PRCAATRX) D VT Q:$D(OUT)
50 S OUT=1
51Q2 Q
52VT ;View a transaction
53 N IOP,%ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTDTH
54 S D0=$G(^TMP("PRCAATR",$J,+Y)) G:'D0 Q3
55 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
56 I IO'=IO(0) W !,"OK, Printing Transaction # ",D0," ..."
57 I $D(PRCAIOS) S IOP=PRCAIOS D ^%ZIS
58 U IO D DQ U IO(0)
59Q3 Q
60DQ ;
61 W @IOF S X="",$P(X,"=",30)="" W !,X," TRANSACTION PROFILE ",X,!!
62 K DXS D ^PRCATR3 K DXS S X=D0 D ENF^IBOLK
63RD1 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
64 Q
65DEB ;View debtor
66 NEW PRCA
67 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)")),"^")
68 Q
Note: See TracBrowser for help on using the repository browser.