source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDMB1MT.m@ 909

Last change on this file since 909 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.7 KB
Line 
1RCDMB1MT ;ALB/MR-REPAYMENT PLAN MONITOR ;16-AUG-00
2 ;;4.5;Accounts Receivable;**167,171,188**;Mar 20, 1995
3 ;
4EN ; - Entry point for this program (Called by PRCABJ - AR Nightly Process)
5 N BILL,CNT,DATA,DFN,FLG,I,J,LINE,RCPT,PTDA,RCAR,RCAT,RCDA,RCDB,RCRP,RPDT
6 N TXT,TYPE,X
7 ;
8 K ^TMP("RCDMBDAT",$J)
9 ;
10 ; - Find data required for report.
11 S RCDA=""
12 F S RCDA=$O(^PRCA(430,"AC",16,RCDA)) Q:'RCDA D
13 . S RCAR=$G(^PRCA(430,RCDA,0)) Q:'RCAR
14 . I '$P($G(^PRCA(430,RCDA,4)),"^") Q ; No Repayment Plan
15 . S RCAT=+$P(RCAR,"^",2) ; Gets AR category.
16 . S RCDB=$P(RCAR,"^",9) ; Gets the pointer to the Debtor file (#340)
17 . S RCPT=$$PAT(RCDB) Q:RCPT="" ; Gets patient info.
18 . S DFN=$P(RCPT,"^",4) ; Gets the pointer to the Patient file (#2)
19 . S RCRP=$$RP(RCDA,RCDB) ; Defaulted Repymt.Plan/New Bill entered
20 . I 'RCRP,'$P(RCRP,"^",2) Q ; Neither case was found
21 . ;
22 . ; - Sets the temporary global
23 . I $P(RCRP,"^") D ; Defaulted on the Repayment Plan
24 . . S ^TMP("RCDMBDAT",$J,1,DFN)=RCPT
25 . . S ^TMP("RCDMBDAT",$J,1,DFN,$P(RCAR,"^"))=""
26 . I $P(RCRP,"^",2) D ; Had a new bill entered
27 . . S ^TMP("RCDMBDAT",$J,2,DFN)=RCPT
28 . . S X=""
29 . . F S X=$O(^TMP("RCDMBDAT",$J,"BILL",X)) Q:X="" D
30 . . . S ^TMP("RCDMBDAT",$J,2,DFN,X)=""
31 . . K ^TMP("RCDMBDAT",$J,"BILL")
32 ;
33 ; - No cases to report were found
34 S LINE=0 I '$D(^TMP("RCDMBDAT",$J)) G SND
35 ;
36 ; - Formats and set the data on ^TMP("RCDMBMSG",$J)
37 K ^TMP("RCDMBMSG",$J)
38 S (TYPE,PTDA,BILL)="",LINE=1
39 F S TYPE=$O(^TMP("RCDMBDAT",$J,TYPE)) Q:TYPE="" D
40 . ;
41 . ; - Prints the Header (Name SSN...) and updates LINE
42 . D HDR(TYPE,.LINE) S CNT=0
43 . F S PTDA=$O(^TMP("RCDMBDAT",$J,TYPE,PTDA)) Q:PTDA="" D
44 . . S DATA=$G(^TMP("RCDMBDAT",$J,TYPE,PTDA))
45 . . S CNT=CNT+1,X=""
46 . . S $E(X,1)=$P(DATA,"^") ; Debtor Name
47 . . S $E(X,38)=$P(DATA,"^",2) ; SSN
48 . . S $E(X,51)=$P(DATA,"^",3) ; Phone Number
49 . . S FLG=0 I $P(DATA,"^",5)'="" S FLG=1 ; Date of Death
50 . . F S BILL=$O(^TMP("RCDMBDAT",$J,TYPE,PTDA,BILL)) Q:BILL="" D
51 . . . I FLG,X="" S $E(X,6)="DOD: "_$P(DATA,"^",5),FLG=0
52 . . . S $E(X,65)=BILL ; Bill Number
53 . . . S ^TMP("RCDMBMSG",$J,LINE)=X,X=""
54 . . . S LINE=LINE+1
55 . . I FLG D
56 . . . S ^TMP("RCDMBMSG",$J,LINE)=" DOD: "_$P(DATA,"^",5)
57 . . . S LINE=LINE+1
58 . I CNT'>1 Q
59 . S ^TMP("RCDMBMSG",$J,LINE)="",LINE=LINE+1 ; Skip a line
60 . S ^TMP("RCDMBMSG",$J,LINE)="Total of "_CNT_" debtor(s)",LINE=LINE+1
61 . S ^TMP("RCDMBMSG",$J,LINE)="",LINE=LINE+1 ; Skip a line
62 ;
63SND ; - If one of the two situations or none of them were found, it will
64 ; informed in the e-mail
65 ;
66 F I=1,2 D
67 . I $D(^TMP("RCDMBDAT",$J,I)) Q
68 . F J=1:1:3 S LINE=LINE+1,^TMP("RCDMBMSG",$J,LINE)=""
69 . I I=1 D Q
70 . . S ^TMP("RCDMBMSG",$J,LINE)="There were no debtors who defaulted on their repayment plan yesterday."
71 . S ^TMP("RCDMBMSG",$J,LINE)="There were no debtors with repayment plans who had new active bills yesterday."
72 ;
73 D XMD ; Sends the Mailman message
74 ;
75ENQ K ^TMP("RCDMBDAT",$J),^TMP("RCDMBMSG",$J)
76 Q
77 ;
78XMD ; Sets the Mailman variables and send the message
79 N DUZ,XMSUB,XMDUZ,XMY,XMDUN,XMMG,XMSCR,XMTEXT,XMZ
80 ;
81 S XMSUB="AR REPAYMENT PLAN MONITOR",XMDUZ="AR PACKAGE"
82 S XMY("G.RC REPAY PLANS")="",XMTEXT="^TMP(""RCDMBMSG"","_$J_","
83 ;
84 D ^XMD
85 ;
86 Q
87 ;
88PAT(DEB) ; - Returns Debtor information
89 ; Input: DEB=AR pointer to Debtor file (#340)
90 ; Output: Name ^ SSN ^ Phone Number ^ Pointer to Patient file ^
91 ; Date of Death (MM/DD/YY)
92 ;
93 N DEATH,DEBTOR,DFN,NAME,PHONE,SSN,VA,VADM,VAERR,VAPA
94 I 'DEB Q ""
95 S DEBTOR=$G(^RCD(340,DEB,0)) I $P(DEBTOR,"^")'["DPT" Q ""
96 S DFN=+DEBTOR
97 D DEM^VADPT S NAME=VADM(1),SSN=$P(VADM(2),"^",2),DEATH=$P(VADM(6),".")
98 I DEATH'="" S DEATH=$$DAT(DEATH)
99 D ADD^VADPT S PHONE=VAPA(8)
100 ;
101 Q (NAME_"^"_SSN_"^"_PHONE_"^"_DFN_"^"_DEATH)
102 ;
103RP(X,DEB) ; - Checks if a Repayment Plan became defaulted or if a new
104 ; bill has been entered to a patient under a Repayment Plan established
105 ; Input: X=Pointer to the AR file #430
106 ; DEB=Pointer to the Detor file #340
107 ; Output: Y=Defaulted? (1-YES/0-NO) ^ New bill entered? (1-YES/0-NO) ^
108 ; Bill(s) # separated by "," (If piece 2 = 1)
109 ;
110 N ARZ,DEF,ELM,I,NEW,NPMT,RCBL,RP,YST
111 ;
112 S (DEF,NEW)=0
113 S RP=$G(^PRCA(430,X,4)),NPMT=$P(RP,"^",4),YST=$$HTFM^XLFDT($H-1,1)
114 ;
115 ; - Checks if the patient defaulted on his Repayment Plan
116 F I=1:1:NPMT D Q:DEF
117 . S ELM=$G(^PRCA(430,X,5,I,0)) Q:ELM=""
118 . I $P(ELM,"^",2) Q
119 . I $$FMDIFF^XLFDT(YST,$P(ELM,"^"))=1 D Q
120 . . S DEF=1
121 ;
122 ; Checks if a Bill became active for the debtor yesterday
123 S RCBL=""
124 F S RCBL=$O(^PRCA(430,"C",DEB,RCBL)) Q:RCBL="" D
125 . I RCBL=X Q
126 . S ARZ=$G(^PRCA(430,RCBL,0))
127 . I $P(ARZ,"^",8)'=16!($P(ARZ,"^",14)'=YST) Q
128 . S NEW=1,^TMP("RCDMBDAT",$J,"BILL",$P($G(^PRCA(430,RCBL,0)),"^"))=""
129 Q (DEF_"^"_NEW)
130 ;
131HDR(TP,LN) ; Sets the temporary global with the header of the E-mail
132 ; Input: TP=Type of problem (1-Defaulted / 2-New bill)
133 ; LN=Next line to be set on the ^TMP("RCDMBMSG",$J,LN) global
134 ;
135 N X,I
136 I TP=1 D
137 . S ^TMP("RCDMBMSG",$J,LN)="The following debtors just defaulted on a Repayment Plan by not making a"
138 . S LN=LN+1
139 . S ^TMP("RCDMBMSG",$J,LN)="scheduled payment on or before the scheduled payment date: "
140 I TP=2 D
141 . F I=1,2 S ^TMP("RCDMBMSG",$J,LN)="",LN=LN+1
142 . S ^TMP("RCDMBMSG",$J,LN)="The following debtors with a Repayment Plan had a new active bill entered: "
143 ;
144 S LN=LN+1,^TMP("RCDMBMSG",$J,LN)=""
145 S X="",$E(X,1)="Name",$E(X,38)="SSN",$E(X,51)="Phone Number"
146 S $E(X,65)=$S(TP=1:"Bill",1:"New Bill")
147 S LN=LN+1,^TMP("RCDMBMSG",$J,LN)=X
148 S X="",$P(X,"=",79)="" S LN=LN+1,^TMP("RCDMBMSG",$J,LN)=X
149 S LN=LN+1
150 Q
151 ;
152DAT(DAT) ;Changes date from FM to MM/DD/YYYY
153 N YR
154 S YR=DAT\10000+1700
155 Q $E(DAT,4,5)_"/"_$E(DAT,6,7)_"/"_YR
Note: See TracBrowser for help on using the repository browser.