source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCTOPU.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1RCTOPU ;WASH IRMFO@ALTOONA,PA/TJK-TOP TRANSMISSION ;2/22/00 12:39 PM
2V ;;4.5;Accounts Receivable;**141**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified
4 ;
5REPORT ;print top report
6 N DIC,DIS,L,BY,FR,TO,FLDS,PG,PRINTOT,DIOEND
7 W !!,"TOP REFERRAL REPORT",!!
8 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include Debtors At TOP With '0' Balance"
9 S DIR("?")="Answering Yes will include those debtors referred whose current TOP balance is '0'."
10 D ^DIR Q:(Y="")!(Y="^")
11 S L=0,(FR,TO)="",DIC=340,BY=.01,FLDS="[RCTOP REPORT]",PRINTOT=0
12 S DIS(0)="I $P($G(^RCD(340,D0,6)),U)"
13 S:'Y DIS(0)=DIS(0)_",$P(^(4),U,3)"
14 S DIOEND="D PRNTOT^RCTOPU"
15PRINT D EN1^DIP
16REPORTQ Q
17 ;
18PRNTOT ;place total amount on report
19 N DASH
20 S DASH="",$P(DASH,"-",81)=""
21 W !!,DASH
22 W !,?6,"TOTAL AMOUNT CURRENTLY REFERRED:",?50,"$"_$J(PRINTOT,15,2)
23 I $E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
24PRNTOTQ Q
25 ;
26BILLREP ;prints individual bills and amounts that make up a TOP account
27 N DIC,DEBTOR,ZTSAVE,ZTDESC,ZTRTN
28 S DIC=340,DIC(0)="AEQM",DIC("S")="I $D(^RCD(340,""TOP"",+Y))" D ^DIC
29 Q:Y<1 S DEBTOR=+Y
30 S %ZIS="AEQ" D ^%ZIS G:POP BILLREPQ
31 I $D(IO("Q")) D G BILLREPQ
32 .S ZTSAVE("DEBTOR")=""
33 .S ZTRTN="BILLREPP^RCTOPU",ZTDESC="TOP BILL REPORT"
34 .D ^%ZTLOAD,^%ZISC
35 .Q
36 ;
37BILLREPP ;Call to build array of bills referred
38 U IO
39 N BILL,B14,B7,D4,FND,BAMT,TAMT,DIRUT,TNM,TID,TDT,DASH,CSTAT
40 S DASH="",$P(DASH,"-",81)="",D4=$G(^RCD(340,DEBTOR,4))
41 S TID=$S($P(D4,U,4)'="":$P(D4,U,4),1:$P(D4,U,1))
42 S TNM=$S($P(D4,U,5)'="":$P(D4,U,5),1:$P(D4,U,2))
43 S Y=$P(^RCD(340,DEBTOR,6),U,1) X ^DD("DD") S TDT=Y
44 S TAMT=$P(D4,U,3) D BILLREPH
45 S (FND,BILL)=0 F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:('BILL)!($D(DIRUT)) D
46 .Q:'+$G(^PRCA(430,BILL,14))
47 .S FND=1 W !,$P(^PRCA(430,BILL,0),U) S CSTAT=$P(^(0),U,8),B7=$G(^(7))
48 .W ?14,$P(^PRCA(430.3,CSTAT,0),U,2)
49 .S BAMT=0 F I=1:1:5 S BAMT=BAMT+$P(B7,U,I)
50 .W ?20,$J(BAMT,10,2)
51 .F I=1:1:5 W $J($P(B7,U,I),10,2)
52 .;check for end of page here, if necessary form feed and print header
53 .I $Y+3>IOSL D
54 ..I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
55 ..D BILLREPH
56 .Q
57 I $E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
58 D ^%ZISC
59BILLREPQ Q
60 ;
61BILLREPH ;header for TOP bill report
62 W @IOF
63 W !,"DEBTOR: "_TNM
64 W !,"TIN: "_TID," REFERRED TO TOP: "_TDT_" CURRENT TOP AMT: "_$J(TAMT,13,2)
65 W !,DASH
66 W !!,"BILL NO.",?14,"STAT",?27,"AMT",?36,"PRIN",?47,"INT",?55,"ADMIN",?65,"COURT",?72,"MARSHALL"
67 W !,"---- ---",?14,"----",?27,"---",?36,"----",?47,"---",?55,"-----",?65,"-----",?72,"--------"
68 Q
69 ;
70STOP ;Stop TOP Referral on a Debtor
71 N DIC,DIE,DA,DIR,Y,DEBTOR,REASON,COMMENT,EFFDT
72 S DIC=340,DIC(0)="AEQM" D ^DIC Q:Y<0
73 S DEBTOR=+Y
74 I $P($G(^RCD(340,DEBTOR,6)),U,2) G DELSTOP
75 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure You Want To Stop TOP Referral For This Debtor" D ^DIR
76 I 'Y W !,*7,"No Action Taken" Q
77 ;
78REASON ;ask referral reason
79 K DIR S DIR(0)="340,6.04" D ^DIR
80 Q:(Y="")!(Y=U)
81 S REASON=Y I REASON="O" D Q:COMMENT=U G REASON:COMMENT=""
82 .S COMMENT="",DIR(0)="340,6.05" D ^DIR S COMMENT=Y
83 .I COMMENT="" W !,"A Reason Of Other requires a comment to be entered"
84 .Q
85 I REASON'="0",$P($G(^RCD(340,DEBTOR,6)),U,5)'="" S $P(^(6),U,5)=""
86 ;
87 I (REASON="N")!(REASON="R") D G STOPFILE
88 .S $P(^RCD(340,DEBTOR,6),U)=""
89 .K ^RCD(340,"TOP",DEBTOR)
90 .S (EFFDT,REASON,COMMENT)=""
91 .Q
92 ;
93 ;ask effective date (for 'waiver','banruptcy','other')
94 ;
95 S DIR(0)="340,6.03",DIR("A")="Enter Effective Date" D ^DIR S EFFDT=Y
96 ;
97STOPFILE ;set stop referral data in file 340
98 S $P(^RCD(340,DEBTOR,6),U,2,5)="1^"_EFFDT_U_REASON_U_$G(COMMENT)
99 ;
100 W !,"Stop TOP Referral Complete"
101 G STOPQ
102 ;
103DELSTOP ;Allows TOP Referral to be re-instituted for debtor
104 W !!,*7,"Referral to TOP has already been stopped for this debtor"
105 S DIR(0)="Y",DIR("A")="Do You Wish To Re-Institute TOP Referral for this Debtor",DIR("B")="NO" D ^DIR G EDSTOP:'Y
106 ;
107 ;reset file to allow top referral to be re-started
108 F I=2:1:5 S $P(^RCD(340,DEBTOR,6),U,I)=""
109 W !!,"Debtor Is Now Eligible To Be Referred To TOP" G STOPQ
110 ;
111EDSTOP S DIR(0)="Y",DIR("A")="Do You Wish To Edit The Stop Referral Data For This Debtor",DIR("B")="NO" D ^DIR G REASON:Y
112STOPQ Q
113 ;
114REVERSE ;Refund Reversal
115 N DEBTOR,DIC,DIE,DR,BILL,TRACE,REFYR
116 W !!,"Refund Reversal Of TOP Refund"
117 S DIC=430,DIC(0)="AEQLMZ",DIC("S")="I $D(^PRCA(430,""TREF"",2,+Y))"
118 S DIC("A")="Enter Refund Bill To Be Reversed:" D ^DIC Q:Y<0
119 S DEBTOR=$P(Y(0),U,9),BILL=+Y
120 I 'DEBTOR W !!,*7,"No Debtor Attached To This Bill." Q
121 S TRACE=$P($G(^RCD(340,DEBTOR,6)),U,7),REFYR=$P($G(^PRCA(430,BILL,14)),U,4)
122 I 'TRACE W !!,*7,"There is no current TOP Trace Number for this debtor",!,"This should have been entered with the most recent TOP payment" Q
123 I 'REFYR W !!,*7,"There is no TOP Refund Year Entered for this bill",!,"This should have been entered when the refund was approved." Q
124 S DIR(0)="Y",DIR("A")="Are You Sure You Wish To Reverse This Refund"
125 S DIR("B")="NO" D ^DIR I 'Y W !!,"No Action Taken" Q
126 S DIE="^PRCA(430,",DA=BILL,DR="142///3;143///^S X=TRACE" D ^DIE
127 W !,"Reversal Will Be Transmitted With Next TOP Transmission"
128REVERSEQ Q
129 ;
130UPDCODE ;Update Refund/Reversal Codes in File 348.2
131 W !,"TOP Refund/Refund Reversal Code Entry"
132 S DIC=348.2,DIC(0)="AEQML" D ^DIC
133UPDCODEQ Q
Note: See TracBrowser for help on using the repository browser.