Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSRPT6

BPSRPT6.m

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