RCRJRCOR ;WISC/RFJ-ar data collector summary report ;1 Mar 97
;;4.5;Accounts Receivable;**68,96,139,103,156,170,174,191,220,138,239,320,338,351**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
SEND ; send data to ndb and data to FMS
N %,AMOUNT,DATEMOYR,FUND,LINE,RSC,SPACE,TOTAL,TOTALFUN,TOTALTYP,TYPE,X,XMY,Y
;
; ---------- send to ndb ----------
; data stored in tmp($j,rcrjrcolndb)
I '$G(RCRJFAR1) D NDB(PRCASITE,DATEBEG,DATEEND)
;
;
; ---------- send sv to fms ----------
; data stored in tmp($j,rcrjrcolsv)
; rcrjfsv is a flag set in the routine rcrjrco for retransmission
; to prevent accepted fms documents from being resent
I '$G(RCRJFSV) D STARTSV^RCXFMSSV(DATEEND)
;
;
; ---------- send wr to fms ----------
; data stored in tmp($j,rcrjrcolwr)
; rcrjfwr is a flag set in the routine rcrjrco for retransmission
; to prevent accepted fms documents from being resent
I '$G(RCRJFWR) D STARTWR^RCXFMSWR(DATEEND)
;
; ---------- send tr to fms ----------
N RCTRANS
; this call returns rctrans array (see rcxfmstx for description)
; rcrjftr is a flag set in the routine rcrjrco for retransmission
; to prevent accepted fms documents from being resent
I '$G(RCRJFTR) D STARTTR^RCXFMSTX(DATEEND)
;
; ---------- send oig extract ----------
; data stored in tmp(j,rcrjroig)
; get non-mccf bills for extract and user report
D NONMCCF^RCRJROIG(DATEEND)
; rcrjfoig is a flag set in the routine rcrjrco for retransmission
; to prevent the oig extract from being resent
I '$G(RCRJFOIG) D OIG^RCRJROIG(DATEEND)
;
; generate a mailman message to the group showing the data
K ^TMP($J,"RCRJRCORMM")
S Y=$E(DATEEND,1,5)_"00" D DD^%DT S DATEMOYR=Y
S LINE=0,SPACE="",$P(SPACE," ",80)=""
D SET("Data has been collected for the month "_DATEMOYR_". The data has been")
D SET("transmitted to the following systems:")
D SET(" ")
;
I '$G(RCRJFAR1) D
. D SET("NATIONAL DATABASE DATA")
. D SET("----------------------")
. D SET("The data has been sent to the National Database. For a detail list")
. D SET("of the data sent, please review the Return Reports which are sent")
. D SET("from the National Database.")
. D SET(" ")
;
I '$G(RCRJFSV) D
. D SET("FMS, STANDARD VOUCHER (SV) DOCUMENT")
. D SET("-----------------------------------")
. D SET("The following data has been transmitted to FMS in the SV document:")
. D SET(" Revenue Source Code Type Amount")
. D SET(" ------------------- ---- ------")
. S TOTAL=0
. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
. . I TYPE=17!(TYPE=18) Q ; display the Medicare totals later
. . S TOTALTYP=0
. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
. . . S TOTALFUN=0
. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
. . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
. . . . S TOTALFUN=TOTALFUN+AMOUNT
. . . . S TOTALTYP=TOTALTYP+AMOUNT
. . . . S TOTAL=TOTAL+AMOUNT
. . . ;
. . . ;N RCFUND S RCFUND=$S($E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),1:$E(FUND,1,4)_"0"_$E(FUND,6))
. . . N RCFUND S RCFUND=$S($L(FUND)<6:FUND,$E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),FUND>528700:FUND,1:$E(FUND,1,4)_"0"_$E(FUND,6)) ;PRCA*4.5*338,351
. . . ;I TYPE=21 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
. . . D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
. . ;
. . D SET(" ----------")
. . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
. . D SET(" ")
. ;
. ; Display Medicare totals and update the SV total
. S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",17)),TOTAL=TOTAL+AMOUNT
. D SET(" Medicare Contractual Adjustment TOTAL TYPE 17"_$J(AMOUNT,13,2))
. S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",18)),TOTAL=TOTAL+AMOUNT
. D SET(" Unreimbursable Medicare Expense TOTAL TYPE 18"_$J(AMOUNT,13,2))
. D SET(" ")
. ;
. D SET(" ----------")
. D SET(" TOTAL SV"_$J(TOTAL,13,2))
. D SET(" ")
;
I '$G(RCRJFWR) D
. D SET("FMS, WRITEOFFS/CONTRACT ADJUSTMENTS (WR) DOCUMENT")
. D SET("-------------------------------------------------")
. D SET("The following data has been transmitted to FMS in the WR document:")
. D SET(" Revenue Source Code Type Amount")
. D SET(" ------------------- ---- ------")
. S TOTAL=0
. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
. . S TOTALTYP=0
. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
. . . S TOTALFUN=0
. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
. . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
. . . . S TOTALFUN=TOTALFUN+AMOUNT
. . . . S TOTALTYP=TOTALTYP+AMOUNT
. . . . S TOTAL=TOTAL+AMOUNT
. . . ;
. . . N RCFUND S RCFUND=$S($L(FUND)<6:FUND,$E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),FUND>528700:FUND,1:$E(FUND,1,4)_"0"_$E(FUND,6)) ;PRCA*4.5*338,351
. . . ;I TYPE=37 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
. . . D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
. . ;
. . D SET(" ----------")
. . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
. . D SET(" ")
. D SET(" ----------")
. D SET(" TOTAL WR"_$J(TOTAL,13,2))
. D SET(" ")
;
I '$G(RCRJFTR) D
. D SET("FMS, TRANSFER FROM MCCF TO HSIF (TR) DOCUMENT")
. D SET("-------------------------------------------------")
. D SET("The following data has been transmitted to FMS in the TR document:")
. D SET(" From Fund From RSC To Fund To RSC Amount")
. D SET(" --------- -------- ------- ------ ----------")
. I $O(RCTRANS(""))="" D SET(" No Dollars to Transfer.") Q
. ;
. S FUND="" F S FUND=$O(RCTRANS(FUND)) Q:FUND="" D
. . S RSC="" F S RSC=$O(RCTRANS(FUND,RSC)) Q:RSC="" D
. . . ; rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
. . . S AMOUNT=RCTRANS(FUND,RSC)
. . . D SET($J(FUND,11)_$J(RSC,12)_$J($P(AMOUNT,"^"),14)_$J($P(AMOUNT,"^",2),10)_$J($P(AMOUNT,"^",3),31,2))
;
S XMY("G.RC AR DATA COLLECTOR")=""
S %=$$SENDMSG("AR Data Collector for "_DATEMOYR_" Station "_PRCASITE,.XMY)
K ^TMP($J,"RCRJRCORMM")
;
; send users detail report
;D USERREPT^RCRJRCOU(DATEMOYR) ;removed from backround job p315 (FY16 HAPE RRE PRCA*4.5*320)
Q
;
;
NDB(PRCASITE,DATEBEG,DATEEND) ; send data to the national database
N %,BATCNAME,COUNT,CRITERIA,DATA,LINE,XMY,X,Y
K ^TMP($J,"RCRJRCORMM")
S LINE=2,DATA="D$ "
S CRITERIA="" F COUNT=1:1 S CRITERIA=$O(^TMP($J,"RCRJRCOLNDB",CRITERIA)) Q:CRITERIA="" D
. S DATA=DATA_":"_COUNT_"/"_CRITERIA_"/"_^TMP($J,"RCRJRCOLNDB",CRITERIA)
. I $L(DATA)>200 D SET(DATA) S DATA="D$ "
I DATA'="D$ " D SET(DATA)
;
; build the first two control lines in mail message
S Y=DATEBEG D DD^%DT
S BATCNAME="AR1-"_$E(Y,1,3)_$E(DATEBEG,6,7)_$TR($P(Y,",",2)," ")
S Y=DATEEND D DD^%DT
S BATCNAME=BATCNAME_"-"_$E(Y,1,3)_$E(DATEEND,6,7)_$TR($P(Y,",",2)," ")
S ^TMP($J,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
; get end time (in %)
D NOW^%DTC
S ^TMP($J,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$"_(COUNT-1)
;
S XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.DOMAIN.EXT")=""
S %=$$SENDMSG("AR1 "_$E(DATEEND,4,5)_"/"_$E(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
K ^TMP($J,"RCRJRCORMM")
Q
;
;
SUMMARY ; print summary report in mailman bulletin
N %,BILLDA,CRITER2,CRITERIA,DATA0,DFN,LINE,STAT,TOTAL,VA,XMY
K ^TMP($J,"RCRJRCOR") ; used to identify test patients
K ^TMP($J,"RCRJRCORMM") ; used to build mailman message
;
; print any test patient bills which have not been closed
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOL","CRIT2",1,BILLDA)) Q:'BILLDA I $D(^(BILLDA,1)) D
. S DATA0=$G(^PRCA(430,BILLDA,0)),STAT=$P(DATA0,"^",8)
. I STAT'=16,STAT='42 Q ; bill not currently open
. S DFN=+$P(DATA0,"^",7) I 'DFN Q
. D PID^VADPT
. I $E($TR($G(VA("PID")),"-"),1,5)="00000" S ^TMP($J,"RCRJRCOR","TEST",BILLDA)=""
;
I '$D(^TMP($J,"RCRJRCOR","TEST")) Q
;
; print data
S LINE=0
D SET(" ")
D SET("The following bills are active and linked to test patients:")
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOR","TEST",BILLDA)) Q:'BILLDA D SET(" "_$P($G(^PRCA(430,BILLDA,0)),"^")_" (#",BILLDA_")")
;
S XMY("G.RC AR DATA COLLECTOR")=""
S %=$$SENDMSG("MCCR DATA COLLECTOR INFORMATION",.XMY)
K ^TMP($J,"RCRJRCOR")
K ^TMP($J,"RCRJRCORMM")
Q
;
;
SET(DATA) ; store report
S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
Q
;
;
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
S XMDUZ="AR PACKAGE",XMTEXT="^TMP($J,""RCRJRCORMM"","
D ^XMD
Q +$G(XMZ)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCOR 10044 printed Dec 13, 2024@01:48:13 Page 2
RCRJRCOR ;WISC/RFJ-ar data collector summary report ;1 Mar 97
+1 ;;4.5;Accounts Receivable;**68,96,139,103,156,170,174,191,220,138,239,320,338,351**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SEND ; send data to ndb and data to FMS
+1 NEW %,AMOUNT,DATEMOYR,FUND,LINE,RSC,SPACE,TOTAL,TOTALFUN,TOTALTYP,TYPE,X,XMY,Y
+2 ;
+3 ; ---------- send to ndb ----------
+4 ; data stored in tmp($j,rcrjrcolndb)
+5 IF '$GET(RCRJFAR1)
DO NDB(PRCASITE,DATEBEG,DATEEND)
+6 ;
+7 ;
+8 ; ---------- send sv to fms ----------
+9 ; data stored in tmp($j,rcrjrcolsv)
+10 ; rcrjfsv is a flag set in the routine rcrjrco for retransmission
+11 ; to prevent accepted fms documents from being resent
+12 IF '$GET(RCRJFSV)
DO STARTSV^RCXFMSSV(DATEEND)
+13 ;
+14 ;
+15 ; ---------- send wr to fms ----------
+16 ; data stored in tmp($j,rcrjrcolwr)
+17 ; rcrjfwr is a flag set in the routine rcrjrco for retransmission
+18 ; to prevent accepted fms documents from being resent
+19 IF '$GET(RCRJFWR)
DO STARTWR^RCXFMSWR(DATEEND)
+20 ;
+21 ; ---------- send tr to fms ----------
+22 NEW RCTRANS
+23 ; this call returns rctrans array (see rcxfmstx for description)
+24 ; rcrjftr is a flag set in the routine rcrjrco for retransmission
+25 ; to prevent accepted fms documents from being resent
+26 IF '$GET(RCRJFTR)
DO STARTTR^RCXFMSTX(DATEEND)
+27 ;
+28 ; ---------- send oig extract ----------
+29 ; data stored in tmp(j,rcrjroig)
+30 ; get non-mccf bills for extract and user report
+31 DO NONMCCF^RCRJROIG(DATEEND)
+32 ; rcrjfoig is a flag set in the routine rcrjrco for retransmission
+33 ; to prevent the oig extract from being resent
+34 IF '$GET(RCRJFOIG)
DO OIG^RCRJROIG(DATEEND)
+35 ;
+36 ; generate a mailman message to the group showing the data
+37 KILL ^TMP($JOB,"RCRJRCORMM")
+38 SET Y=$EXTRACT(DATEEND,1,5)_"00"
DO DD^%DT
SET DATEMOYR=Y
+39 SET LINE=0
SET SPACE=""
SET $PIECE(SPACE," ",80)=""
+40 DO SET("Data has been collected for the month "_DATEMOYR_". The data has been")
+41 DO SET("transmitted to the following systems:")
+42 DO SET(" ")
+43 ;
+44 IF '$GET(RCRJFAR1)
Begin DoDot:1
+45 DO SET("NATIONAL DATABASE DATA")
+46 DO SET("----------------------")
+47 DO SET("The data has been sent to the National Database. For a detail list")
+48 DO SET("of the data sent, please review the Return Reports which are sent")
+49 DO SET("from the National Database.")
+50 DO SET(" ")
End DoDot:1
+51 ;
+52 IF '$GET(RCRJFSV)
Begin DoDot:1
+53 DO SET("FMS, STANDARD VOUCHER (SV) DOCUMENT")
+54 DO SET("-----------------------------------")
+55 DO SET("The following data has been transmitted to FMS in the SV document:")
+56 DO SET(" Revenue Source Code Type Amount")
+57 DO SET(" ------------------- ---- ------")
+58 SET TOTAL=0
+59 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP($JOB,"RCRJRCOLSV",TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+60 ; display the Medicare totals later
IF TYPE=17!(TYPE=18)
QUIT
+61 SET TOTALTYP=0
+62 SET FUND=""
FOR
SET FUND=$ORDER(^TMP($JOB,"RCRJRCOLSV",TYPE,FUND))
if FUND=""
QUIT
Begin DoDot:3
+63 SET TOTALFUN=0
+64 SET RSC=""
FOR
SET RSC=$ORDER(^TMP($JOB,"RCRJRCOLSV",TYPE,FUND,RSC))
if RSC=""
QUIT
SET AMOUNT=^(RSC)
Begin DoDot:4
+65 DO SET(" "_RSC_" "_$EXTRACT($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$JUSTIFY(AMOUNT,13,2))
+66 SET TOTALFUN=TOTALFUN+AMOUNT
+67 SET TOTALTYP=TOTALTYP+AMOUNT
+68 SET TOTAL=TOTAL+AMOUNT
End DoDot:4
+69 ;
+70 ;N RCFUND S RCFUND=$S($E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),1:$E(FUND,1,4)_"0"_$E(FUND,6))
+71 ;PRCA*4.5*338,351
NEW RCFUND
SET RCFUND=$SELECT($LENGTH(FUND)<6:FUND,$EXTRACT(DATEEND,2,5)<"0410":$EXTRACT(FUND,1,4)_"."_$EXTRACT(FUND,6),FUND>528700:FUND,1:$EXTRACT(FUND,1,4)_"0"_$EXTRACT(FUND,6))
+72 ;I TYPE=21 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
+73 DO SET($EXTRACT(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$JUSTIFY(TOTALFUN,12,2))
End DoDot:3
+74 ;
+75 DO SET(" ----------")
+76 DO SET(" TOTAL TYPE "_TYPE_$JUSTIFY(TOTALTYP,13,2))
+77 DO SET(" ")
End DoDot:2
+78 ;
+79 ; Display Medicare totals and update the SV total
+80 SET AMOUNT=+$GET(^TMP($JOB,"RCRJRCOLSV",17))
SET TOTAL=TOTAL+AMOUNT
+81 DO SET(" Medicare Contractual Adjustment TOTAL TYPE 17"_$JUSTIFY(AMOUNT,13,2))
+82 SET AMOUNT=+$GET(^TMP($JOB,"RCRJRCOLSV",18))
SET TOTAL=TOTAL+AMOUNT
+83 DO SET(" Unreimbursable Medicare Expense TOTAL TYPE 18"_$JUSTIFY(AMOUNT,13,2))
+84 DO SET(" ")
+85 ;
+86 DO SET(" ----------")
+87 DO SET(" TOTAL SV"_$JUSTIFY(TOTAL,13,2))
+88 DO SET(" ")
End DoDot:1
+89 ;
+90 IF '$GET(RCRJFWR)
Begin DoDot:1
+91 DO SET("FMS, WRITEOFFS/CONTRACT ADJUSTMENTS (WR) DOCUMENT")
+92 DO SET("-------------------------------------------------")
+93 DO SET("The following data has been transmitted to FMS in the WR document:")
+94 DO SET(" Revenue Source Code Type Amount")
+95 DO SET(" ------------------- ---- ------")
+96 SET TOTAL=0
+97 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP($JOB,"RCRJRCOLWR",TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+98 SET TOTALTYP=0
+99 SET FUND=""
FOR
SET FUND=$ORDER(^TMP($JOB,"RCRJRCOLWR",TYPE,FUND))
if FUND=""
QUIT
Begin DoDot:3
+100 SET TOTALFUN=0
+101 SET RSC=""
FOR
SET RSC=$ORDER(^TMP($JOB,"RCRJRCOLWR",TYPE,FUND,RSC))
if RSC=""
QUIT
SET AMOUNT=^(RSC)
Begin DoDot:4
+102 DO SET(" "_RSC_" "_$EXTRACT($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$JUSTIFY(AMOUNT,13,2))
+103 SET TOTALFUN=TOTALFUN+AMOUNT
+104 SET TOTALTYP=TOTALTYP+AMOUNT
+105 SET TOTAL=TOTAL+AMOUNT
End DoDot:4
+106 ;
+107 ;PRCA*4.5*338,351
NEW RCFUND
SET RCFUND=$SELECT($LENGTH(FUND)<6:FUND,$EXTRACT(DATEEND,2,5)<"0410":$EXTRACT(FUND,1,4)_"."_$EXTRACT(FUND,6),FUND>528700:FUND,1:$EXTRACT(FUND,1,4)_"0"_$EXTRACT(FUND,6))
+108 ;I TYPE=37 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
+109 DO SET($EXTRACT(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$JUSTIFY(TOTALFUN,12,2))
End DoDot:3
+110 ;
+111 DO SET(" ----------")
+112 DO SET(" TOTAL TYPE "_TYPE_$JUSTIFY(TOTALTYP,13,2))
+113 DO SET(" ")
End DoDot:2
+114 DO SET(" ----------")
+115 DO SET(" TOTAL WR"_$JUSTIFY(TOTAL,13,2))
+116 DO SET(" ")
End DoDot:1
+117 ;
+118 IF '$GET(RCRJFTR)
Begin DoDot:1
+119 DO SET("FMS, TRANSFER FROM MCCF TO HSIF (TR) DOCUMENT")
+120 DO SET("-------------------------------------------------")
+121 DO SET("The following data has been transmitted to FMS in the TR document:")
+122 DO SET(" From Fund From RSC To Fund To RSC Amount")
+123 DO SET(" --------- -------- ------- ------ ----------")
+124 IF $ORDER(RCTRANS(""))=""
DO SET(" No Dollars to Transfer.")
QUIT
+125 ;
+126 SET FUND=""
FOR
SET FUND=$ORDER(RCTRANS(FUND))
if FUND=""
QUIT
Begin DoDot:2
+127 SET RSC=""
FOR
SET RSC=$ORDER(RCTRANS(FUND,RSC))
if RSC=""
QUIT
Begin DoDot:3
+128 ; rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
+129 SET AMOUNT=RCTRANS(FUND,RSC)
+130 DO SET($JUSTIFY(FUND,11)_$JUSTIFY(RSC,12)_$JUSTIFY($PIECE(AMOUNT,"^"),14)_$JUSTIFY($PIECE(AMOUNT,"^",2),10)_$JUSTIFY($PIECE(AMOUNT,"^",3),31,2))
End DoDot:3
End DoDot:2
End DoDot:1
+131 ;
+132 SET XMY("G.RC AR DATA COLLECTOR")=""
+133 SET %=$$SENDMSG("AR Data Collector for "_DATEMOYR_" Station "_PRCASITE,.XMY)
+134 KILL ^TMP($JOB,"RCRJRCORMM")
+135 ;
+136 ; send users detail report
+137 ;D USERREPT^RCRJRCOU(DATEMOYR) ;removed from backround job p315 (FY16 HAPE RRE PRCA*4.5*320)
+138 QUIT
+139 ;
+140 ;
NDB(PRCASITE,DATEBEG,DATEEND) ; send data to the national database
+1 NEW %,BATCNAME,COUNT,CRITERIA,DATA,LINE,XMY,X,Y
+2 KILL ^TMP($JOB,"RCRJRCORMM")
+3 SET LINE=2
SET DATA="D$ "
+4 SET CRITERIA=""
FOR COUNT=1:1
SET CRITERIA=$ORDER(^TMP($JOB,"RCRJRCOLNDB",CRITERIA))
if CRITERIA=""
QUIT
Begin DoDot:1
+5 SET DATA=DATA_":"_COUNT_"/"_CRITERIA_"/"_^TMP($JOB,"RCRJRCOLNDB",CRITERIA)
+6 IF $LENGTH(DATA)>200
DO SET(DATA)
SET DATA="D$ "
End DoDot:1
+7 IF DATA'="D$ "
DO SET(DATA)
+8 ;
+9 ; build the first two control lines in mail message
+10 SET Y=DATEBEG
DO DD^%DT
+11 SET BATCNAME="AR1-"_$EXTRACT(Y,1,3)_$EXTRACT(DATEBEG,6,7)_$TRANSLATE($PIECE(Y,",",2)," ")
+12 SET Y=DATEEND
DO DD^%DT
+13 SET BATCNAME=BATCNAME_"-"_$EXTRACT(Y,1,3)_$EXTRACT(DATEEND,6,7)_$TRANSLATE($PIECE(Y,",",2)," ")
+14 SET ^TMP($JOB,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
+15 ; get end time (in %)
+16 DO NOW^%DTC
+17 SET ^TMP($JOB,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$"_(COUNT-1)
+18 ;
+19 SET XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.DOMAIN.EXT")=""
+20 SET %=$$SENDMSG("AR1 "_$EXTRACT(DATEEND,4,5)_"/"_$EXTRACT(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
+21 KILL ^TMP($JOB,"RCRJRCORMM")
+22 QUIT
+23 ;
+24 ;
SUMMARY ; print summary report in mailman bulletin
+1 NEW %,BILLDA,CRITER2,CRITERIA,DATA0,DFN,LINE,STAT,TOTAL,VA,XMY
+2 ; used to identify test patients
KILL ^TMP($JOB,"RCRJRCOR")
+3 ; used to build mailman message
KILL ^TMP($JOB,"RCRJRCORMM")
+4 ;
+5 ; print any test patient bills which have not been closed
+6 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^TMP($JOB,"RCRJRCOL","CRIT2",1,BILLDA))
if 'BILLDA
QUIT
IF $DATA(^(BILLDA,1))
Begin DoDot:1
+7 SET DATA0=$GET(^PRCA(430,BILLDA,0))
SET STAT=$PIECE(DATA0,"^",8)
+8 ; bill not currently open
IF STAT'=16
IF STAT='42
QUIT
+9 SET DFN=+$PIECE(DATA0,"^",7)
IF 'DFN
QUIT
+10 DO PID^VADPT
+11 IF $EXTRACT($TRANSLATE($GET(VA("PID")),"-"),1,5)="00000"
SET ^TMP($JOB,"RCRJRCOR","TEST",BILLDA)=""
End DoDot:1
+12 ;
+13 IF '$DATA(^TMP($JOB,"RCRJRCOR","TEST"))
QUIT
+14 ;
+15 ; print data
+16 SET LINE=0
+17 DO SET(" ")
+18 DO SET("The following bills are active and linked to test patients:")
+19 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^TMP($JOB,"RCRJRCOR","TEST",BILLDA))
if 'BILLDA
QUIT
DO SET(" "_$PIECE($GET(^PRCA(430,BILLDA,0)),"^")_" (#",BILLDA_")")
+20 ;
+21 SET XMY("G.RC AR DATA COLLECTOR")=""
+22 SET %=$$SENDMSG("MCCR DATA COLLECTOR INFORMATION",.XMY)
+23 KILL ^TMP($JOB,"RCRJRCOR")
+24 KILL ^TMP($JOB,"RCRJRCORMM")
+25 QUIT
+26 ;
+27 ;
SET(DATA) ; store report
+1 SET LINE=LINE+1
SET ^TMP($JOB,"RCRJRCORMM",LINE)=DATA
+2 QUIT
+3 ;
+4 ;
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
+1 NEW %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
+2 SET XMDUZ="AR PACKAGE"
SET XMTEXT="^TMP($J,""RCRJRCORMM"","
+3 DO ^XMD
+4 QUIT +$GET(XMZ)
