| 1 | RCNRIG ;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 |  ;
 | 
|---|
| 6 | QUEUE ;  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 |  ;
 | 
|---|
| 13 | EN2 ;  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 |  ;
 | 
|---|
| 47 | FYQ ;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 |  ;
 | 
|---|
| 52 | NOW() N X,Y,%,%H
 | 
|---|
| 53 |  S %H=$H D YX^%DTC
 | 
|---|
| 54 |  Q Y
 | 
|---|
| 55 |  ;
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 | BUILD(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 |  ;
 | 
|---|
| 80 | AMT(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 |  ;
 | 
|---|
| 86 | GETRSC() ;  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)
 | 
|---|