source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSRPT6.m@ 1769

BPSRPT6 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05

 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5**;JUN 2004;Build 45

 ;;Per VHA Directive 2004-038, 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

 ;

 ;Reset Insurance

 S BP36=""

 ;

 ;First Pull From BPS Transactions

 S BPIN=+$P($G(^BPST(BP59,9)),U)

 I +BPIN S BP36=$P($G(^BPST(BP59,10,BPIN,0)),U,7) S:BP36]"" BP36="1^"_BP36

 ;

 ;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) N COL,RET

 S RET=$$BILLINFO^IBNCPDPI(BPRX,BPREF)

 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

 ;

 ;Determine Bill #

 ;

 ; Returned Value -> Bill Number

 ;

BILL(BPRX,BPREF) N BILL

 S BILL=$P($$BILLINFO^IBNCPDPI(BPRX,BPREF),U)

 Q BILL

 ;

 ;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) Q $$STATUS^BPSOSRX(BPRX,BPREF,0)

 ;

 ;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:"")