source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJROIG.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: 5.0 KB
RevLine 
[613]1RCRJROIG ;WISC/RFJ-send data for oig extract ;1 Jul 99
2 ;;4.5;Accounts Receivable;**103,174,203,205,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7NONMCCF(DATEEND) ; build the non-mccf bills for user report and submission to oig
8 N BILLDA,DATE,DATA7,OTHER,PRINCPAL
9 S BILLDA=0 F S BILLDA=$O(^PRCA(430,BILLDA)) Q:'BILLDA D
10 . ; if already stored, then it is a current receivable
11 . I $D(^TMP($J,"RCRJROIG",BILLDA)) Q
12 . ; calculate principal and other (int + admin) balance
13 . S DATA7=$G(^PRCA(430,BILLDA,7))
14 . S PRINCPAL=+$P(DATA7,"^")
15 . S OTHER=$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
16 . ; in some bills, the principal and other balance may cancel
17 . ; each other. for example principal .08 + interest -.08 = 0
18 . I (PRINCPAL+OTHER)'>0 Q
19 . ; store the data for submission to oig
20 . S ^TMP($J,"RCRJROIG",BILLDA)=PRINCPAL_"^"_OTHER
21 . ; store the data for the user report (only if bill activated)
22 . S DATE=+$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".") I 'DATE Q
23 . S ^TMP($J,"RCRJRCOLREPORT",DATE,BILLDA)=PRINCPAL_"^"_OTHER
24 Q
25 ;
26 ;
27OIG(DATEEND) ; send data to the OIG
28 N BILLDA,COUNT,DATA,DATA0,FUND,FYQ,OIGDATA,SEQUENCE,SITE,TOTALAMT
29 N TOTALCNT,TOTALMSG,X,X1
30 ;
31 ; get previous fiscal year quarter for mail message header
32 S FYQ=$E(DATEEND,4,5),FYQ=$S(FYQ<4:1,FYQ<7:2,FYQ<10:3,1:4)
33 S SITE=$$SITE^RCMSITE()
34 ;
35 ; calculate the number of messages to be sent
36 S (X,X1)=0 F S X=$O(^TMP($J,"RCRJROIG",X)) Q:'X S X1=X1+1
37 S TOTALMSG=X1\272 I X1#272 S TOTALMSG=TOTALMSG+1
38 ;
39 ; build the extract for oig
40 S COUNT=0 ; used to count bills to be sent in a single mail msg
41 S SEQUENCE=0 ; used to count mail messages sent (in mail subject)
42 S TOTALCNT=0 ; used to count total bills sent all mail messages
43 S TOTALAMT=0 ; used to calculate total dollars all mail messages
44 K ^TMP($J,"RCRJROIGMM")
45 S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJROIG",BILLDA)) Q:'BILLDA D
46 . S DATA=^TMP($J,"RCRJROIG",BILLDA)
47 . S DATA0=^PRCA(430,BILLDA,0)
48 . ; bill number, position 1-11
49 . S OIGDATA=$$LJ^XLFSTR($P(DATA0,"^"),11)
50 . ; category, position 12-36
51 . S OIGDATA=OIGDATA_$$LJ^XLFSTR($E($P($G(^PRCA(430.2,+$P(DATA0,"^",2),0)),"^"),1,25),25)
52 . ; status, position 37-56
53 . S OIGDATA=OIGDATA_$$LJ^XLFSTR($E($P($G(^PRCA(430.3,+$P(DATA0,"^",8),0)),"^"),1,20),20)
54 . ; principal balance, position 57-65 (example 000000110 for 1.10)
55 . S OIGDATA=OIGDATA_$TR($J($P(DATA,"^"),10,2)," .","0")
56 . ; date status last updated, position 66-76 (example APR 08,1999)
57 . S OIGDATA=OIGDATA_$$DATE($P(DATA0,"^",14))
58 . ; fms fund, position 77-82
59 . S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
60 . S FUND=$$ADJFUND^RCRJRCO(FUND) ; may delete this line after 10/1/03
61 . S OIGDATA=OIGDATA_$J(FUND,6)
62 . ; revenue source code, position 83-86
63 . S OIGDATA=OIGDATA_$J($$GETRSC(BILLDA,FUND),4)
64 . ; general ledger account number, position 87-90
65 . S OIGDATA=OIGDATA_$J($P(DATA,"^",3),4)
66 . ; date bill entered, position 91-101 (example APR 08,1999)
67 . S OIGDATA=OIGDATA_$$DATE($P(DATA0,"^",10))
68 . ; interest + admin balance, position 102-110
69 . S OIGDATA=OIGDATA_$TR($J($P(DATA,"^",2),10,2)," .","0")_"$"
70 . ;
71 . ; total count and dollars for bills sent
72 . S TOTALCNT=TOTALCNT+1
73 . S TOTALAMT=TOTALAMT+$P(DATA,"^")
74 . ;
75 . ; store data for transmission
76 . S COUNT=COUNT+1
77 . S ^TMP($J,"RCRJROIGMM",COUNT)=OIGDATA
78 . ; only send message with 272 bills
79 . I COUNT'=272 Q
80 . ; if there are no more bills, do not send message until the
81 . ; totals are placed at the end
82 . I '$O(^TMP($J,"RCRJROIG",BILLDA)) Q
83 . ;
84 . ; send current code sheets
85 . S SEQUENCE=SEQUENCE+1
86 . D MAILIT(SITE,FYQ,SEQUENCE)
87 . S COUNT=0
88 . K ^TMP($J,"RCRJROIGMM")
89 ;
90 ; mail last message with totals at the end
91 S COUNT=COUNT+1
92 S ^TMP($J,"RCRJROIGMM",COUNT)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_TOTALCNT_" TOTAL AMOUNT: "_TOTALAMT
93 S SEQUENCE=SEQUENCE+1
94 D MAILIT(SITE,FYQ,SEQUENCE)
95 ;
96 K ^TMP($J,"RCRJROIGMM")
97 K ^TMP($J,"RCRJROIG")
98 Q
99 ;
100 ;
101MAILIT(SITE,FYQ,SEQUENCE) ; send code sheets to oig
102 N %,%H,%Z,X,XCNP,XMDUZ,XMSCR,XMSUB,XMY,XMZ,Y
103 ;
104 ; set a header record in each file to be transmitted
105 S ^TMP($J,"RCRJROIGMM",.5)="OH$"_$$RJ^XLFSTR(SEQUENCE,5,0)_"$"_$$RJ^XLFSTR(TOTALMSG,5,0)_"$|"
106 ;
107 I TOTALCNT=0 S XMY("G.RC AR DATA COLLECTOR")=""
108 S XMY("XXX@Q-OIG.VA.GOV")=""
109 S XMDUZ="AR PACKAGE"
110 S %H=$H D YX^%DTC
111 S XMSUB=SITE_"/BILL/"_FYQ_"/SEQ#: "_SEQUENCE_"/"_Y
112 S XMTEXT="^TMP($J,""RCRJROIGMM"","
113 D ^XMD
114 Q
115 ;
116 ;
117DATE(DATE) ; format date
118 ; example input=2990408, output=APR 08,1999
119 I DATE D
120 . S Y=DATE D DD^%DT
121 . S DATE=$E(Y,1,3)_" "_$E(DATE,6,7)_","_(1700+$E(DATE,1,3))
122 Q $$LJ^XLFSTR(DATE,11)
123 ;
124 ;
125GETRSC(BILLDA,FUND) ; return the rsc for a bill
126 I '$$PTACCT^PRCAACC(FUND),FUND'=4032 Q $P($G(^PRCA(430,BILLDA,11)),"^",6)
127 ; check missing patient for reimbursable health insurance
128 I $P(^PRCA(430,BILLDA,0),"^",2)=9,'$P(^PRCA(430,BILLDA,0),"^",7) Q " "
129 Q $$CALCRSC^RCXFMSUR(BILLDA)
Note: See TracBrowser for help on using the repository browser.