source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCRT1.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1RCRCRT1 ;ALB/CMS - RC AND DOJ TRANSACTION ROU 1 ;8/14/97
2V ;;4.5;Accounts Receivable;**63,198**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5EN(PRCATYPE) ;Enter here from Options
6 ;Refer Accounts receivable to RC/DOJ option enter PRCATYPE=34
7 ; (3 - RC, 4 - DOJ)
8 ;Re-Refer to RC/DOJ option enter PRCATYPE=5
9 ;Return by RC/DOJ option enter PRCATYPE=6
10 I 'PRCATYPE G ENQ
11 ;
12 N C,D,DA,DIC,D0,I,RCOUT,RCCAT,X,Y,%
13 N PRCA,PRCAAB,PRCABN,PRCABN0,PRCABN6,PRCABN7,PRCACAT,PRCACC,PRCACODE,PRCACURB,PRCADT,PRCAEN
14 N PRCAD,PRCAIB,PRCAMF,PRCAPB,PRCAPROC,PRCARAMT,PRCAS,PRCATEMP,PRCATY
15 ;
16GET D BILL I $G(PRCABN)<1 G ENQ
17 S DA=PRCABN,DIC="^PRCA(430," D LCK^PRCAUPD I '$D(DA) G GET
18 S PRCACAT=$P(PRCABN0,U,2)
19 S PRCABN6=$G(^PRCA(430,PRCABN,6)),PRCADT=+$P(PRCABN6,U,4)
20 I 'PRCADT,PRCATYPE'=34 W !!,"This Bill was not referred to RC/DOJ !",! G GET
21 S PRCARAMT=$P(PRCABN6,U,6),PRCACODE=$P(PRCABN6,U,5),PRCAPROC=""
22 I PRCACODE="DC" S PRCACODE="RC"
23 S PRCABN7=$G(^PRCA(430,PRCABN,7))
24 S PRCAPB=$P(PRCABN7,U,1),PRCAIB=$P(PRCABN7,U,2),PRCAAB=$P(PRCABN7,U,3)
25 S PRCAMF=$P(PRCABN7,U,4),PRCACC=$P(PRCABN7,U,5)
26 S PRCACURB=0 F I=1:1:5 S PRCACURB=PRCACURB+$P(PRCABN7,U,I)
27 ;
28 D WRREF^RCRCRT2 I $G(RCOUT)=1 G ENQ
29 I PRCADT,PRCATYPE=34 D CAN^RCRCRT2 G ENQ
30 I PRCATYPE=34 D REF
31 I PRCATYPE=0 W !,"The Principal Balance is less than the Minimum set for Referral" G ENQ
32 I (PRCATYPE=3)!(PRCATYPE=4) S PRCATEMP="[PRCAC DCDOJ REFER]"
33 I PRCATYPE=5 S PRCATEMP="[PRCAC DCDOJ REREFER]"
34 I PRCATYPE=6 S PRCATEMP="[PRCAC DCDOJ RETN]"
35 D PROC
36 ;
37ENQ I $G(PRCABN)>0 L -^PRCA(430,+PRCABN)
38 K PRCATYPE
39 Q
40 ;
41PROC ;Create Transaction and Update Bill
42 N DA,DIE,DR,PRCAOK,PRCATOT
43 D SETTR^PRCAUTL,PATTR^PRCAUTL
44 I '$D(PRCAEN) W !!,"*Could not create Transaction at this time. Try again." G PROCQ
45 D SETEN
46 I 'PRCATOT W !!,"No Referral Action taken.",! G PROCQ
47 I PRCATYPE=6 S (PRCACODE,PRCATOT)="@"
48 S DR="64///"_$S(PRCATYPE=6:"@",1:PRCADT)_";65///"_PRCACODE_";66///"_PRCATOT
49 I PRCATYPE=6 S DR=DR_";68.3///"_PRCADT
50 I PRCATYPE=5 S DR=DR_";68.2///"_PRCADT
51 S DA=PRCABN,DIE="^PRCA(430," D ^DIE
52 W !!,"Referral Action taken.",!
53PROCQ Q
54 ;
55REF ;Check Group File for RC or DOJ based on amount
56 N MAX,MIN,PRCAGRP,PRCAMAX,PRCAMIN
57 I $P($G(^PRCA(430.2,+PRCACAT,0)),U,6)="T" S PRCACODE="RC",PRCATYPE=3 G REFQ
58 S PRCAMAX=5000,PRCAMIN=1,PRCATYPE=3
59 S PRCAGRP=$O(^RC(342.2,"B","REGIONAL COUNSEL",0)) I PRCAGRP="" G REFQ
60 S PRCAGRP=$O(^RC(342.1,"AC",PRCAGRP,0))
61 S MIN=$P($G(^RC(342.1,+PRCAGRP,2)),"^"),MAX=$P($G(^(2)),U,2)
62 S PRCAMIN=$S(+MIN>0:MIN,1:PRCAMIN),PRCAMAX=$S(+MAX>0:MAX,1:PRCAMAX)
63 S PRCATYPE=$S(PRCAPB<PRCAMIN:0,PRCAPB<PRCAMAX:3,1:4)
64 S PRCACODE=$S(PRCATYPE=3:"RC",1:"DOJ")
65REFQ Q
66 ;
67SETEN ;record the Referral action transaction in the #433.
68 N DR,DIE,DIC,DA,D0,PRCAOK,X,Y
69 N PRCAEDIT,PRCAEN1,PRCAEN8,PRCAKDT,PRCAKTY
70EDT S DIE="^PRCA(433,",DR=PRCATEMP,DA=PRCAEN D ^DIE
71 S DR="41" D ^DIE
72 S PRCAEN8=$G(^PRCA(433,PRCAEN,8))
73 S PRCAPB=+$P(PRCAEN8,U,1),PRCAIB=+$P(PRCAEN8,U,2),PRCAAB=+$P(PRCAEN8,U,3)
74 S PRCAMF=+$P(PRCAEN8,U,4),PRCACC=+$P(PRCAEN8,U,5)
75 S PRCATOT=PRCAPB+PRCAIB+PRCAAB+PRCAMF+PRCACC
76 S $P(^PRCA(433,PRCAEN,1),U,5)=PRCATOT
77 S PRCAEN1=$G(^PRCA(433,PRCAEN,1)),PRCADT=$P(PRCAEN1,U,1)
78 S PRCAKTY=$S($P(PRCAEN1,U,2)'="":$P(^PRCA(430.3,$P(PRCAEN1,U,2),0),U,1),1:"")
79 S PRCAKDT=""
80 I PRCADT S Y=PRCADT D D^DIQ S PRCAKDT=Y
81 I PRCATOT>0 D WRDATA^RCRCRT2
82 I 'PRCATOT W !!,"**TRANSACTION TOTAL IS ZERO",! D ASKED I $D(PRCAEDIT) G EDT
83 I 'PRCATOT,'$D(PRCAEDIT) D DEL G SETENQ
84 I $G(RCCAT(PRCACAT)),PRCACURB'=PRCATOT W !!,"**TRANSACTION TOTAL MUST EQUAL THE CURRENT BILL BALANCE $"_PRCACURB D ASKED I $D(PRCAEDIT) G EDT
85 I $G(RCCAT(PRCACAT)),PRCACURB'=PRCATOT,'$D(PRCAEDIT) D DEL G SETENQ
86 D ASKOK I $D(PRCAOK) G SETENQ
87 I $D(PRCAEDIT) G EDT
88 D DEL
89SETENQ Q
90 ;
91ASKOK K PRCAOK S %=2 W !,"IS THIS CORRECT " D YN^DICN I %=1 S PRCAOK="" Q
92 I %=0 D M1^PRCAMESG G ASKOK
93 Q:%<0
94ASKED K PRCAEDIT S %=2 W !!,"DO YOU WANT TO EDIT " D YN^DICN Q:%<0
95 I %=0 D M2^PRCAMESG G ASKED
96 S:%=1 PRCAEDIT=""
97 Q
98DEL ;delete the entry.
99 N PRCACOMM
100 W !!,"* Deleting Transaction ......",!
101 S PRCACOMM="USER CANCELED REFERRAL ACTION"
102 D DELETE^PRCAWO1 S PRCATOT=0
103 Q
104BILL ;Get Active Bill that is not a TP Electronic Refer Type
105 ;Return PRCABN=Y,PRCABN(0)=Y(0)
106 N DA,DIC,X,Y,%Y W !
107 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
108 D RCCAT^RCRCUTL(.RCCAT)
109 S DIC="^PRCA(430,",DIC(0)="AEQMZ"
110 S DIC("S")="I $P(^(0),U,8)=16,+$G(RCCAT(+$P(^(0),U,2)))'=1"
111 D ^DIC S PRCABN=+Y,PRCABN0=$G(Y(0))
112 Q
113 ;RCRCRT1
Note: See TracBrowser for help on using the repository browser.