RCRJROIG ;WISC/RFJ-send data for oig extract ;1 Jul 99
;;4.5;Accounts Receivable;**103,174,203,205,220,270,335,338**;Mar 20, 1995;Build 69
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
NONMCCF(DATEEND) ; build the non-mccf bills for user report and submission to oig
N BILLDA,DATE,DATA7,OTHER,PRINCPAL
S BILLDA=0 F S BILLDA=$O(^PRCA(430,BILLDA)) Q:'BILLDA D
. N RCFUND,RCRSC
. ; if already stored, then it is a current receivable
. I $D(^TMP($J,"RCRJROIG",BILLDA)) Q
. ; calculate principal and other (int + admin) balance
. S DATA7=$G(^PRCA(430,BILLDA,7))
. S PRINCPAL=+$P(DATA7,"^")
. S OTHER=$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
. ; in some bills, the principal and other balance may cancel
. ; each other. for example principal .08 + interest -.08 = 0
. I (PRINCPAL+OTHER)'>0 Q
. ; store the data for submission to oig
. S ^TMP($J,"RCRJROIG",BILLDA)=PRINCPAL_"^"_OTHER
. ; store the data for the user report (only if bill activated)
. S DATE=+$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".") I 'DATE Q
. S ^TMP($J,"RCRJRCOLREPORT",DATE,BILLDA)=PRINCPAL_"^"_OTHER
. S RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
. I RCFUND="" S RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
. S RCRSC=$$GETRSC(BILLDA,RCFUND)
. D STORE^RCRJRCOU(BILLDA,DATEBEG,DATEEND,DATE,$P(^PRCA(430,BILLDA,0),"^",2),"",RCFUND,RCRSC,$P(DATA7,"^",1,5),1)
Q
;
;
OIG(DATEEND) ; send data to the OIG
N BILLDA,COUNT,DATA,DATA0,FUND,FYQ,OIGDATA,SEQUENCE,SITE,TOTALAMT
N TOTALCNT,TOTALMSG,X,X1
;
; get previous fiscal year quarter for mail message header
S FYQ=$E(DATEEND,4,5),FYQ=$S(FYQ<4:1,FYQ<7:2,FYQ<10:3,1:4)
S SITE=$$SITE^RCMSITE()
;
; calculate the number of messages to be sent
S (X,X1)=0 F S X=$O(^TMP($J,"RCRJROIG",X)) Q:'X S X1=X1+1
S TOTALMSG=X1\272 I X1#272 S TOTALMSG=TOTALMSG+1
;
; build the extract for oig
S COUNT=0 ; used to count bills to be sent in a single mail msg
S SEQUENCE=0 ; used to count mail messages sent (in mail subject)
S TOTALCNT=0 ; used to count total bills sent all mail messages
S TOTALAMT=0 ; used to calculate total dollars all mail messages
K ^TMP($J,"RCRJROIGMM")
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJROIG",BILLDA)) Q:'BILLDA D
. S DATA=^TMP($J,"RCRJROIG",BILLDA)
. S DATA0=^PRCA(430,BILLDA,0)
. ; bill number, position 1-11
. S OIGDATA=$E($$LJ^XLFSTR($P(DATA0,"^"),11),1,11) ; WCJ;PRCA*4.5*270
. ; category, position 12-36
. S OIGDATA=OIGDATA_$$LJ^XLFSTR($E($P($G(^PRCA(430.2,+$P(DATA0,"^",2),0)),"^"),1,25),25)
. ; status, position 37-56
. S OIGDATA=OIGDATA_$$LJ^XLFSTR($E($P($G(^PRCA(430.3,+$P(DATA0,"^",8),0)),"^"),1,20),20)
. ; principal balance, position 57-65 (example 000000110 for 1.10)
. S OIGDATA=OIGDATA_$TR($J($P(DATA,"^"),10,2)," .","0")
. ; date status last updated, position 66-76 (example APR 08,1999)
. S OIGDATA=OIGDATA_$$DATE($P(DATA0,"^",14))
. ; fms fund, position 77-82
. S FUND=$$GET1^DIQ(430,BILLDA_",",203)
. I FUND="" S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
. ;S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
. S FUND=$$ADJFUND^RCRJRCO(FUND) ; may delete this line after 10/1/03
. S OIGDATA=OIGDATA_$J(FUND,6)
. ; revenue source code, position 83-86
. S OIGDATA=OIGDATA_$J($$GETRSC(BILLDA,FUND),4)
. ; general ledger account number, position 87-90
. S OIGDATA=OIGDATA_$J($P(DATA,"^",3),4)
. ; date bill entered, position 91-101 (example APR 08,1999)
. S OIGDATA=OIGDATA_$$DATE($P(DATA0,"^",10))
. ; interest + admin balance, position 102-110
. S OIGDATA=OIGDATA_$TR($J($P(DATA,"^",2),10,2)," .","0")_"$"
. ;
. ; total count and dollars for bills sent
. S TOTALCNT=TOTALCNT+1
. S TOTALAMT=TOTALAMT+$P(DATA,"^")
. ;
. ; store data for transmission
. S COUNT=COUNT+1
. S ^TMP($J,"RCRJROIGMM",COUNT)=OIGDATA
. ; only send message with 272 bills
. I COUNT'=272 Q
. ; if there are no more bills, do not send message until the
. ; totals are placed at the end
. I '$O(^TMP($J,"RCRJROIG",BILLDA)) Q
. ;
. ; send current code sheets
. S SEQUENCE=SEQUENCE+1
. D MAILIT(SITE,FYQ,SEQUENCE)
. S COUNT=0
. K ^TMP($J,"RCRJROIGMM")
;
; mail last message with totals at the end
S COUNT=COUNT+1
S ^TMP($J,"RCRJROIGMM",COUNT)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_TOTALCNT_" TOTAL AMOUNT: "_TOTALAMT
S SEQUENCE=SEQUENCE+1
D MAILIT(SITE,FYQ,SEQUENCE)
;
K ^TMP($J,"RCRJROIGMM")
K ^TMP($J,"RCRJROIG")
Q
;
;
MAILIT(SITE,FYQ,SEQUENCE) ; send code sheets to oig
N %,%H,%Z,X,XCNP,XMDUZ,XMSCR,XMSUB,XMY,XMZ,Y
;
; set a header record in each file to be transmitted
S ^TMP($J,"RCRJROIGMM",.5)="OH$"_$$RJ^XLFSTR(SEQUENCE,5,0)_"$"_$$RJ^XLFSTR(TOTALMSG,5,0)_"$|"
;
I TOTALCNT=0 S XMY("G.RC AR DATA COLLECTOR")=""
S XMY("XXX@Q-OIG.DOMAIN.EXT")=""
S XMDUZ="AR PACKAGE"
S %H=$H D YX^%DTC
S XMSUB=SITE_"/BILL/"_FYQ_"/SEQ#: "_SEQUENCE_"/"_Y
S XMTEXT="^TMP($J,""RCRJROIGMM"","
D ^XMD
Q
;
;
DATE(DATE) ; format date
; example input=2990408, output=APR 08,1999
I DATE D
. S Y=DATE D DD^%DT
. S DATE=$E(Y,1,3)_" "_$E(DATE,6,7)_","_(1700+$E(DATE,1,3))
Q $$LJ^XLFSTR(DATE,11)
;
;
GETRSC(BILLDA,FUND) ; return the rsc for a bill
N RCRSC
I '$$PTACCT^PRCAACC(FUND),FUND'=4032 Q $P($G(^PRCA(430,BILLDA,11)),"^",6)
; check missing patient for reimbursable health insurance
I $P(^PRCA(430,BILLDA,0),"^",2)=9,'$P(^PRCA(430,BILLDA,0),"^",7) Q " "
;PRCA*4.5*338 - retrieve existing RSC before calculating a new one
S RCRSC=$$GET1^DIQ(430,BILLDA_",",255)
S:RCRSC="" RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
Q:RCRSC'="" RCRSC
;end RCRSC
Q $$CALCRSC^RCXFMSUR(BILLDA)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJROIG 5859 printed Oct 16, 2024@17:49:07 Page 2
RCRJROIG ;WISC/RFJ-send data for oig extract ;1 Jul 99
+1 ;;4.5;Accounts Receivable;**103,174,203,205,220,270,335,338**;Mar 20, 1995;Build 69
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
NONMCCF(DATEEND) ; build the non-mccf bills for user report and submission to oig
+1 NEW BILLDA,DATE,DATA7,OTHER,PRINCPAL
+2 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^PRCA(430,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:1
+3 NEW RCFUND,RCRSC
+4 ; if already stored, then it is a current receivable
+5 IF $DATA(^TMP($JOB,"RCRJROIG",BILLDA))
QUIT
+6 ; calculate principal and other (int + admin) balance
+7 SET DATA7=$GET(^PRCA(430,BILLDA,7))
+8 SET PRINCPAL=+$PIECE(DATA7,"^")
+9 SET OTHER=$PIECE(DATA7,"^",2)+$PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5)
+10 ; in some bills, the principal and other balance may cancel
+11 ; each other. for example principal .08 + interest -.08 = 0
+12 IF (PRINCPAL+OTHER)'>0
QUIT
+13 ; store the data for submission to oig
+14 SET ^TMP($JOB,"RCRJROIG",BILLDA)=PRINCPAL_"^"_OTHER
+15 ; store the data for the user report (only if bill activated)
+16 SET DATE=+$PIECE($PIECE($GET(^PRCA(430,BILLDA,6)),"^",21),".")
IF 'DATE
QUIT
+17 SET ^TMP($JOB,"RCRJRCOLREPORT",DATE,BILLDA)=PRINCPAL_"^"_OTHER
+18 SET RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
+19 IF RCFUND=""
SET RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
+20 SET RCRSC=$$GETRSC(BILLDA,RCFUND)
+21 DO STORE^RCRJRCOU(BILLDA,DATEBEG,DATEEND,DATE,$PIECE(^PRCA(430,BILLDA,0),"^",2),"",RCFUND,RCRSC,$PIECE(DATA7,"^",1,5),1)
End DoDot:1
+22 QUIT
+23 ;
+24 ;
OIG(DATEEND) ; send data to the OIG
+1 NEW BILLDA,COUNT,DATA,DATA0,FUND,FYQ,OIGDATA,SEQUENCE,SITE,TOTALAMT
+2 NEW TOTALCNT,TOTALMSG,X,X1
+3 ;
+4 ; get previous fiscal year quarter for mail message header
+5 SET FYQ=$EXTRACT(DATEEND,4,5)
SET FYQ=$SELECT(FYQ<4:1,FYQ<7:2,FYQ<10:3,1:4)
+6 SET SITE=$$SITE^RCMSITE()
+7 ;
+8 ; calculate the number of messages to be sent
+9 SET (X,X1)=0
FOR
SET X=$ORDER(^TMP($JOB,"RCRJROIG",X))
if 'X
QUIT
SET X1=X1+1
+10 SET TOTALMSG=X1\272
IF X1#272
SET TOTALMSG=TOTALMSG+1
+11 ;
+12 ; build the extract for oig
+13 ; used to count bills to be sent in a single mail msg
SET COUNT=0
+14 ; used to count mail messages sent (in mail subject)
SET SEQUENCE=0
+15 ; used to count total bills sent all mail messages
SET TOTALCNT=0
+16 ; used to calculate total dollars all mail messages
SET TOTALAMT=0
+17 KILL ^TMP($JOB,"RCRJROIGMM")
+18 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^TMP($JOB,"RCRJROIG",BILLDA))
if 'BILLDA
QUIT
Begin DoDot:1
+19 SET DATA=^TMP($JOB,"RCRJROIG",BILLDA)
+20 SET DATA0=^PRCA(430,BILLDA,0)
+21 ; bill number, position 1-11
+22 ; WCJ;PRCA*4.5*270
SET OIGDATA=$EXTRACT($$LJ^XLFSTR($PIECE(DATA0,"^"),11),1,11)
+23 ; category, position 12-36
+24 SET OIGDATA=OIGDATA_$$LJ^XLFSTR($EXTRACT($PIECE($GET(^PRCA(430.2,+$PIECE(DATA0,"^",2),0)),"^"),1,25),25)
+25 ; status, position 37-56
+26 SET OIGDATA=OIGDATA_$$LJ^XLFSTR($EXTRACT($PIECE($GET(^PRCA(430.3,+$PIECE(DATA0,"^",8),0)),"^"),1,20),20)
+27 ; principal balance, position 57-65 (example 000000110 for 1.10)
+28 SET OIGDATA=OIGDATA_$TRANSLATE($JUSTIFY($PIECE(DATA,"^"),10,2)," .","0")
+29 ; date status last updated, position 66-76 (example APR 08,1999)
+30 SET OIGDATA=OIGDATA_$$DATE($PIECE(DATA0,"^",14))
+31 ; fms fund, position 77-82
+32 SET FUND=$$GET1^DIQ(430,BILLDA_",",203)
+33 IF FUND=""
SET FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
+34 ;S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
+35 ; may delete this line after 10/1/03
SET FUND=$$ADJFUND^RCRJRCO(FUND)
+36 SET OIGDATA=OIGDATA_$JUSTIFY(FUND,6)
+37 ; revenue source code, position 83-86
+38 SET OIGDATA=OIGDATA_$JUSTIFY($$GETRSC(BILLDA,FUND),4)
+39 ; general ledger account number, position 87-90
+40 SET OIGDATA=OIGDATA_$JUSTIFY($PIECE(DATA,"^",3),4)
+41 ; date bill entered, position 91-101 (example APR 08,1999)
+42 SET OIGDATA=OIGDATA_$$DATE($PIECE(DATA0,"^",10))
+43 ; interest + admin balance, position 102-110
+44 SET OIGDATA=OIGDATA_$TRANSLATE($JUSTIFY($PIECE(DATA,"^",2),10,2)," .","0")_"$"
+45 ;
+46 ; total count and dollars for bills sent
+47 SET TOTALCNT=TOTALCNT+1
+48 SET TOTALAMT=TOTALAMT+$PIECE(DATA,"^")
+49 ;
+50 ; store data for transmission
+51 SET COUNT=COUNT+1
+52 SET ^TMP($JOB,"RCRJROIGMM",COUNT)=OIGDATA
+53 ; only send message with 272 bills
+54 IF COUNT'=272
QUIT
+55 ; if there are no more bills, do not send message until the
+56 ; totals are placed at the end
+57 IF '$ORDER(^TMP($JOB,"RCRJROIG",BILLDA))
QUIT
+58 ;
+59 ; send current code sheets
+60 SET SEQUENCE=SEQUENCE+1
+61 DO MAILIT(SITE,FYQ,SEQUENCE)
+62 SET COUNT=0
+63 KILL ^TMP($JOB,"RCRJROIGMM")
End DoDot:1
+64 ;
+65 ; mail last message with totals at the end
+66 SET COUNT=COUNT+1
+67 SET ^TMP($JOB,"RCRJROIGMM",COUNT)="END OF TRANSMISSION FOR SITE# "_SITE_": TOTAL RECORDS: "_TOTALCNT_" TOTAL AMOUNT: "_TOTALAMT
+68 SET SEQUENCE=SEQUENCE+1
+69 DO MAILIT(SITE,FYQ,SEQUENCE)
+70 ;
+71 KILL ^TMP($JOB,"RCRJROIGMM")
+72 KILL ^TMP($JOB,"RCRJROIG")
+73 QUIT
+74 ;
+75 ;
MAILIT(SITE,FYQ,SEQUENCE) ; send code sheets to oig
+1 NEW %,%H,%Z,X,XCNP,XMDUZ,XMSCR,XMSUB,XMY,XMZ,Y
+2 ;
+3 ; set a header record in each file to be transmitted
+4 SET ^TMP($JOB,"RCRJROIGMM",.5)="OH$"_$$RJ^XLFSTR(SEQUENCE,5,0)_"$"_$$RJ^XLFSTR(TOTALMSG,5,0)_"$|"
+5 ;
+6 IF TOTALCNT=0
SET XMY("G.RC AR DATA COLLECTOR")=""
+7 SET XMY("XXX@Q-OIG.DOMAIN.EXT")=""
+8 SET XMDUZ="AR PACKAGE"
+9 SET %H=$HOROLOG
DO YX^%DTC
+10 SET XMSUB=SITE_"/BILL/"_FYQ_"/SEQ#: "_SEQUENCE_"/"_Y
+11 SET XMTEXT="^TMP($J,""RCRJROIGMM"","
+12 DO ^XMD
+13 QUIT
+14 ;
+15 ;
DATE(DATE) ; format date
+1 ; example input=2990408, output=APR 08,1999
+2 IF DATE
Begin DoDot:1
+3 SET Y=DATE
DO DD^%DT
+4 SET DATE=$EXTRACT(Y,1,3)_" "_$EXTRACT(DATE,6,7)_","_(1700+$EXTRACT(DATE,1,3))
End DoDot:1
+5 QUIT $$LJ^XLFSTR(DATE,11)
+6 ;
+7 ;
GETRSC(BILLDA,FUND) ; return the rsc for a bill
+1 NEW RCRSC
+2 IF '$$PTACCT^PRCAACC(FUND)
IF FUND'=4032
QUIT $PIECE($GET(^PRCA(430,BILLDA,11)),"^",6)
+3 ; check missing patient for reimbursable health insurance
+4 IF $PIECE(^PRCA(430,BILLDA,0),"^",2)=9
IF '$PIECE(^PRCA(430,BILLDA,0),"^",7)
QUIT " "
+5 ;PRCA*4.5*338 - retrieve existing RSC before calculating a new one
+6 SET RCRSC=$$GET1^DIQ(430,BILLDA_",",255)
+7 if RCRSC=""
SET RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
+8 if RCRSC'=""
QUIT RCRSC
+9 ;end RCRSC
+10 QUIT $$CALCRSC^RCXFMSUR(BILLDA)
