BPSRPT6 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,23**;JUN 2004;Build 44
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;Get the Insurance Company pointer and name
;
; Returned Value -> ptr^Insurance Company Name
;
INSNAM(BP59) N BPIN,BPDOS,BPDFN,BPSZZ,BP36,BPX,BPINAME,BPIBA,BP36IEN
;
;Reset Insurance
S BP36=""
;
;First Pull From BPS Transactions
S BPIN=+$P($G(^BPST(BP59,9)),U)
I +BPIN D
. S BPINAME=$P($G(^BPST(BP59,10,BPIN,0)),U,7)
. S BPIBA=$P($G(^BPST(BP59,10,BPIN,0)),U,1)
. S BP36IEN=$$INSPL^IBNCPDPI(BPIBA)
. S:BP36IEN]""&BPINAME]"" BP36=BP36IEN_"^"_BPINAME
;If Not Found, look up using API
I BP36="" D
.S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1
.I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1
.S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
.S BPX=$$INSUR^IBBAPI(BPDFN,BPDOS,,.BPSZZ,"1")
.S BP36=$G(BPSZZ("IBBAPI","INSUR",1,1))
;
;If Not Found, put in MISSING INSURANCE
I $TR(BP36,U)="" S BP36=" ^**MISSING INSURANCE**"
;
Q BP36
;
;Select an Insurance Company file entry (Fileman Lookup)
;
; Returned value -> Insurance Company Name
;
SELINS() N INS
S INS=$$SELINSUR^IBNCPDPI("Select Insurance","")
I $P(INS,U)=-1 S INS="^"
E S INS=$P(INS,U,2)
Q INS
;
;Get the drug name for display
;
; Input variable -> BP50 - Lookup to DRUG (#50)
; BPLEN - Length of the display field
; Returned value -> Name of the drug
;
DRGNAM(BP50,BPLEN) Q $E($$DRUGDIE^BPSUTIL1(+BP50,.01,"E"),1,BPLEN)
;
;Select a DRUG file entry (Fileman Lookup)
;
; Returned Variable -> Y
;
SELDRG N DIC S DIC(0)="QEAM",DIC=50,DIC("A")="Select Drug: "
D DRUGDIC^BPSUTIL1(.DIC)
Q
;
;Get the drug class for display
;
; Input variable -> BP50605 - Lookup to VA DRUG CLASS (#50.605)
; BPLEN - Length of the display field
; Returned value -> Name of the drug class
;
DRGCLNAM(BP50605,BPLEN) N IEN,Y
K ^TMP($J,"BPSRPT6")
S Y=""
I BP50605]"" D
.D C^PSN50P65(BP50605,"","BPSRPT6")
.S IEN=$O(^TMP($J,"BPSRPT6",0))
.I IEN]"" S Y=$E($G(^TMP($J,"BPSRPT6",IEN,1)),1,BPLEN)
K ^TMP($J,"BPSRPT6")
Q Y
;
;Select a VA DRUG CLASS file entry (Fileman Lookup)
;
SELDRGC N DIR,DIRUT,DTOUT,DUOUT,IEN,TOT,X
K ^TMP($J,"BPSRPT6")
;
F D Q:Y]""
.K ^TMP($J,"BPSRPT6"),^TMP($J,"BPSRPT6X")
.S DIR(0)="FO^1:35"
.S DIR("A")="Select Drug Class"
.S DIR("?")="Answer with VA DRUG CLASS CODE, or CLASSIFICATION. TYPE '??' FOR A LIST"
.S DIR("??")="^D DCLIST^BPSRPT6"
.D ^DIR
.I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(Y)="") S Y="^" Q
.;
.;Get list based on original user input
.D C^PSN50P65("",Y,"BPSRPT6X")
.;
.;Get list based on uppercase input
.S Y=$$UP^XLFSTR(Y)
.D C^PSN50P65("",Y,"BPSRPT6")
.;
.;Merge lists together
.M ^TMP($J,"BPSRPT6")=^TMP($J,"BPSRPT6X")
.K ^TMP($J,"BPSRPT6X")
.;
.; Reset 0 node based on combined lists
.S Y=0 F TOT=0:1 S Y=$O(^TMP($J,"BPSRPT6",Y)) Q:'+Y
.S ^TMP($J,"BPSRPT6",0)=TOT
.;
.;Check for no entries found
.I TOT<1 W " ??" S Y="" Q
.;
.;Check for Unique Entry
.I TOT=1 D Q
..S Y="",IEN=$O(^TMP($J,"BPSRPT6",0))
..I IEN]"" S Y=$G(^TMP($J,"BPSRPT6",IEN,1)) W $C(13),"Select Drug Class: ",Y
.;
.;Check for multiple entries - allow user to pick
.I TOT>1 S Y=$$DCSEL(TOT)
.I Y="^^" S Y=""
.;
Q
;
;List Entries in VA DRUG CLASS
;
DCLIST N CL,DTOUT,IEN,Y
K ^TMP($J,"BPSRPT6")
D C^PSN50P65("","??","BPSRPT6")
;
;First create new index - sorted by CLASSIFICATION
S IEN=0 F S IEN=$O(^TMP($J,"BPSRPT6",IEN)) Q:'IEN D
.S CL=$G(^TMP($J,"BPSRPT6",IEN,1)) Q:CL=""
.S ^TMP($J,"BPSRPT6","B",CL,IEN)=$G(^TMP($J,"BPSRPT6",IEN,".01"))
;
;Now loop through and display entries
S $X=0,$Y=0 W !,?3,"Choose from: ",!
S (Y,CL)="" F S CL=$O(^TMP($J,"BPSRPT6","B",CL)) Q:CL="" D Q:Y]""
.S IEN="" F S IEN=$O(^TMP($J,"BPSRPT6","B",CL,IEN)) Q:IEN="" D Q:Y]""
..W ?3,$G(^TMP($J,"BPSRPT6","B",CL,IEN)),!,?3,CL,!
..I $Y>19!'$Y D
...W ?3 R "'^' TO STOP: ",Y:$G(DTIME,300)
...E S DTOUT=1
...W $C(13),$J("",17),$C(13)
...I ($G(DTOUT)=1)!($G(Y)="^") S Y="^" Q
...S $X=0,$Y=0
;
K ^TMP($J,"BPSRPT6")
Q
;
;Allow user to pick VA DRUG CLASS entry based on initial input
;
; Input variable - TOT -> Total entries placed in ^TMP($J,"BPSRPT6")
; Returned value - VA DRUG CLASSIFICATION
;
DCSEL(TOT) N CL,DTOUT,I,IEN,IX,Y
;
;First create new index
F IX="B","N" K ^TMP($J,"BPSRPT6",IX)
S Y="",IEN=0 F S IEN=$O(^TMP($J,"BPSRPT6",IEN)) Q:'IEN D
.S CL=$G(^TMP($J,"BPSRPT6",IEN,1)) Q:CL=""
.S ^TMP($J,"BPSRPT6","B",CL,IEN)=$G(^TMP($J,"BPSRPT6",IEN,".01"))
;
;Now loop through and allow one to be picked
S (Y,CL)="" F S CL=$O(^TMP($J,"BPSRPT6","B",CL)) Q:CL="" D Q:Y]""
.S IEN="" F S IEN=$O(^TMP($J,"BPSRPT6","B",CL,IEN)) Q:IEN="" D Q:Y]""
..S I=$G(I)+1 W !,?5,I,?9,$G(^TMP($J,"BPSRPT6","B",CL,IEN)),!,?3,CL
..S ^TMP($J,"BPSRPT6","N",I)=CL
..;
..;Stop after every 5 entries
..I I#5=0 I TOT>I D Q:$G(Y)="^"!($G(Y)="^^")
...W !,"Press <RETURN> to see more, '^' to exit this list, OR"
...W !,"CHOOSE 1 - "_I R ": ",Y:DTIME S:'$T DTOUT=1
...I ($G(DTOUT)=1)!(Y="^") S Y="^^"
..;
..;Stop after last entry
..I I=TOT D
...W !,"CHOOSE 1 - "_I R ": ",Y:DTIME S:'$T DTOUT=1
..I ($G(DTOUT)=1)!(Y="^") S Y="^^"
..;
..;Check for valid entry
..I Y="^^" S Y=""
..I Y]"",'$D(^TMP($J,"BPSRPT6","N",Y)) W " ??" S Y=""
..I Y]"",$D(^TMP($J,"BPSRPT6","N",Y)) S Y=$G(^TMP($J,"BPSRPT6","N",Y))
;
Q Y
;
;Get DRUG file pointer
;
; Return Value -> n = ptr to DRUG (#50)
; 0 = Unknown
;
GETDRUG(BPRX) Q +$$RXAPI1^BPSUTIL1(BPRX,6,"I")
;
;Get VA DRUG CLASS pointer
;
; Input Variables: BP50 - ptr to DRUG (#50)
;
; Return Value -> n = ptr to VA DRUG CLASS (#50.605)
; 0 = Unknown
;
GETDRGCL(BP50) Q $$DRUGDIE^BPSUTIL1(BP50,25)
;
;Determine whether claim was Mail, Window, or CMOP
;
; Input Variables: BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
;
; Return Value -> M = Mail
; W = Window
; C = CMOP
;
MWC(BPRX,BPREF) Q $$MWC^PSOBPSU2(BPRX,BPREF)
;
;Get Patient Name
;
; Input variable -> BPDFN - ptr to PATIENT (#2)
; Returned value -> Patient Name (shortened)
;
PATNAME(BPDFN) Q $E($P($G(^DPT(BPDFN,0)),U),1,25)
;
;Get Last 4 of SSN
;
; Input variable -> BPDFN - ptr to PATIENT (#2)
; Returned value -> Last 4 digits of patient's SSN
;
SSN4(BPDFN) N X
S X=$P($G(^DPT(BPDFN,0)),U,9)
Q $E(X,$L(X)-3,$L(X))
;
;Get RX#
;
; Returned value -> RX#
;
RXNUM(BPRX) Q $$RXAPI1^BPSUTIL1(+BPRX,.01,"I")
;
;Determine $Collected
;
; Returned Value -> $Collected
;
COLLECTD(BPRX,BPREF,BPPAYSEQ) N COL,RET
S RET=$$BILLINFO^IBNCPDPI(BPRX,BPREF,BPPAYSEQ)
S COL=$P(RET,U,5) I COL="0",($P(RET,U,3)=16)!($P(RET,U,3)=27) S COL=""
I $P(RET,U,7)=1 S COL="N/A"
Q COL_U_$P(RET,U,2)
;
;Determine Bill #
;
; Returned Value -> Bill Number
;
BILL(BPRX,BPREF,BPPSEQ) ;
N BPSARR,BPSZ,IBIEN
I BPPSEQ=1 Q $P($$BILLINFO^IBNCPDPI(BPRX,BPREF,BPPSEQ),U,1)
I BPPSEQ=2 S BPSZ=$$RXBILL^IBNCPUT3(BPRX,BPREF,"S",,.BPSARR),IBIEN="" D I +IBIEN>0 Q $P($G(BPSARR(IBIEN)),U,1)
. S IBIEN=+$P(BPSZ,U,2) Q:IBIEN>0 ; get active bill first
. S IBIEN=+$O(BPSARR(999999999),-1) ; get most recent bill next
. Q
Q ""
;
;Get the Closed Claim Reason
;
; Input variable -> 0 for All Closed Claim Reasons or
; lookup to CLAIMS TRACKING NON-BILLABLE REASONS (#356.8)
; Returned value -> ALL or the selected Closed Claim Reason
;
GETCLR(RSN) ;
I RSN="0" S RSN="ALL"
E S RSN=$P($G(^IBE(356.8,+RSN,0)),U)
Q RSN
;
;Get the Closed By Person
;
; Returned Value -> Closed By Name
;
CLSBY(BP59) N BP02,CBY,Y
S BP02=+$P($G(^BPST(BP59,0)),U,4)
S CBY=+$P($G(^BPSC(BP02,900)),U,3)
S Y=$$GET1^DIQ(200,CBY_",",".01")
Q Y
;
;Get the Claim Status
;
; Input Variables: BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
;
STATUS(BPRX,BPREF,BPSEQ) Q $$STATUS^BPSOSRX(BPRX,BPREF,0,,$G(BPSEQ))
;
;Elapsed Time
;
; Returned Value -> TIME - Elapsed Processing Time
;
ELAPSE(BP59) Q $$TIMEDIFI^BPSOSUD($P($G(^BPST(BP59,0)),U,11),$P($G(^BPST(BP59,0)),U,8))
;
;Get RX issue date
;
RXISSDT(BPRX) Q +$$RXAPI1^BPSUTIL1(BPRX,1,"I")
;
;
;Get RX's fill date
RXFILDT(BPRX) Q +$$RXAPI1^BPSUTIL1(BPRX,22,"I")
;
;Get Refill's issue date
;
REFISSDT(BPRX,BPREF) Q $$REFDISDT(BPRX,BPREF)
;
;Get Refill's dispense date
;
REFDISDT(BPRX,BPREF) Q +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,10.1,"I")
;
;Get Refill's refill date
;
REFFILDT(BPRX,BPREF) Q +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,.01,"I")
;
;Get RX's release date
;
RXRELDT(BPRX) Q +$$RXAPI1^BPSUTIL1(BPRX,31,"I")
;
;Get Refill's release date
;
REFRELDT(BPRX,BPREF) Q +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,17,"I")
;
;See if refill exists
;
IFREFILL(BPRX,BPREF) Q $S(+$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,.01,"I"):1,1:0)
;
;Get RX status
;
; Input Variables -> BP59 = ptr to BPS TRANSACTIONS
;
RXSTATUS(BP59) Q $$RXST^BPSSCRU2(BP59)
;
;Return RX Quantity (From BPS TRANSACTION)
;
QTY(BP59) Q +$P($G(^BPST(BP59,5)),U,1)
;
;Return NDC Number
GETNDC(BPRX,BPREF) Q $$GETNDC^PSONDCUT(BPRX,BPREF)
;
;Return Copay Status ($)
COPAY(BPRX) Q $S(+$$RXAPI1^BPSUTIL1(BPRX,105,"I"):"$",1:"")
;
;Get Insurance BIN
;
; Input variable -> BP59 - ptr to BPS TRANS-PATIENT INSURANCE MULTIPLE (#9002313.59902)
; Returned value -> BIN
;
INSBIN(BP59) ;
N BPSBIN,BPSCIEN
;
S BPSBIN=""
; Get Claim IEN from BPS TRANS
S BPSCIEN=$$GET1^DIQ(9002313.59,BP59,3.1)
; Get BIN from BPS CLAIMS (#9002313.02)
S BPSBIN=$$GET1^DIQ(9002313.02,BPSCIEN,101)
;
Q BPSBIN
;
;Get Prescriber ID and Name
;
; Input variable -> BP59 - ptr to BPS TRANSACTIONS (#9002313.59)
; Returned value -> Prescriber ID ^ Prescriber Name
;
PRESCIN(BP59) ;
N BPSIEN,BPSPID,BPSPNM,BPSRX
;
S BPSRX=$$GET1^DIQ(9002313.59,BP59,1.11,"I")
S BPSIEN=$$GET1^DIQ(52,BPSRX,4,"I")
S BPSPNM=$$GET1^DIQ(200,BPSIEN,.01)
S BPSPID=$$GET1^DIQ(200,BPSIEN,41.99)
;
Q BPSPID_"^"_BPSPNM
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT6 10337 printed Oct 16, 2024@17:53:35 Page 2
BPSRPT6 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,23**;JUN 2004;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;Get the Insurance Company pointer and name
+7 ;
+8 ; Returned Value -> ptr^Insurance Company Name
+9 ;
INSNAM(BP59) NEW BPIN,BPDOS,BPDFN,BPSZZ,BP36,BPX,BPINAME,BPIBA,BP36IEN
+1 ;
+2 ;Reset Insurance
+3 SET BP36=""
+4 ;
+5 ;First Pull From BPS Transactions
+6 SET BPIN=+$PIECE($GET(^BPST(BP59,9)),U)
+7 IF +BPIN
Begin DoDot:1
+8 SET BPINAME=$PIECE($GET(^BPST(BP59,10,BPIN,0)),U,7)
+9 SET BPIBA=$PIECE($GET(^BPST(BP59,10,BPIN,0)),U,1)
+10 SET BP36IEN=$$INSPL^IBNCPDPI(BPIBA)
+11 if BP36IEN]""&BPINAME]""
SET BP36=BP36IEN_"^"_BPINAME
End DoDot:1
+12 ;If Not Found, look up using API
+13 IF BP36=""
Begin DoDot:1
+14 SET BPDOS=+$PIECE($GET(^BPST(BP59,12)),U,2)\1
+15 IF BPDOS=0
SET BPDOS=+$PIECE($GET(^BPST(BP59,0)),U,8)\1
+16 SET BPDFN=+$PIECE($GET(^BPST(BP59,0)),U,6)
+17 SET BPX=$$INSUR^IBBAPI(BPDFN,BPDOS,,.BPSZZ,"1")
+18 SET BP36=$GET(BPSZZ("IBBAPI","INSUR",1,1))
End DoDot:1
+19 ;
+20 ;If Not Found, put in MISSING INSURANCE
+21 IF $TRANSLATE(BP36,U)=""
SET BP36=" ^**MISSING INSURANCE**"
+22 ;
+23 QUIT BP36
+24 ;
+25 ;Select an Insurance Company file entry (Fileman Lookup)
+26 ;
+27 ; Returned value -> Insurance Company Name
+28 ;
SELINS() NEW INS
+1 SET INS=$$SELINSUR^IBNCPDPI("Select Insurance","")
+2 IF $PIECE(INS,U)=-1
SET INS="^"
+3 IF '$TEST
SET INS=$PIECE(INS,U,2)
+4 QUIT INS
+5 ;
+6 ;Get the drug name for display
+7 ;
+8 ; Input variable -> BP50 - Lookup to DRUG (#50)
+9 ; BPLEN - Length of the display field
+10 ; Returned value -> Name of the drug
+11 ;
DRGNAM(BP50,BPLEN) QUIT $EXTRACT($$DRUGDIE^BPSUTIL1(+BP50,.01,"E"),1,BPLEN)
+1 ;
+2 ;Select a DRUG file entry (Fileman Lookup)
+3 ;
+4 ; Returned Variable -> Y
+5 ;
SELDRG NEW DIC
SET DIC(0)="QEAM"
SET DIC=50
SET DIC("A")="Select Drug: "
+1 DO DRUGDIC^BPSUTIL1(.DIC)
+2 QUIT
+3 ;
+4 ;Get the drug class for display
+5 ;
+6 ; Input variable -> BP50605 - Lookup to VA DRUG CLASS (#50.605)
+7 ; BPLEN - Length of the display field
+8 ; Returned value -> Name of the drug class
+9 ;
DRGCLNAM(BP50605,BPLEN) NEW IEN,Y
+1 KILL ^TMP($JOB,"BPSRPT6")
+2 SET Y=""
+3 IF BP50605]""
Begin DoDot:1
+4 DO C^PSN50P65(BP50605,"","BPSRPT6")
+5 SET IEN=$ORDER(^TMP($JOB,"BPSRPT6",0))
+6 IF IEN]""
SET Y=$EXTRACT($GET(^TMP($JOB,"BPSRPT6",IEN,1)),1,BPLEN)
End DoDot:1
+7 KILL ^TMP($JOB,"BPSRPT6")
+8 QUIT Y
+9 ;
+10 ;Select a VA DRUG CLASS file entry (Fileman Lookup)
+11 ;
SELDRGC NEW DIR,DIRUT,DTOUT,DUOUT,IEN,TOT,X
+1 KILL ^TMP($JOB,"BPSRPT6")
+2 ;
+3 FOR
Begin DoDot:1
+4 KILL ^TMP($JOB,"BPSRPT6"),^TMP($JOB,"BPSRPT6X")
+5 SET DIR(0)="FO^1:35"
+6 SET DIR("A")="Select Drug Class"
+7 SET DIR("?")="Answer with VA DRUG CLASS CODE, or CLASSIFICATION. TYPE '??' FOR A LIST"
+8 SET DIR("??")="^D DCLIST^BPSRPT6"
+9 DO ^DIR
+10 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)!($GET(Y)="")
SET Y="^"
QUIT
+11 ;
+12 ;Get list based on original user input
+13 DO C^PSN50P65("",Y,"BPSRPT6X")
+14 ;
+15 ;Get list based on uppercase input
+16 SET Y=$$UP^XLFSTR(Y)
+17 DO C^PSN50P65("",Y,"BPSRPT6")
+18 ;
+19 ;Merge lists together
+20 MERGE ^TMP($JOB,"BPSRPT6")=^TMP($JOB,"BPSRPT6X")
+21 KILL ^TMP($JOB,"BPSRPT6X")
+22 ;
+23 ; Reset 0 node based on combined lists
+24 SET Y=0
FOR TOT=0:1
SET Y=$ORDER(^TMP($JOB,"BPSRPT6",Y))
if '+Y
QUIT
+25 SET ^TMP($JOB,"BPSRPT6",0)=TOT
+26 ;
+27 ;Check for no entries found
+28 IF TOT<1
WRITE " ??"
SET Y=""
QUIT
+29 ;
+30 ;Check for Unique Entry
+31 IF TOT=1
Begin DoDot:2
+32 SET Y=""
SET IEN=$ORDER(^TMP($JOB,"BPSRPT6",0))
+33 IF IEN]""
SET Y=$GET(^TMP($JOB,"BPSRPT6",IEN,1))
WRITE $CHAR(13),"Select Drug Class: ",Y
End DoDot:2
QUIT
+34 ;
+35 ;Check for multiple entries - allow user to pick
+36 IF TOT>1
SET Y=$$DCSEL(TOT)
+37 IF Y="^^"
SET Y=""
+38 ;
End DoDot:1
if Y]""
QUIT
+39 QUIT
+40 ;
+41 ;List Entries in VA DRUG CLASS
+42 ;
DCLIST NEW CL,DTOUT,IEN,Y
+1 KILL ^TMP($JOB,"BPSRPT6")
+2 DO C^PSN50P65("","??","BPSRPT6")
+3 ;
+4 ;First create new index - sorted by CLASSIFICATION
+5 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"BPSRPT6",IEN))
if 'IEN
QUIT
Begin DoDot:1
+6 SET CL=$GET(^TMP($JOB,"BPSRPT6",IEN,1))
if CL=""
QUIT
+7 SET ^TMP($JOB,"BPSRPT6","B",CL,IEN)=$GET(^TMP($JOB,"BPSRPT6",IEN,".01"))
End DoDot:1
+8 ;
+9 ;Now loop through and display entries
+10 SET $X=0
SET $Y=0
WRITE !,?3,"Choose from: ",!
+11 SET (Y,CL)=""
FOR
SET CL=$ORDER(^TMP($JOB,"BPSRPT6","B",CL))
if CL=""
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(^TMP($JOB,"BPSRPT6","B",CL,IEN))
if IEN=""
QUIT
Begin DoDot:2
+13 WRITE ?3,$GET(^TMP($JOB,"BPSRPT6","B",CL,IEN)),!,?3,CL,!
+14 IF $Y>19!'$Y
Begin DoDot:3
+15 WRITE ?3
READ "'^' TO STOP: ",Y:$GET(DTIME,300)
+16 IF '$TEST
SET DTOUT=1
+17 WRITE $CHAR(13),$JUSTIFY("",17),$CHAR(13)
+18 IF ($GET(DTOUT)=1)!($GET(Y)="^")
SET Y="^"
QUIT
+19 SET $X=0
SET $Y=0
End DoDot:3
End DoDot:2
if Y]""
QUIT
End DoDot:1
if Y]""
QUIT
+20 ;
+21 KILL ^TMP($JOB,"BPSRPT6")
+22 QUIT
+23 ;
+24 ;Allow user to pick VA DRUG CLASS entry based on initial input
+25 ;
+26 ; Input variable - TOT -> Total entries placed in ^TMP($J,"BPSRPT6")
+27 ; Returned value - VA DRUG CLASSIFICATION
+28 ;
DCSEL(TOT) NEW CL,DTOUT,I,IEN,IX,Y
+1 ;
+2 ;First create new index
+3 FOR IX="B","N"
KILL ^TMP($JOB,"BPSRPT6",IX)
+4 SET Y=""
SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"BPSRPT6",IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET CL=$GET(^TMP($JOB,"BPSRPT6",IEN,1))
if CL=""
QUIT
+6 SET ^TMP($JOB,"BPSRPT6","B",CL,IEN)=$GET(^TMP($JOB,"BPSRPT6",IEN,".01"))
End DoDot:1
+7 ;
+8 ;Now loop through and allow one to be picked
+9 SET (Y,CL)=""
FOR
SET CL=$ORDER(^TMP($JOB,"BPSRPT6","B",CL))
if CL=""
QUIT
Begin DoDot:1
+10 SET IEN=""
FOR
SET IEN=$ORDER(^TMP($JOB,"BPSRPT6","B",CL,IEN))
if IEN=""
QUIT
Begin DoDot:2
+11 SET I=$GET(I)+1
WRITE !,?5,I,?9,$GET(^TMP($JOB,"BPSRPT6","B",CL,IEN)),!,?3,CL
+12 SET ^TMP($JOB,"BPSRPT6","N",I)=CL
+13 ;
+14 ;Stop after every 5 entries
+15 IF I#5=0
IF TOT>I
Begin DoDot:3
+16 WRITE !,"Press <RETURN> to see more, '^' to exit this list, OR"
+17 WRITE !,"CHOOSE 1 - "_I
READ ": ",Y:DTIME
if '$TEST
SET DTOUT=1
+18 IF ($GET(DTOUT)=1)!(Y="^")
SET Y="^^"
End DoDot:3
if $GET(Y)="^"!($GET(Y)="^^")
QUIT
+19 ;
+20 ;Stop after last entry
+21 IF I=TOT
Begin DoDot:3
+22 WRITE !,"CHOOSE 1 - "_I
READ ": ",Y:DTIME
if '$TEST
SET DTOUT=1
End DoDot:3
+23 IF ($GET(DTOUT)=1)!(Y="^")
SET Y="^^"
+24 ;
+25 ;Check for valid entry
+26 IF Y="^^"
SET Y=""
+27 IF Y]""
IF '$DATA(^TMP($JOB,"BPSRPT6","N",Y))
WRITE " ??"
SET Y=""
+28 IF Y]""
IF $DATA(^TMP($JOB,"BPSRPT6","N",Y))
SET Y=$GET(^TMP($JOB,"BPSRPT6","N",Y))
End DoDot:2
if Y]""
QUIT
End DoDot:1
if Y]""
QUIT
+29 ;
+30 QUIT Y
+31 ;
+32 ;Get DRUG file pointer
+33 ;
+34 ; Return Value -> n = ptr to DRUG (#50)
+35 ; 0 = Unknown
+36 ;
GETDRUG(BPRX) QUIT +$$RXAPI1^BPSUTIL1(BPRX,6,"I")
+1 ;
+2 ;Get VA DRUG CLASS pointer
+3 ;
+4 ; Input Variables: BP50 - ptr to DRUG (#50)
+5 ;
+6 ; Return Value -> n = ptr to VA DRUG CLASS (#50.605)
+7 ; 0 = Unknown
+8 ;
GETDRGCL(BP50) QUIT $$DRUGDIE^BPSUTIL1(BP50,25)
+1 ;
+2 ;Determine whether claim was Mail, Window, or CMOP
+3 ;
+4 ; Input Variables: BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
+5 ;
+6 ; Return Value -> M = Mail
+7 ; W = Window
+8 ; C = CMOP
+9 ;
MWC(BPRX,BPREF) QUIT $$MWC^PSOBPSU2(BPRX,BPREF)
+1 ;
+2 ;Get Patient Name
+3 ;
+4 ; Input variable -> BPDFN - ptr to PATIENT (#2)
+5 ; Returned value -> Patient Name (shortened)
+6 ;
PATNAME(BPDFN) QUIT $EXTRACT($PIECE($GET(^DPT(BPDFN,0)),U),1,25)
+1 ;
+2 ;Get Last 4 of SSN
+3 ;
+4 ; Input variable -> BPDFN - ptr to PATIENT (#2)
+5 ; Returned value -> Last 4 digits of patient's SSN
+6 ;
SSN4(BPDFN) NEW X
+1 SET X=$PIECE($GET(^DPT(BPDFN,0)),U,9)
+2 QUIT $EXTRACT(X,$LENGTH(X)-3,$LENGTH(X))
+3 ;
+4 ;Get RX#
+5 ;
+6 ; Returned value -> RX#
+7 ;
RXNUM(BPRX) QUIT $$RXAPI1^BPSUTIL1(+BPRX,.01,"I")
+1 ;
+2 ;Determine $Collected
+3 ;
+4 ; Returned Value -> $Collected
+5 ;
COLLECTD(BPRX,BPREF,BPPAYSEQ) NEW COL,RET
+1 SET RET=$$BILLINFO^IBNCPDPI(BPRX,BPREF,BPPAYSEQ)
+2 SET COL=$PIECE(RET,U,5)
IF COL="0"
IF ($PIECE(RET,U,3)=16)!($PIECE(RET,U,3)=27)
SET COL=""
+3 IF $PIECE(RET,U,7)=1
SET COL="N/A"
+4 QUIT COL_U_$PIECE(RET,U,2)
+5 ;
+6 ;Determine Bill #
+7 ;
+8 ; Returned Value -> Bill Number
+9 ;
BILL(BPRX,BPREF,BPPSEQ) ;
+1 NEW BPSARR,BPSZ,IBIEN
+2 IF BPPSEQ=1
QUIT $PIECE($$BILLINFO^IBNCPDPI(BPRX,BPREF,BPPSEQ),U,1)
+3 IF BPPSEQ=2
SET BPSZ=$$RXBILL^IBNCPUT3(BPRX,BPREF,"S",,.BPSARR)
SET IBIEN=""
Begin DoDot:1
+4 ; get active bill first
SET IBIEN=+$PIECE(BPSZ,U,2)
if IBIEN>0
QUIT
+5 ; get most recent bill next
SET IBIEN=+$ORDER(BPSARR(999999999),-1)
+6 QUIT
End DoDot:1
IF +IBIEN>0
QUIT $PIECE($GET(BPSARR(IBIEN)),U,1)
+7 QUIT ""
+8 ;
+9 ;Get the Closed Claim Reason
+10 ;
+11 ; Input variable -> 0 for All Closed Claim Reasons or
+12 ; lookup to CLAIMS TRACKING NON-BILLABLE REASONS (#356.8)
+13 ; Returned value -> ALL or the selected Closed Claim Reason
+14 ;
GETCLR(RSN) ;
+1 IF RSN="0"
SET RSN="ALL"
+2 IF '$TEST
SET RSN=$PIECE($GET(^IBE(356.8,+RSN,0)),U)
+3 QUIT RSN
+4 ;
+5 ;Get the Closed By Person
+6 ;
+7 ; Returned Value -> Closed By Name
+8 ;
CLSBY(BP59) NEW BP02,CBY,Y
+1 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+2 SET CBY=+$PIECE($GET(^BPSC(BP02,900)),U,3)
+3 SET Y=$$GET1^DIQ(200,CBY_",",".01")
+4 QUIT Y
+5 ;
+6 ;Get the Claim Status
+7 ;
+8 ; Input Variables: BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
+9 ;
STATUS(BPRX,BPREF,BPSEQ) QUIT $$STATUS^BPSOSRX(BPRX,BPREF,0,,$GET(BPSEQ))
+1 ;
+2 ;Elapsed Time
+3 ;
+4 ; Returned Value -> TIME - Elapsed Processing Time
+5 ;
ELAPSE(BP59) QUIT $$TIMEDIFI^BPSOSUD($PIECE($GET(^BPST(BP59,0)),U,11),$PIECE($GET(^BPST(BP59,0)),U,8))
+1 ;
+2 ;Get RX issue date
+3 ;
RXISSDT(BPRX) QUIT +$$RXAPI1^BPSUTIL1(BPRX,1,"I")
+1 ;
+2 ;
+3 ;Get RX's fill date
RXFILDT(BPRX) QUIT +$$RXAPI1^BPSUTIL1(BPRX,22,"I")
+1 ;
+2 ;Get Refill's issue date
+3 ;
REFISSDT(BPRX,BPREF) QUIT $$REFDISDT(BPRX,BPREF)
+1 ;
+2 ;Get Refill's dispense date
+3 ;
REFDISDT(BPRX,BPREF) QUIT +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,10.1,"I")
+1 ;
+2 ;Get Refill's refill date
+3 ;
REFFILDT(BPRX,BPREF) QUIT +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,.01,"I")
+1 ;
+2 ;Get RX's release date
+3 ;
RXRELDT(BPRX) QUIT +$$RXAPI1^BPSUTIL1(BPRX,31,"I")
+1 ;
+2 ;Get Refill's release date
+3 ;
REFRELDT(BPRX,BPREF) QUIT +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,17,"I")
+1 ;
+2 ;See if refill exists
+3 ;
IFREFILL(BPRX,BPREF) QUIT $SELECT(+$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,+BPREF,.01,"I"):1,1:0)
+1 ;
+2 ;Get RX status
+3 ;
+4 ; Input Variables -> BP59 = ptr to BPS TRANSACTIONS
+5 ;
RXSTATUS(BP59) QUIT $$RXST^BPSSCRU2(BP59)
+1 ;
+2 ;Return RX Quantity (From BPS TRANSACTION)
+3 ;
QTY(BP59) QUIT +$PIECE($GET(^BPST(BP59,5)),U,1)
+1 ;
+2 ;Return NDC Number
GETNDC(BPRX,BPREF) QUIT $$GETNDC^PSONDCUT(BPRX,BPREF)
+1 ;
+2 ;Return Copay Status ($)
COPAY(BPRX) QUIT $SELECT(+$$RXAPI1^BPSUTIL1(BPRX,105,"I"):"$",1:"")
+1 ;
+2 ;Get Insurance BIN
+3 ;
+4 ; Input variable -> BP59 - ptr to BPS TRANS-PATIENT INSURANCE MULTIPLE (#9002313.59902)
+5 ; Returned value -> BIN
+6 ;
INSBIN(BP59) ;
+1 NEW BPSBIN,BPSCIEN
+2 ;
+3 SET BPSBIN=""
+4 ; Get Claim IEN from BPS TRANS
+5 SET BPSCIEN=$$GET1^DIQ(9002313.59,BP59,3.1)
+6 ; Get BIN from BPS CLAIMS (#9002313.02)
+7 SET BPSBIN=$$GET1^DIQ(9002313.02,BPSCIEN,101)
+8 ;
+9 QUIT BPSBIN
+10 ;
+11 ;Get Prescriber ID and Name
+12 ;
+13 ; Input variable -> BP59 - ptr to BPS TRANSACTIONS (#9002313.59)
+14 ; Returned value -> Prescriber ID ^ Prescriber Name
+15 ;
PRESCIN(BP59) ;
+1 NEW BPSIEN,BPSPID,BPSPNM,BPSRX
+2 ;
+3 SET BPSRX=$$GET1^DIQ(9002313.59,BP59,1.11,"I")
+4 SET BPSIEN=$$GET1^DIQ(52,BPSRX,4,"I")
+5 SET BPSPNM=$$GET1^DIQ(200,BPSIEN,.01)
+6 SET BPSPID=$$GET1^DIQ(200,BPSIEN,41.99)
+7 ;
+8 QUIT BPSPID_"^"_BPSPNM
+9 ;
