source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRCAL1.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1RCRCAL1 ;ALB/CMS - TP REFERRAL ACTION LIST BUILD ; 09/02/97
2V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLDL ; build active list for third party referral action list
6 ; Send: RCSBN or RCS* sort variables in RCRCALB
7 ; Returns: TMP("RCRCAL", TMP("RCRCALPT", TMP("RCRCALBX and VALMCNT
8 ;
9 K ^TMP("RCRCAL",$J,"B")
10 I '$O(RCSBN(0)) D BLDL^RCRCAL2
11 ;
12 N CNT,PRCABN,RCCNT,RCY
13 S (RCCNT,CNT,PRCABN)=0
14 F S PRCABN=$O(RCSBN(PRCABN)) Q:'PRCABN D
15 .S CNT=RCSBN(PRCABN)
16 .S RCCNT=$G(RCCNT)+1
17 .D SCRN(PRCABN,RCCNT)
18 .QUIT
19 ;
20 ;Add findings to list sorted by Pt. Name then Activation date
21 D RESL
22 ;
23BLDLQ K RCSBN,RCSI,RCSIF,RCSIL,RCRCI Q
24 ;
25SCRN(PRCABN,RCCNT) ;
26 ; add bill to screen list "B" sort (must Re Sequence List after)
27 ; Send: PRCABN,RCCNT
28 I '$G(^PRCA(430,+$G(PRCABN),0)) G SCRNQ
29 N PRCA,RCY,RCBN0,X,Y S X=""
30 S RCBN0=$G(^PRCA(430,+PRCABN,0))
31 D BNVAR^RCRCUTL(PRCABN),DEBT^RCRCUTL(PRCABN)
32 S RCY=$G(RCCNT),X=$$SETFLD^VALM1(RCY,X,"NUMBER")
33 S RCY=$P($G(^DPT(+$P(RCBN0,U,7),0),"UNK"),U,1),X=$$SETFLD^VALM1(RCY,X,"PATIENT")
34 S RCY=$P($P(RCBN0,U,1),"-",2),X=$$SETFLD^VALM1(RCY,X,"BILL")
35 S RCY=$S($$REFST^RCRCUTL(PRCABN):"r",$$RETN^RCRCUTL(PRCABN):"x",1:""),X=$$SETFLD^VALM1(RCY,X,"REFER")
36 S RCY=$S($$HD^RCRCUIB(PRCABN):"*",1:""),X=$$SETFLD^VALM1(RCY,X,"CATCHOLD")
37 S RCY=$P($G(PRCA("CAT")),U,3),X=$$SETFLD^VALM1(RCY,X,"CAT")
38 S RCY=$S($$MINS^RCRCUIB(PRCABN):"+",1:""),X=$$SETFLD^VALM1(RCY,X,"MULTIIN")
39 S RCY=$G(PRCA("DEBTNM")),X=$$SETFLD^VALM1(RCY,X,"DEBTOR")
40 S RCY=$$DATE($P(RCBN0,U,10)),X=$$SETFLD^VALM1(RCY,X,"DATE")
41 S RCY=$$BILL^RCJIBFN2(PRCABN)
42 S X=$$SETFLD^VALM1($J(+$P(RCY,U,1),9,2),X,"ORIGAMT")
43 S X=$$SETFLD^VALM1($J(+$P(RCY,U,3),10,2),X,"CURAMT")
44 S ^TMP("RCRCAL",$J,"B",$P($G(^DPT(+$P(RCBN0,U,7),0),"UNK"),U,1),+PRCABN)=X
45SCRNQ Q
46 ;
47DATE(X) ; date in external format
48 N Y S Y="" I X?7N.E S Y=$$FMTE^XLFDT(X,"5ZD")
49 Q Y
50 ;
51RESL ;Build or Rebuild and sequence List with added or subtracted bill
52 N PRCABN,RCPT,X,Y
53 I '$D(^TMP("RCRCAL",$J,"B")) G RESLQ
54 S VALMCNT=0
55 S RCPT="" F S RCPT=$O(^TMP("RCRCAL",$J,"B",RCPT)) Q:RCPT="" D
56 .S PRCABN=0 F S PRCABN=$O(^TMP("RCRCAL",$J,"B",RCPT,PRCABN)) Q:'PRCABN D
57 ..S VALMCNT=VALMCNT+1
58 ..S X=^TMP("RCRCAL",$J,"B",RCPT,PRCABN)
59 ..S RCY=VALMCNT,X=$$SETFLD^VALM1(RCY,X,"NUMBER")
60 ..S ^TMP("RCRCAL",$J,VALMCNT,0)=X
61 ..S ^TMP("RCRCAL",$J,"IDX",VALMCNT,VALMCNT)=""
62 ..S ^TMP("RCRCALX",$J,VALMCNT)=VALMCNT_U_PRCABN
63 ..S ^TMP("RCRCALPT",$J,VALMCNT)=+$P(^PRCA(430,PRCABN,0),U,7)
64 ..D FLDCTRL^VALM10(VALMCNT)
65RESLQ Q
66 ;RCRCAL1
Note: See TracBrowser for help on using the repository browser.