RCDPRTP0 ;ALB/LDB - CLAIMS MATCHING REPORT ;5/24/00 10:48 AM
;;4.5;Accounts Receivable;**151,315,339,338**;Mar 20, 1995;Build 69
;;Per VA Directive 6402, this routine should not be modified.
;
PAT ;find patient bills
S RCNAM=$$NAM^RCFN01(RCDEBT)
S RCSSN=$$SSN^RCFN01(RCDEBT)
S RCBIL=0 F S RCBIL=$O(^PRCA(430,"E",RCDFN,RCBIL)) Q:'RCBIL D
.I '$$SCRNARCT^RCDPRTP($P($G(^PRCA(430,+RCBIL,0)),"^",2)) Q
.S RCPAY=0 F S RCPAY=$O(^PRCA(433,"C",RCBIL,RCPAY)) Q:'RCPAY D
..S RCPAY1=$G(^PRCA(433,+RCPAY,1)) Q:RCPAY1=""
..I "^2^34^"[("^"_$P(RCPAY1,"^",2)_"^"),($P(RCPAY1,"^",9)'<DATESTRT),($P(RCPAY1,"^",9)<(DATEEND_".999999")) D
...S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
...S RCTYPE=$$TYP^IBRFN(RCBIL) ; added care type - 315
...S RCTYPE=$S(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
...I $D(RCTYPE(RCTYPE)) D Q:'RCTYPE
....S ^TMP("RCDPRTPB",$J,RCNAM)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
....S ^TMP("RCDPRTPB",$J,RCNAM,RCBIL)=$P($P(RCPAY1,"^",9),".")
....K DFN,VA,VADM,VAEL,VAERR
K RCDFN,RCDEBT
Q
;
DATE ;find third party bills by date of payments
N RCDFN,RCDEBT
F RCTYP=2,34 S DAT=$$FMADD^XLFDT(DATESTRT,-1)_".999999" F S DAT=$O(^PRCA(433,"AT",RCTYP,DAT)) Q:'DAT!(DAT>(DATEEND_".999999")) D
.S RCPAY=0 F S RCPAY=$O(^PRCA(433,"AT",RCTYP,DAT,RCPAY)) Q:'RCPAY D
..S RCBIL=$P($G(^PRCA(433,+RCPAY,0)),"^",2)
..S RCBIL0=$G(^PRCA(430,+RCBIL,0)) Q:RCBIL0=""
..Q:'$$SCRNARCT^RCDPRTP($P(RCBIL0,"^",2)) ;PRCA*4.5*338
..S RCDFN=$P(RCBIL0,"^",7)
..S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
..S RCNAM=$$NAM^RCFN01(RCDEBT)
..S RCSSN=$$SSN^RCFN01(RCDEBT)
..S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
..S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
..S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P(DAT,".")
..K DFN,VA,VADM,VAEL,VAERR
Q
;
TYPE ;find third party bills by care type PRCA*4.5*315
N RCDFN,RCDEBT,RCTYP
F RCTYP=2,34 S DAT=$$FMADD^XLFDT(DATESTRT,-1)_".999999" F S DAT=$O(^PRCA(433,"AT",RCTYP,DAT)) Q:'DAT!(DAT>(DATEEND_".999999")) D
.S RCPAY=0 F S RCPAY=$O(^PRCA(433,"AT",RCTYP,DAT,RCPAY)) Q:'RCPAY D
..S RCBIL=$P($G(^PRCA(433,+RCPAY,0)),"^",2)
..S RCBIL0=$G(^PRCA(430,+RCBIL,0)) Q:RCBIL0=""
..Q:'$$SCRNARCT^RCDPRTP($P(RCBIL0,"^",2)) ;PRCA*4.5*338
..S RCDFN=$P(RCBIL0,"^",7)
..S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
..S RCNAM=$$NAM^RCFN01(RCDEBT)
..S RCSSN=$$SSN^RCFN01(RCDEBT)
..S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
..S RCTYPE=$$TYP^IBRFN(RCBIL)
..S RCTYPE=$S(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
..I $D(RCTYPE(RCTYPE)) D Q:'RCTYPE
...S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
...S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P(DAT,".")
...K DFN,VA,VADM,VAEL,VAERR
Q
BILL ;set TMP array
S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
S RCNAM=$$NAM^RCFN01(RCDEBT)
S RCSSN=$$SSN^RCFN01(RCDEBT)
S DFN=+$G(^RCD(340,RCDEBT,0))
D DEM^VADPT,ELIG^VADPT
S RCTP=0 F S RCTP=$O(^PRCA(433,"C",RCBILL,RCTP)) Q:'RCTP I "^2^34^"[("^"_$P($G(^PRCA(433,+RCTP,1)),"^",2)_"^") S RCTP(0)=$P($P($G(^PRCA(433,+RCTP,1)),"^",9),".")
S ^TMP("RCDPRTPB",$J,RCNAM)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
S ^TMP("RCDPRTPB",$J,RCNAM,RCBILL)=RCTP
K DFN,VA,VADM,VAEL,VAERR,RCBILL,RCTP
Q
;
REC ;find receipt payments
N RCDEBT,RCDFN,RCREC1,RCPAY1,RCBIL,RCBIL0,RCDFN,RCDEBT,RCSSN
S RCREC1=0 F S RCREC1=$O(^PRCA(433,"AF",RCPT,RCREC1)) Q:'RCREC1 D
.S RCPAY1=$G(^PRCA(433,+RCREC1,1)) Q:RCPAY1=""
.S RCBIL=0 I "^2^34^"[("^"_$P(RCPAY1,"^",2)_"^") S RCBIL=$P($G(^PRCA(433,+RCREC1,0)),"^",2)
.Q:'RCBIL
.S RCBIL0=$G(^PRCA(430,+RCBIL,0))
.Q:'$$SCRNARCT^RCDPRTP($P(RCBIL0,"^",2)) ;PRCA*4.5*338
.S RCDFN=$P(RCBIL0,"^",7) Q:'RCDFN
.S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0)) Q:'RCDEBT
.S RCSSN=$$SSN^RCFN01(RCDEBT)
.S RCNAM=$$NAM^RCFN01(RCDEBT)
.S DFN=RCDFN D DEM^VADPT,ELIG^VADPT
.S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT)=$P($G(VADM(3)),"^",2)_"^"_$P($G(VAEL(1)),"^",2)_"^"_RCSSN
.K DFN,VA,VADM,VAEL,VAERR
.S ^TMP("RCDPRTPB",$J,RCNAM_"^"_RCDEBT,RCBIL)=$P($P($G(^PRCA(433,+RCREC1,1)),"^",9),".")
Q
;
TYPEPIC(RCTYPE) ; function for user selection of care types PRCA*4.5*315
; RCTYPE is an output array, pass by reference
; RCTYPE(type)="" where type can be (I)npatient, (O)utpatient,(P)rosthetics or (R)x (Prescription)
; Function value is 1 if at least 1 care type was selected, 0 otherwise
; User can select one, all or a combination of care types.
;
N DIR,X,Y,OK,DTOUT,DUOUT,DIRUT,DIROUT,RC
K RCTYPE
S OK=1 ; all OK default
S DIR(0)="S"
S RC=";I:Inpatient"
S RC=RC_";O:Outpatient"
S RC=RC_";P:Prosthetic"
S RC=RC_";R:Prescription"
S RC=RC_";ALL:All"
S $P(DIR(0),U,2)=RC,DIR("B")="ALL"
S DIR("A")="Select a Care Type"
W ! D ^DIR K DIR
I (Y["A") D Q ; all types selected so set & quit
. F X="I","O","P","R" S RCTYPE(X)=""
. Q
I $D(DIRUT)!(Y="") Q
S X=$$UP^XLFSTR(X)
S RCTYPE(X)="" ; Toggle back on
; Select another type
I (Y'["A") F D Q:X=""!(RCQUIT)
. I ($G(DIRUT)'="") S OK=0,RCQUIT=1 Q
. S DIR(0)="SBO^I:Inpatient;O:Outpatient;P:Prosthetic;R:Prescription"
. S DIR("A")="Select another Care Type" D ^DIR K DIR
. I $G(DUOUT) W !!,"User exited with '^', quitting",! S RCQUIT=1 Q
. I $D(DIRUT) S OK=0 Q
. I (X="") Q
. S X=$$UP^XLFSTR(X)
. S RCTYPE(X)=""
. Q
I $D(DUOUT)!$D(DTOUT) S OK=0 ; exit if "^" or time-out
I '$D(RCTYPE) S OK=0 W $C(7)
Q OK
;
FORMAT(RCEXCEL) ; capture the report format from the user (normal or CSV output) PRCA*4.5*315
; RCEXCEL=0 for normal output
; RCEXCEL=1 (^ separated values) for Excel output
; pass parameter by reference
;
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S RCEXCEL=0
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("B")="NO"
S DIR(0)="Y"
S DIR("?",1)="If you want to capture the output from this report in a ^-separated"
S DIR("?",2)="values (Excel) format, then answer YES here."
S DIR("?",3)=" "
S DIR("?")="If you just want a normal report output, then answer NO here."
W ! D ^DIR K DIR
I $D(DIRUT) S RCQUIT=1 Q 0 ; get out
S RCEXCEL=Y
Q RCEXCEL
;
DEVICE ; Device Selection for Excel output PRCA*4.5*315
; RCEXCEL=1 for Excel ('^' separated values) output
;
N ZTRTN,ZTDESC,ZTSAVE,POP,ZTSK,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
D EXMSG
;
S ZTRTN="PRINT^RCDPRTEX"
S ZTDESC="Claims Matching Excel Report"
S ZTSAVE("DATEEND")="",ZTSAVE("DATESTRT")="",ZTSAVE("RCQUIT")="",ZTSAVE("RCSORT")="",ZTSAVE("RCEXCEL")=""
S ZTSAVE("RCAN")="",ZTSAVE("ZTREQ")="@",ZTSAVE("^TMP(""RCDPRTPB"",$J,")=""
I RCSORT=1 S ZTSAVE("RCDEBT")="",ZTSAVE("RCDFN")="",ZTSAVE("RCTYPE*")=""
I RCSORT=2 S ZTSAVE("RCBILL")="",ZTSAVE("RCDFN")="",ZTSAVE("RCDEBT")=""
I RCSORT=4 S ZTSAVE("RCPT")=""
I RCSORT=5 S ZTSAVE("RCTYPE*")="",ZTSAVE("DATE*")=""
;
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1) Q:POP
I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
Q
;
EXMSG ; - Displays the message about capturing to an Excel file format
;
W !!?5,"This report may take a while to run. It is recommended that you Queue it."
W !!?5,"To capture as an Excel format, it is recommended that you queue this"
W !?5,"report to a spool device with margins of 256 and page length of 99999"
W !?5,"(e.g. spoolname;256;99999). This should help avoid wrapping problems."
W !!?5,"Another method would be to set up your terminal to capture the detail"
W !?5,"report data. On some terminals, this can be done by clicking on the"
W !?5,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
W !?5,"Desktop. To avoid undesired wrapping of the data saved to the file,"
W !?5,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRTP0 7933 printed Nov 22, 2024@16:56:36 Page 2
RCDPRTP0 ;ALB/LDB - CLAIMS MATCHING REPORT ;5/24/00 10:48 AM
+1 ;;4.5;Accounts Receivable;**151,315,339,338**;Mar 20, 1995;Build 69
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PAT ;find patient bills
+1 SET RCNAM=$$NAM^RCFN01(RCDEBT)
+2 SET RCSSN=$$SSN^RCFN01(RCDEBT)
+3 SET RCBIL=0
FOR
SET RCBIL=$ORDER(^PRCA(430,"E",RCDFN,RCBIL))
if 'RCBIL
QUIT
Begin DoDot:1
+4 IF '$$SCRNARCT^RCDPRTP($PIECE($GET(^PRCA(430,+RCBIL,0)),"^",2))
QUIT
+5 SET RCPAY=0
FOR
SET RCPAY=$ORDER(^PRCA(433,"C",RCBIL,RCPAY))
if 'RCPAY
QUIT
Begin DoDot:2
+6 SET RCPAY1=$GET(^PRCA(433,+RCPAY,1))
if RCPAY1=""
QUIT
+7 IF "^2^34^"[("^"_$PIECE(RCPAY1,"^",2)_"^")
IF ($PIECE(RCPAY1,"^",9)'<DATESTRT)
IF ($PIECE(RCPAY1,"^",9)<(DATEEND_".999999"))
Begin DoDot:3
+8 SET DFN=RCDFN
DO DEM^VADPT
DO ELIG^VADPT
+9 ; added care type - 315
SET RCTYPE=$$TYP^IBRFN(RCBIL)
+10 SET RCTYPE=$SELECT(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
+11 IF $DATA(RCTYPE(RCTYPE))
Begin DoDot:4
+12 SET ^TMP("RCDPRTPB",$JOB,RCNAM)=$PIECE($GET(VADM(3)),"^",2)_"^"_$PIECE($GET(VAEL(1)),"^",2)_"^"_RCSSN
+13 SET ^TMP("RCDPRTPB",$JOB,RCNAM,RCBIL)=$PIECE($PIECE(RCPAY1,"^",9),".")
+14 KILL DFN,VA,VADM,VAEL,VAERR
End DoDot:4
if 'RCTYPE
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL RCDFN,RCDEBT
+16 QUIT
+17 ;
DATE ;find third party bills by date of payments
+1 NEW RCDFN,RCDEBT
+2 FOR RCTYP=2,34
SET DAT=$$FMADD^XLFDT(DATESTRT,-1)_".999999"
FOR
SET DAT=$ORDER(^PRCA(433,"AT",RCTYP,DAT))
if 'DAT!(DAT>(DATEEND_".999999"))
QUIT
Begin DoDot:1
+3 SET RCPAY=0
FOR
SET RCPAY=$ORDER(^PRCA(433,"AT",RCTYP,DAT,RCPAY))
if 'RCPAY
QUIT
Begin DoDot:2
+4 SET RCBIL=$PIECE($GET(^PRCA(433,+RCPAY,0)),"^",2)
+5 SET RCBIL0=$GET(^PRCA(430,+RCBIL,0))
if RCBIL0=""
QUIT
+6 ;PRCA*4.5*338
if '$$SCRNARCT^RCDPRTP($PIECE(RCBIL0,"^",2))
QUIT
+7 SET RCDFN=$PIECE(RCBIL0,"^",7)
+8 SET RCDEBT=$ORDER(^RCD(340,"B",RCDFN_";DPT(",0))
if 'RCDEBT
QUIT
+9 SET RCNAM=$$NAM^RCFN01(RCDEBT)
+10 SET RCSSN=$$SSN^RCFN01(RCDEBT)
+11 SET DFN=RCDFN
DO DEM^VADPT
DO ELIG^VADPT
+12 SET ^TMP("RCDPRTPB",$JOB,RCNAM_"^"_RCDEBT)=$PIECE($GET(VADM(3)),"^",2)_"^"_$PIECE($GET(VAEL(1)),"^",2)_"^"_RCSSN
+13 SET ^TMP("RCDPRTPB",$JOB,RCNAM_"^"_RCDEBT,RCBIL)=$PIECE(DAT,".")
+14 KILL DFN,VA,VADM,VAEL,VAERR
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
TYPE ;find third party bills by care type PRCA*4.5*315
+1 NEW RCDFN,RCDEBT,RCTYP
+2 FOR RCTYP=2,34
SET DAT=$$FMADD^XLFDT(DATESTRT,-1)_".999999"
FOR
SET DAT=$ORDER(^PRCA(433,"AT",RCTYP,DAT))
if 'DAT!(DAT>(DATEEND_".999999"))
QUIT
Begin DoDot:1
+3 SET RCPAY=0
FOR
SET RCPAY=$ORDER(^PRCA(433,"AT",RCTYP,DAT,RCPAY))
if 'RCPAY
QUIT
Begin DoDot:2
+4 SET RCBIL=$PIECE($GET(^PRCA(433,+RCPAY,0)),"^",2)
+5 SET RCBIL0=$GET(^PRCA(430,+RCBIL,0))
if RCBIL0=""
QUIT
+6 ;PRCA*4.5*338
if '$$SCRNARCT^RCDPRTP($PIECE(RCBIL0,"^",2))
QUIT
+7 SET RCDFN=$PIECE(RCBIL0,"^",7)
+8 SET RCDEBT=$ORDER(^RCD(340,"B",RCDFN_";DPT(",0))
if 'RCDEBT
QUIT
+9 SET RCNAM=$$NAM^RCFN01(RCDEBT)
+10 SET RCSSN=$$SSN^RCFN01(RCDEBT)
+11 SET DFN=RCDFN
DO DEM^VADPT
DO ELIG^VADPT
+12 SET RCTYPE=$$TYP^IBRFN(RCBIL)
+13 SET RCTYPE=$SELECT(RCTYPE="":-1,RCTYPE="PR":"P",RCTYPE="PH":"R",1:RCTYPE)
+14 IF $DATA(RCTYPE(RCTYPE))
Begin DoDot:3
+15 SET ^TMP("RCDPRTPB",$JOB,RCNAM_"^"_RCDEBT)=$PIECE($GET(VADM(3)),"^",2)_"^"_$PIECE($GET(VAEL(1)),"^",2)_"^"_RCSSN
+16 SET ^TMP("RCDPRTPB",$JOB,RCNAM_"^"_RCDEBT,RCBIL)=$PIECE(DAT,".")
+17 KILL DFN,VA,VADM,VAEL,VAERR
End DoDot:3
if 'RCTYPE
QUIT
End DoDot:2
End DoDot:1
+18 QUIT
BILL ;set TMP array
+1 SET RCDEBT=$ORDER(^RCD(340,"B",RCDFN_";DPT(",0))
if 'RCDEBT
QUIT
+2 SET RCNAM=$$NAM^RCFN01(RCDEBT)
+3 SET RCSSN=$$SSN^RCFN01(RCDEBT)
+4 SET DFN=+$GET(^RCD(340,RCDEBT,0))
+5 DO DEM^VADPT
DO ELIG^VADPT
+6 SET RCTP=0
FOR
SET RCTP=$ORDER(^PRCA(433,"C",RCBILL,RCTP))
if 'RCTP
QUIT
IF "^2^34^"[("^"_$PIECE($GET(^PRCA(433,+RCTP,1)),"^",2)_"^")
SET RCTP(0)=$PIECE($PIECE($GET(^PRCA(433,+RCTP,1)),"^",9),".")
+7 SET ^TMP("RCDPRTPB",$JOB,RCNAM)=$PIECE($GET(VADM(3)),"^",2)_"^"_$PIECE($GET(VAEL(1)),"^",2)_"^"_RCSSN
+8 SET ^TMP("RCDPRTPB",$JOB,RCNAM,RCBILL)=RCTP
+9 KILL DFN,VA,VADM,VAEL,VAERR,RCBILL,RCTP
+10 QUIT
+11 ;
REC ;find receipt payments
+1 NEW RCDEBT,RCDFN,RCREC1,RCPAY1,RCBIL,RCBIL0,RCDFN,RCDEBT,RCSSN
+2 SET RCREC1=0
FOR
SET RCREC1=$ORDER(^PRCA(433,"AF",RCPT,RCREC1))
if 'RCREC1
QUIT
Begin DoDot:1
+3 SET RCPAY1=$GET(^PRCA(433,+RCREC1,1))
if RCPAY1=""
QUIT
+4 SET RCBIL=0
IF "^2^34^"[("^"_$PIECE(RCPAY1,"^",2)_"^")
SET RCBIL=$PIECE($GET(^PRCA(433,+RCREC1,0)),"^",2)
+5 if 'RCBIL
QUIT
+6 SET RCBIL0=$GET(^PRCA(430,+RCBIL,0))
+7 ;PRCA*4.5*338
if '$$SCRNARCT^RCDPRTP($PIECE(RCBIL0,"^",2))
QUIT
+8 SET RCDFN=$PIECE(RCBIL0,"^",7)
if 'RCDFN
QUIT
+9 SET RCDEBT=$ORDER(^RCD(340,"B",RCDFN_";DPT(",0))
if 'RCDEBT
QUIT
+10 SET RCSSN=$$SSN^RCFN01(RCDEBT)
+11 SET RCNAM=$$NAM^RCFN01(RCDEBT)
+12 SET DFN=RCDFN
DO DEM^VADPT
DO ELIG^VADPT
+13 SET ^TMP("RCDPRTPB",$JOB,RCNAM_"^"_RCDEBT)=$PIECE($GET(VADM(3)),"^",2)_"^"_$PIECE($GET(VAEL(1)),"^",2)_"^"_RCSSN
+14 KILL DFN,VA,VADM,VAEL,VAERR
+15 SET ^TMP("RCDPRTPB",$JOB,RCNAM_"^"_RCDEBT,RCBIL)=$PIECE($PIECE($GET(^PRCA(433,+RCREC1,1)),"^",9),".")
End DoDot:1
+16 QUIT
+17 ;
TYPEPIC(RCTYPE) ; function for user selection of care types PRCA*4.5*315
+1 ; RCTYPE is an output array, pass by reference
+2 ; RCTYPE(type)="" where type can be (I)npatient, (O)utpatient,(P)rosthetics or (R)x (Prescription)
+3 ; Function value is 1 if at least 1 care type was selected, 0 otherwise
+4 ; User can select one, all or a combination of care types.
+5 ;
+6 NEW DIR,X,Y,OK,DTOUT,DUOUT,DIRUT,DIROUT,RC
+7 KILL RCTYPE
+8 ; all OK default
SET OK=1
+9 SET DIR(0)="S"
+10 SET RC=";I:Inpatient"
+11 SET RC=RC_";O:Outpatient"
+12 SET RC=RC_";P:Prosthetic"
+13 SET RC=RC_";R:Prescription"
+14 SET RC=RC_";ALL:All"
+15 SET $PIECE(DIR(0),U,2)=RC
SET DIR("B")="ALL"
+16 SET DIR("A")="Select a Care Type"
+17 WRITE !
DO ^DIR
KILL DIR
+18 ; all types selected so set & quit
IF (Y["A")
Begin DoDot:1
+19 FOR X="I","O","P","R"
SET RCTYPE(X)=""
+20 QUIT
End DoDot:1
QUIT
+21 IF $DATA(DIRUT)!(Y="")
QUIT
+22 SET X=$$UP^XLFSTR(X)
+23 ; Toggle back on
SET RCTYPE(X)=""
+24 ; Select another type
+25 IF (Y'["A")
FOR
Begin DoDot:1
+26 IF ($GET(DIRUT)'="")
SET OK=0
SET RCQUIT=1
QUIT
+27 SET DIR(0)="SBO^I:Inpatient;O:Outpatient;P:Prosthetic;R:Prescription"
+28 SET DIR("A")="Select another Care Type"
DO ^DIR
KILL DIR
+29 IF $GET(DUOUT)
WRITE !!,"User exited with '^', quitting",!
SET RCQUIT=1
QUIT
+30 IF $DATA(DIRUT)
SET OK=0
QUIT
+31 IF (X="")
QUIT
+32 SET X=$$UP^XLFSTR(X)
+33 SET RCTYPE(X)=""
+34 QUIT
End DoDot:1
if X=""!(RCQUIT)
QUIT
+35 ; exit if "^" or time-out
IF $DATA(DUOUT)!$DATA(DTOUT)
SET OK=0
+36 IF '$DATA(RCTYPE)
SET OK=0
WRITE $CHAR(7)
+37 QUIT OK
+38 ;
FORMAT(RCEXCEL) ; capture the report format from the user (normal or CSV output) PRCA*4.5*315
+1 ; RCEXCEL=0 for normal output
+2 ; RCEXCEL=1 (^ separated values) for Excel output
+3 ; pass parameter by reference
+4 ;
+5 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+6 SET RCEXCEL=0
+7 SET DIR("A")="Do you want to capture report data for an Excel document"
+8 SET DIR("B")="NO"
+9 SET DIR(0)="Y"
+10 SET DIR("?",1)="If you want to capture the output from this report in a ^-separated"
+11 SET DIR("?",2)="values (Excel) format, then answer YES here."
+12 SET DIR("?",3)=" "
+13 SET DIR("?")="If you just want a normal report output, then answer NO here."
+14 WRITE !
DO ^DIR
KILL DIR
+15 ; get out
IF $DATA(DIRUT)
SET RCQUIT=1
QUIT 0
+16 SET RCEXCEL=Y
+17 QUIT RCEXCEL
+18 ;
DEVICE ; Device Selection for Excel output PRCA*4.5*315
+1 ; RCEXCEL=1 for Excel ('^' separated values) output
+2 ;
+3 NEW ZTRTN,ZTDESC,ZTSAVE,POP,ZTSK,DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
+4 DO EXMSG
+5 ;
+6 SET ZTRTN="PRINT^RCDPRTEX"
+7 SET ZTDESC="Claims Matching Excel Report"
+8 SET ZTSAVE("DATEEND")=""
SET ZTSAVE("DATESTRT")=""
SET ZTSAVE("RCQUIT")=""
SET ZTSAVE("RCSORT")=""
SET ZTSAVE("RCEXCEL")=""
+9 SET ZTSAVE("RCAN")=""
SET ZTSAVE("ZTREQ")="@"
SET ZTSAVE("^TMP(""RCDPRTPB"",$J,")=""
+10 IF RCSORT=1
SET ZTSAVE("RCDEBT")=""
SET ZTSAVE("RCDFN")=""
SET ZTSAVE("RCTYPE*")=""
+11 IF RCSORT=2
SET ZTSAVE("RCBILL")=""
SET ZTSAVE("RCDFN")=""
SET ZTSAVE("RCDEBT")=""
+12 IF RCSORT=4
SET ZTSAVE("RCPT")=""
+13 IF RCSORT=5
SET ZTSAVE("RCTYPE*")=""
SET ZTSAVE("DATE*")=""
+14 ;
+15 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
if POP
QUIT
+16 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+17 QUIT
+18 ;
EXMSG ; - Displays the message about capturing to an Excel file format
+1 ;
+2 WRITE !!?5,"This report may take a while to run. It is recommended that you Queue it."
+3 WRITE !!?5,"To capture as an Excel format, it is recommended that you queue this"
+4 WRITE !?5,"report to a spool device with margins of 256 and page length of 99999"
+5 WRITE !?5,"(e.g. spoolname;256;99999). This should help avoid wrapping problems."
+6 WRITE !!?5,"Another method would be to set up your terminal to capture the detail"
+7 WRITE !?5,"report data. On some terminals, this can be done by clicking on the"
+8 WRITE !?5,"'Tools' menu above, then click on 'Capture Incoming Data' to save to"
+9 WRITE !?5,"Desktop. To avoid undesired wrapping of the data saved to the file,"
+10 WRITE !?5,"please enter '0;256;99999' at the 'DEVICE:' prompt.",!
+11 QUIT
+12 ;
