RCNRIG ;Washington IRMFO@Altoona, Pa/TJK-IG REPORTS ;6/17/96 11:37 AM
;;4.5;Accounts Receivable;**41,77,117,103,203,220,270**;Mar. 20, 1995;Build 25
Q
;
;
QUEUE ; queue extract
W !,"QUEUE STATS PROGRAM"
S ZTIO="",ZTRTN="EN2^RCNRIG",ZTDESC="AR OIG Transaction Extract",ZTDTH=$H
D ^%ZTLOAD,^%ZISC
Q
;
;
EN2 ; called by routine rcrjr as part of the nightly process
; this will generate the OIG extract of transactions on the 15th
; day of each quarter
L +^XTMP("RCNRIG")
K ^XTMP("RCNRIG")
S ^XTMP("RCNRIG",0)=DT_"^"_DT_"^OIG Transaction Extract"
;
N B0,CNT,TRANS,BILL,TD,STDT,EDT,T0,T1,TT,FYQ,AMT,FUND,RSC
D FYQ
S STDT=$S(FYQ=1:1001,FYQ=2:"0101",FYQ=3:"0401",FYQ=4:"0701")
S STDT=$S(FYQ=1:($E(DT,1,3)-1)_STDT,1:$E(DT,1,3)_STDT)
S EDT=$E(STDT,1,3)_$S(FYQ=1:1231.9999,FYQ=2:"0331.9999",FYQ=3:"0630.9999",1:"0930.9999")
S (CNT,TRANS)=0
F S TRANS=$O(^PRCA(433,TRANS)) Q:TRANS'?1N.N D
.S T1=$G(^PRCA(433,TRANS,1)),T0=$G(^(0))
.S TD=$P(T1,U,9) Q:$S(TD<STDT:1,TD>EDT:1,1:0)
.S BILL=$P(T0,U,2) S:'BILL B0=" ",FUND=" ",RSC=" "
.S:BILL B0=$P($G(^PRCA(430,BILL,0)),U),B0=$E($$LJ^XLFSTR(B0,11),1,11) ;WCJ;PRCA*4.5*270
.S AMT=$P(T1,"^",5) S AMT=$$AMT(AMT)
.S TT=+$P(T1,"^",2) S:'TT TT=" "
.S:TT TT=$G(^PRCA(430.3,TT,0)),TT=$E($P(TT,"^"),1,22),TT=$$LJ^XLFSTR(TT,22)
.D:BILL
..S FUND=$$GETFUNDB^RCXFMSUF(BILL,1)
..S FUND=$$ADJFUND^RCRJRCO(FUND)
..S RSC=$$GETRSC
..S FUND=$J(FUND,6),RSC=$J(RSC,4)
.S CNT=CNT+1
.S ^XTMP("RCNRIG",CNT)=$J(TRANS,8)_AMT_B0_TT_FUND_RSC_"$"
.Q
D BUILD("T",FYQ,CNT)
L -^XTMP("RCNRIG")
Q
;
;
FYQ ;CALCULATE PREVIOUS FY QUARTER
S FYQ=$E(DT,4,5),FYQ=$S(FYQ<4:1,FYQ<7:2,FYQ<10:3,1:4)
Q
;
;
NOW() N X,Y,%,%H
S %H=$H D YX^%DTC
Q Y
;
;
BUILD(CODE,FYQ,CNT) ;BUILDS MESSAGE ARRAY
N %Z,XCNP,XMDUZ,XMSCR,XMZ
N MAX,CNTR,SEQ,REC,SITE
S SITE=$$SITE^RCMSITE()
S MAX=$S(CODE="B":350,1:500),(SEQ,CNTR)=0
F CNTR=1:1:CNT D
.D:CNTR#MAX=1
..K ^XTMP("RCNRIG","BUILD") S SEQ=SEQ+1
..S REC=0
..Q
.S REC=REC+1,^XTMP("RCNRIG","BUILD",REC)=^XTMP("RCNRIG",CNTR)
.S:CNTR=CNT ^XTMP("RCNRIG","BUILD",REC+1)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_CNT
.I $S(CNTR=CNT:1,CNTR#MAX=0:1,1:0) D
..N XMY,XMSUB
..S XMY("XXX@Q-OIG.DOMAIN.EXT")="",XMDUZ="AR PACKAGE"
..S XMSUB=SITE_"/"_$S(CODE="B":"BILL",1:"TRANSACTION")_"/"_FYQ_"/SEQ#: "_SEQ_"/"_$$NOW()
..S XMTEXT="^XTMP(""RCNRIG"",""BUILD"","
..D ^XMD
..Q
.Q
Q
;
;
AMT(X) ;CONVERTS AMOUNT TO RIGHT JUSTIFIED, 0 FILLED
S X=$J(X,0,2),X=$P(X,".")_$P(X,".",2)
S X=$E("000000000",1,9-$L(X))_X
Q X
;
;
GETRSC() ; return the rsc for a bill
I $E(FUND,1,4)'=5287,FUND'=4032 Q $P($G(^PRCA(430,BILL,11)),U,6)
I FUND[5287,'$$PTACCT^PRCAACC(FUND) Q $P($G(^PRCA(430,BILL,11)),U,6)
; check missing patient for reimbursable health insurance
I $P(^PRCA(430,BILL,0),"^",2)=9,'$P(^PRCA(430,BILL,0),"^",7) Q " "
Q $$CALCRSC^RCXFMSUR(BILL)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCNRIG 3109 printed Nov 22, 2024@16:57:27 Page 2
RCNRIG ;Washington IRMFO@Altoona, Pa/TJK-IG REPORTS ;6/17/96 11:37 AM
+1 ;;4.5;Accounts Receivable;**41,77,117,103,203,220,270**;Mar. 20, 1995;Build 25
+2 QUIT
+3 ;
+4 ;
QUEUE ; queue extract
+1 WRITE !,"QUEUE STATS PROGRAM"
+2 SET ZTIO=""
SET ZTRTN="EN2^RCNRIG"
SET ZTDESC="AR OIG Transaction Extract"
SET ZTDTH=$HOROLOG
+3 DO ^%ZTLOAD
DO ^%ZISC
+4 QUIT
+5 ;
+6 ;
EN2 ; called by routine rcrjr as part of the nightly process
+1 ; this will generate the OIG extract of transactions on the 15th
+2 ; day of each quarter
+3 LOCK +^XTMP("RCNRIG")
+4 KILL ^XTMP("RCNRIG")
+5 SET ^XTMP("RCNRIG",0)=DT_"^"_DT_"^OIG Transaction Extract"
+6 ;
+7 NEW B0,CNT,TRANS,BILL,TD,STDT,EDT,T0,T1,TT,FYQ,AMT,FUND,RSC
+8 DO FYQ
+9 SET STDT=$SELECT(FYQ=1:1001,FYQ=2:"0101",FYQ=3:"0401",FYQ=4:"0701")
+10 SET STDT=$SELECT(FYQ=1:($EXTRACT(DT,1,3)-1)_STDT,1:$EXTRACT(DT,1,3)_STDT)
+11 SET EDT=$EXTRACT(STDT,1,3)_$SELECT(FYQ=1:1231.9999,FYQ=2:"0331.9999",FYQ=3:"0630.9999",1:"0930.9999")
+12 SET (CNT,TRANS)=0
+13 FOR
SET TRANS=$ORDER(^PRCA(433,TRANS))
if TRANS'?1N.N
QUIT
Begin DoDot:1
+14 SET T1=$GET(^PRCA(433,TRANS,1))
SET T0=$GET(^(0))
+15 SET TD=$PIECE(T1,U,9)
if $SELECT(TD<STDT
QUIT
+16 SET BILL=$PIECE(T0,U,2)
if 'BILL
SET B0=" "
SET FUND=" "
SET RSC=" "
+17 ;WCJ;PRCA*4.5*270
if BILL
SET B0=$PIECE($GET(^PRCA(430,BILL,0)),U)
SET B0=$EXTRACT($$LJ^XLFSTR(B0,11),1,11)
+18 SET AMT=$PIECE(T1,"^",5)
SET AMT=$$AMT(AMT)
+19 SET TT=+$PIECE(T1,"^",2)
if 'TT
SET TT=" "
+20 if TT
SET TT=$GET(^PRCA(430.3,TT,0))
SET TT=$EXTRACT($PIECE(TT,"^"),1,22)
SET TT=$$LJ^XLFSTR(TT,22)
+21 if BILL
Begin DoDot:2
+22 SET FUND=$$GETFUNDB^RCXFMSUF(BILL,1)
+23 SET FUND=$$ADJFUND^RCRJRCO(FUND)
+24 SET RSC=$$GETRSC
+25 SET FUND=$JUSTIFY(FUND,6)
SET RSC=$JUSTIFY(RSC,4)
End DoDot:2
+26 SET CNT=CNT+1
+27 SET ^XTMP("RCNRIG",CNT)=$JUSTIFY(TRANS,8)_AMT_B0_TT_FUND_RSC_"$"
+28 QUIT
End DoDot:1
+29 DO BUILD("T",FYQ,CNT)
+30 LOCK -^XTMP("RCNRIG")
+31 QUIT
+32 ;
+33 ;
FYQ ;CALCULATE PREVIOUS FY QUARTER
+1 SET FYQ=$EXTRACT(DT,4,5)
SET FYQ=$SELECT(FYQ<4:1,FYQ<7:2,FYQ<10:3,1:4)
+2 QUIT
+3 ;
+4 ;
NOW() NEW X,Y,%,%H
+1 SET %H=$HOROLOG
DO YX^%DTC
+2 QUIT Y
+3 ;
+4 ;
BUILD(CODE,FYQ,CNT) ;BUILDS MESSAGE ARRAY
+1 NEW %Z,XCNP,XMDUZ,XMSCR,XMZ
+2 NEW MAX,CNTR,SEQ,REC,SITE
+3 SET SITE=$$SITE^RCMSITE()
+4 SET MAX=$SELECT(CODE="B":350,1:500)
SET (SEQ,CNTR)=0
+5 FOR CNTR=1:1:CNT
Begin DoDot:1
+6 if CNTR#MAX=1
Begin DoDot:2
+7 KILL ^XTMP("RCNRIG","BUILD")
SET SEQ=SEQ+1
+8 SET REC=0
+9 QUIT
End DoDot:2
+10 SET REC=REC+1
SET ^XTMP("RCNRIG","BUILD",REC)=^XTMP("RCNRIG",CNTR)
+11 if CNTR=CNT
SET ^XTMP("RCNRIG","BUILD",REC+1)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_CNT
+12 IF $SELECT(CNTR=CNT:1,CNTR#MAX=0:1,1:0)
Begin DoDot:2
+13 NEW XMY,XMSUB
+14 SET XMY("XXX@Q-OIG.DOMAIN.EXT")=""
SET XMDUZ="AR PACKAGE"
+15 SET XMSUB=SITE_"/"_$SELECT(CODE="B":"BILL",1:"TRANSACTION")_"/"_FYQ_"/SEQ#: "_SEQ_"/"_$$NOW()
+16 SET XMTEXT="^XTMP(""RCNRIG"",""BUILD"","
+17 DO ^XMD
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
+22 ;
AMT(X) ;CONVERTS AMOUNT TO RIGHT JUSTIFIED, 0 FILLED
+1 SET X=$JUSTIFY(X,0,2)
SET X=$PIECE(X,".")_$PIECE(X,".",2)
+2 SET X=$EXTRACT("000000000",1,9-$LENGTH(X))_X
+3 QUIT X
+4 ;
+5 ;
GETRSC() ; return the rsc for a bill
+1 IF $EXTRACT(FUND,1,4)'=5287
IF FUND'=4032
QUIT $PIECE($GET(^PRCA(430,BILL,11)),U,6)
+2 IF FUND[5287
IF '$$PTACCT^PRCAACC(FUND)
QUIT $PIECE($GET(^PRCA(430,BILL,11)),U,6)
+3 ; check missing patient for reimbursable health insurance
+4 IF $PIECE(^PRCA(430,BILL,0),"^",2)=9
IF '$PIECE(^PRCA(430,BILL,0),"^",7)
QUIT " "
+5 QUIT $$CALCRSC^RCXFMSUR(BILL)
