Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRJRCOU

RCRJRCOU.m

Go to the documentation of this file. 
  1. RCRJRCOU ;WISC/RFJ-ar data collector summary report ;1 Mar 97
  1.  ;;4.5;Accounts Receivable;**103,320,335,338,351**;Mar 20, 1995;Build 15
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  Q
  1.  ; IA - 4398        FIRST^VAUTOMA
  1.  ;       4385        $$MRATYPE^IBCEMU2
  1.  ; 
  1.  ; 
  1.  ;ARDC detailed report - Modified to print directly as per  PRCA*4.5*320 (HAPE FY16 RRE)
  1.  ;  a MailMan message is no longer generated by this routine !
  1.  ; Called by VistA Option - PRCA ARDC REPORT       (ARDC Detail Report)
  1.  ;
  1. START ;  Entry point from the Option
  1.  N VAUTSTR,VAUTNI,DIC,Y,SCREEN,EXCEL,VAUTC,QUIT,DTFRMTO,BGDT,RCSTDT
  1.  ;
  1.  S QUIT=0
  1.  N TXT,MSG F TXT=1:1:12 S MSG=$T(MENU+TXT) W !,?5,$P(MSG,";;",2)
  1.  S SCREEN="^16^18^32^33^40^42^",DIC="^PRCA(430.3,",VAUTNI=2,VAUTSTR="Status",VAUTVB="VAUTC",DIC("S")="I SCREEN[(U_Y_U)" D FIRST^VAUTOMA
  1.  I VAUTC=1 F I=2:1:7 S VAUTC($P(SCREEN,U,I))=$P(^PRCA(430.3,$P(SCREEN,U,I),0),U)  ;set array equal to the screen if ALL was selected
  1.  Q:'$D(VAUTC)!(Y=-1)
  1.  N TXT,MSG W ! F TXT=1:1:12 S MSG=$T(DESCTEXT+TXT) W !,?3,$P(MSG,";;",2)
  1.  W !!,?10,"<< Checking available dates.  Please wait >>"
  1.  D FIRST  ;Get earliest date for selected Status
  1.  W !!,"The earliest date on file for selected status is:  ",$G(BGDT)
  1.  S DTFRMTO=$$DTFRMTO Q:'DTFRMTO  ;Get date range for report
  1.  S EXCEL=0,PROMPT="CAPTURE Report data to an Excel Document?",DIR(0)="Y",DIR("?")="^D HEXC^RCRJRCOU"
  1.  S EXCEL=$$SELECT^RCTCSJR(PROMPT,"NO") I "01"'[EXCEL Q
  1.  I EXCEL=1 D EXCMSG^RCTCSJR ; Display Excel display message
  1.  I 'EXCEL W !!,"This report requires 132 characters",!
  1.  K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  .S ZTDESC="ARDC Detail Report",ZTRTN="DQ^RCRJRCOU"
  1.  .S ZTSAVE("VAUTC*")="",ZTSAVE("RCRET")="",ZTSAVE("DTFRMTO")="",ZTSAVE("ZTREQ")="@",ZTSAVE("EXCEL")=""
  1.  .D ^%ZTLOAD,HOME^%ZIS S QUIT=1
  1.  W !!,"<*> please wait <*>"
  1.  ;
  1. DQ ;  generate user detailed report
  1.  N DATEEND,RCDATE,BILLDA,DATA,RCLINE,REPTDATA,Y,RCBILLN,RCDTAC,RCCAT,RCSTAT,TRANTYP,RCTOT,RCPRIN,RCRSC,PRCASITE,VAUTVB,XMNOW
  1.  N STAT,BILLDA,RCRSC,RECORD,RCBAL,ARACTDT,DATEMOYR,MRATYPE,POP,RCFUND,RCOTHER,TYPE,RCOUT,CURDT,DTFRM,DTFROM,DTTO,RCRET,LIST,ERR
  1.  N RCACCRD,RCRHITYP
  1.  ;
  1.  S (RCDATE,DTFRM)=$$FMADD^XLFDT(+$P(DTFRMTO,U,2)),DTTO=$P(DTFRMTO,U,3),CURDT=0
  1.  S XMNOW=$$NOW^XLFDT  ;Capture the date and time the report was started for the header
  1.  S DATEEND=$$LDATE^RCRJR(DT),DATEMOYR=$E(DATEEND,1,5)_"00"
  1.  S PRCASITE=$$SITE^RCMSITE
  1.  S RCRET=$NA(^TMP($J,"RCRJRCOU")) K @RCRET
  1.  ; 
  1.  S (RCLINE,STAT)=0 F  S STAT=$O(VAUTC(STAT)) Q:'STAT  S RCDATE=DTFRM D
  1.  . S BILLDA=0 F  S BILLDA=$O(^PRCA(430,"AC",STAT,BILLDA)) Q:'BILLDA  D
  1.  ..Q:$P(^PRCA(430,BILLDA,0),U,10)=""
  1.  ..Q:$P(^PRCA(430,BILLDA,0),U,8)'=STAT  ;Quit if the Current Status from the xref is incorrect
  1.  ..S RCDATE=$P(^PRCA(430,BILLDA,0),U,10)
  1.  ..Q:RCDATE<DTFRM!(RCDATE>DTTO)
  1.  .. ;As per email from the VA - We need to see all bills, not just accrued bills.
  1.  .. ;I $$ACCK^PRCAACC(BILLDA),$P($G(^PRCA(430,BILLDA,0)),"^",2)'=26 D   ;from CURRENT^RCRJRCOC 
  1.  .. ;
  1.  .. I $P($G(^PRCA(430,BILLDA,0)),"^",2)'=26 D   ;from CURRENT^RCRJRCOC 
  1.  ... S DATA=$G(^PRCA(430,BILLDA,0)) Q:'DATA
  1.  ... S (TYPE,TRANTYP,RCRSC,RCFUND,RCPRIN)="",RCBAL=0
  1.  ... ;  bill number
  1.  ... ;S RCBILLN=$P($P(DATA,"^"),"-",2)
  1.  ... S RCBILLN=$P(DATA,"^")
  1.  ... ;  date activated
  1.  ... S RCDTAC=$$FMTE^XLFDT(RCDATE,"2Z")
  1.  ... ;  category
  1.  ... S RCCAT=$P($G(^PRCA(430.2,+$P(DATA,"^",2),0)),"^")
  1.  ... S RCACCRD=$$GET1^DIQ(430.2,+$P(DATA,"^",2)_",",12,"I")
  1.  ... ;  status
  1.  ... S RCSTAT=$P($G(^PRCA(430.3,+$P(DATA,"^",8),0)),"^")
  1.  ... ;PRCA*4.5*338 - re-wrote section to correctly retrieve RSCs, properly ID TRICARE, CHAMPVA BD doc types, and TORT/MRA SV doc types
  1.  ... ;             - grab fund and RSC from Bill instead of recalculating.  Recalculate only if they are NULL
  1.  ... S RCRSC=$$GET1^DIQ(430,BILLDA_",",255,"I")
  1.  ... S:RCRSC="" RCRSC=$$GET1^DIQ(430,BILLDA_",",255.1)
  1.  ... I $$ACCK^PRCAACC(BILLDA) S:RCRSC="" RCRSC=$$CALCRSC^RCXFMSUR(BILLDA) ;          (as per CURRENT^RCRJRCOC)
  1.  ... ;Fund
  1.  ... S RCFUND=$$GET1^DIQ(430,BILLDA_",",203)
  1.  ... I RCFUND="" S RCFUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
  1.  ... S TYPE="SV21"       ; Default the doc type.
  1.  ... ;  special type for tort feasor
  1.  ... I RCCAT["TORT" S TYPE="2A"  ;Using the category name to look for TORTs
  1.  ... ;  Get AR Date Active for bill
  1.  ... S ARACTDT=+$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".")  ;                          (as per START^RCRJRBD)
  1.  ... ;  determine Receivable Type: 1=pre-MRA, 2=post-MRA Medicre, 3=post-MRA non-Medicare
  1.  ... ;  fms report type - TRANTYP variable
  1.  ... S MRATYPE=$$MRATYPE^IBCEMU2(BILLDA,ARACTDT) ;                                     (as per CURRENT^RCRJRCOC)
  1.  ... ; Set TYPE to 2F for post-MRA Medicare bills or to 2L for post-MRA non-Medicare bills (for RHI receivables only)
  1.  ... ; Moved TYPE set for RHI to function call to ensure Community Care RSCs are captured correctly.
  1.  ... S RCRHITYP=$$RHITYPE^RCRJRCOC(RCRSC,MRATYPE,RCCAT) S:+RCRHITYP TYPE=$P(RCRHITYP,U,2)
  1.  ... I 'RCACCRD S TYPE="BD"                 ; Non accrued have BD FMS doc types.
  1.  ... S TRANTYP=$G(TYPE),REPTDATA=""
  1.  ... K LIST D FIND^DIC(430,,"@;71;11;IX","M","`"_BILLDA,,,,,"LIST","ERR")
  1.  ... S RCPRIN=$G(LIST("DILIST","ID",1,71)),RCBAL=$G(LIST("DILIST","ID",1,11))
  1.  ... I RCBAL'>0 Q  ;Don't show if current balance not greater than $0
  1.  ... S RCPRIN=$J(RCPRIN,9,2),RCBAL=$J(RCBAL,10,2)
  1.  ... S RCLINE=RCLINE+1  ;(record counter)
  1.  ... S @RCRET@(RCLINE)=RCBILLN_U_RCDTAC_U_RCCAT_U_RCSTAT_U_TRANTYP_U_RCFUND_U_RCRSC_U_RCPRIN_U_RCBAL
  1.  ; end of gathering data
  1.  ;
  1.  I RCLINE=0 W !!,"***The report found no receivables that match your selection***",!! G EXIT
  1.  ;
  1.  D PRINT
  1.  ;
  1. EXIT ;commom exit point
  1.  D ^%ZISC
  1.  K ^TMP($J,"RCRJRCOU")
  1.  Q
  1.  ;
  1. HDR ;Set the header
  1.  ;
  1.  S PAGE=PAGE+1 U IO W @IOF
  1.  I 'EXCEL W ?14,"ARDC Detailed Report",?50,"Run Date: ",$$FMTE^XLFDT(XMNOW,"2Z"),?107,"Page:",PAGE,!
  1.  I EXCEL W U_"ARDC Detailed Report"_U_U_"Run Date: "_$$FMTE^XLFDT(XMNOW,"2Z")_U_U_U_U_"Page:"_PAGE,!
  1.  N I F I=1:1:120 W "-"
  1.  I 'EXCEL W !,"Bill#",?14,"Create",?26,"AR Category",?50,"Bill",?68,"FMS",?75,"Fund",?84,"RSC",?93,"Principal",?107,"Current"
  1.  I 'EXCEL W !,?14,"Date",?50,"Status",?75,"Type",?96,"Amount",?107,"Balance",!
  1.  I EXCEL W !,"Bill#"_U_"Create"_U_"AR Category"_U_"Bill"_U_"FMS"_U_"Fund"_U_"RSC"_U_"Principal"_U_"Current"
  1.  I EXCEL W !,U_"Date"_U_U_"Status"_U_U_"Type"_U_U_"Amount"_U_"Balance",!
  1.  N I F I=1:1:120 W "-"
  1.  Q
  1.  ;
  1. PRINT ; print records to screen or printer
  1.  N PAGE S (RCOUT,PAGE)=0,RECORD=0
  1.  F  S RECORD=$O(@RCRET@(RECORD)) Q:'RECORD!(RCOUT)  D
  1.  . I RECORD=1 D HDR
  1.  . I 'EXCEL,$Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
  1.  .. I $D(DTOUT)!($D(DUOUT)) S RCOUT=1 G EXIT
  1.  .. D HDR
  1.  . Q:RCOUT
  1.  . I 'EXCEL W !,$P(@RCRET@(RECORD),U),?14,$P(@RCRET@(RECORD),U,2),?26,$E($P(@RCRET@(RECORD),U,3),1,20),?50,$E($P(@RCRET@(RECORD),U,4),1,15),?68,$P(@RCRET@(RECORD),U,5)
  1.  . I 'EXCEL W ?75,$P(@RCRET@(RECORD),U,6),?84,$P(@RCRET@(RECORD),U,7),?92,$P(@RCRET@(RECORD),U,8),?104,$P(@RCRET@(RECORD),U,9)
  1.  . I EXCEL W !,$P(@RCRET@(RECORD),U)_U_$P(@RCRET@(RECORD),U,2)_U_$P(@RCRET@(RECORD),U,3)_U_$P(@RCRET@(RECORD),U,4)_U_$P(@RCRET@(RECORD),U,5)
  1.  . I EXCEL W U_$P(@RCRET@(RECORD),U,6)_U_$P(@RCRET@(RECORD),U,7)_U_$P(@RCRET@(RECORD),U,8)_U_$P(@RCRET@(RECORD),U,9)
  1.  I 'EXCEL,$E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
  1.  Q
  1.  ;
  1. DTFRMTO(PROMPT) ;Get from and to dates  (added as per PRCA*4.5*320 to be able to sort by dates for reports)
  1.  N %DT,Y,X,BEGDT,ENDDT,DTOUT,OUT,DIRUT,DUOUT,DIROUT,STATUS,BDT,STDT,STATUS
  1.  ;INPUT ;   PROMPT - Message to display prior to prompting for dates
  1.  ;OUTPUT:     1^BEGDT^ENDDT - Data found
  1.  ;            0             - User up arrowed or timed out
  1.  ;If they want to show first available date for that set of Status, use this sub
  1.  S OUT=0
  1.  ;W !,$G(PROMPT)
  1.  S %DT="AEX",%DT("A")="Date Range: FROM: " ;Enter Beginning Date: "
  1.  W ! D ^%DT K %DT
  1.  I Y<0 W !!,"No Date selected, quitting. ",!! Q OUT  ;Quit if user time out or didn't enter valid date
  1.  S DTFROM=+Y,%DT="AEX",%DT("A")="              TO:   ",%DT("B")="T" ;"TODAY"
  1.  D ^%DT
  1.  K %DT
  1.  ;Quit if user time out or didn't enter valid date
  1.  I Y<0 W !!,"No Date selected, quitting. ",!! Q OUT
  1.  S DTTO=+Y,OUT=1_U_DTFROM_U_DTTO
  1.  ;Switch dates if Begin Date is more recent than End Date
  1.  S:DTFROM>DTTO OUT=1_U_DTTO_U_DTFROM
  1.  Q OUT
  1.  ;
  1. HEXC ; - 'Do you want to capture data to EXCEL' prompt
  1.  W !!,"      Enter:  'Y'   -  To capture detail report data to transfer"
  1.  W !,"                        to an Excel document"
  1.  W !,"              '<CR>' -  To skip this option"
  1.  W !,"              '^'    -  To quit this option"
  1.  Q
  1. FIRST ; Get 1st available date for selected status
  1.  N RCBILL
  1.  S STATUS=0,(RCBILL,BDT)="" F  S STATUS=$O(VAUTC(STATUS)) Q:STATUS=""  D
  1.  . S RCBILL=0 F  S RCBILL=$O(^PRCA(430,"AC",STATUS,RCBILL)) Q:'RCBILL  D
  1.  .. Q:$P($G(^PRCA(430,RCBILL,0)),U,10)=""
  1.  .. S RCSTDT=$P($G(^PRCA(430,RCBILL,0)),U,10)
  1.  .. I $G(BDT)="" S BDT=RCSTDT Q
  1.  .. I RCSTDT<+BDT S BDT=RCSTDT_U_STATUS ;Use earliest available date
  1.  ;
  1.  S BGDT=$S(BDT'="":$$FMTE^XLFDT(+BDT,"Z2"),1:"No records on file")
  1.  Q
  1.  ;;
  1.  ;;
  1.  ;;ARDC Detail Report, please select the status desired below:
  1.  ;;
  1.  ;;     AC - ACTIVE(16)
  1.  ;;     N  - NEW BILL(18)
  1.  ;;     R  - RETURNED FOR AMENDMENT(32)
  1.  ;;     AM - AMENDED BILL(33)
  1.  ;;     S  - SUSPENDED(40)
  1.  ;;     O  - OPEN(42)
  1.  ;;     ALL of the above (Default, press enter) 
  1.  ;;
  1.  Q
  1. DESCTEXT ;
  1.  ;; This report was originally generated from the monthly background
  1.  ;; process and generated a MailMan message.  It can now only be run
  1.  ;; manually through this option. The new data does not contain bills
  1.  ;; that have been previously closed out. Note that when running the
  1.  ;; new report, only specific AR current status are available.  
  1.  ;; There will be a note that displays the oldest bill in VistA 
  1.  ;; associated with these statuses for users to know which date 
  1.  ;; MUST be entered into the "FROM:" prompt for monthly
  1.  ;; reconciliation reporting.  
  1.  ;; Different dates can be entered for other types of audits.
  1.  ;; 
  1.  ;; Please run after hours when possible.
  1.  ;; 
  1.  Q
  1.  ;
  1. STORE(BILLDA,DATEBEG,DATEEND,ARACTDT,CATEGORY,TYPE,RCFUND,RCRSC,RCVALUE,SCREEN) ; 
  1.  ;called by ^RCRJRCOC to store the bills in the AR DEBT COLLECTOR DATA (430.7) file.
  1.  ; BILLDA - IEN of 430
  1.  ; DATEBEG - Beginning date of accounting month
  1.  ; DATEEND - Ending date of accouting month
  1.  ; ARACTDT - Date account activitated
  1.  ; CATEGORY - Category of bill (pointer)
  1.  ; TYPE - FMS Document Type (include SV or whatever)
  1.  ; RCFUND - Fund
  1.  ; RCRSC - Revenue Source Code
  1.  ; RCVALUE - value of bill prin ^ int ^ admin ^ mf ^ cc
  1.  ; SCREEN - data from OIG routine needs to be screened
  1.  ; 
  1.  N RCREPORT,RCDR,RCZERO,RCLIST,DIE,DR,DA,X,Y,RCDA,RCSTAT
  1.  ;
  1.  Q:'$G(DATEBEG)!('$G(DATEEND))!('$G(BILLDA))
  1.  S RCSTAT=$P(^PRCA(430,BILLDA,0),"^",8)
  1.  I $G(SCREEN) Q:RCSTAT'=16&(RCSTAT'=40)  ; only active and suspended
  1.  ;
  1.  ; Add .01 top file level entry if it doesn't exist
  1.  S RCREPORT=$O(^PRCA(430.7,"B",$E(DATEEND,1,5)_"00",0)) I 'RCREPORT D
  1.  . N DO,DIC,X,Y,RCKEEP,RCPURGE
  1.  . S DIC="^PRCA(430.7,",DIC(0)="",X=$E(DATEEND,1,5)_"00"
  1.  . S DIC("DR")=.02_"////"_DATEBEG_";.03////"_DATEEND
  1.  . D FILE^DICN
  1.  . S RCREPORT=+Y
  1.  . ; purge any reports more than 3 months old
  1.  . S RCKEEP=$E($$FMADD^XLFDT(DATEEND,-65),1,5)_"00",RCPURGE=0
  1.  . F  S RCPURGE=$O(^PRCA(430.7,"B",RCPURGE)) Q:'RCPURGE!(RCPURGE'<RCKEEP)  D
  1.  .. N DIK,DA
  1.  .. S DIK="^PRCA(430.7,",DA=$O(^PRCA(430.7,"B",RCPURGE,0))
  1.  .. D ^DIK
  1.  ; update last date
  1.  S DIE="^PRCA(430.7,",DA=RCREPORT,DR=".04////"_$$NOW^XLFDT D ^DIE
  1.  ;
  1.  ; determine data for the bill
  1.  S RCDR(.02)=ARACTDT ; date bill activitated
  1.  S RCDR(.03)=CATEGORY ; AR Cateogry
  1.  S RCDR(.04)=RCSTAT ; AR Status
  1.  S:TYPE'="" RCDR(.05)=TYPE ; fms type
  1.  S RCDR(.06)=RCFUND ; Fund Type
  1.  S RCDR(.07)=RCRSC ; Revenue Source Code
  1.  S RCDR(.08)=+RCVALUE ; Principal Amount
  1.  S RCDR(.09)=RCVALUE+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5) ; Current Balance
  1.  ;
  1.  ; Check for new or update entry
  1.  S RCDA=$O(^PRCA(430.7,RCREPORT,1,"B",BILLDA,0))
  1.  I 'RCDA D  Q
  1.  . ; add new entry
  1.  . N DO,DIC,X,Y,DA
  1.  . S DIC="^PRCA(430.7,"_RCREPORT_",1,",DIC(0)="",DA(1)=RCREPORT,X=BILLDA
  1.  . S DIC("DR")="",X=0
  1.  . F  S X=$O(RCDR(X)) Q:'X  S DIC("DR")=DIC("DR")_X_"////"_RCDR(X)_";"
  1.  . S DIC("DR")=$E(DIC("DR"),1,$L(DIC("DR"))-1)
  1.  . S X=BILLDA
  1.  . D FILE^DICN
  1.  ;
  1.  ; update entry (if it already exited)
  1.  S DIE="^PRCA(430.7,"_RCREPORT_",1,",DA=RCDA,DA(1)=RCREPORT
  1.  S DR="",X=0
  1.  F  S X=$O(RCDR(X)) Q:'X  S DR=DR_X_"////"_RCDR(X)_";"
  1.  S DR=$E(DR,1,$L(DR)-1) D:'$G(SCREEN) ^DIE
  1.  Q
  1.  ;
  1. EN ; option entry point to run the report
  1.  N RCREPORT,EXCEL,RCPROMPT,X,Y,DTOUT,DUOUT,DIR,ZTDESC,ZTSAVE,ZTRTN,ZTSK
  1.  ;
  1.  W !,"Select which accounting month/year for the ARDC Report"
  1.  S DIC="^PRCA(430.7,",DIC(0)="AEMNQ" D ^DIC Q:Y<1
  1.  S RCREPORT=+Y
  1.  S EXCEL=0,RCPROMPT="CAPTURE Report data to an Excel Document?",DIR(0)="Y",DIR("?")="^D HEXC^RCRJRCOU"
  1.  S EXCEL=$$SELECT^RCTCSJR(RCPROMPT,"NO") I "01"'[EXCEL Q
  1.  I EXCEL=1 D EXCMSG^RCTCSJR ; Display Excel display message
  1.  I 'EXCEL W !!,"This report requires 132 characters",!
  1.  K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  .S ZTDESC="ARDC Detail Report",ZTRTN="DQQ^RCRJRCOU"
  1.  .S (ZTSAVE("RC*"),ZTSAVE("EXCEL"))="",ZTSAVE("ZTREQ")="@"
  1.  .D ^%ZTLOAD,HOME^%ZIS S QUIT=1
  1.  ;
  1. DQQ ; Print the report
  1.  N XMNOW,PAGE,RCOUT,RCREC,RCSP
  1.  S XMNOW=$$NOW^XLFDT  ;Capture the date and time the report was started for the header
  1.  S (RCOUT,PAGE)=0
  1.  S RCREC=0 F  S RCREC=$O(^PRCA(430.7,RCREPORT,1,RCREC)) Q:'RCREC!(RCOUT)  D
  1.  . N RCARRAY
  1.  . I PAGE<1 D HDR
  1.  . I 'EXCEL,$Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
  1.  .. I $D(DTOUT)!($D(DUOUT)) S RCOUT=1 G EXIT
  1.  .. D HDR
  1.  . Q:RCOUT
  1.  . ; extract data from file in external form
  1.  . D GETS^DIQ(430.71,RCREC_","_RCREPORT_",","*","","RCARRAY")
  1.  . S RCSP="0^14^26^50^68^75^84^92^104"
  1.  . W ! F X=.01:.01:.09 D
  1.  .. W:'EXCEL @("?"_$P(RCSP,"^",X*100))
  1.  .. S Y=$S(X=.03:20,X=.04:15,1:999)
  1.  .. W $E($G(RCARRAY(430.71,RCREC_","_RCREPORT_",",X)),1,Y)
  1.  .. I EXCEL,X'=.09 W "^"
  1.  ;
  1.  Q
  1.  ;