source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCAT.m@ 1005

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1RCRCAT ;ALB/CMS - AR/RC AR TRANSACTION TRANSMISSION ;16-JUN-00
2V ;;4.5;Accounts Receivable;**63,127,159**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6EN ;Entry from Protocol to Transmit AR Transaction(s) to RC
7 N LN,PRCABN,RCA,RCCAT,RCCNT,RCCOM,RCDATA,RCDOM,RCMSG,RCOUT,RCSITE,RCXCNT,RCY,X,Y S RCCNT=0,LN=4
8 D FULL^VALM1
9 I '$O(^TMP("RCRCAL",$J,"SEL",0)) W !!,"NOTHING TO REFER!",!,"No selected items from list." G ENQ
10 ;D RCCAT^RCRCUTL(.RCCAT)
11 W !! S DIR("A",1)="Referring transactions for bill(s) on highlighted Selection List "
12 S DIR("A")="Okay to Continue ",DIR("?")="Enter Yes to Continue"
13 D ASK^RCRCACP I $G(Y)'=1 G ENQ
14 K ^TMP("RCRCAT",$J,"XM") S RCXCNT=0
15 S RCY=0 F S RCY=$O(^TMP("RCRCAL",$J,"SEL",RCY)) Q:('RCY)!($G(RCOUT)) D
16 .S PRCABN=$P($G(^TMP("RCRCALX",$J,RCY)),U,2)
17 .S PRCABN0=$G(^PRCA(430,+PRCABN,0)) Q:'PRCABN0
18 .;I $P($G(RCCAT(+$P(PRCABN0,U,2))),U,1)'=1 Q
19 .D EN^RCRCAT1
20 .Q
21 I $G(RCOUT) G ENQ
22 ; - If nothing to send go write message on screen
23 I '$O(^TMP("RCRCAT",$J,"XM",0)) W !,"Nothing to transmit!" G ENQ
24 ;
25 ; - create E-Mail and send off
26 D SEND
27 ;
28ENQ K DIR D PAUSE^VALM1 S VALMBCK="R"
29 Q
30 ;
31SEND ;Send bills in mail message
32 N II,LN,LNCNT,PRCABN,RCDATA,RCI,RCSUB,RCWHO,RETRY,TRCNT
33 N XNDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
34 S RETRY=0,RCCOM=""
35 S RCSITE=$$SITE^RCMSITE
36 I '$D(RCDOM)&($O(RCDIV(0))) S RCDOM=$P($G(RCDIV(+$P($G(RCDIV(0)),U,3))),U,6)
37 I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
38 N PRCABN
39SNDA ;Come back here if didn't go to mail man
40 S (XMDUN,XMDUZ)=$S(+$G(DUZ):DUZ,1:.5)
41 S (RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" AR "_$S($G(RCTYP)="CL":"COMMENT LOG",$G(RCTYP)="TR":"TRANSACTION HISTORY",1:"REQUEST FOR ACTION")
42 D XMZ^XMA2 I $G(XMZ)<1 S RETRY=RETRY+1 I RETRY<100 G SNDA
43 I $G(XMZ)<1 G SENDQ
44 S RCWHO=RCDOM
45 S XMY(RCWHO)="",TRCNT=0
46 S ^XMB(3.9,XMZ,2,0)="^3.92^1^1^"_DT
47 S ^XMB(3.9,XMZ,2,1,0)="$$RC$"_$G(RCTYP,"TR")_"$$"_RCSITE_"$S.RC RC SERV"
48 S PRCABN=0,LN=1 F S PRCABN=$O(^TMP("RCRCAT",$J,"XM",PRCABN)) Q:'PRCABN D
49 .S II=0 F S II=$O(^TMP("RCRCAT",$J,"XM",PRCABN,II)) Q:'II D
50 ..S RCI=0,TRCNT=TRCNT+1 F S RCI=$O(^TMP("RCRCAT",$J,"XM",PRCABN,II,RCI)) Q:'RCI D
51 ...S RCDATA=$G(^TMP("RCRCAT",$J,"XM",PRCABN,II,RCI))
52 ...I RCDATA="" Q
53 ...S LN=LN+1,^XMB(3.9,XMZ,2,LN,0)=RCDATA
54 ;
55 S LNCNT=LN-1
56 S LN=LN+1,^XMB(3.9,XMZ,2,LN,0)="$END$"_TRCNT_"$"_LNCNT
57 S $P(^XMB(3.9,XMZ,2,0),U,3,4)=LN_U_LN
58 ;
59 D ENT1^XMD
60 I $E($G(IOST),1,2)="C-" W !!,"Message #",XMZ," Transmitted ",$G(TRCNT,0)," Transaction(s)."
61 S RCCOM="Message contains AR Transactions."
62 D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,.RCCOM)
63SENDQ Q
64 ;
65DISP ;Display Bill and Transactions Select Items
66 ;Input: PRCABN
67 N DIR,CNT,RCY,PRCA,PRCAEN,X,Y S RCOUT=0
68 I '$D(^PRCA(430,PRCABN,0)) G DISPQ
69 D BNVAR^RCRCUTL(PRCABN)
70 D DEBT^RCRCUTL(PRCABN)
71 D HD
72 S (PRCAEN,CNT)=0 F S PRCAEN=$O(^PRCA(433,"C",PRCABN,PRCAEN)) Q:'PRCAEN D
73 .S CNT=CNT+1
74 .S RCEN1=$G(^PRCA(433,PRCAEN,1)),RCTY=+$P(RCEN1,U,2)
75 .S RCTY=$P($G(^PRCA(430.3,RCTY,0)),U,1)
76 .I RCTY="COMMENT" S RCTY=$P($G(^PRCA(433,PRCAEN,5)),U,2)
77 .S Y=+RCEN1 D D^DIQ S RCDT=Y
78 .S DIR("L",CNT)=CNT_" "_PRCAEN_" "_RCTY_" "_RCDT_" "_+$P(RCEN1,U,5)
79 .S ^TMP("RCRCAL",$J,"XM",PRCA("DEBTNM"),0)=PRCA("DEBTNM")
80 .S ^TMP("RCRCAL",$J,"XM",PRCA("DEBTNM"),PRCA("BNAME"),PRCAEN,0)=PRCA("BNAME")_" Transaction # "_PRCAEN_" Transaction Date "_DT
81DISPQ Q
82 ;
83HD ;Write Heading
84 W @IOF,!,PRCA("DEBTNM"),!,PRCA("DEBTAD1")
85 W:$G(PRCA("DEBTAD2"))]"" !,PRCA("DEBTAD2")
86 W !,PRCA("DEBTCT"),", ",PRCA("DEBTST")," ",PRCA("DEBTZIP")
87 W !,"PHONE #: ",$P(PRCA("DEBTADD"),U,7)
88 W !!," BILL #: ",PRCA("BNAME")
89 W !!,"Item",?8,"TR #",?20,"Tran. Type",?45,"Date",?55,"Amount"
90 W ! F I=1:1:(IOM-1) W "="
91HDQ Q
92 ;
93PF(RCT) ;Input: PRCAEN, PRCABN Called from PRCAPAY1 and INC^RCRCRT
94 ;Send RC a mail message about Payment in Full or Increase
95 N PRCA,RCWHO,RCXMB,X,XNDUZ,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
96 N RCBDIV,RCCAT,RCCOM,RCD,RCDOM,RCDIV,RCSITE,RCSUB,RC1 S XMCHAN=""
97 D RCCAT^RCRCUTL(.RCCAT)
98 I $P($G(RCCAT(+$P(^PRCA(430,+PRCABN,0),U,2))),U,1)'=1 G PFQ
99 I '$$REFST^RCRCUTL(PRCABN),(RCT="I") G PFQ
100 I RCT="P" S X=$P($G(^PRCA(430,PRCABN,6)),U,4,6) I 'X G PFQ
101 D BNVAR^RCRCUTL(+PRCABN)
102 D RCDIV^RCRCDIV(.RCDIV)
103 I $O(RCDIV(0)) S RCBDIV=$$DIV^IBJDF2(PRCABN) S X=0 F S X=$O(RCDIV(X)) Q:'X D
104 .;I $P(RCDIV(X),U,3)=+RCBDIV S RCDOM=$P(RCDIV(X),U,2)
105 .I X=+RCBDIV S RCDOM=$P(RCDIV(X),U,6)
106 S RCSITE=$$SITE^RCMSITE
107 I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
108 S XMDUZ=DUZ,(RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_$S(RCT="I":" INCREASE TO CURRENT BALANCE",1:" FULL PAYMENT FOR BILL")
109 S RCWHO=RCDOM,XMY(RCWHO)=""
110 S RCXMB(1,0)="$$RC$"_$S(RCT="I":"IN",1:"FP")_"$$"_RCSITE_"$S.RC RC SERV"
111 S RC1=$G(^PRCA(433,+PRCAEN,1))
112 S RCXMB(2,0)=$G(PRCA("BNAME"),"UNK")_U_PRCAEN_U_+$P(RC1,U,1)_U_+$P(RC1,U,5)
113 S RCXMB(3,0)="$END$1$"
114 S XMTEXT="RCXMB(" D ^XMD
115 S RCCOM="Sent "_$S(RCT="I":"Increase Adjustment",1:"Payment in Full")_" information to RC in MM# "_$G(XMZ)
116 I RCT="I" W !!,RCCOM
117 I $G(XMZ) D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,RCCOM)
118PFQ Q
119 ;RCRCAT
Note: See TracBrowser for help on using the repository browser.