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