source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCVCK.m@ 862

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1RCRCVCK ;ALB/CMS - TP POSSIBLE REFERRAL LIST CHECK ; 09/02/97
2V ;;4.5;Accounts Receivable;**63,122,189**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6EN ;Entry point from protocol
7 N PRCABN,RCA,RCMSG,RCOK,RCY S RCY=0,RCA=""
8 D FULL^VALM1
9 I '$O(^TMP("RCRCVL",$J,"SEL",RCY)) W !!,"NOTHING TO VALIDATE!",!,"No selected items from list." G ENQ
10 W !!,"Checking all bill(s) on highlighted Selection List "
11 F S RCY=$O(^TMP("RCRCVL",$J,"SEL",RCY)) Q:'RCY D
12 .S PRCABN=$P($G(^TMP("RCRCVLX",$J,RCY)),U,2)
13 .I 'PRCABN Q
14 .S RCMSG=""
15 .D CHK(PRCABN,.RCMSG,0)
16 .I RCMSG]"" S RCA(PRCABN,RCY)=RCMSG
17 .W "."
18 ;
19 I '$O(RCA(0)) W !,"Everything is Okay!" G ENQ
20 D CHKD
21ENQ D PAUSE^VALM1 S VALMBCK="R"
22 Q
23 ;
24RCINFO(PRCABN) ; get new info for *189 to refer bills
25 N DIE,DA,DR
26 W !,"Bill No.: ",$P($G(^PRCA(430,PRCABN,0)),"^")
27 S DIE="^PRCA(430,",DA=PRCABN,DR="[PRCAC RC INFO]" D ^DIE
28 S PRCA("REF REASON")=$P($G(^PRCA(430,PRCABN,6)),"^",22,23)
29 I PRCA("REF REASON")'["^" S PRCA("REF REASON")=PRCA("REF REASON")_"^"
30 Q
31 ;
32CHK(PRCABN,COM,RCS) ;Validate Bill for Electronic Referral
33 ;Return: COM Comments if didn't pass
34 ;Return: RCCAT(,DFN,PRCA(,VA(,VADM(,VAPD( if transmitting
35 N I,RCY,X,Y
36 ;if calling from RCRCXM1 do not new variables
37 I 'RCS N DFN,PRCA,RCCAT,VA,VADM,VAPA
38 D RCCAT^RCRCUTL(.RCCAT)
39 D BNVAR^RCRCUTL(PRCABN)
40 I '$G(PRCABN) S COM="Not a valid Bill Number." G CHKQ
41 I '$G(PRCA("CAT")) S COM="Bill Category not entered." G CHKQ
42 I +PRCA("STATUS")'=16 S COM="Bill Status is not Active." G CHKQ
43 D DEBT^RCRCUTL(PRCABN)
44 I $G(PRCA("DEBTNM"))="" S COM="No Debtor Name." G CHKQ
45 I "ZZzzZ-z-"[$E(PRCA("DEBTNM"),1,2) S COM="Debtor Name starts with "_$E(PRCA("DEBTNM"),1,2) G CHKQ
46 S DFN=+$P(^PRCA(430,PRCABN,0),U,7)
47 I 'DFN S COM="No Patient Information." G CHKQ
48 D DEM^VADPT,ADD^VADPT
49 I "ZZzzZ-z-"[$E(VADM(1),1,2) S COM="Patient name starts with "_$E(VADM(1),1,2) G CHKQ
50 I $E(VADM(2),1,5)="00000" S COM="Test Patient." G CHKQ
51 S RCY=$$BILL^RCJIBFN2(PRCABN)
52 I '$P(RCY,U,3) S COM="No Current Balance." G CHKQ
53 I $G(^DGCR(399,PRCABN,0))="" S COM="No Bill Claim Information." G CHKQ
54 I 'RCS,$G(RCCAT(+PRCA("CAT")))'=1 S COM=$P(PRCA("CAT"),U,2)_" bills can be referred, but not electronically."
55 D RCINFO(PRCABN) I 'PRCA("REF REASON") S COM="RC Referal Reason Code is REQUIRED" G CHKQ
56 I +PRCA("REF REASON")=5,'$L($P(PRCA("REF REASON"),"^",2)) S COM="Referral Comments is REQUIRED for RC Reason Code 5" G CHKQ
57 S COM=""
58CHKQ I COM]"" S COM=$G(PRCA("BNAME"))_" - "_COM
59 Q
60 ;
61CHKD ;Display invalid bills and message from RCA array
62 ;Ask user what they want to do with bad referral
63 N PRCABN,RCY
64 S PRCABN=0 F S PRCABN=$O(RCA(PRCABN)) Q:('PRCABN)!($G(RCOUT)) D
65 .S RCY=0 F S RCY=$O(RCA(PRCABN,RCY)) Q:('RCY)!($G(RCOUT)) D
66 ..W !!!,"Item ",RCY,". ",RCA(PRCABN,RCY)
67 ..D UNSEL^RCRCVLE(RCY)
68CHKDQ Q
69 ;RCRCVCK
Note: See TracBrowser for help on using the repository browser.