source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCVXM.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: 3.5 KB
Line 
1RCRCVXM ;ALB/CMS - AR/RC ORIG BILL TRANSMISSION ; 16-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 ;ORIGINAL BILL TRANSPORT
5 ;
6 Q
7EN ;Entry from Protocol to Refer bills to RC
8 N DIR,LN,PRCABN,RCA,RCCNT,RCCOM,RCDOM,RCMSG,RCSITE,RCY,X,Y S RCCNT=0,LN=4
9 D FULL^VALM1
10 I '$O(^TMP("RCRCVL",$J,"SEL",0)) W !!,"NOTHING TO REFER!",!,"No selected items from list." G ENQ
11 W !! S DIR("A",1)="Referring all bill(s) on highlighted Selection List "
12 S DIR("A",2)=" ",DIR("A",3)="This action will:"
13 S DIR("A",4)="Create a 'Refer to RC' or 'Re-establish Referral' AR Transaction,"
14 S DIR("A",5)="electronically transmit transferable bills to RC,"
15 S DIR("A",6)="list bills that did not pass the validation check and did not transmit,"
16 S DIR("A",7)="then mark the highlighted bills as referred."
17 S DIR("A",8)=" "
18 S DIR("A")="Okay to Continue: "
19 D ASK^RCRCACP I Y'=1 G ENQ
20 S RCY=0 F S RCY=$O(^TMP("RCRCVL",$J,"SEL",RCY)) Q:'RCY D
21 .S PRCABN=$P($G(^TMP("RCRCVLX",$J,RCY)),U,2) W "."
22 .I 'PRCABN Q
23 .K ^TMP("RCRCVL",$J,"XM",PRCABN)
24 .; - Validate bill and save variables
25 .S RCMSG="" D CHK^RCRCVCK(PRCABN,.RCMSG,1)
26 .I RCMSG]"" S RCA(PRCABN,RCY)=RCMSG Q
27 .D IBS^RCRCXM1
28 .Q
29 ;
30 ; - If nothing to send go write message on screen
31 I '$O(^TMP("RCRCVL",$J,"XM",0)) G ENW
32 ;
33 ; - create E-Mail and send off S RCCOM
34 D SEND
35 ;
36 ; - update AR Transaction,430 Referral Date and LM Screen
37 D ARUP
38 ;
39 ; - list bills that did not go
40ENW I $O(RCA(0)) W !!,"Did not Refer the following bills",! D
41 .S PRCABN=0 F S PRCABN=$O(RCA(PRCABN)) Q:'PRCABN D
42 ..S RCY=0 F S RCY=$O(RCA(PRCABN,RCY)) Q:'RCY D
43 ...W !,"Item ",RCY,". ",RCA(PRCABN,RCY)
44 ...;I $Y>(IOSL+3) D PAUSE^VALM1 W @IOF
45 ;
46ENQ K DIR D PAUSE^VALM1 S VALMBCK="R"
47 Q
48 ;
49SEND ;Send bills in mail message
50 N DATA,II,LN,PRCABN,RCCNT,RCBDIV,RCI,RCSUB,RCWHO,RETRY
51 N XNDUZ,XMSUB,XMTEXT,XMY,XMZ,X,Y
52 S (RCCNT,PRCABN)=0 F S PRCABN=$O(^TMP("RCRCVL",$J,"XM",PRCABN)) Q:(RCCNT)!('PRCABN) D
53 .S II=0 F S II=$O(^TMP("RCRCVL",$J,"XM",PRCABN,II)) Q:(RCCNT)!('II) D
54 ..S RCCNT=RCCNT+1
55 I RCCNT=0 G SENDQ
56 S (RCCNT,RETRY)=0,RCCOM=""
57 S RCSITE=$$SITE^RCMSITE
58 I $O(RCDIV(0)) S RCDOM=$P($G(RCDIV(+$P($G(RCDIV(0)),U,3))),U,6)
59 I $O(^TMP("RCDOMAIN",$J,0)) S RCDOM=$P(^TMP("RCDOMAIN",$J,+$P($G(^TMP("RCDOMAIN",$J,0)),U,3)),U,6)
60 I $G(RCDOM)="" S RCDOM=$$RCDOM^RCRCUTL
61SNDA ;Come back here if didn't go to mail man
62 S (XMDUN,XMDUZ)=DUZ
63 S (RCSUB,XMSUB)="AR/RC - "_$G(RCSITE,"UNK")_" ORIGINAL BILL TRANSMISSION"
64 D XMZ^XMA2 I $G(XMZ)<1 S RETRY=RETRY+1 I RETRY<100 G SNDA
65 I $G(XMZ)<1 G SENDQ
66 S RCWHO=RCDOM
67 S XMY(RCWHO)="",XMY(DUZ)=""
68 S ^XMB(3.9,XMZ,2,0)="^3.92^1^1^"_DT
69 S ^XMB(3.9,XMZ,2,1,0)="$$RC$OB$$"_RCSITE_"$S.RC RC SERV"
70 S PRCABN=0,LN=1 F S PRCABN=$O(^TMP("RCRCVL",$J,"XM",PRCABN)) Q:'PRCABN D
71 .I $O(^TMP("RCRCVL",$J,"XM",PRCABN,0)) S RCCNT=RCCNT+1
72 .S II=0 F S II=$O(^TMP("RCRCVL",$J,"XM",PRCABN,II)) Q:'II D
73 ..S RCI=0 F S RCI=$O(^TMP("RCRCVL",$J,"XM",PRCABN,II,RCI)) Q:'RCI D
74 ...S DATA=$G(^TMP("RCRCVL",$J,"XM",PRCABN,II,RCI))
75 ...I DATA="" Q
76 ...S LN=LN+1
77 ...S ^XMB(3.9,XMZ,2,LN,0)=DATA
78 ;
79 S ^XMB(3.9,XMZ,2,LN+1,0)="$END$"_LN_"$"_RCCNT_"$"
80 D ENT1^XMD
81 W !!,"Message #",XMZ," Transmitted ",$G(RCCNT,0)," bill(s)."
82 S RCCOM="Message contains "_+$G(RCCNT)_" bill(s)."
83 D ENT^RCRCXMS(XMZ,RCSUB,RCWHO,.RCCOM)
84SENDQ Q
85 ;
86ARUP ;Update AR with information
87 N PRCABN,RCY
88 S PRCABN=0 F S PRCABN=$O(^TMP("RCRCVL",$J,"XM",PRCABN)) Q:'PRCABN D
89 .D REF^RCRCRT
90 .; - Reset field in List Template
91 .S RCY=^TMP("RCRCVL",$J,"XM",PRCABN,0)
92 .D FLDTEXT^VALM10(RCY,"REFER","r")
93 .Q
94ARUPQ Q
95 ;
96 ;RCRCVXM
Note: See TracBrowser for help on using the repository browser.