- 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 Feb 18, 2025@23:12:47 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 ;
