source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCACP.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: 6.1 KB
Line 
1RCRCACP ;ALB/CMS - RC THIRD PARTY REFERRAL ACTION CODE LIST ; 06-JUN-00
2V ;;4.5;Accounts Receivable;**63,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6TCD ;view of TRANSACTION CODE list
7 NEW RCDA,RCY,RC0,X S (VALMCNT,X)=""
8 K ^TMP("RCRCAC",$J)
9 S RCDA=0 F S RCDA=$O(^RCT(349.4,RCDA)) Q:'RCDA D
10 .S RC0=^RCT(349.4,RCDA,0)
11 .I $P(RC0,U,1)="PP" Q
12 .S VALMCNT=+$G(VALMCNT)+1
13 .S RCY=VALMCNT,X=$$SETFLD^VALM1(RCY,X,"NUMBER")
14 .S RCY=$P(RC0,U,1),X=$$SETFLD^VALM1(RCY,X,"CODE")
15 .S RCY=$P(RC0,U,2),X=$$SETFLD^VALM1(RCY,X,"NAME")
16 .S ^TMP("RCRCAC",$J,VALMCNT,0)=X
17 .S ^TMP("RCRCAC",$J,"IDX",VALMCNT,VALMCNT)=RCDA
18 .Q
19 I VALMCNT=0 S VALMSG="NOTHING TO REPORT"
20TCDQ Q
21 ;
22TRD(D0) ;Display Transaction Profile
23 N DXS,J,I,PRCAIO,PRCAIO,PRCATYP,X,Y,Z
24 S PRCAIO=IO,PRCAIO(0)=IO(0)
25 W @IOF,!,?12,"TRANSACTION PROFILE",!
26 D ^PRCATR3,ENF^IBOLK
27 W !!
28TRDQ Q
29 ;
30EOB ;Process the EOB Codes
31 N CNT,D,DA,DIC,DIE,DR,PRCA,PRCABN,PRCABN0,PRCAEN,PRCATN,RCCAT,RCCOM,RCCNT,RCOUT,RCSEL,RCXMB,RCY,X,XMZ,Y
32 N DIR,DIRUT,DIROUT,DTOUT,DUOUT S RCOUT=0
33 D FULL^VALM1
34 I '$O(^TMP("RCRCBL",$J,"SEL",0)) W !!,"NO PAYMENT TRANSACTION SELECTED !!",! G EOBQ
35 I '$O(^PRCA(433,"AEOB",0)) W !!,"ALL TP BILLS ARE PROCESSED !!" G EOBQ
36 D RCCAT^RCRCUTL(.RCCAT) K DIR
37 S RCSEL=0 F S RCSEL=$O(^TMP("RCRCBL",$J,"SEL",RCSEL)) Q:('RCSEL)!(RCOUT=1) S RCCNT=$G(^(RCSEL)) D
38 .S PRCATN=+$P($G(^TMP("RCRCBLX",$J,RCSEL)),U,2),RCCNT=+RCCNT
39 .S PRCABN=$P($G(^PRCA(433,PRCATN,0)),U,2)
40 .I '$D(^PRCA(433,"AEOB",PRCABN,PRCATN)) W !!," Item ",RCSEL,". Transaction Number ",PRCATN," is processed.",! D PAUSE^VALM1 Q
41 .D BNVAR^RCRCUTL(PRCABN)
42 .D TRD(PRCATN)
43 .S DA=PRCATN,DIE(0)="AQEZ",DIE="^PRCA(433,",DR="54" D ^DIE
44 .K DIR W ! S DIR("A")="Ready to process payment information"
45 .S DIR("?")="Enter 'Yes' to transmit the payment to RC and update the referral amount."
46 .D ASK K DIR I $G(Y)="^" S RCOUT=1
47 .I ($G(Y)'=1)!(RCOUT=1) S ^PRCA(433,"AEOB",+PRCABN,+PRCATN)="" Q
48 .S RCCOM=$P($G(^PRCA(433,PRCATN,5)),U,4)
49 .I RCCOM]"" S RCCOM="Payment EOB CODE: "_RCCOM D COM^RCRCRT(PRCATN,RCCOM)
50 .S DA=PRCABN,DIE="^PRCA(430,",DR="66///^S X="_+$G(^PRCA(430,PRCABN,7)) D ^DIE
51 .K ^PRCA(433,"AEOB",PRCABN,PRCATN)
52 .D FLDTEXT^VALM10(RCSEL,"DEBTOR","Processed ")
53 .I $P($G(RCCAT(+$P(^PRCA(430,PRCABN,0),U,2))),U,1)'=1 Q
54 .S Y=$G(^PRCA(433,PRCATN,1))
55 .S RCXMB(2,0)=$G(PRCA("BNAME"),"UNK")_U_PRCATN_U_$P($P(Y,U,9),".",1)_U_+$P(Y,U,5)
56 .S RCXMB(3,0)="EOB^"_$P($G(^PRCA(433,PRCATN,5)),U,4)
57 .D EOBS
58 .S RCCOM="Payment information sent to RC in MM# "_$G(XMZ) D COM^RCRCRT(PRCATN,RCCOM)
59 .Q
60EOBQ I $G(RCOUT)=1,$O(^PRCA(433,"AEOB",0)) D
61 .W !!," NOTICE: All bills pending EOB processing should be processed inorder"
62 .W !,?9,"to electronically send Partial Payment information to Regional Counsel"
63 .W !,?9,"and update the bill referral amount. Not processing may cause the"
64 .W !,?9,"referral amount to be out-of-balance with Regional Counsel.",!
65 D PAUSE^VALM1 S VALMBCK="R"
66 Q
67 ;
68EOBS ;Send Partial Payment data to RC
69 N RCBDIV,RCCOM,RCDIV,RCDOM,RCSITE,RCSUB,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,X,Y
70 I '$O(RCXMB(0)) G EOBSQ
71 S RCSITE=$$SITE^RCMSITE
72 D RCDIV^RCRCDIV(.RCDIV)
73 I $O(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(PRCABN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
74 .I X=+RCBDIV S RCDOM=$P(RCDIV(X),U,6)
75 I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
76 S XMDUZ=DUZ,(RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" PARTIAL PAYMENT"
77 S RCWHO=RCDOM,XMY(RCWHO)="",XMY(DUZ)=""
78 S RCXMB(1,0)="$$RC$PP$$"_RCSITE_"$S.RC RC SERV"
79 S RCXMB(4,0)="$END$1$"
80 S XMTEXT="RCXMB(",XMCHAN=1 D ^XMD
81 S RCCOM="Sent Payment Transaction to RC in MM# "_$G(XMZ)
82 I $G(XMZ) D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
83 W !!,?10,RCCOM,!
84EOBSQ Q
85 ;
86ASK ;Ask Yes or No Caller send DIR("A"),DIR("?")
87 N DIROUT,DUOUT,DTOUT,DIRUT
88 S DIR(0)="Y",DIR("B")="Yes" D ^DIR
89ASKQ Q
90 ;
91REQ ;Transmit a Action Request to RC
92 N DIR,PRCABN,RCCOM,RCY,VALMCNT,VALMY,X,Y
93 I '$O(^TMP("RCRCAL",$J,"SEL",0)) W !,"NO BILLS SELECTED!",!,"No selected items from Bill List" G REQQ
94 D EN^VALM2($G(XQORNOD(0)),"SO") I '$O(VALMY(0)) G REQQ
95 D FULL^VALM1
96 S RCCOM=$G(^TMP("RCRCAC",$J,+$O(VALMY(0)),0))
97 W !!,"You Selected: "_RCCOM
98 W !!,"This action creates an AR Comment Transaction requesting that a "_RCCOM
99 W !,"action be applied by Regional Counsel to the bills on the highlighted"
100 W !,"selection list. You can then edit the Comment Transaction request"
101 W !,"and transmit the request to RC.",!
102 ;
103 S RCCOM=^TMP("RCRCAC",$J,"IDX",+RCCOM,+RCCOM),RCCOM=$P($G(^RCT(349.4,+RCCOM,0)),U,1)
104 S RCCOM="I am requesting that a "_RCCOM_" be applied to this bill."
105 K DIR S DIR("A")="Okay to Create a Comment Transaction "
106 S DIR("?")="Enter Yes to create a Comment Transaction or No to exit."
107 D ASK K DIR I $G(Y)'=1 G REQQ
108 K ^TMP("RCRCAC",$J,"XM")
109 S RCY=0 F S RCY=$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q:'RCY D
110 .S PRCABN=+$P($G(^TMP("RCRCALX",$J,RCY)),U,2),PRCAEN=0
111 .D CCOM
112 .Q
113 I '$O(^TMP("RCRCAC",$J,"XM",0)) G REQQ
114 K DIR S DIR("A")="Send Request to RC now ",DIR("?")="Enter Yes if to transmit the created Comment entries"
115 D ASK I $G(Y)=1 D SND
116 ;
117REQQ K ^TMP("RCRCAC",$J,"XM")
118 K DIR D PAUSE^VALM1 S XQORM("B")="Quit",VALMBCK="R"
119 Q
120 ;
121CCOM ;Create Comment Transaction
122 ;Input: PRCABN
123 N DA,DIC,DIE,DR,D0,PRCA,PRCABN0,PRCAD,PRCAEN,PRCAMT,X,Y
124 S PRCABN0=$G(^PRCA(430,+$G(PRCABN),0))
125 I 'PRCABN0 W !,PRCABN_" NOT A VALID AR BILL!",! G CCOMQ
126 W !!,"Bill No. # "_$P(PRCABN0,U,1)
127 D SETTR^PRCAUTL,PATTR^PRCAUTL
128 I '$D(PRCAEN) W "COULD NOT CREATE A TRANSACTION AT THIS TIME!",!,"Try again later." G CCOMQ
129 I $G(RCCOM)]"" D COM^RCRCRT(PRCAEN,RCCOM)
130 S DIE="^PRCA(433,",DA=PRCAEN,DR="[PRCA COMMENT]" D ^DIE
131 S DR="4////^S X=2" D ^DIE
132 S ^TMP("RCRCAC",$J,"XM",PRCABN,PRCAEN)=""
133CCOMQ Q
134 ;
135SND ;Send data to RC
136 N PRCABN,PRCAEN,PRCA,RCXCNT,X,Y,RCSITE,RCDIV,RCDOM,RCBDIV
137 K ^TMP("RCRCAT",$J,"XM") S RCXCNT=0
138 S RCSITE=$$SITE^RCMSITE
139 D RCDIV^RCRCDIV(.RCDIV)
140 S PRCABN=0 F S PRCABN=$O(^TMP("RCRCAC",$J,"XM",PRCABN)) Q:'PRCABN D
141 .D BNVAR^RCRCUTL(PRCABN)
142 .D DEBT^RCRCUTL(PRCABN)
143 .S PRCAEN=0 F S PRCAEN=$O(^TMP("RCRCAC",$J,"XM",PRCABN,PRCAEN)) Q:'PRCAEN D
144 ..D SET^RCRCAT1
145 ..I $G(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(PRCABN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
146 ...I X=+RCBDIV S RCDOM=$P(RCDIV(X),"^",6)
147 I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
148 D SEND^RCRCAT
149 K ^TMP("RCRCAT",$J,"XM")
150SNDQ Q
151 ;RCRCACP
Note: See TracBrowser for help on using the repository browser.