BPSRPT4 ;BHAM ISC/BEE - ECME REPORTS (CONT) ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,19,23,24,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL
;
; Input Variable -> DFLT = 3 NOT RELEASED
; 2 RELEASED
; 1 ALL
;
; Return Value -> 3 = NOT RELEASED
; 2 = RELEASED
; 1 = ALL
; ^ = Exit
;
SELRLNRL(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DFLT=$S($G(DFLT)=1:"ALL",$G(DFLT)=3:"NOT RELEASED",1:"RELEASED")
S DIR(0)="S^R:RELEASED;N:NOT RELEASED;A:ALL"
S DIR("A")="Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL",DIR("B")=DFLT
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^"
;
S Y=$S(Y="A":1,Y="R":2,Y="N":3,1:Y)
;
Q Y
;
SELRC(DFLT) ;
;
; Display (S)pecific Reject Codes or (A)ll
;
; Input Variable -> DFLT = ALL
;
; Return Value -> 1 = Reject Codes
; 0 = ALL
; ^ = Exit
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
;Select to include (S)pecific Reject Codes or (A)ll Reject Codes
;
S DIR(0)="S^S:Specific Reject Code;A:ALL"
S DIR("A")="Include (S)pecific Reject Code or (A)LL"
S DIR("B")="A"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" S Specific Reject Code"
S DIR("L",4)=" A ALL"
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
S Y=$S(Y="A":0,Y="S":1,1:Y)
Q Y
;
SELREJCD() ;
; Allow user to select a single or multiple REJECT CODEs.
;
; If the users selected one or more REJECT CODEs, the selection will be stored
; in BPARR("RC")separated by a comma. e.g. BPARR("RC")= ien1 , ien2
;
BPSREJCD ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
N BPARR,BPSARRAY,BPSIEN
;
S BPARR("RC")=""
;
; This tag prompts user to 'Select Reject Code' and validates it against file #9002313.93.
D RCSEL(.BPSARRAY)
;
; If the user entered "^" quit, no longer prompting the user to 'Select Reject Code'
I $G(BPSARRAY)="^" Q "^"
;
; If no Reject Code was selected, return the user to 'Include (S)pecific Reject Code or (A)LL'
I $G(BPSARRAY)=0 Q 0
;
M BPARR("RC")=BPSARRAY
;
; Creates a string of all the Reject Code ien's selected separated by a comma.
S BPSIEN=""
F S BPSIEN=$O(BPARR("RC",BPSIEN)) Q:BPSIEN="" I BPSIEN'="B" D
. I BPARR("RC")'="" S BPARR("RC")=BPARR("RC")_","
. S BPARR("RC")=BPARR("RC")_BPSIEN
. Q
;
Q BPARR("RC")
;
; Include Auto(R)eversed or (A)LL
;
; Input Variable -> DFLT = 1 AutoReversed
; 0 ALL
;
; Return Value -> 1 = AutoReversed
; 0 = ALL
; ^ = Exit
;
SELAUREV(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S DFLT=$S($G(DFLT)=1:"AutoReversed",1:"ALL")
S DIR(0)="S^R:AutoReversed;A:ALL"
S DIR("A")="Include Auto(R)eversed or (A)LL",DIR("B")=DFLT
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^"
;
S Y=$S(Y="A":0,Y="R":1,1:Y)
;
Q Y
;
; Include A(C)cepted or (R)ejected or (A)LL
;
; Input Variable -> DFLT = 2 Accepted
; 1 Rejected
; 0 ALL
;
; Return Value -> 2 = Accepted
; 1 = Rejected
; 0 = ALL
; ^ = Exit
;
SELACREJ(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
S DFLT=$S($G(DFLT)=2:"Accepted",$G(DFLT)=1:"Rejected",1:"ALL")
S DIR(0)="S^C:Accepted;R:Rejected;A:ALL"
S DIR("A")="Include A(C)cepted or (R)ejected or (A)LL",DIR("B")=DFLT
D ^DIR
;
;Check for "^", timeout, or blank entry
I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^"
;
S Y=$S(Y="C":2,Y="R":1,Y="A":0,1:Y)
;
Q Y
;
SELCCR(DFLT) ;
;
; Display (S)pecific Close Claim Reason or (A)ll
;
; Input Variable -> DFLT = ALL
;
; Return Value -> 1 = Close Claim Reasons
; 0 = ALL
; ^ = Exit
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
;Select to include (S)pecific Close Claim Reason or (A)ll Close Claim Reasons
;
S DIR(0)="S^S:Specific Close Claim Reason;A:ALL"
S DIR("A")="Include (S)pecific Close Claim Reason or (A)LL"
S DIR("B")="A"
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
S Y=$S(Y="A":0,Y="S":1,1:Y)
Q Y
;
SELCCRSN(DFLT) ;
;
; Allow user to select a single or multiple CLOSE CLAIM REASON(s).
;
; If the users selected one or more CLOSE CLAIM REASONs, the selection will be stored
; in BPARR("CCR")separated by a comma. e.g. BPARR("CCR")= ien1 , ien2
; NOTE: the ien's are pointers to CLAIMS TRACKING NON-BILLABLE REASONS (#356.8)
;
BPSCCR ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
N BPARR,BPSARRAY,BPSIEN
;
S BPARR("CCR")=""
;
; The SEL tag prompts user to 'Select Close Claim Reason' and validates the selection
; against file #356.8 - CLAIMS TRACKING NON-BILLABLE REASONS.
D CCRSEL("Close Claim Reason","^IBE(356.8,",.BPSARRAY)
;
; If the user entered "^" quit, no longer prompting the user to 'Select Close Claim Reason'
I $G(BPSARRAY)="^" Q "^"
;
; If no Close Claim Reason was selected, return the user to 'Include (S)pecific Close Claim Reason or (A)LL'
I $G(BPSARRAY)=0 Q 0
;
M BPARR("CCR")=BPSARRAY
;
; Creates a string of all the Close Claim Reasons ien's selected separated by a comma.
S BPSIEN=""
F S BPSIEN=$O(BPARR("CCR",BPSIEN)) Q:BPSIEN="" I BPSIEN'="B" D
. I BPARR("CCR")'="" S BPARR("CCR")=BPARR("CCR")_","
. S BPARR("CCR")=BPARR("CCR")_BPSIEN
. Q
;
Q BPARR("CCR")
;
RCSEL(BPSARRAY) ;
; Prompts user to select one or more Reject Codes
;
N DIC,DTOUT,DUOUT,QT,Y,X
N BPSCODE,BPSEXP
;
S DIC="^BPSF(9002313.93,",DIC(0)="AEMNQ"
S DIC("A")="Select Reject Code: "
I $G(DEFAULT)'="" S DIC("B")=DEFAULT
;
F D ^DIC Q:X="" D Q:$G(QT)
. ; Check for "^" or timeout, if found set BPSARRAY="^" and quit.
. I $D(DTOUT)!$D(DUOUT) K BPSARRAY S BPSARRAY="^",QT=1 Q
. ;
. ; If selection already exists in BPSARRAY, ask user if they
. ; want to Delete the entry.
. I $D(BPSARRAY(+Y)) D Q
. . N P
. . S P=Y ;Save Original Value
. . S DIR(0)="S^Y:YES;N:NO"
. . S DIR("A")="Delete "_$P(BPSARRAY("B",+P),U,1)_" "_$P(BPSARRAY("B",+P),U,2)_" from your list?"
. . S DIR("B")="NO"
. . D ^DIR
. . I Y="Y" K BPSARRAY(+P),BPSARRAY("B",+P)
. . ; Display a list of current selections
. . I $D(BPSARRAY) D
. . . N X
. . . W !,?2,"Selected:"
. . . S X="" F S X=$O(BPSARRAY("B",X)) Q:X="" D
. . . . W ?12,$P(BPSARRAY("B",X),U)," ",$P(BPSARRAY("B",X),U,2),!
. E D
. . ;Define new entries in BPSARRAY
. . ; Get the Reject Code and Explanation for the selected Reject Code
. . S BPSCODE=$$GET1^DIQ(9002313.93,+Y,.01)
. . S BPSEXP=$$GET1^DIQ(9002313.93,+Y,.02)
. . S BPSARRAY(+Y)=Y
. . S BPSARRAY("B",+Y)=BPSCODE_"^"_BPSEXP
. ;
. ; Display a list of current selections
. N X
. W !,?2,"Selected:"
. S X="" F S X=$O(BPSARRAY("B",X)) Q:X="" W ?12,$P(BPSARRAY("B",X),U,1)," ",$P(BPSARRAY("B",X),U,2),!
;
; If nothing was selected set BPSARRAY=0
I '$D(BPSARRAY) S BPSARRAY=0
Q
;
CCRSEL(FIELD,FILE,BPSARRAY,DEFAULT) ;
; Provides selection of one or many Close Claim Reasons.
;
N BPSARR,DIC,DTOUT,DUOUT,QT,Y,X
;
S DIC=FILE,DIC(0)="QEZAM",DIC("A")="Select "_FIELD_": "
I $G(DEFAULT)'="" S DIC("B")=DEFAULT
;
F D ^DIC Q:X="" D Q:$G(QT)
. ; Check for "^" or timeout, if found set BPSARRAY="^" and quit.
. I $D(DTOUT)!$D(DUOUT) K BPSARRAY S BPSARRAY="^",QT=1 Q
. ;
. ; If selection already exists in BPSARRAY, ask user if they
. ; want to Delete the entry
. I $D(BPSARRAY(+Y)) D Q
. . N P
. . S P=Y ;Save Original Value
. . S DIR(0)="S^Y:YES;N:NO"
. . S DIR("A")="Delete "_$P(P,U,2)_" from your list?"
. . S DIR("B")="NO"
. . D ^DIR
. . I Y="Y" K BPSARRAY(+P),BPSARRAY("B",$P(P,U,2),+P)
. . ; Display a list of current selections
. . I $D(BPSARRAY) D
. . . N X
. . . W !,?2,"Selected:"
. . . S X="" F S X=$O(BPSARRAY(X)) Q:(X="")!(X="B") W ?12,BPSARRAY(X),!
. E D
. . ;Define new entries in BPSCCR array
. . S BPSARRAY(+Y)=$P(Y,U,2)
. . S BPSARRAY("B",$P(Y,U,2),+Y)=""
. ;
. ;Display a list of current selections
. N X
. W !,?2,"Selected:"
. S X="" F S X=$O(BPSARRAY(X)) Q:(X="")!(X="B") W ?12,BPSARRAY(X),!
. K DIC("B")
;
; If nothing was selected set BPSARRAY=0
I '$D(BPSARRAY) S BPSARRAY=0
Q
;
;Pull Selected BPS Pharmacies for Display
;
; Input Variables:
; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array of internal
; pointers of selected pharmacies
; - BPLEN = The length of the display field
; Returned value -> List of selected BPS Pharmacies (possibly cut short)
;
GETDIVS(BPLEN,BPPHARM) N BPDIV,BPSTR,BPQUIT
I $G(BPPHARM)=0 S BPSTR="ALL"
E D
.S BPDIV="",BPQUIT=0,BPSTR=""
.F S BPDIV=$O(BPPHARM(BPDIV)) Q:+BPDIV=0 D Q:BPQUIT=1
.. I $L(BPSTR_$$DIVNAME^BPSSCRDS(BPDIV))>(BPLEN-4) D S BPQUIT=1 Q
... S BPSTR=$$LJ^BPSSCR02(BPSTR_",...",BPLEN)
.. S BPSTR=BPSTR_$S(BPSTR]"":", ",1:"")_$$DIVNAME^BPSSCRDS(BPDIV)
Q BPSTR
;
;Get the Reject Code
;
; Input variable -> 0 for All Reject Codes or
; lookup to BPS NCPDP REJECT CODES (#9002313.93)
; Returned value -> ALL or the selected Reject Code
;
GETREJ(REJ) ;
I REJ="0" S REJ="ALL"
E S REJ=$P($G(^BPSF(9002313.93,+REJ,0)),U,2)
Q REJ
;
;Print Header 2 Line 1
;
; Input variable: BPRTYPE -> Report Type (1-7)
;
HEADLN1(BPRTYPE) ;
I (",1,2,3,4,5,7,8,9,10,")[(","_BPRTYPE_",") W !,"PATIENT NAME",?27,"Pt.ID"
;
I (BPRTYPE=1)!(BPRTYPE=4) D Q
. W ?35,"ELIG"
. W ?40,"RX#"
. W ?52,"REF/ECME#"
. W ?73,"DATE"
. W ?83,$J("$BILLED",10)
. W ?102,$J("$INS RESPONSE",13)
. W ?122,$J("$COLLECT",10)
;
I BPRTYPE=2 D Q
. W ?35,"ELIG"
. W ?40,"RX#"
. W ?52,"REF/ECME#"
. W ?73,"DATE"
. W ?83,"RELEASED ON"
. W ?96,"RX INFO"
. W ?114,"COB"
. W ?121,"OPEN/CLOSED"
;
I BPRTYPE=3 D Q
. W ?35,"RX#"
. W ?47,"REF/ECME#"
. W ?68,"DATE"
. W ?100,$J("$BILLED",10)
. W ?119,$J("$INS RESPONSE",13)
;
I BPRTYPE=5 D Q
. W ?35,"RX#"
. W ?47,"REF/ECME#"
. W ?65,"COMPLETED"
. W ?83,"TRANS TYPE"
. W ?100,"PAYER RESPONSE"
. W ?125,"COB"
;
I BPRTYPE=6 D Q
. W !,?33,$J("AMOUNT",17)
. W ?51,$J("RETURNED",17)
. W ?69,$J("RETURNED",17)
. W ?87,$J("AMOUNT",17)
;
I BPRTYPE=7 D Q
. W ?35,"ELIG"
. W ?40,"RX#"
. W ?52,"REF/ECME#"
. W ?70,"RX INFO"
. W ?89,"DRUG"
. W ?118,"NDC"
;
I (BPRTYPE=8) D Q
. W ?35,"RX#"
. W ?47,"REF/ECME#"
. W ?68,"DATE"
. W ?78,$J("$BILLED",10)
. W ?97,$J("$INS RESPONSE",13)
. W ?122,$J("$COLLECT",10)
;
I BPRTYPE=9 D Q
. W ?35,"ELIG"
. W ?40,"RX#"
. W ?52,"REF"
. W ?64,"DATE"
. W ?84,$J("$DRUG COST",10)
;
I BPRTYPE=10 D Q
. W ?35,"ELIG"
. W ?45,"REF/ECME#"
. W ?65,"DATE"
. W ?77,$J("$BILLED",10)
. W ?90,$J("$INS RESPONSE",13)
. W ?106,$J("$COLLECT",10)
. W ?118,$J("Pt.RESP(INS)",12)
Q
;
;Print Header 2 Line 2
;
; Input variable: BPRTYPE -> Report Type (1-10)
;
HEADLN2(BPRTYPE) ;
I (BPRTYPE=1)!(BPRTYPE=4) D Q
. W !,?4,"DRUG"
. W ?36,"NDC"
. I BPRTYPE=1 W ?47,"RELEASED ON"
. W ?68,"RX INFO"
. I BPRTYPE=4 W ?92,"COB"
. I BPRTYPE=1 W ?120,"BILL#",?129,"COB"
;
I BPRTYPE=2 D Q
. W !,?3,"CARDHOLD.ID"
. W ?26,"GROUP ID"
. W ?41,$J("$BILLED",10)
. W ?54,"QTY"
. W ?61,"NDC#"
. W ?82,"PRESCRIBER ID"
. W ?98,"NAME"
;
I BPRTYPE=3 D Q
. W !,?4,"DRUG"
. W ?43,"NDC"
. W ?68,"RX INFO"
. W ?88,"COB"
. W ?96,"ELIG"
;
I BPRTYPE=5 D Q
. W !,?4,"DRUG"
. W ?32,"NDC"
. W ?47,"RX INFO"
. W ?69,"INSURANCE"
. W ?112,"ELAP TIME IN SECONDS"
;
I BPRTYPE=6 D Q
.W !,?1,"DATE"
.W ?15,$J("#CLAIMS",17)
.W ?33,$J("SUBMITTED",17)
.W ?51,$J("REJECTED",17)
.W ?69,$J("PAYABLE",17)
.W ?87,$J("TO RECEIVE",17)
.W ?115,$J("DIFFERENCE",17)
;
I BPRTYPE=7 D Q
. W !,?3,"CARDHOLD.ID"
. W ?27,"GROUP ID"
. W ?46,"CLOSE DATE/TIME"
. W ?65,"CLOSED BY"
. W ?93,"CLOSE REASON"
. W ?126,"COB"
;
I BPRTYPE=8 D Q
. W !,?2,"DRUG"
. W ?38,"RX INFO"
. W ?54,"INS GROUP#"
. W ?72,"INS GROUP NAME"
. W ?125,"BILL#"
;
I BPRTYPE=9 D Q
. W !,?4,"DRUG"
. W ?36,"NDC"
. W ?47,"RELEASED ON"
. W ?62,"RX INFO"
. W ?75,"NON-BILLABLE STATUS"
;
I BPRTYPE=10 D Q
. W !,?4,"DRUG"
. W ?36,"NDC"
. W ?47,"RELEASED ON"
. W ?68,"RX INFO"
. W ?94,"BILL#"
. W ?112,"COB"
. W ?119,"STATUS"
Q
;
;Print Header 2 Line 3
;
; Input variable: BPRTYPE -> Report Type (1-7)
;
HEADLN3(BPTYP) ;
I BPTYP=4 D Q
. W !,?6,"RELEASED ON"
. W ?22,"REVERSAL METHOD/RETURN STATUS/REASON"
;
I BPTYP=8 D Q
. W !,?4,"$PROVIDER NETWORK"
. W ?23,"$BRAND DRUG"
. W ?38,"$NON-PREF FORM"
. W ?56,"$BRAND NON-PREF FORM"
. W ?81,"$COVERAGE GAP"
. W ?96,"$HEALTH ASST"
. W ?111,"$SPEND ACCT REMAINING"
Q
;
SELEXCEL() ; - Returns whether to capture data for Excel report.
; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
;
N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
I ",1,2,3,4,"[(","_BPRTYPE_",") D
. W !!,"Data fields VA Ingredient Cost, VA Dispensing Fee, Ingredient Cost Paid,",!
. W "Dispensing Fee Paid and Patient Responsibility (INS) will only be included",!
. W "when the report is captured for an Excel document. All additional data fields",!
. W "may not be present for all reports."
I BPRTYPE=7 D
. W !!,"Data field for billed amount will only be included when the report is captured",!
. W "for an Excel document. All additional data fields may not be present for all",!
. W "reports."
I BPRTYPE=10 D
. W !!,"Data fields VA Ingredient Cost, VA Dispensing Fee, Ingredient Cost Paid",!
. W "and Dispensing Fee Paid will only be included when the report is captured",!
. W "for an Excel document. All additional data fields may not be present for all",!
. W "reports."
;
S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
S DIR("A")="Do you want to capture report data for an Excel document"
S DIR("?")="^D HEXC^BPSRPT4"
D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
K DIROUT,DTOUT,DUOUT,DIRUT
S EXCEL=0 I Y S EXCEL=1
;
;Display Excel display message
I EXCEL=1 D EXMSG
;
Q EXCEL
;
HEXC ; - 'Do you want to capture data...' prompt
W !!," Enter: 'Y' - To capture detail report data to transfer"
W !," to an Excel document"
W !," '<CR>' - To skip this option"
W !," '^' - To quit this option"
Q
;
;Display the message about capturing to an Excel file format
;
EXMSG ;
I (",1,2,3,4,7,9,")'[BPRTYPE D
. W !!?5,"Before continuing, please set up your terminal to capture the"
. W !?5,"detail report data. On some terminals, this can be done by"
. W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
. W !?5,"Incoming Data' to save to Desktop. This report may take a"
. W !?5,"while to run."
. W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
. W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
E D
. W !!?5,"Before continuing, please set up your terminal to capture the"
. W !?5,"detail report data and save the detail report data in a text file"
. W !?5,"to a local drive. This report may take a while to run."
. W !!?5,"Note: 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[HBPSRPT4 16050 printed Oct 16, 2024@17:53:32 Page 2
BPSRPT4 ;BHAM ISC/BEE - ECME REPORTS (CONT) ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,19,23,24,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL
+7 ;
+8 ; Input Variable -> DFLT = 3 NOT RELEASED
+9 ; 2 RELEASED
+10 ; 1 ALL
+11 ;
+12 ; Return Value -> 3 = NOT RELEASED
+13 ; 2 = RELEASED
+14 ; 1 = ALL
+15 ; ^ = Exit
+16 ;
SELRLNRL(DFLT) NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+1 SET DFLT=$SELECT($GET(DFLT)=1:"ALL",$GET(DFLT)=3:"NOT RELEASED",1:"RELEASED")
+2 SET DIR(0)="S^R:RELEASED;N:NOT RELEASED;A:ALL"
+3 SET DIR("A")="Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL"
SET DIR("B")=DFLT
+4 DO ^DIR
+5 ;
+6 ;Check for "^", timeout, or blank entry
+7 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET Y="^"
+8 ;
+9 SET Y=$SELECT(Y="A":1,Y="R":2,Y="N":3,1:Y)
+10 ;
+11 QUIT Y
+12 ;
SELRC(DFLT) ;
+1 ;
+2 ; Display (S)pecific Reject Codes or (A)ll
+3 ;
+4 ; Input Variable -> DFLT = ALL
+5 ;
+6 ; Return Value -> 1 = Reject Codes
+7 ; 0 = ALL
+8 ; ^ = Exit
+9 ;
+10 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+11 ;
+12 ;Select to include (S)pecific Reject Codes or (A)ll Reject Codes
+13 ;
+14 SET DIR(0)="S^S:Specific Reject Code;A:ALL"
+15 SET DIR("A")="Include (S)pecific Reject Code or (A)LL"
+16 SET DIR("B")="A"
+17 SET DIR("L",1)="Select one of the following:"
+18 SET DIR("L",2)=""
+19 SET DIR("L",3)=" S Specific Reject Code"
+20 SET DIR("L",4)=" A ALL"
+21 DO ^DIR
+22 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+23 SET Y=$SELECT(Y="A":0,Y="S":1,1:Y)
+24 QUIT Y
+25 ;
SELREJCD() ;
+1 ; Allow user to select a single or multiple REJECT CODEs.
+2 ;
+3 ; If the users selected one or more REJECT CODEs, the selection will be stored
+4 ; in BPARR("RC")separated by a comma. e.g. BPARR("RC")= ien1 , ien2
+5 ;
BPSREJCD ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 NEW BPARR,BPSARRAY,BPSIEN
+3 ;
+4 SET BPARR("RC")=""
+5 ;
+6 ; This tag prompts user to 'Select Reject Code' and validates it against file #9002313.93.
+7 DO RCSEL(.BPSARRAY)
+8 ;
+9 ; If the user entered "^" quit, no longer prompting the user to 'Select Reject Code'
+10 IF $GET(BPSARRAY)="^"
QUIT "^"
+11 ;
+12 ; If no Reject Code was selected, return the user to 'Include (S)pecific Reject Code or (A)LL'
+13 IF $GET(BPSARRAY)=0
QUIT 0
+14 ;
+15 MERGE BPARR("RC")=BPSARRAY
+16 ;
+17 ; Creates a string of all the Reject Code ien's selected separated by a comma.
+18 SET BPSIEN=""
+19 FOR
SET BPSIEN=$ORDER(BPARR("RC",BPSIEN))
if BPSIEN=""
QUIT
IF BPSIEN'="B"
Begin DoDot:1
+20 IF BPARR("RC")'=""
SET BPARR("RC")=BPARR("RC")_","
+21 SET BPARR("RC")=BPARR("RC")_BPSIEN
+22 QUIT
End DoDot:1
+23 ;
+24 QUIT BPARR("RC")
+25 ;
+26 ; Include Auto(R)eversed or (A)LL
+27 ;
+28 ; Input Variable -> DFLT = 1 AutoReversed
+29 ; 0 ALL
+30 ;
+31 ; Return Value -> 1 = AutoReversed
+32 ; 0 = ALL
+33 ; ^ = Exit
+34 ;
SELAUREV(DFLT) NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+1 ;
+2 SET DFLT=$SELECT($GET(DFLT)=1:"AutoReversed",1:"ALL")
+3 SET DIR(0)="S^R:AutoReversed;A:ALL"
+4 SET DIR("A")="Include Auto(R)eversed or (A)LL"
SET DIR("B")=DFLT
+5 DO ^DIR
+6 ;
+7 ;Check for "^", timeout, or blank entry
+8 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET Y="^"
+9 ;
+10 SET Y=$SELECT(Y="A":0,Y="R":1,1:Y)
+11 ;
+12 QUIT Y
+13 ;
+14 ; Include A(C)cepted or (R)ejected or (A)LL
+15 ;
+16 ; Input Variable -> DFLT = 2 Accepted
+17 ; 1 Rejected
+18 ; 0 ALL
+19 ;
+20 ; Return Value -> 2 = Accepted
+21 ; 1 = Rejected
+22 ; 0 = ALL
+23 ; ^ = Exit
+24 ;
SELACREJ(DFLT) NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+1 ;
+2 SET DFLT=$SELECT($GET(DFLT)=2:"Accepted",$GET(DFLT)=1:"Rejected",1:"ALL")
+3 SET DIR(0)="S^C:Accepted;R:Rejected;A:ALL"
+4 SET DIR("A")="Include A(C)cepted or (R)ejected or (A)LL"
SET DIR("B")=DFLT
+5 DO ^DIR
+6 ;
+7 ;Check for "^", timeout, or blank entry
+8 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(X)="")
SET Y="^"
+9 ;
+10 SET Y=$SELECT(Y="C":2,Y="R":1,Y="A":0,1:Y)
+11 ;
+12 QUIT Y
+13 ;
SELCCR(DFLT) ;
+1 ;
+2 ; Display (S)pecific Close Claim Reason or (A)ll
+3 ;
+4 ; Input Variable -> DFLT = ALL
+5 ;
+6 ; Return Value -> 1 = Close Claim Reasons
+7 ; 0 = ALL
+8 ; ^ = Exit
+9 ;
+10 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+11 ;
+12 ;Select to include (S)pecific Close Claim Reason or (A)ll Close Claim Reasons
+13 ;
+14 SET DIR(0)="S^S:Specific Close Claim Reason;A:ALL"
+15 SET DIR("A")="Include (S)pecific Close Claim Reason or (A)LL"
+16 SET DIR("B")="A"
+17 DO ^DIR
+18 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+19 SET Y=$SELECT(Y="A":0,Y="S":1,1:Y)
+20 QUIT Y
+21 ;
SELCCRSN(DFLT) ;
+1 ;
+2 ; Allow user to select a single or multiple CLOSE CLAIM REASON(s).
+3 ;
+4 ; If the users selected one or more CLOSE CLAIM REASONs, the selection will be stored
+5 ; in BPARR("CCR")separated by a comma. e.g. BPARR("CCR")= ien1 , ien2
+6 ; NOTE: the ien's are pointers to CLAIMS TRACKING NON-BILLABLE REASONS (#356.8)
+7 ;
BPSCCR ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 NEW BPARR,BPSARRAY,BPSIEN
+3 ;
+4 SET BPARR("CCR")=""
+5 ;
+6 ; The SEL tag prompts user to 'Select Close Claim Reason' and validates the selection
+7 ; against file #356.8 - CLAIMS TRACKING NON-BILLABLE REASONS.
+8 DO CCRSEL("Close Claim Reason","^IBE(356.8,",.BPSARRAY)
+9 ;
+10 ; If the user entered "^" quit, no longer prompting the user to 'Select Close Claim Reason'
+11 IF $GET(BPSARRAY)="^"
QUIT "^"
+12 ;
+13 ; If no Close Claim Reason was selected, return the user to 'Include (S)pecific Close Claim Reason or (A)LL'
+14 IF $GET(BPSARRAY)=0
QUIT 0
+15 ;
+16 MERGE BPARR("CCR")=BPSARRAY
+17 ;
+18 ; Creates a string of all the Close Claim Reasons ien's selected separated by a comma.
+19 SET BPSIEN=""
+20 FOR
SET BPSIEN=$ORDER(BPARR("CCR",BPSIEN))
if BPSIEN=""
QUIT
IF BPSIEN'="B"
Begin DoDot:1
+21 IF BPARR("CCR")'=""
SET BPARR("CCR")=BPARR("CCR")_","
+22 SET BPARR("CCR")=BPARR("CCR")_BPSIEN
+23 QUIT
End DoDot:1
+24 ;
+25 QUIT BPARR("CCR")
+26 ;
RCSEL(BPSARRAY) ;
+1 ; Prompts user to select one or more Reject Codes
+2 ;
+3 NEW DIC,DTOUT,DUOUT,QT,Y,X
+4 NEW BPSCODE,BPSEXP
+5 ;
+6 SET DIC="^BPSF(9002313.93,"
SET DIC(0)="AEMNQ"
+7 SET DIC("A")="Select Reject Code: "
+8 IF $GET(DEFAULT)'=""
SET DIC("B")=DEFAULT
+9 ;
+10 FOR
DO ^DIC
if X=""
QUIT
Begin DoDot:1
+11 ; Check for "^" or timeout, if found set BPSARRAY="^" and quit.
+12 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL BPSARRAY
SET BPSARRAY="^"
SET QT=1
QUIT
+13 ;
+14 ; If selection already exists in BPSARRAY, ask user if they
+15 ; want to Delete the entry.
+16 IF $DATA(BPSARRAY(+Y))
Begin DoDot:2
+17 NEW P
+18 ;Save Original Value
SET P=Y
+19 SET DIR(0)="S^Y:YES;N:NO"
+20 SET DIR("A")="Delete "_$PIECE(BPSARRAY("B",+P),U,1)_" "_$PIECE(BPSARRAY("B",+P),U,2)_" from your list?"
+21 SET DIR("B")="NO"
+22 DO ^DIR
+23 IF Y="Y"
KILL BPSARRAY(+P),BPSARRAY("B",+P)
+24 ; Display a list of current selections
+25 IF $DATA(BPSARRAY)
Begin DoDot:3
+26 NEW X
+27 WRITE !,?2,"Selected:"
+28 SET X=""
FOR
SET X=$ORDER(BPSARRAY("B",X))
if X=""
QUIT
Begin DoDot:4
+29 WRITE ?12,$PIECE(BPSARRAY("B",X),U)," ",$PIECE(BPSARRAY("B",X),U,2),!
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+30 IF '$TEST
Begin DoDot:2
+31 ;Define new entries in BPSARRAY
+32 ; Get the Reject Code and Explanation for the selected Reject Code
+33 SET BPSCODE=$$GET1^DIQ(9002313.93,+Y,.01)
+34 SET BPSEXP=$$GET1^DIQ(9002313.93,+Y,.02)
+35 SET BPSARRAY(+Y)=Y
+36 SET BPSARRAY("B",+Y)=BPSCODE_"^"_BPSEXP
End DoDot:2
+37 ;
+38 ; Display a list of current selections
+39 NEW X
+40 WRITE !,?2,"Selected:"
+41 SET X=""
FOR
SET X=$ORDER(BPSARRAY("B",X))
if X=""
QUIT
WRITE ?12,$PIECE(BPSARRAY("B",X),U,1)," ",$PIECE(BPSARRAY("B",X),U,2),!
End DoDot:1
if $GET(QT)
QUIT
+42 ;
+43 ; If nothing was selected set BPSARRAY=0
+44 IF '$DATA(BPSARRAY)
SET BPSARRAY=0
+45 QUIT
+46 ;
CCRSEL(FIELD,FILE,BPSARRAY,DEFAULT) ;
+1 ; Provides selection of one or many Close Claim Reasons.
+2 ;
+3 NEW BPSARR,DIC,DTOUT,DUOUT,QT,Y,X
+4 ;
+5 SET DIC=FILE
SET DIC(0)="QEZAM"
SET DIC("A")="Select "_FIELD_": "
+6 IF $GET(DEFAULT)'=""
SET DIC("B")=DEFAULT
+7 ;
+8 FOR
DO ^DIC
if X=""
QUIT
Begin DoDot:1
+9 ; Check for "^" or timeout, if found set BPSARRAY="^" and quit.
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL BPSARRAY
SET BPSARRAY="^"
SET QT=1
QUIT
+11 ;
+12 ; If selection already exists in BPSARRAY, ask user if they
+13 ; want to Delete the entry
+14 IF $DATA(BPSARRAY(+Y))
Begin DoDot:2
+15 NEW P
+16 ;Save Original Value
SET P=Y
+17 SET DIR(0)="S^Y:YES;N:NO"
+18 SET DIR("A")="Delete "_$PIECE(P,U,2)_" from your list?"
+19 SET DIR("B")="NO"
+20 DO ^DIR
+21 IF Y="Y"
KILL BPSARRAY(+P),BPSARRAY("B",$PIECE(P,U,2),+P)
+22 ; Display a list of current selections
+23 IF $DATA(BPSARRAY)
Begin DoDot:3
+24 NEW X
+25 WRITE !,?2,"Selected:"
+26 SET X=""
FOR
SET X=$ORDER(BPSARRAY(X))
if (X="")!(X="B")
QUIT
WRITE ?12,BPSARRAY(X),!
End DoDot:3
End DoDot:2
QUIT
+27 IF '$TEST
Begin DoDot:2
+28 ;Define new entries in BPSCCR array
+29 SET BPSARRAY(+Y)=$PIECE(Y,U,2)
+30 SET BPSARRAY("B",$PIECE(Y,U,2),+Y)=""
End DoDot:2
+31 ;
+32 ;Display a list of current selections
+33 NEW X
+34 WRITE !,?2,"Selected:"
+35 SET X=""
FOR
SET X=$ORDER(BPSARRAY(X))
if (X="")!(X="B")
QUIT
WRITE ?12,BPSARRAY(X),!
+36 KILL DIC("B")
End DoDot:1
if $GET(QT)
QUIT
+37 ;
+38 ; If nothing was selected set BPSARRAY=0
+39 IF '$DATA(BPSARRAY)
SET BPSARRAY=0
+40 QUIT
+41 ;
+42 ;Pull Selected BPS Pharmacies for Display
+43 ;
+44 ; Input Variables:
+45 ; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array of internal
+46 ; pointers of selected pharmacies
+47 ; - BPLEN = The length of the display field
+48 ; Returned value -> List of selected BPS Pharmacies (possibly cut short)
+49 ;
GETDIVS(BPLEN,BPPHARM) NEW BPDIV,BPSTR,BPQUIT
+1 IF $GET(BPPHARM)=0
SET BPSTR="ALL"
+2 IF '$TEST
Begin DoDot:1
+3 SET BPDIV=""
SET BPQUIT=0
SET BPSTR=""
+4 FOR
SET BPDIV=$ORDER(BPPHARM(BPDIV))
if +BPDIV=0
QUIT
Begin DoDot:2
+5 IF $LENGTH(BPSTR_$$DIVNAME^BPSSCRDS(BPDIV))>(BPLEN-4)
Begin DoDot:3
+6 SET BPSTR=$$LJ^BPSSCR02(BPSTR_",...",BPLEN)
End DoDot:3
SET BPQUIT=1
QUIT
+7 SET BPSTR=BPSTR_$SELECT(BPSTR]"":", ",1:"")_$$DIVNAME^BPSSCRDS(BPDIV)
End DoDot:2
if BPQUIT=1
QUIT
End DoDot:1
+8 QUIT BPSTR
+9 ;
+10 ;Get the Reject Code
+11 ;
+12 ; Input variable -> 0 for All Reject Codes or
+13 ; lookup to BPS NCPDP REJECT CODES (#9002313.93)
+14 ; Returned value -> ALL or the selected Reject Code
+15 ;
GETREJ(REJ) ;
+1 IF REJ="0"
SET REJ="ALL"
+2 IF '$TEST
SET REJ=$PIECE($GET(^BPSF(9002313.93,+REJ,0)),U,2)
+3 QUIT REJ
+4 ;
+5 ;Print Header 2 Line 1
+6 ;
+7 ; Input variable: BPRTYPE -> Report Type (1-7)
+8 ;
HEADLN1(BPRTYPE) ;
+1 IF (",1,2,3,4,5,7,8,9,10,")[(","_BPRTYPE_",")
WRITE !,"PATIENT NAME",?27,"Pt.ID"
+2 ;
+3 IF (BPRTYPE=1)!(BPRTYPE=4)
Begin DoDot:1
+4 WRITE ?35,"ELIG"
+5 WRITE ?40,"RX#"
+6 WRITE ?52,"REF/ECME#"
+7 WRITE ?73,"DATE"
+8 WRITE ?83,$JUSTIFY("$BILLED",10)
+9 WRITE ?102,$JUSTIFY("$INS RESPONSE",13)
+10 WRITE ?122,$JUSTIFY("$COLLECT",10)
End DoDot:1
QUIT
+11 ;
+12 IF BPRTYPE=2
Begin DoDot:1
+13 WRITE ?35,"ELIG"
+14 WRITE ?40,"RX#"
+15 WRITE ?52,"REF/ECME#"
+16 WRITE ?73,"DATE"
+17 WRITE ?83,"RELEASED ON"
+18 WRITE ?96,"RX INFO"
+19 WRITE ?114,"COB"
+20 WRITE ?121,"OPEN/CLOSED"
End DoDot:1
QUIT
+21 ;
+22 IF BPRTYPE=3
Begin DoDot:1
+23 WRITE ?35,"RX#"
+24 WRITE ?47,"REF/ECME#"
+25 WRITE ?68,"DATE"
+26 WRITE ?100,$JUSTIFY("$BILLED",10)
+27 WRITE ?119,$JUSTIFY("$INS RESPONSE",13)
End DoDot:1
QUIT
+28 ;
+29 IF BPRTYPE=5
Begin DoDot:1
+30 WRITE ?35,"RX#"
+31 WRITE ?47,"REF/ECME#"
+32 WRITE ?65,"COMPLETED"
+33 WRITE ?83,"TRANS TYPE"
+34 WRITE ?100,"PAYER RESPONSE"
+35 WRITE ?125,"COB"
End DoDot:1
QUIT
+36 ;
+37 IF BPRTYPE=6
Begin DoDot:1
+38 WRITE !,?33,$JUSTIFY("AMOUNT",17)
+39 WRITE ?51,$JUSTIFY("RETURNED",17)
+40 WRITE ?69,$JUSTIFY("RETURNED",17)
+41 WRITE ?87,$JUSTIFY("AMOUNT",17)
End DoDot:1
QUIT
+42 ;
+43 IF BPRTYPE=7
Begin DoDot:1
+44 WRITE ?35,"ELIG"
+45 WRITE ?40,"RX#"
+46 WRITE ?52,"REF/ECME#"
+47 WRITE ?70,"RX INFO"
+48 WRITE ?89,"DRUG"
+49 WRITE ?118,"NDC"
End DoDot:1
QUIT
+50 ;
+51 IF (BPRTYPE=8)
Begin DoDot:1
+52 WRITE ?35,"RX#"
+53 WRITE ?47,"REF/ECME#"
+54 WRITE ?68,"DATE"
+55 WRITE ?78,$JUSTIFY("$BILLED",10)
+56 WRITE ?97,$JUSTIFY("$INS RESPONSE",13)
+57 WRITE ?122,$JUSTIFY("$COLLECT",10)
End DoDot:1
QUIT
+58 ;
+59 IF BPRTYPE=9
Begin DoDot:1
+60 WRITE ?35,"ELIG"
+61 WRITE ?40,"RX#"
+62 WRITE ?52,"REF"
+63 WRITE ?64,"DATE"
+64 WRITE ?84,$JUSTIFY("$DRUG COST",10)
End DoDot:1
QUIT
+65 ;
+66 IF BPRTYPE=10
Begin DoDot:1
+67 WRITE ?35,"ELIG"
+68 WRITE ?45,"REF/ECME#"
+69 WRITE ?65,"DATE"
+70 WRITE ?77,$JUSTIFY("$BILLED",10)
+71 WRITE ?90,$JUSTIFY("$INS RESPONSE",13)
+72 WRITE ?106,$JUSTIFY("$COLLECT",10)
+73 WRITE ?118,$JUSTIFY("Pt.RESP(INS)",12)
End DoDot:1
QUIT
+74 QUIT
+75 ;
+76 ;Print Header 2 Line 2
+77 ;
+78 ; Input variable: BPRTYPE -> Report Type (1-10)
+79 ;
HEADLN2(BPRTYPE) ;
+1 IF (BPRTYPE=1)!(BPRTYPE=4)
Begin DoDot:1
+2 WRITE !,?4,"DRUG"
+3 WRITE ?36,"NDC"
+4 IF BPRTYPE=1
WRITE ?47,"RELEASED ON"
+5 WRITE ?68,"RX INFO"
+6 IF BPRTYPE=4
WRITE ?92,"COB"
+7 IF BPRTYPE=1
WRITE ?120,"BILL#",?129,"COB"
End DoDot:1
QUIT
+8 ;
+9 IF BPRTYPE=2
Begin DoDot:1
+10 WRITE !,?3,"CARDHOLD.ID"
+11 WRITE ?26,"GROUP ID"
+12 WRITE ?41,$JUSTIFY("$BILLED",10)
+13 WRITE ?54,"QTY"
+14 WRITE ?61,"NDC#"
+15 WRITE ?82,"PRESCRIBER ID"
+16 WRITE ?98,"NAME"
End DoDot:1
QUIT
+17 ;
+18 IF BPRTYPE=3
Begin DoDot:1
+19 WRITE !,?4,"DRUG"
+20 WRITE ?43,"NDC"
+21 WRITE ?68,"RX INFO"
+22 WRITE ?88,"COB"
+23 WRITE ?96,"ELIG"
End DoDot:1
QUIT
+24 ;
+25 IF BPRTYPE=5
Begin DoDot:1
+26 WRITE !,?4,"DRUG"
+27 WRITE ?32,"NDC"
+28 WRITE ?47,"RX INFO"
+29 WRITE ?69,"INSURANCE"
+30 WRITE ?112,"ELAP TIME IN SECONDS"
End DoDot:1
QUIT
+31 ;
+32 IF BPRTYPE=6
Begin DoDot:1
+33 WRITE !,?1,"DATE"
+34 WRITE ?15,$JUSTIFY("#CLAIMS",17)
+35 WRITE ?33,$JUSTIFY("SUBMITTED",17)
+36 WRITE ?51,$JUSTIFY("REJECTED",17)
+37 WRITE ?69,$JUSTIFY("PAYABLE",17)
+38 WRITE ?87,$JUSTIFY("TO RECEIVE",17)
+39 WRITE ?115,$JUSTIFY("DIFFERENCE",17)
End DoDot:1
QUIT
+40 ;
+41 IF BPRTYPE=7
Begin DoDot:1
+42 WRITE !,?3,"CARDHOLD.ID"
+43 WRITE ?27,"GROUP ID"
+44 WRITE ?46,"CLOSE DATE/TIME"
+45 WRITE ?65,"CLOSED BY"
+46 WRITE ?93,"CLOSE REASON"
+47 WRITE ?126,"COB"
End DoDot:1
QUIT
+48 ;
+49 IF BPRTYPE=8
Begin DoDot:1
+50 WRITE !,?2,"DRUG"
+51 WRITE ?38,"RX INFO"
+52 WRITE ?54,"INS GROUP#"
+53 WRITE ?72,"INS GROUP NAME"
+54 WRITE ?125,"BILL#"
End DoDot:1
QUIT
+55 ;
+56 IF BPRTYPE=9
Begin DoDot:1
+57 WRITE !,?4,"DRUG"
+58 WRITE ?36,"NDC"
+59 WRITE ?47,"RELEASED ON"
+60 WRITE ?62,"RX INFO"
+61 WRITE ?75,"NON-BILLABLE STATUS"
End DoDot:1
QUIT
+62 ;
+63 IF BPRTYPE=10
Begin DoDot:1
+64 WRITE !,?4,"DRUG"
+65 WRITE ?36,"NDC"
+66 WRITE ?47,"RELEASED ON"
+67 WRITE ?68,"RX INFO"
+68 WRITE ?94,"BILL#"
+69 WRITE ?112,"COB"
+70 WRITE ?119,"STATUS"
End DoDot:1
QUIT
+71 QUIT
+72 ;
+73 ;Print Header 2 Line 3
+74 ;
+75 ; Input variable: BPRTYPE -> Report Type (1-7)
+76 ;
HEADLN3(BPTYP) ;
+1 IF BPTYP=4
Begin DoDot:1
+2 WRITE !,?6,"RELEASED ON"
+3 WRITE ?22,"REVERSAL METHOD/RETURN STATUS/REASON"
End DoDot:1
QUIT
+4 ;
+5 IF BPTYP=8
Begin DoDot:1
+6 WRITE !,?4,"$PROVIDER NETWORK"
+7 WRITE ?23,"$BRAND DRUG"
+8 WRITE ?38,"$NON-PREF FORM"
+9 WRITE ?56,"$BRAND NON-PREF FORM"
+10 WRITE ?81,"$COVERAGE GAP"
+11 WRITE ?96,"$HEALTH ASST"
+12 WRITE ?111,"$SPEND ACCT REMAINING"
End DoDot:1
QUIT
+13 QUIT
+14 ;
SELEXCEL() ; - Returns whether to capture data for Excel report.
+1 ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
+2 ;
+3 NEW EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
+4 IF ",1,2,3,4,"[(","_BPRTYPE_",")
Begin DoDot:1
+5 WRITE !!,"Data fields VA Ingredient Cost, VA Dispensing Fee, Ingredient Cost Paid,",!
+6 WRITE "Dispensing Fee Paid and Patient Responsibility (INS) will only be included",!
+7 WRITE "when the report is captured for an Excel document. All additional data fields",!
+8 WRITE "may not be present for all reports."
End DoDot:1
+9 IF BPRTYPE=7
Begin DoDot:1
+10 WRITE !!,"Data field for billed amount will only be included when the report is captured",!
+11 WRITE "for an Excel document. All additional data fields may not be present for all",!
+12 WRITE "reports."
End DoDot:1
+13 IF BPRTYPE=10
Begin DoDot:1
+14 WRITE !!,"Data fields VA Ingredient Cost, VA Dispensing Fee, Ingredient Cost Paid",!
+15 WRITE "and Dispensing Fee Paid will only be included when the report is captured",!
+16 WRITE "for an Excel document. All additional data fields may not be present for all",!
+17 WRITE "reports."
End DoDot:1
+18 ;
+19 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("T")=DTIME
WRITE !
+20 SET DIR("A")="Do you want to capture report data for an Excel document"
+21 SET DIR("?")="^D HEXC^BPSRPT4"
+22 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT "^"
+23 KILL DIROUT,DTOUT,DUOUT,DIRUT
+24 SET EXCEL=0
IF Y
SET EXCEL=1
+25 ;
+26 ;Display Excel display message
+27 IF EXCEL=1
DO EXMSG
+28 ;
+29 QUIT EXCEL
+30 ;
HEXC ; - 'Do you want to capture data...' prompt
+1 WRITE !!," Enter: 'Y' - To capture detail report data to transfer"
+2 WRITE !," to an Excel document"
+3 WRITE !," '<CR>' - To skip this option"
+4 WRITE !," '^' - To quit this option"
+5 QUIT
+6 ;
+7 ;Display the message about capturing to an Excel file format
+8 ;
EXMSG ;
+1 IF (",1,2,3,4,7,9,")'[BPRTYPE
Begin DoDot:1
+2 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+3 WRITE !?5,"detail report data. On some terminals, this can be done by"
+4 WRITE !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
+5 WRITE !?5,"Incoming Data' to save to Desktop. This report may take a"
+6 WRITE !?5,"while to run."
+7 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the"
+8 WRITE !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+11 WRITE !?5,"detail report data and save the detail report data in a text file"
+12 WRITE !?5,"to a local drive. This report may take a while to run."
+13 WRITE !!?5,"Note: To avoid undesired wrapping of the data saved to the file,"
+14 WRITE !?5," please enter '0;256;99999' at the 'DEVICE:' prompt.",!
End DoDot:1
+15 QUIT