source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAI169.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1PRCAI169 ;WISC/RFJ-post init patch 169 ; 26 Jan 01
2 ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7START ; start post init
8 ;
9 D BMES^XPDUTL(" >> Queuing the Post-Initialization routine ...")
10 ;
11 N ZTIO,ZTDTH,ZTRTN,ZTSK
12 S ZTIO="",ZTDTH=$H,ZTRTN="DQ^PRCAI169"
13 D ^%ZTLOAD
14 ;
15 D MES^XPDUTL(" in task "_ZTSK_".")
16 ;
17 D BMES^XPDUTL(" ")
18 D MES^XPDUTL(" IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT")
19 D MES^XPDUTL(" *********************************************************************")
20 D MES^XPDUTL(" When the Queued Post-Initialization finishes running, a mail")
21 D MES^XPDUTL(" message will be delivered to the mail groups IRM and PRCA")
22 D MES^XPDUTL(" ADJUSTMENT TRANS with the subject: AR Patch 169 Installation")
23 D MES^XPDUTL(" Completed. You should receive this message within 24 hours.")
24 D MES^XPDUTL(" If you do not receive the message, you will need to restart")
25 D MES^XPDUTL(" the Post-Initialization by running the routine START^PRCAI169.")
26 D MES^XPDUTL(" *********************************************************************")
27 D MES^XPDUTL(" IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT")
28 Q
29 ;
30 ;
31DQ ; queue post initialization
32 ;
33 ; add the post install entry for history
34 N RCMSPOST
35 S RCMSPOST=$$START^RCMSPOST("PRCA*4.5*169")
36 ;
37 ; 1. ***** disable type of payment IRS PAYMENT by
38 ; removing the category field entry .06
39 N %,D,D0,DA,DI,DIC,DIE,DQ,DR,X
40 S DA=$O(^RC(341.1,"B","IRS PAYMENT",0))
41 I DA S (DIC,DIE)="^RC(341.1,",DR=".06///@;" D ^DIE
42 ;
43 ;
44 ; 2. ***** delete IRS mail group
45 ; reference to XMB allowed in integration agreement 3359
46 N %,DA,DIC,DIK,RCMIRSDA,RCDA,X,Y
47 S RCMIRSDA=+$O(^XMB(3.8,"B","IRS",0))
48 I RCMIRSDA D
49 . ; check to see if IRS mail group is a member of another
50 . ; mail group. If so, delete it from the other mail group.
51 . S RCDA(1)=0 F S RCDA(1)=$O(^XMB(3.8,"AD",RCMIRSDA,RCDA(1))) Q:'RCDA(1) D
52 . . S RCDA=0 F S RCDA=$O(^XMB(3.8,"AD",RCMIRSDA,RCDA(1),RCDA)) Q:'RCDA D
53 . . . S DA(1)=RCDA(1),DA=RCDA,DIK="^XMB(3.8,"_RCDA(1)_",5,"
54 . . . D ^DIK
55 . ;
56 . ; delete the mail group
57 . S DA=RCMIRSDA,DIK="^XMB(3.8,"
58 . D ^DIK
59 ;
60 ;
61 ; 3. ***** fix ineligible bills, convert transaction type 24 to 02
62 N RCBILLDA,RCDATE
63 S RCDATE=3001000
64 F S RCDATE=$O(^PRCA(430,"ACTDT",RCDATE)) Q:'RCDATE D
65 . S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"ACTDT",RCDATE,RCBILLDA)) Q:'RCBILLDA D
66 . . ; if not an ineligible bill, quit
67 . . I $P($G(^PRCA(430,RCBILLDA,0)),"^",2)'=1 Q
68 . . ; if the tranasaction type already equals 02, quit
69 . . I $P($G(^PRCA(430,RCBILLDA,11)),"^",10)=02 Q
70 . . S $P(^PRCA(430,RCBILLDA,11),"^",10)="02"
71 ;
72 ;
73 ; 4. ***** fix exemptions where the transaction is not split between
74 ; interest and admin
75 D START^PRCAI16A
76 ;
77 ;
78 ; 5. ***** fix exemption date problem
79 ; build a list of accounts out of balance at the site
80 N ACCTDATA,DATA,OUTOFBAL,RCDATE,RCDEBTDA,RCEXDATA,RCEXDATE,RCLINE,RCNEXT,RCPADATA,RCTOTAL1,RCTOTAL2,RCTRANDA,X,Y
81 K ^TMP("PRCAI169",$J)
82 ;
83 ; build list of accounts out of balance
84 S RCDEBTDA=0
85 F S RCDEBTDA=$O(^RCD(340,"AB","DPT(",RCDEBTDA)) Q:'RCDEBTDA D
86 . S OUTOFBAL=$$EN^PRCAMRKC(RCDEBTDA)
87 . I OUTOFBAL S ^TMP("PRCAI169",$J,RCDEBTDA)=""
88 ;
89 ; loop all transactions for debtor and look at the exempt charge.
90 ; if the exempt transaction date is not equal to the payment
91 ; transaction date, change the exempt charge date.
92 S RCDEBTDA=0
93 F S RCDEBTDA=$O(^TMP("PRCAI169",$J,RCDEBTDA)) Q:'RCDEBTDA D
94 . ; get the last statement date
95 . S RCDATE=$P(+$$LST^RCFN01(RCDEBTDA,2),".")
96 . ;
97 . ; loop all transactions up to the last statement date + 1 day
98 . S RCEXDATE=0
99 . F S RCEXDATE=$O(^PRCA(433,"ATD",RCDEBTDA,RCEXDATE)) Q:'RCEXDATE!(RCEXDATE>(RCDATE+1)) D
100 . . S RCTRANDA=0
101 . . F S RCTRANDA=$O(^PRCA(433,"ATD",RCDEBTDA,RCEXDATE,RCTRANDA)) Q:'RCTRANDA D
102 . . . ; type of transaction is not an exemption
103 . . . S RCEXDATA=$G(^PRCA(433,RCTRANDA,1))
104 . . . I $P(RCEXDATA,"^",2)'=14 Q
105 . . . ;
106 . . . ; get the next transaction for the bill
107 . . . S RCNEXT=$O(^PRCA(433,"C",+$P($G(^PRCA(433,+RCTRANDA,0)),"^",2),RCTRANDA))
108 . . . ; is it a payment?, if no, quit
109 . . . S RCPADATA=$G(^PRCA(433,+RCNEXT,1))
110 . . . I $P(RCPADATA,"^",2)'=2,$P(RCPADATA,"^",2)'=34 Q
111 . . . ;
112 . . . ; check to see if this is an automatic exemption,
113 . . . ; if not, then do not change the date
114 . . . I $G(^PRCA(433,RCTRANDA,7,1,0))'["Auto" Q
115 . . . ;
116 . . . ; it is a payment, if the date of the payment is greater
117 . . . ; than the date of the exemption by more than 1 minute,
118 . . . ; change the exemption date to be equal to the payment date
119 . . . I ($P(RCPADATA,"^",9)-$P(RCEXDATA,"^",9))>.0001 S X=$$EDIT433^RCBEUTRA(RCTRANDA,"19////"_$P(RCPADATA,"^",9)_";")
120 ;
121 ; recheck the accounts out of balance
122 S RCTOTAL1=0 ;used to count accts out of balance prior to install
123 S RCTOTAL2=0 ;used to count accts fixed by the patch
124 S RCDEBTDA=0
125 F S RCDEBTDA=$O(^TMP("PRCAI169",$J,RCDEBTDA)) Q:'RCDEBTDA D
126 . ; check to see if account has a bill in refund review.
127 . ; if it does, remove it from the list.
128 . I $$REFUREVW^RCBEREFU(RCDEBTDA) K ^TMP("PRCAI169",$J,RCDEBTDA) Q
129 . ; original count of accounts out of balance before patch install
130 . S RCTOTAL1=RCTOTAL1+1
131 . ; check to see if account is out of balance. if it is
132 . ; not out of balance, remove it from the list.
133 . S OUTOFBAL=$$EN^PRCAMRKC(RCDEBTDA)
134 . I 'OUTOFBAL S RCTOTAL2=RCTOTAL2+1 K ^TMP("PRCAI169",$J,RCDEBTDA)
135 ;
136 ; build mailman message showing patch installed and accounts still
137 ; out of balance
138 K ^TMP($J,"RCRJRCORMM")
139 S ^TMP($J,"RCRJRCORMM",1)="The Post-Initialization routine for patch PRCA*4.5*169 is completed."
140 S ^TMP($J,"RCRJRCORMM",2)="Patch PRCA*4.5*169 has been completely installed."
141 S ^TMP($J,"RCRJRCORMM",3)=" "
142 S ^TMP($J,"RCRJRCORMM",4)="The following accounts are still out of balance after the patch install."
143 S ^TMP($J,"RCRJRCORMM",5)="This list excludes accounts with bills in refund review."
144 S ^TMP($J,"RCRJRCORMM",6)=" "
145 S RCLINE=6
146 S RCDEBTDA=0
147 F S RCDEBTDA=$O(^TMP("PRCAI169",$J,RCDEBTDA)) Q:'RCDEBTDA D
148 . S ACCTDATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA)
149 . S DATA=$E($P(ACCTDATA,"^")_" ",1,30)_" "
150 . S DATA=DATA_$E($P(ACCTDATA,"^",2)_" ",1,12)_" "
151 . S DATA=DATA_$P(ACCTDATA,"^",3)
152 . S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=DATA
153 ;
154 S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=" "
155 S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=" TOTAL ACCOUNTS OUT OF BALANCE BEFORE PATCH INSTALL: "_$J(RCTOTAL1,8)
156 S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=" TOTAL ACCOUNTS FIXED BY PATCH: "_$J(RCTOTAL2,8)
157 S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=" "_$J("--------",8)
158 S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=" TOTAL ACCOUNTS OUT OF BALANCE AFTER PATCH INSTALL: "_$J((RCTOTAL1-RCTOTAL2),8)
159 ;
160 ; send mail message
161 ; difrom needs to be newed or mailman will not deliver the message
162 N DIFROM,XMDUN,XMY,XMZ
163 S XMY("G.IRM")=""
164 S XMY("G.PRCA ADJUSTMENT TRANS")=""
165 S XMY(.5)=""
166 S XMY(DUZ)=""
167 S XMZ=$$SENDMSG^RCRJRCOR("AR Patch 169 Installation Completed",.XMY)
168 K ^TMP($J,"RCRJRCORMM")
169 ;
170 K ^TMP("PRCAI169",$J)
171 ;
172 ; set the end date for the post initialization
173 D END^RCMSPOST(RCMSPOST)
174 Q
Note: See TracBrowser for help on using the repository browser.