source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAWOF.m@ 1204

Last change on this file since 1204 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PRCAWOF ;WASH-ISC@ALTOONA,PA/RGY-AR WRITE-OFF REPORT ;8/23/95 9:00 AM
2V ;;4.5;Accounts Receivable;**20*,104*;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 NEW BEG,DIR,DIROUT,DIRUT,DTOUT,DUOUT,END,IOS,X,Y,%DT,%ZIS,ZTSK
5BEG ;
6 W ! D NOW^%DTC S %DT(0)=-%,%DT="AEXP",%DT("A")="Starting Date: " D ^%DT G:Y<0 Q S BEG=Y
7 S %DT="AEX",%DT("A")=" Ending Date: " D ^%DT G:Y<0 Q S END=Y
8 I BEG>END W !!,*7,"*** Beginning date is Greater than or equal to Ending date ***",! G BEG
9 S %ZIS="MQ" D ^%ZIS G:POP Q
10 I $D(IO("Q")) S ZTRTN="DQ^PRCAWOF",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTDESC="Write-Off Report" D ^%ZTLOAD G Q
11 U IO D DQ
12Q D ^%ZISC Q
13DQ ;
14 NEW DATE,DEBT,BILL,PAGE,PRI
15 S (DEBT,PAGE)=0
16 W:$E(IOST)="C" @IOF D HDR1
17 F S DEBT=$O(^PRCA(433,"ATD",DEBT)) Q:'DEBT S PRI=1 F DATE=BEG-.0001:0 S DATE=$O(^PRCA(433,"ATD",DEBT,DATE)) Q:DATE>(END+.9999)!'DATE F TRAN=0:0 S TRAN=$O(^PRCA(433,"ATD",DEBT,DATE,TRAN)) Q:'TRAN D
18 . I $G(^RCD(340,+DEBT,0))'["DPT" Q
19 . I ","_$O(^PRCA(430.3,"AC",2,0))_","_$O(^PRCA(430.3,"AC",20,0))_","'[(","_$P($G(^PRCA(433,TRAN,1)),"^",2)_",") Q
20 . I PRI F BILL=0:0 S BILL=$O(^PRCA(430,"C",DEBT,BILL)) Q:'BILL D Q:DEBT="Z"
21 .. I $P($G(^PRCA(430,BILL,0)),"^",8)'=$O(^PRCA(430.3,"AC",109,0)) G Q2
22 .. I PRI D:$Y+5>IOSL HDR G:DEBT="Z" Q2 W !,$P($G(^DPT(+$P(^RCD(340,DEBT,0),"^"),0)),"^") S X=$P(^(0),"^",9) W " (",$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9),")" S PRI=0
23 .. D:$Y+5>IOSL HDR G:DEBT="Z" Q2
24 .. W !?5,"Bill # ",$P(^PRCA(430,BILL,0),"^") S X=$G(^PRCA(430,BILL,7)) W ?25,"Amt: ",$J($P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5),7,2)
25 .. F X=0:0 S X=$O(^PRCA(433,"C",BILL,X)) Q:'X I ",9,29,8,10,11,"[(","_$P($G(^PRCA(433,X,1)),"^",2)_",") W ?45,$P(^PRCA(430.3,+$P(^PRCA(433,X,1),"^",2),0),"^") Q
26 .. W:'X ?40,"Unknown Type"
27Q2 .. Q
28 . I DEBT="Z" G Q1
29 . I PRI S DEBT=DEBT_.1 G Q1
30 . D:$Y+5>IOS HDR G:DEBT="Z" Q1
31 . W !?5,"Trans #: ",TRAN,?20,"Date: ",$$SLH^RCFN01(DATE) S X=$G(^PRCA(433,TRAN,3)) W ?40,"Amt: ",$J($P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5),7,2)
32 . W ?60,$P(^PRCA(430.3,+$P(^PRCA(433,TRAN,1),"^",2),0),"^")
33Q1 . Q
34 Q
35HDR ;Print Header of report
36 I $E(IOST)="C" R !!,"Press return to continue: ",X:DTIME S:'$T DTOUT=1 I X["^"!$D(DTOUT) S DEBT="Z" G Q3
37 W @IOF
38HDR1 ;
39 S PAGE=PAGE+1
40 W !!,"Payments Received for Patient Accounts with Written-off Bills",?IOM-($L(PAGE)+7),"Page: ",PAGE
41 W !,"From ",$$SLH^RCFN01(BEG)," thru ",$$SLH^RCFN01(END) S X="Date: "_$$SLH^RCFN01(DT) W ?IOM-$L(X)-1,X,!
42 S X="",$P(X,"-",80)="" W X,!
43Q3 Q
Note: See TracBrowser for help on using the repository browser.