source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCNRIG.m@ 824

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1RCNRIG ;Washington IRMFO@Altoona, Pa/TJK-IG REPORTS ;6/17/96 11:37 AM
2 ;;4.5;Accounts Receivable;**41,77,117,103,203,220**;Mar. 20, 1995
3 Q
4 ;
5 ;
6QUEUE ; queue extract
7 W !,"QUEUE STATS PROGRAM"
8 S ZTIO="",ZTRTN="EN2^RCNRIG",ZTDESC="AR OIG Transaction Extract",ZTDTH=$H
9 D ^%ZTLOAD,^%ZISC
10 Q
11 ;
12 ;
13EN2 ; called by routine rcrjr as part of the nightly process
14 ; this will generate the OIG extract of transactions on the 15th
15 ; day of each quarter
16 L +^XTMP("RCNRIG")
17 K ^XTMP("RCNRIG")
18 S ^XTMP("RCNRIG",0)=DT_"^"_DT_"^OIG Transaction Extract"
19 ;
20 N B0,CNT,TRANS,BILL,TD,STDT,EDT,T0,T1,TT,FYQ,AMT,FUND,RSC
21 D FYQ
22 S STDT=$S(FYQ=1:1001,FYQ=2:"0101",FYQ=3:"0401",FYQ=4:"0701")
23 S STDT=$S(FYQ=1:($E(DT,1,3)-1)_STDT,1:$E(DT,1,3)_STDT)
24 S EDT=$E(STDT,1,3)_$S(FYQ=1:1231.9999,FYQ=2:"0331.9999",FYQ=3:"0630.9999",1:"0930.9999")
25 S (CNT,TRANS)=0
26 F S TRANS=$O(^PRCA(433,TRANS)) Q:TRANS'?1N.N D
27 .S T1=$G(^PRCA(433,TRANS,1)),T0=$G(^(0))
28 .S TD=$P(T1,U,9) Q:$S(TD<STDT:1,TD>EDT:1,1:0)
29 .S BILL=$P(T0,U,2) S:'BILL B0=" ",FUND=" ",RSC=" "
30 .S:BILL B0=$P($G(^PRCA(430,BILL,0)),U),B0=$$LJ^XLFSTR(B0,11)
31 .S AMT=$P(T1,"^",5) S AMT=$$AMT(AMT)
32 .S TT=+$P(T1,"^",2) S:'TT TT=" "
33 .S:TT TT=$G(^PRCA(430.3,TT,0)),TT=$E($P(TT,"^"),1,22),TT=$$LJ^XLFSTR(TT,22)
34 .D:BILL
35 ..S FUND=$$GETFUNDB^RCXFMSUF(BILL,1)
36 ..S FUND=$$ADJFUND^RCRJRCO(FUND)
37 ..S RSC=$$GETRSC
38 ..S FUND=$J(FUND,6),RSC=$J(RSC,4)
39 .S CNT=CNT+1
40 .S ^XTMP("RCNRIG",CNT)=$J(TRANS,8)_AMT_B0_TT_FUND_RSC_"$"
41 .Q
42 D BUILD("T",FYQ,CNT)
43 L -^XTMP("RCNRIG")
44 Q
45 ;
46 ;
47FYQ ;CALCULATE PREVIOUS FY QUARTER
48 S FYQ=$E(DT,4,5),FYQ=$S(FYQ<4:1,FYQ<7:2,FYQ<10:3,1:4)
49 Q
50 ;
51 ;
52NOW() N X,Y,%,%H
53 S %H=$H D YX^%DTC
54 Q Y
55 ;
56 ;
57BUILD(CODE,FYQ,CNT) ;BUILDS MESSAGE ARRAY
58 N %Z,XCNP,XMDUZ,XMSCR,XMZ
59 N MAX,CNTR,SEQ,REC,SITE
60 S SITE=$$SITE^RCMSITE()
61 S MAX=$S(CODE="B":350,1:500),(SEQ,CNTR)=0
62 F CNTR=1:1:CNT D
63 .D:CNTR#MAX=1
64 ..K ^XTMP("RCNRIG","BUILD") S SEQ=SEQ+1
65 ..S REC=0
66 ..Q
67 .S REC=REC+1,^XTMP("RCNRIG","BUILD",REC)=^XTMP("RCNRIG",CNTR)
68 .S:CNTR=CNT ^XTMP("RCNRIG","BUILD",REC+1)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_CNT
69 .I $S(CNTR=CNT:1,CNTR#MAX=0:1,1:0) D
70 ..N XMY,XMSUB
71 ..S XMY("XXX@Q-OIG.VA.GOV")="",XMDUZ="AR PACKAGE"
72 ..S XMSUB=SITE_"/"_$S(CODE="B":"BILL",1:"TRANSACTION")_"/"_FYQ_"/SEQ#: "_SEQ_"/"_$$NOW()
73 ..S XMTEXT="^XTMP(""RCNRIG"",""BUILD"","
74 ..D ^XMD
75 ..Q
76 .Q
77 Q
78 ;
79 ;
80AMT(X) ;CONVERTS AMOUNT TO RIGHT JUSTIFIED, 0 FILLED
81 S X=$J(X,0,2),X=$P(X,".")_$P(X,".",2)
82 S X=$E("000000000",1,9-$L(X))_X
83 Q X
84 ;
85 ;
86GETRSC() ; return the rsc for a bill
87 I $E(FUND,1,4)'=5287,FUND'=4032 Q $P($G(^PRCA(430,BILL,11)),U,6)
88 I FUND[5287,'$$PTACCT^PRCAACC(FUND) Q $P($G(^PRCA(430,BILL,11)),U,6)
89 ; check missing patient for reimbursable health insurance
90 I $P(^PRCA(430,BILL,0),"^",2)=9,'$P(^PRCA(430,BILL,0),"^",7) Q " "
91 Q $$CALCRSC^RCXFMSUR(BILL)
Note: See TracBrowser for help on using the repository browser.