source: FOIAVistA/tag/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCTOPD.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1RCTOPD ;WASH IRMFO@ALTOONA,PA/TJK-TOP TRANSMISSION ;2/11/00 3:34 PM
2V ;;4.5;Accounts Receivable;**141,187,224,236,229**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4ENTER ;Entry point from nightly process
5 Q:'$D(RCDOC)
6 N DEBTOR,BILL,DEBTOR0,B0,B6,B7,P181DT,PRIN,INT,ADMIN,B4
7 N EFFDT,DFN,CNTR,SITE,LN,FN,MN,DOB,SITE,F60DT,VADM
8 N PHONE,QUIT,TOTAL,ZIPCODE,FULLNM,RCNT,REPAY,X1,X2
9 N ERROR,ADDR,CAT,BILLDT,P10YDT,CURRTOT,HOLD,SITECD,RCNEW
10 ;
11 ;initialize temporary global, variables
12 ;
13 K ^XTMP("RCTOPD") S ^XTMP("RCTOPD",0)=DT_U_DT
14 S SITE=$E($$SITE^RCMSITE(),1,3),SITECD=$P(^RC(342,1,3),U,5)
15 S X1=DT,X2=-181 D C^%DTC S (P181DT,EFFDT)=X
16 S X1=DT,X2=-3650 D C^%DTC S P10YDT=X
17 S X1=DT,X2=+60 D C^%DTC S F60DT=X
18 S (CNTR(1),CNTR(2),CNTR(4),DEBTOR,RCNT)=0
19 ;
20 ;branch if recertification document
21 I RCDOC="Y" D RECERT G EXIT
22 ;
23 ;branch to do update documents
24 D UPDATE I RCDOC="U" G EXIT
25 ;
26 ;master sheet compilation
27 ;
28 F S DEBTOR=$O(^PRCA(430,"C",DEBTOR)) Q:DEBTOR'?1N.N D
29 .N X,RCDFN
30 .S RCDFN=$G(^RCD(340,DEBTOR,0))
31 .I $P(RCDFN,";",2)["DPT",$$EMERES^PRCAUTL(+RCDFN)]"" Q ;stop the master sheet compilation for hurricane Katrina sites (patients)
32 .Q:$D(^RCD(340,"TOP",DEBTOR))
33 .; quit if debtor address marked unknown
34 .Q:$P($G(^RCD(340,+DEBTOR,1)),"^",9)=1
35 .S DEBTOR6=$G(^RCD(340,DEBTOR,6)),DEBTOR0=$G(^(0)),HOLD=0,RCNEW=1
36 .I $P(DEBTOR6,U,2),'$P(DEBTOR6,U,3) Q
37 .S QUIT=1,FILE=$$FILE(DEBTOR0) Q:'FILE
38 .S EFFDT=P181DT
39 .D PROC(DEBTOR,.QUIT,FILE,.HOLD,.EFFDT) Q:QUIT
40 .D EN1^RCTOP2(DEBTOR,"M",FILE)
41 .D EN1^RCTOP1(DEBTOR,TOTAL,"M",EFFDT,0,FILE)
42 .;set hold date in file for employee, ex-employee, vendor records
43 .;Austin holds these for 60 days before transmitting to TOP
44 .I $G(HOLD) S $P(^RCD(340,DEBTOR,6),U,6)=F60DT
45 .Q
46 ;compile documents into mail messages--sets referral date in 430
47 D COMPILE
48EXIT K RCDOC,^XTMP("RCTOPD"),^TMP("RCTOPD"),XMDUZ D KVAR^VADPT
49 Q
50 ;
51UPDATE ;weekly update compilation
52 F S DEBTOR=$O(^RCD(340,"TOP",DEBTOR)) Q:DEBTOR'?1N.N D
53 .S QUIT=1,DEBTOR0=^RCD(340,DEBTOR,0),DEBTOR6=^(6),DEBTOR4=^(4),FILE=$$FILE(DEBTOR0),EFFDT=$P(DEBTOR4,U,6),RCNEW=0
54 .D EN1^RCTOP2(DEBTOR,"U",FILE)
55 .D PROC(DEBTOR,.QUIT,FILE,0,.EFFDT) I QUIT D Q
56 ..;process type 4 document if necessary
57 ..S TAXID=$$TAXID^RCTOP1(DEBTOR,FILE),OTAXID=$P(DEBTOR4,U)
58 ..S NAME=$$NAME^RCTOP1(+DEBTOR0,FILE),ONAME=$P(DEBTOR4,U,2),NAME=$P(NAME,U)
59 ..I NAME=ONAME,TAXID=OTAXID Q
60 ..D EN1^RCTOP4(NAME,TAXID,DEBTOR4,DEBTOR,FILE)
61 ..Q
62 .D EN1^RCTOP1(DEBTOR,TOTAL,"U",EFFDT,0,FILE)
63 .Q
64 ;refund/refund reversal documents
65 D REFDOC
66 ;compile documents into mail messages--sets referral date in 430
67 D:$G(RCDOC)="U" COMPILE
68 Q
69 ;
70RECERT ;send yearly recertification documents
71 F S DEBTOR=$O(^RCD(340,"TOP",DEBTOR)) Q:DEBTOR'?1N.N D
72 .S DEBTOR4=$G(^RCD(340,DEBTOR,4)),TOTAL=$P(DEBTOR4,U,3),EFFDT=$P(DEBTOR4,U,6),DEBTOR0=$G(^(0)),FILE=$$FILE(DEBTOR0)
73 .I TOTAL D EN1^RCTOP1(DEBTOR,TOTAL,"Y",EFFDT,0,FILE)
74 .Q
75 ;compile documents into mail messages
76 D COMPILE
77 Q
78 ;
79REFDOC ; refund, refund reversal documents
80 N CODE,BILL,DEBTOR,TOTAL,EFFDT,FILE,RFCODE
81 F RFCODE=1,3 S CODE=$S(RFCODE=1:"R",1:"RV") D
82 .S BILL=0 F S BILL=$O(^PRCA(430,"TREF",RFCODE,BILL)) Q:'BILL D
83 ..S DEBTOR=$P($G(^PRCA(430,BILL,0)),U,9) Q:'DEBTOR
84 ..S TOTAL=$P($G(^(7)),U,18) Q:'TOTAL ;NAKED TO LINE ABOVE
85 ..S EFFDT=$P($G(^RCD(340,+DEBTOR,4)),U,6),FILE=$$FILE(^(0))
86 ..D EN1^RCTOP1(DEBTOR,TOTAL,CODE,EFFDT,BILL,FILE)
87 ..Q
88 .Q
89 Q
90 ;
91COMPILE ;compiles documents into mail messages and transmits them
92 ;builds message array
93 N CNT,SEQ,REC,XMDUZ,DOCTYPE,LRTYPE,XMSUB,XMTEXT,XMY,TSEQ,DOCAMT
94 S (SEQ,TSEQ)=0
95 F I=1,2,4 S TSEQ=TSEQ+($G(CNTR(I))\150)+$S($G(CNTR(I))#150:1,1:0)
96 F DOCTYPE=1,2,4 D:$D(^XTMP("RCTOPD",$J,DOCTYPE)) COMPILE1(DOCTYPE,CNTR(DOCTYPE))
97 D USRMSG
98 Q
99COMPILE1(DOCTYPE,CNTR) ; compiles each type of document separately
100 S RCNT=RCNT+CNTR
101 I '$G(LRTYPE) F I=1,2,4 S:$D(^XTMP("RCTOPD",$J,I)) LRTYPE=I
102 F CNT=1:1:CNTR D
103 .D:CNT#150=1
104 ..K ^XTMP("RCTOPD",$J,"BUILD") S SEQ=SEQ+1
105 ..S REC=1,DOCAMT=0
106 ..Q
107 .S REC=REC+1,^XTMP("RCTOPD",$J,"BUILD",REC)=^XTMP("RCTOPD",$J,DOCTYPE,CNT)_U S:DOCTYPE=1 DOCAMT=DOCAMT+($E(^(REC),135,146)/100)
108 .I CNTR=CNT,LRTYPE=DOCTYPE S ^XTMP("RCTOPD",$J,"BUILD",REC+1)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_RCNT
109 .I $S(CNTR=CNT:1,CNT#150=0:1,1:0) D
110 ..S ^XTMP("RCTOPD",$J,"BUILD",1)=SITE_U_$TR($J(SEQ,2)," ",0)_U_$TR($J(TSEQ,2)," ",0)_U_(REC-1)_U_DOCAMT_U
111 ..S XMDUZ="AR PACKAGE"
112 ..S XMY("XXX@Q-TOP.MED.VA.GOV")=""
113 ..S XMY("G.TOP")=""
114 ..S XMSUB=SITE_"/TOP TRANSMISSION/SEQ#: "_SEQ_"/"_$$NOW()
115 ..S XMTEXT="^XTMP(""RCTOPD"","_$J_",""BUILD"","
116 ..D ^XMD
117 ..Q
118 .Q
119 Q
120 ;
121USRMSG ;sends mailman message of documents sent to user
122 N XMY,XMDUZ,XMSUB,X,RCNT
123 S XMDUZ="AR PACKAGE",XMY("G.TOP")=""
124 S XMSUB="TOP "_$S(RCDOC="M":"MASTER/UPDATE",RCDOC="U":"UPDATE",1:"RECERTIFICATION")_" RECORDS SENT ON "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
125 S ^XTMP("RCTOPD",$J,"REC1",1)="Name TIN TYPE AMOUNT"
126 S ^XTMP("RCTOPD",$J,"REC1",2)="---- --- ---- ------"
127 S X="",RCNT=3 F S X=$O(^XTMP("RCTOPD",$J,"REC",X)) Q:X="" S ^XTMP("RCTOPD",$J,"REC1",RCNT)=^(X),RCNT=RCNT+1
128 S ^XTMP("RCTOPD",$J,"REC1",RCNT)="Total Records: "_(RCNT-3)
129 S XMTEXT="^XTMP(""RCTOPD"","_$J_",""REC1"","
130 D ^XMD
131 ;
132THIRD ;sends mailman message to user if no third letter found
133 Q:'$D(^XTMP("RCTOPD",$J,"THIRD"))
134 K ^XTMP("RCTOPD",$J,"REC1")
135 S XMDUZ="AR PACKAGE",XMY("G.TOP")=""
136 N TCT,TDEB,TDEB0,TBIL,TSP,FST
137 S XMSUB="TOP QUALIFIED/NO 3RD LETTER SENT ON "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
138 S ^XTMP("RCTOPD",$J,"REC1",1)="The following list of debtor bills were not sent to TOP."
139 S ^XTMP("RCTOPD",$J,"REC1",2)="Please review debtor's account to determine why the third"
140 S ^XTMP("RCTOPD",$J,"REC1",3)="notice letter has not been sent:"
141 S ^XTMP("RCTOPD",$J,"REC1",4)="Name Bill #"
142 S ^XTMP("RCTOPD",$J,"REC1",5)="---- ------"
143 S TCT=6,TSP=0,TDEB=""
144 F S TDEB=$O(^XTMP("RCTOPD",$J,"THIRD",TDEB)) Q:TDEB="" D
145 .S FST=1,TBIL=""
146 .I FST,TCT'=6 S ^XTMP("RCTOPD",$J,"REC1",TCT)="",TCT=TCT+1,TSP=TSP+1
147 .F S TBIL=$O(^XTMP("RCTOPD",$J,"THIRD",TDEB,TBIL)) Q:TBIL="" D
148 ..S TDEB0=$S(FST:TDEB,1:"")
149 ..S ^XTMP("RCTOPD",$J,"REC1",TCT)=TDEB0_$J(" ",35-$L(TDEB0))_TBIL
150 ..S TCT=TCT+1,FST=0
151 S ^XTMP("RCTOPD",$J,"REC1",TCT)="Total records: "_(TCT-(6+TSP))
152 S XMTEXT="^XTMP(""RCTOPD"","_$J_",""REC1"","
153 D ^XMD
154COMPQ Q
155 ;
156PROC(DEBTOR,QUIT,FILE,HOLD,EFFDT) ;process bills for a specific debtor
157 K ^TMP("RCTOPD",$J,"BILL")
158 S DEBTOR0=$G(^RCD(340,DEBTOR,0))
159 Q:'FILE
160 I FILE=2 S DFN=+DEBTOR0 D DEM^VADPT Q:$E(VADM(2),1,5)="00000"
161 S (BILL,TOTAL,REPAY)=0
162 I RCNEW,FILE=440 S HOLD=1
163 I 'RCNEW,$P(^RCD(340,DEBTOR,6),U,2),'$P(^(6),U,3) G TOTAL
164 I RCNEW,$D(^RCD(340,"DMC",1,DEBTOR)) G TOTAL
165 F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
166 .I FILE=2,+VADM(6) S TOTAL=0,REPAY=1 Q
167 .S B0=$G(^PRCA(430,BILL,0)),B4=$G(^(4)),B6=$G(^(6)),B7=$G(^(7))
168 .Q:$P(B0,U,8)'=16
169 .Q:B4
170 .Q:'$P(B0,U,2) S CAT=$P($G(^PRCA(430.2,$P(B0,U,2),0)),U,7)
171 .Q:'CAT I ",16,17,21,22,23,26,27,33,"[(","_CAT_",") Q
172 .;check for DOJ referral here
173 .I $P(B6,U,4),($P(B6,U,5)="DOJ") Q
174 .S BILLDT=$P(B6,U,21) I (BILLDT<P10YDT)!(BILLDT>P181DT)!(BILLDT<$P(DEBTOR6,U,3)) Q
175 .I '$P(B6,U,3) D Q
176 ..;no 3rd letter being sent
177 ..N TDEB,TFIL
178 ..S TDEB=$G(^RCD(340,DEBTOR,0)),TFIL=$$FILE(TDEB),TDEB=$$NAME^RCTOP1(+TDEB,TFIL),TDEB=$P(TDEB,U,2),^XTMP("RCTOPD",$J,"THIRD",TDEB,$P(B0,U))=""
179 .I RCNEW,CAT>12,CAT<15 S HOLD=1
180 .I BILLDT,BILLDT<EFFDT S EFFDT=BILLDT
181 .S TOTAL=TOTAL+$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
182 .S ^TMP("RCTOPD",$J,"BILL",BILL)=""
183 .Q
184 ;
185TOTAL ;set transmission total, reset quit variable
186 N RCSWINFO S RCSWINFO=$$SWSTAT^IBBAPI() ;PRCA*4.5*229
187 I RCNEW,'+RCSWINFO Q:TOTAL<25 ;PRCA*4.5*229
188 I RCNEW,+RCSWINFO Q:TOTAL'>0 ;PRCA*4.5*229
189 ;
190 I 'RCNEW S:TOTAL<25 TOTAL=0 S CURRTOT=$P($G(^RCD(340,DEBTOR,4)),U,3) Q:CURRTOT=TOTAL S TOTAL=TOTAL-CURRTOT
191 S QUIT=0
192PROCQ Q
193 ;
194NOW() ;compiles current date,time
195 N X,Y,%,%H
196 S %H=$H D YX^%DTC
197 Q Y
198 ;
199FILE(DEBTOR0) ;gets file number for debtor
200 S FILE=$P($P(DEBTOR0,U),";",2)
201 S FILE=$S(FILE["DPT(":2,FILE["PRC(440":440,FILE["VA(200":200,1:0)
202FILEQ Q FILE
Note: See TracBrowser for help on using the repository browser.