- 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 Jan 18, 2025@02:49:26 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)