BPSSCRLG ;BHAM ISC/SS - ECME LOGINFO ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,15,18,20,22,24,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; -- main entry point for BPS LSTMN LOG
D EN^VALM("BPS LSTMN LOG")
Q
;
HDR ; -- header code
S VALMHDR(1)="Claim Log information"
S VALMHDR(2)=""
Q
;
INIT ; -- init variables and list array
N BPSELCLM,LINE
S BPSELCLM=$G(@VALMAR@("SELLN"))
; piece 2: patient ien #2
; piece 3: insurance ien #36
; piece 4: ptr to #9002313.59
S LINE=1
S VALMCNT=$$PREPINFO(.LINE,$P(BPSELCLM,U,2),$P(BPSELCLM,U,3),$P(BPSELCLM,U,4))
S:VALMCNT>1 VALMCNT=VALMCNT-1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
K X
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
;
LOG ;entry point for LOG menu option
N BPRET,BPSEL,BP59,BPVLM
I '$D(@(VALMAR)) Q
D FULL^VALM1
W !,"Enter the line number for which you wish to print claim logs."
S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE Rx Line.")
I BPSEL<1 S VALMBCK="R" Q
;
S BP59=$P(BPSEL,U,4)
S BPVLM=+$P(BPSEL,U,5) ; 1st line for indexes in the LM display array
;
; check for non-billable entry for claim LOG display
I $$NB^BPSSCR03(BP59) D S VALMBCK="R" Q
. W !!,$G(@VALMAR@(BPVLM,0)) ; LM display array
. W !?6,$$EREJTXT^BPSSCR03(BP59) ; eT/eC non-billable reason line
. W !,"Entry is NON BILLABLE. There is no Claim Log to display."
. D PAUSE^VALM1
. Q
;
D SAVESEL(BPSEL,VALMAR)
D EN
S VALMBCK="R"
Q
;
;save for ListManager
;BPSEL - selected line
;BPVALMR - parent VALMAR
SAVESEL(BPSEL,BPVALMR) ;
D CLEANIT
S ^TMP("BPSLOG",$J,"VALM","SELLN")=BPSEL
S ^TMP("BPSLOG",$J,"VALM","PARENT")=BPVALMR
M ^TMP("BPSLOG",$J,"VALM","VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")
Q
;
CLEANIT ;
K ^TMP("BPSLOG",$J,"VALM")
Q
;
PREPINFO(BPLN,BPDFN,BP36,BP59) ;
;input:
; BPDFN: patient ien #2
; BP36: insurance ien #36
; BP59: ptr to #9002313.59
; returns # of lines
;
; Moved to ^BPSSCRL1 for sake of space
;
Q $$PREPINFO^BPSSCRL1(BPLN,BPDFN,BP36,BP59)
;
;increments BPLINE
SETLINE(BPLINE,BPSTR) ;
D SET^VALM10(BPLINE,BPSTR)
S BPLINE=BPLINE+1
Q
;
;display claim record
DISPCLM(BPLN,BP59,BPIEN02,BP57,BPSTYPE,BPSDTALT) ;
;
; Moved to ^BPSSCRL1 for sake of space
;
D DISPCLM^BPSSCRL1
Q
;
;Submitted By User
SUBMTBY(BP57) ;
N BPIEN,BPUSR
S BPIEN=$P($G(^BPSTL(BP57,0)),U,10)
S BPUSR=$$GETUSRNM^BPSSCRU1(BPIEN)
Q $S(BPUSR']"":"UNKNOWN",1:BPUSR)
;
;Date of service
DOSCLM(BPIEN02) ;
N BPDT
S BPDT=$P($G(^BPSC(BPIEN02,401)),U,1)\1
Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4)
;
;Create date
CREATEDT(BPIEN02,BPSDTALT) ;
N BPSDT
S BPSDT=+$P($G(^BPSC(BPIEN02,0)),U,6)
Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT))
;
;Plan ID
PLANID(BP57) ;
Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,1)
;
CERTMOD(BP57) ;
Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,5)
;
;Software Vendor/Cert ID
CERTIEN(BP57) ;
Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,6)
;
;Division
DIV(BP57) ;
Q $$GET1^DIQ(9002313.57,BP57_",",11)
;
;NPI
NPI(BPIEN02) ;
Q $$GET1^DIQ(9002313.02,BPIEN02_",",201)
;
;Group ID
GRPID(BPIEN02) ;
Q $E($P($G(^BPSC(BPIEN02,300)),U,1),3,99)
;
;Group Name
GRPNM(BPSIEN02) ;
N BPSGPN
S BPSGPN=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),3)),U,1)
Q BPSGPN
;
;Cardholder ID
CRDHLDID(BPIEN02) ;
Q $E($P($G(^BPSC(BPIEN02,300)),U,2),3,99)
;
;Cardholder First name
CRDHLDFN(BPIEN02,BP57) ;
N Y
S Y=$E($P($G(^BPSC(BPIEN02,300)),U,12),3,99)
I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,6)
Q Y
;
;Cardholder Last Name
CRDHLDLN(BPIEN02,BP57) ;
N Y
S Y=$E($P($G(^BPSC(BPIEN02,300)),U,13),3,99)
I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,7)
Q Y
;
;Facility ID Qualifier - BPS*1*22
FACIDQ(BPEIN02) ;
Q $P($G(^BPSC(BPIEN02,400,1,"B90")),U,5)
;
;Patient Relationship Code
PATRELSH(BPIEN02) ;
N Y
S Y=$E($P($G(^BPSC(BPIEN02,300)),U,6),3,99)
Q $S(Y=0:"NOT SPECIFIED",Y=1:"CARDHOLDER",Y=2:"SPOUSE",Y=3:"CHILD",Y=4:"OTHER",1:Y)
;
PCN(BPIEN02) ;
Q $P($G(^BPSC(BPIEN02,100)),U,4)
;
; Get the Payer Sheet Version Number.
GETVER(BPIEN02) ;
N BPSVER
S BPSVER=$P($G(^BPSC(BPIEN02,100)),U,2)
I $G(BPSVER)]"" S BPSVER=$E(BPSVER,1)_"."_$E(BPSVER,2,99)
Q BPSVER
;
BIN(BPIEN02) ;
Q $P($G(^BPSC(BPIEN02,100)),U,1)
;
;Prescriber DEA Number
PDEA(BPIEN02) ;
Q $E($P($G(^BPSC(BPIEN02,400,1,"D00")),U,1),3,18)
;
;Total Prescribed Quantity Remaining
TOTPQR(BPIEN02) ;
N X
S X=$E($P($G(^BPSC(BPIEN02,400,1,"D00")),U,2),3,99)
Q +X
;
;insurance name by 9002313.57 pointer
INSUR57(BPIEN57) ;
N BPINSN
S BPINSN=+$G(^BPSTL(BPIEN57,9))
Q $P($G(^BPSTL(BPIEN57,10,BPINSN,0)),U,7)
;
PHPLANID(BPIEN57) ; Get the Pharmacy Plan ID from the BPS Log of Transactions file
; Input - BPSIEN57: IEN from the BPS Log of Transactions file.
I '$G(BPIEN57) Q ""
N BPINSN
S BPINSN=+$G(^BPSTL(BPIEN57,9))
Q $P($G(^BPSTL(BPIEN57,10,BPINSN,3)),U,3)
;
QTY(BPIEN02) ;
Q $E($P($G(^BPSC(BPIEN02,400,1,440)),U,2),3,99)/1000
;
;NCPDP Units
UNITS(BPIEN02) ;
I $G(BPIEN02)="" Q "( )"
N X
S X=$E($P($G(^BPSC(BPIEN02,400,1,600)),U,1),3,99)
Q $S(X="":"( )",1:"("_X_")")
;
UNTPRICE(BPIEN57) ;
I $G(BPIEN57)="" Q ""
Q +$P($G(^BPSTL(BPIEN57,5)),U,2)
;
TOTPRICE(BPIEN02) ;
I $G(BPIEN02)="" Q ""
N X
S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,30),3,99)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
BILLQTY(BPIEN57) ;
Q $P($G(^BPSTL(BPIEN57,5)),U,9)
;
BILLUNT(BPIEN57) ;
I $G(BPIEN57)="" Q "( )"
N X
S X=$P($G(^BPSTL(BPIEN57,5)),U,10)
Q $S(X="":"( )",1:"("_X_")")
;
;Ingredient Cost
INGRCST(BPIEN02) ;
I $G(BPIEN02)="" Q ""
N X
S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,9),3,99)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
;Dispensing Fee Submitted
DISPFEE(BPIEN02) ;
I $G(BPIEN02)="" Q ""
N X
S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,12),3,99)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
;U&C Charge
UCCHRG(BPIEN02) ;
I $G(BPIEN02)="" Q ""
N X
S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,26),3,99)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
;Admin Fee
ADMNFEE(BPIEN02) ;
I $G(BPIEN02)="" Q ""
N CNT,X,AF
S AF="",CNT=0 F S CNT=$O(^BPSC(BPIEN02,400,1,478.01,CNT)) Q:'CNT D
. S X=$G(^BPSC(BPIEN02,400,1,478.01,CNT,0))
. I +$E($P(X,U,2),3,4)=4 S AF=AF+$$DFF2EXT^BPSECFM($E($P(X,U,3),3,10))
Q $S(AF="":AF,1:$J(AF,0,2))
;
;get ECME pharmacy division ptr for LOG
LDIV(BPIEN57) ;
Q +$P($G(^BPSTL(BPIEN57,1)),U,7)
;
;transaction code
TRCODE(BPIEN02) ;
Q $P($G(^BPSC(BPIEN02,100)),U,3)
;
;days supply
DAYSSUPL(BPIEN02) ;
;format D5NNN -> NNN
Q +$E($P($G(^BPSC(BPIEN02,400,1,400)),U,5),3,99)
;
;display response record
DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ;
;
; Moved to ^BPSSCRL1 for sake of space
;
D DISPRSP^BPSSCRL1
Q
;
RESPREC(BPIEN03,BPSDTALT) ;
N BPSDT
S BPSDT=+$P($G(^BPSR(BPIEN03,0)),U,2)
Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT))
;
DOSRSP(BPIEN03) ;
N BPDT
S BPDT=$P($G(^BPSR(BPIEN03,400)),U,1)\1
Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4)
;
TOTAMNT(BPIEN03) ;
I $G(BPIEN03)="" Q ""
N X
S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,9)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
ICPAID(BPIEN03) ;Ingredient Cost Paid
I $G(BPIEN03)="" Q ""
N X
S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,6)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
; BPS*1*22 - Reconciliation ID
RECONID(BPEIN03) ;
Q $P($G(^BPSR(BPIEN03,1000,1,"B98")),U,1)
;
DFPAID(BPIEN03) ;Dispensing Fee Paid
I $G(BPIEN03)="" Q ""
N X
S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,7)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
PTRESP(BPIEN03) ;Patient Responsibility
I $G(BPIEN03)="" Q ""
N X
S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,5)
Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X))
;
MESSAGE(BPIEN03) ;
Q $P($G(^BPSR(BPIEN03,504)),U)
;
ADDMESS(BPIEN03,POS,BPADDMSG) ;
N ADM,X,QUA,TXT,CON,BPMTMP,L,NEXT
K BPMTMP,BPADDMSG
I '$G(BPIEN03) Q
I '$G(POS) S POS=1
S (ADM,L)=0 F S ADM=$O(^BPSR(BPIEN03,1000,POS,130.01,ADM)) Q:'ADM D
. S X=$G(^BPSR(BPIEN03,1000,POS,130.01,ADM,0))
. S TXT=$P($G(^BPSR(BPIEN03,1000,POS,130.01,ADM,1)),U,1)
. S QUA=$P(X,U,3),CON=$P(X,U,2)
. ; This should not happen, but if the qualifier is null, set it
. ; to "Z"_concatenated with a unique number so that it follows the
. ; other qualifiers. Per the D0 standard, qualifiers can be 1-9 and
. ; A-Z. ECL limits this to 1-9 but an future ECL may extend this.
. I QUA="" S L=L+1,QUA="Z"_L
. S BPMTMP(QUA)=CON_U_TXT
I '$D(BPMTMP) Q
S L=0,(QUA,NEXT)="" F S QUA=$O(BPMTMP(QUA)) Q:QUA="" D
. S CON=$P(BPMTMP(QUA),U,1),TXT=$P(BPMTMP(QUA),U,2)
. I NEXT="+" S BPADDMSG(L)=BPADDMSG(L)_TXT,NEXT=CON Q
. S L=L+1,BPADDMSG(L)=TXT,NEXT=CON
Q
;
DURTEXT(BPIEN03) ;
; DUR FREE TEXT MESSAGE from first instance of DUR PPS RESPONSE
Q $P($G(^BPSR(BPIEN03,1000,1,567.01,1,0)),U,9)
;
DURREAS(BPIEN03) ;
; REASON FOR SERVICE CODE from first instance of DUR PPS RESPONSE
Q $$GET1^DIQ(9002313.1101,"1,1,"_BPIEN03_",",439)
;
DURADD(BPIEN03) ;
; DUR ADDITIONAL TEXT from first instance of DUR PPS RESPONSE
Q $P($G(^BPSR(BPIEN03,1000,1,567.01,1,1)),U)
;
;Payer HPID from response ***BPS*1*18 IB ICR #6061
HPID(BPIEN03,BP57) ;
N BPHPD
Q:$P($G(^BPSR(BPIEN03,560)),U,8)'="01" ""
S BPHPD=$P($G(^BPSR(BPIEN03,560)),U,9)
; 6/25/14 no validation of HPID for this screen
;S:BPHPD'="" BPHPD=BPHPD_$P($$HOD^IBCNHUT1(BPHPD,BP57),U,3)
Q BPHPD
;
RXCOB57(BPIEN57) ;
N BPCOB
S BPCOB=+$P($G(^BPSTL(BPIEN57,0)),U,14)
Q $S(BPCOB=2:"SECONDARY",BPCOB=3:"TERTIARY",1:"PRIMARY")
;
;Display other payer(s)
DISPPYR(BPLN,BPIEN03) ;
N PYR,PYRDATA,BPSTR1
S PYR=0 F S PYR=$O(^BPSR(BPIEN03,1000,1,355.01,PYR)) Q:'PYR D
. S PYRDATA=^BPSR(BPIEN03,1000,1,355.01,PYR,1)
. S BPSTR1="Other Payer Information ("_PYR_")(#"_BPIEN03_")"
. D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-"))
. D SETLINE(.BPLN,"Other Payer ID Count: "_$$PYRIDCNT(BPIEN03,PYR))
. D SETLINE(.BPLN,"Other Payer ID: "_$P(PYRDATA,U,3))
. D SETLINE(.BPLN,"Other Payer Coverage Type: "_$P(PYRDATA,U,1))
. D SETLINE(.BPLN,"Other Payer ID Qualifier: "_$P(PYRDATA,U,2))
. D SETLINE(.BPLN,"Other Payer Help Desk Phone Number: "_$P(PYRDATA,U,8))
. D SETLINE(.BPLN,"Other Payer Processor Control Number: "_$P(PYRDATA,U,4))
. D SETLINE(.BPLN,"Other Payer Effective Date: "_$P(PYRDATA,U,10))
. D SETLINE(.BPLN,"Other Payer Termination Date: "_$P(PYRDATA,U,11))
. D SETLINE(.BPLN,"Other Payer Person Code: "_$P(PYRDATA,U,7))
. D SETLINE(.BPLN,"Other Payer Patient Relationship Code: "_$P(PYRDATA,U,9))
. D SETLINE(.BPLN,"Other Payer Cardholder ID: "_$P(PYRDATA,U,5))
. D SETLINE(.BPLN,"Other Payer Group ID: "_$P(PYRDATA,U,6))
Q
;
PYRIDCNT(BPIEN03,PYR) ;
Q $P($G(^BPSR(BPIEN03,1000,1,355.01,PYR,0)),U)
;
; Invalid Provider Data Source
INVPROV(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2387,"E")
;
; Formulary Alternative Effective Date
FAEDT(BPIEN03) ;
N BPDT
S BPDT=$$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2389,"I")
I BPDT'="" S BPDT=$E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4)
Q BPDT
;
; DUR/DUE Co-Agent Description
DCADES(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2393,"E")
;
; Unit of Prior Dispensed Qty
UPDQ(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2394,"I")
;
; Other Pharmacy ID Qualifier
OPIDQ(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2395,"E")
;
; Other Pharmacy Name
OPNAM(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2397,"E")
;
; Other Pharmacy Telephone
OPTELE(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2398,"E")
;
; Other Prescriber Last Name
OPLNAM(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2399,"E")
;
; Other Prescriber ID Qualifier
OPRIDQ(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2401,"E")
;
; Other Prescriber ID
OPRID(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2402,"E")
;
; Other Prescriber ID Phone Number
OPRPH(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2403,"E")
;
; DUR/DUE Compound Product ID
CMPPID(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2404,"E")
;
; DUR/DUE Compound Product ID Qualifier
CMPPIDQ(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2405,"E")
;
; DUR/DUE Maximum Daily Dose Qty
MAXDDQ(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2406,"E")
;
; DUR/DUE Maximum Daily Dose - Unit
MAXDDU(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2407,"I")
;
; DUR/DUE Minimum Daily Dose Qty
MINDDQ(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2408,"E")
;
; DUR/DUE Minimum Daily Dose - Unit
MINDDU(BPIEN03) ;
Q $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2409,"I")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRLG 12969 printed Nov 22, 2024@17:03:24 Page 2
BPSSCRLG ;BHAM ISC/SS - ECME LOGINFO ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,15,18,20,22,24,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; -- main entry point for BPS LSTMN LOG
+1 DO EN^VALM("BPS LSTMN LOG")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Claim Log information"
+2 SET VALMHDR(2)=""
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 NEW BPSELCLM,LINE
+2 SET BPSELCLM=$GET(@VALMAR@("SELLN"))
+3 ; piece 2: patient ien #2
+4 ; piece 3: insurance ien #36
+5 ; piece 4: ptr to #9002313.59
+6 SET LINE=1
+7 SET VALMCNT=$$PREPINFO(.LINE,$PIECE(BPSELCLM,U,2),$PIECE(BPSELCLM,U,3),$PIECE(BPSELCLM,U,4))
+8 if VALMCNT>1
SET VALMCNT=VALMCNT-1
+9 QUIT
+10 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 KILL X
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
+3 ;
LOG ;entry point for LOG menu option
+1 NEW BPRET,BPSEL,BP59,BPVLM
+2 IF '$DATA(@(VALMAR))
QUIT
+3 DO FULL^VALM1
+4 WRITE !,"Enter the line number for which you wish to print claim logs."
+5 SET BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE Rx Line.")
+6 IF BPSEL<1
SET VALMBCK="R"
QUIT
+7 ;
+8 SET BP59=$PIECE(BPSEL,U,4)
+9 ; 1st line for indexes in the LM display array
SET BPVLM=+$PIECE(BPSEL,U,5)
+10 ;
+11 ; check for non-billable entry for claim LOG display
+12 IF $$NB^BPSSCR03(BP59)
Begin DoDot:1
+13 ; LM display array
WRITE !!,$GET(@VALMAR@(BPVLM,0))
+14 ; eT/eC non-billable reason line
WRITE !?6,$$EREJTXT^BPSSCR03(BP59)
+15 WRITE !,"Entry is NON BILLABLE. There is no Claim Log to display."
+16 DO PAUSE^VALM1
+17 QUIT
End DoDot:1
SET VALMBCK="R"
QUIT
+18 ;
+19 DO SAVESEL(BPSEL,VALMAR)
+20 DO EN
+21 SET VALMBCK="R"
+22 QUIT
+23 ;
+24 ;save for ListManager
+25 ;BPSEL - selected line
+26 ;BPVALMR - parent VALMAR
SAVESEL(BPSEL,BPVALMR) ;
+1 DO CLEANIT
+2 SET ^TMP("BPSLOG",$JOB,"VALM","SELLN")=BPSEL
+3 SET ^TMP("BPSLOG",$JOB,"VALM","PARENT")=BPVALMR
+4 MERGE ^TMP("BPSLOG",$JOB,"VALM","VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")
+5 QUIT
+6 ;
CLEANIT ;
+1 KILL ^TMP("BPSLOG",$JOB,"VALM")
+2 QUIT
+3 ;
PREPINFO(BPLN,BPDFN,BP36,BP59) ;
+1 ;input:
+2 ; BPDFN: patient ien #2
+3 ; BP36: insurance ien #36
+4 ; BP59: ptr to #9002313.59
+5 ; returns # of lines
+6 ;
+7 ; Moved to ^BPSSCRL1 for sake of space
+8 ;
+9 QUIT $$PREPINFO^BPSSCRL1(BPLN,BPDFN,BP36,BP59)
+10 ;
+11 ;increments BPLINE
SETLINE(BPLINE,BPSTR) ;
+1 DO SET^VALM10(BPLINE,BPSTR)
+2 SET BPLINE=BPLINE+1
+3 QUIT
+4 ;
+5 ;display claim record
DISPCLM(BPLN,BP59,BPIEN02,BP57,BPSTYPE,BPSDTALT) ;
+1 ;
+2 ; Moved to ^BPSSCRL1 for sake of space
+3 ;
+4 DO DISPCLM^BPSSCRL1
+5 QUIT
+6 ;
+7 ;Submitted By User
SUBMTBY(BP57) ;
+1 NEW BPIEN,BPUSR
+2 SET BPIEN=$PIECE($GET(^BPSTL(BP57,0)),U,10)
+3 SET BPUSR=$$GETUSRNM^BPSSCRU1(BPIEN)
+4 QUIT $SELECT(BPUSR']"":"UNKNOWN",1:BPUSR)
+5 ;
+6 ;Date of service
DOSCLM(BPIEN02) ;
+1 NEW BPDT
+2 SET BPDT=$PIECE($GET(^BPSC(BPIEN02,401)),U,1)\1
+3 QUIT $EXTRACT(BPDT,5,6)_"/"_$EXTRACT(BPDT,7,8)_"/"_$EXTRACT(BPDT,1,4)
+4 ;
+5 ;Create date
CREATEDT(BPIEN02,BPSDTALT) ;
+1 NEW BPSDT
+2 SET BPSDT=+$PIECE($GET(^BPSC(BPIEN02,0)),U,6)
+3 QUIT $$DATETIME^BPSSCRU5($SELECT(BPSDT>0:BPSDT,1:BPSDTALT))
+4 ;
+5 ;Plan ID
PLANID(BP57) ;
+1 QUIT $PIECE($GET(^BPSTL(BP57,10,+$GET(^BPSTL(BP57,9)),0)),U,1)
+2 ;
CERTMOD(BP57) ;
+1 QUIT $PIECE($GET(^BPSTL(BP57,10,+$GET(^BPSTL(BP57,9)),0)),U,5)
+2 ;
+3 ;Software Vendor/Cert ID
CERTIEN(BP57) ;
+1 QUIT $PIECE($GET(^BPSTL(BP57,10,+$GET(^BPSTL(BP57,9)),0)),U,6)
+2 ;
+3 ;Division
DIV(BP57) ;
+1 QUIT $$GET1^DIQ(9002313.57,BP57_",",11)
+2 ;
+3 ;NPI
NPI(BPIEN02) ;
+1 QUIT $$GET1^DIQ(9002313.02,BPIEN02_",",201)
+2 ;
+3 ;Group ID
GRPID(BPIEN02) ;
+1 QUIT $EXTRACT($PIECE($GET(^BPSC(BPIEN02,300)),U,1),3,99)
+2 ;
+3 ;Group Name
GRPNM(BPSIEN02) ;
+1 NEW BPSGPN
+2 SET BPSGPN=$PIECE($GET(^BPSTL(BP57,10,+$GET(^BPSTL(BP57,9)),3)),U,1)
+3 QUIT BPSGPN
+4 ;
+5 ;Cardholder ID
CRDHLDID(BPIEN02) ;
+1 QUIT $EXTRACT($PIECE($GET(^BPSC(BPIEN02,300)),U,2),3,99)
+2 ;
+3 ;Cardholder First name
CRDHLDFN(BPIEN02,BP57) ;
+1 NEW Y
+2 SET Y=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,300)),U,12),3,99)
+3 IF $LENGTH(Y)=0
SET Y=$PIECE($GET(^BPSTL(BP57,10,+$GET(^BPSTL(BP57,9)),1)),U,6)
+4 QUIT Y
+5 ;
+6 ;Cardholder Last Name
CRDHLDLN(BPIEN02,BP57) ;
+1 NEW Y
+2 SET Y=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,300)),U,13),3,99)
+3 IF $LENGTH(Y)=0
SET Y=$PIECE($GET(^BPSTL(BP57,10,+$GET(^BPSTL(BP57,9)),1)),U,7)
+4 QUIT Y
+5 ;
+6 ;Facility ID Qualifier - BPS*1*22
FACIDQ(BPEIN02) ;
+1 QUIT $PIECE($GET(^BPSC(BPIEN02,400,1,"B90")),U,5)
+2 ;
+3 ;Patient Relationship Code
PATRELSH(BPIEN02) ;
+1 NEW Y
+2 SET Y=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,300)),U,6),3,99)
+3 QUIT $SELECT(Y=0:"NOT SPECIFIED",Y=1:"CARDHOLDER",Y=2:"SPOUSE",Y=3:"CHILD",Y=4:"OTHER",1:Y)
+4 ;
PCN(BPIEN02) ;
+1 QUIT $PIECE($GET(^BPSC(BPIEN02,100)),U,4)
+2 ;
+3 ; Get the Payer Sheet Version Number.
GETVER(BPIEN02) ;
+1 NEW BPSVER
+2 SET BPSVER=$PIECE($GET(^BPSC(BPIEN02,100)),U,2)
+3 IF $GET(BPSVER)]""
SET BPSVER=$EXTRACT(BPSVER,1)_"."_$EXTRACT(BPSVER,2,99)
+4 QUIT BPSVER
+5 ;
BIN(BPIEN02) ;
+1 QUIT $PIECE($GET(^BPSC(BPIEN02,100)),U,1)
+2 ;
+3 ;Prescriber DEA Number
PDEA(BPIEN02) ;
+1 QUIT $EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,"D00")),U,1),3,18)
+2 ;
+3 ;Total Prescribed Quantity Remaining
TOTPQR(BPIEN02) ;
+1 NEW X
+2 SET X=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,"D00")),U,2),3,99)
+3 QUIT +X
+4 ;
+5 ;insurance name by 9002313.57 pointer
INSUR57(BPIEN57) ;
+1 NEW BPINSN
+2 SET BPINSN=+$GET(^BPSTL(BPIEN57,9))
+3 QUIT $PIECE($GET(^BPSTL(BPIEN57,10,BPINSN,0)),U,7)
+4 ;
PHPLANID(BPIEN57) ; Get the Pharmacy Plan ID from the BPS Log of Transactions file
+1 ; Input - BPSIEN57: IEN from the BPS Log of Transactions file.
+2 IF '$GET(BPIEN57)
QUIT ""
+3 NEW BPINSN
+4 SET BPINSN=+$GET(^BPSTL(BPIEN57,9))
+5 QUIT $PIECE($GET(^BPSTL(BPIEN57,10,BPINSN,3)),U,3)
+6 ;
QTY(BPIEN02) ;
+1 QUIT $EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,440)),U,2),3,99)/1000
+2 ;
+3 ;NCPDP Units
UNITS(BPIEN02) ;
+1 IF $GET(BPIEN02)=""
QUIT "( )"
+2 NEW X
+3 SET X=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,600)),U,1),3,99)
+4 QUIT $SELECT(X="":"( )",1:"("_X_")")
+5 ;
UNTPRICE(BPIEN57) ;
+1 IF $GET(BPIEN57)=""
QUIT ""
+2 QUIT +$PIECE($GET(^BPSTL(BPIEN57,5)),U,2)
+3 ;
TOTPRICE(BPIEN02) ;
+1 IF $GET(BPIEN02)=""
QUIT ""
+2 NEW X
+3 SET X=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,400)),U,30),3,99)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
BILLQTY(BPIEN57) ;
+1 QUIT $PIECE($GET(^BPSTL(BPIEN57,5)),U,9)
+2 ;
BILLUNT(BPIEN57) ;
+1 IF $GET(BPIEN57)=""
QUIT "( )"
+2 NEW X
+3 SET X=$PIECE($GET(^BPSTL(BPIEN57,5)),U,10)
+4 QUIT $SELECT(X="":"( )",1:"("_X_")")
+5 ;
+6 ;Ingredient Cost
INGRCST(BPIEN02) ;
+1 IF $GET(BPIEN02)=""
QUIT ""
+2 NEW X
+3 SET X=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,400)),U,9),3,99)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
+6 ;Dispensing Fee Submitted
DISPFEE(BPIEN02) ;
+1 IF $GET(BPIEN02)=""
QUIT ""
+2 NEW X
+3 SET X=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,400)),U,12),3,99)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
+6 ;U&C Charge
UCCHRG(BPIEN02) ;
+1 IF $GET(BPIEN02)=""
QUIT ""
+2 NEW X
+3 SET X=$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,400)),U,26),3,99)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
+6 ;Admin Fee
ADMNFEE(BPIEN02) ;
+1 IF $GET(BPIEN02)=""
QUIT ""
+2 NEW CNT,X,AF
+3 SET AF=""
SET CNT=0
FOR
SET CNT=$ORDER(^BPSC(BPIEN02,400,1,478.01,CNT))
if 'CNT
QUIT
Begin DoDot:1
+4 SET X=$GET(^BPSC(BPIEN02,400,1,478.01,CNT,0))
+5 IF +$EXTRACT($PIECE(X,U,2),3,4)=4
SET AF=AF+$$DFF2EXT^BPSECFM($EXTRACT($PIECE(X,U,3),3,10))
End DoDot:1
+6 QUIT $SELECT(AF="":AF,1:$JUSTIFY(AF,0,2))
+7 ;
+8 ;get ECME pharmacy division ptr for LOG
LDIV(BPIEN57) ;
+1 QUIT +$PIECE($GET(^BPSTL(BPIEN57,1)),U,7)
+2 ;
+3 ;transaction code
TRCODE(BPIEN02) ;
+1 QUIT $PIECE($GET(^BPSC(BPIEN02,100)),U,3)
+2 ;
+3 ;days supply
DAYSSUPL(BPIEN02) ;
+1 ;format D5NNN -> NNN
+2 QUIT +$EXTRACT($PIECE($GET(^BPSC(BPIEN02,400,1,400)),U,5),3,99)
+3 ;
+4 ;display response record
DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ;
+1 ;
+2 ; Moved to ^BPSSCRL1 for sake of space
+3 ;
+4 DO DISPRSP^BPSSCRL1
+5 QUIT
+6 ;
RESPREC(BPIEN03,BPSDTALT) ;
+1 NEW BPSDT
+2 SET BPSDT=+$PIECE($GET(^BPSR(BPIEN03,0)),U,2)
+3 QUIT $$DATETIME^BPSSCRU5($SELECT(BPSDT>0:BPSDT,1:BPSDTALT))
+4 ;
DOSRSP(BPIEN03) ;
+1 NEW BPDT
+2 SET BPDT=$PIECE($GET(^BPSR(BPIEN03,400)),U,1)\1
+3 QUIT $EXTRACT(BPDT,5,6)_"/"_$EXTRACT(BPDT,7,8)_"/"_$EXTRACT(BPDT,1,4)
+4 ;
TOTAMNT(BPIEN03) ;
+1 IF $GET(BPIEN03)=""
QUIT ""
+2 NEW X
+3 SET X=$PIECE($GET(^BPSR(BPIEN03,1000,1,500)),U,9)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
ICPAID(BPIEN03) ;Ingredient Cost Paid
+1 IF $GET(BPIEN03)=""
QUIT ""
+2 NEW X
+3 SET X=$PIECE($GET(^BPSR(BPIEN03,1000,1,500)),U,6)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
+6 ; BPS*1*22 - Reconciliation ID
RECONID(BPEIN03) ;
+1 QUIT $PIECE($GET(^BPSR(BPIEN03,1000,1,"B98")),U,1)
+2 ;
DFPAID(BPIEN03) ;Dispensing Fee Paid
+1 IF $GET(BPIEN03)=""
QUIT ""
+2 NEW X
+3 SET X=$PIECE($GET(^BPSR(BPIEN03,1000,1,500)),U,7)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
PTRESP(BPIEN03) ;Patient Responsibility
+1 IF $GET(BPIEN03)=""
QUIT ""
+2 NEW X
+3 SET X=$PIECE($GET(^BPSR(BPIEN03,1000,1,500)),U,5)
+4 QUIT $SELECT(X="":X,1:$$DFF2EXT^BPSECFM(X))
+5 ;
MESSAGE(BPIEN03) ;
+1 QUIT $PIECE($GET(^BPSR(BPIEN03,504)),U)
+2 ;
ADDMESS(BPIEN03,POS,BPADDMSG) ;
+1 NEW ADM,X,QUA,TXT,CON,BPMTMP,L,NEXT
+2 KILL BPMTMP,BPADDMSG
+3 IF '$GET(BPIEN03)
QUIT
+4 IF '$GET(POS)
SET POS=1
+5 SET (ADM,L)=0
FOR
SET ADM=$ORDER(^BPSR(BPIEN03,1000,POS,130.01,ADM))
if 'ADM
QUIT
Begin DoDot:1
+6 SET X=$GET(^BPSR(BPIEN03,1000,POS,130.01,ADM,0))
+7 SET TXT=$PIECE($GET(^BPSR(BPIEN03,1000,POS,130.01,ADM,1)),U,1)
+8 SET QUA=$PIECE(X,U,3)
SET CON=$PIECE(X,U,2)
+9 ; This should not happen, but if the qualifier is null, set it
+10 ; to "Z"_concatenated with a unique number so that it follows the
+11 ; other qualifiers. Per the D0 standard, qualifiers can be 1-9 and
+12 ; A-Z. ECL limits this to 1-9 but an future ECL may extend this.
+13 IF QUA=""
SET L=L+1
SET QUA="Z"_L
+14 SET BPMTMP(QUA)=CON_U_TXT
End DoDot:1
+15 IF '$DATA(BPMTMP)
QUIT
+16 SET L=0
SET (QUA,NEXT)=""
FOR
SET QUA=$ORDER(BPMTMP(QUA))
if QUA=""
QUIT
Begin DoDot:1
+17 SET CON=$PIECE(BPMTMP(QUA),U,1)
SET TXT=$PIECE(BPMTMP(QUA),U,2)
+18 IF NEXT="+"
SET BPADDMSG(L)=BPADDMSG(L)_TXT
SET NEXT=CON
QUIT
+19 SET L=L+1
SET BPADDMSG(L)=TXT
SET NEXT=CON
End DoDot:1
+20 QUIT
+21 ;
DURTEXT(BPIEN03) ;
+1 ; DUR FREE TEXT MESSAGE from first instance of DUR PPS RESPONSE
+2 QUIT $PIECE($GET(^BPSR(BPIEN03,1000,1,567.01,1,0)),U,9)
+3 ;
DURREAS(BPIEN03) ;
+1 ; REASON FOR SERVICE CODE from first instance of DUR PPS RESPONSE
+2 QUIT $$GET1^DIQ(9002313.1101,"1,1,"_BPIEN03_",",439)
+3 ;
DURADD(BPIEN03) ;
+1 ; DUR ADDITIONAL TEXT from first instance of DUR PPS RESPONSE
+2 QUIT $PIECE($GET(^BPSR(BPIEN03,1000,1,567.01,1,1)),U)
+3 ;
+4 ;Payer HPID from response ***BPS*1*18 IB ICR #6061
HPID(BPIEN03,BP57) ;
+1 NEW BPHPD
+2 if $PIECE($GET(^BPSR(BPIEN03,560)),U,8)'="01"
QUIT ""
+3 SET BPHPD=$PIECE($GET(^BPSR(BPIEN03,560)),U,9)
+4 ; 6/25/14 no validation of HPID for this screen
+5 ;S:BPHPD'="" BPHPD=BPHPD_$P($$HOD^IBCNHUT1(BPHPD,BP57),U,3)
+6 QUIT BPHPD
+7 ;
RXCOB57(BPIEN57) ;
+1 NEW BPCOB
+2 SET BPCOB=+$PIECE($GET(^BPSTL(BPIEN57,0)),U,14)
+3 QUIT $SELECT(BPCOB=2:"SECONDARY",BPCOB=3:"TERTIARY",1:"PRIMARY")
+4 ;
+5 ;Display other payer(s)
DISPPYR(BPLN,BPIEN03) ;
+1 NEW PYR,PYRDATA,BPSTR1
+2 SET PYR=0
FOR
SET PYR=$ORDER(^BPSR(BPIEN03,1000,1,355.01,PYR))
if 'PYR
QUIT
Begin DoDot:1
+3 SET PYRDATA=^BPSR(BPIEN03,1000,1,355.01,PYR,1)
+4 SET BPSTR1="Other Payer Information ("_PYR_")(#"_BPIEN03_")"
+5 DO SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$LENGTH(BPSTR1),"-"))
+6 DO SETLINE(.BPLN,"Other Payer ID Count: "_$$PYRIDCNT(BPIEN03,PYR))
+7 DO SETLINE(.BPLN,"Other Payer ID: "_$PIECE(PYRDATA,U,3))
+8 DO SETLINE(.BPLN,"Other Payer Coverage Type: "_$PIECE(PYRDATA,U,1))
+9 DO SETLINE(.BPLN,"Other Payer ID Qualifier: "_$PIECE(PYRDATA,U,2))
+10 DO SETLINE(.BPLN,"Other Payer Help Desk Phone Number: "_$PIECE(PYRDATA,U,8))
+11 DO SETLINE(.BPLN,"Other Payer Processor Control Number: "_$PIECE(PYRDATA,U,4))
+12 DO SETLINE(.BPLN,"Other Payer Effective Date: "_$PIECE(PYRDATA,U,10))
+13 DO SETLINE(.BPLN,"Other Payer Termination Date: "_$PIECE(PYRDATA,U,11))
+14 DO SETLINE(.BPLN,"Other Payer Person Code: "_$PIECE(PYRDATA,U,7))
+15 DO SETLINE(.BPLN,"Other Payer Patient Relationship Code: "_$PIECE(PYRDATA,U,9))
+16 DO SETLINE(.BPLN,"Other Payer Cardholder ID: "_$PIECE(PYRDATA,U,5))
+17 DO SETLINE(.BPLN,"Other Payer Group ID: "_$PIECE(PYRDATA,U,6))
End DoDot:1
+18 QUIT
+19 ;
PYRIDCNT(BPIEN03,PYR) ;
+1 QUIT $PIECE($GET(^BPSR(BPIEN03,1000,1,355.01,PYR,0)),U)
+2 ;
+3 ; Invalid Provider Data Source
INVPROV(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2387,"E")
+2 ;
+3 ; Formulary Alternative Effective Date
FAEDT(BPIEN03) ;
+1 NEW BPDT
+2 SET BPDT=$$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2389,"I")
+3 IF BPDT'=""
SET BPDT=$EXTRACT(BPDT,5,6)_"/"_$EXTRACT(BPDT,7,8)_"/"_$EXTRACT(BPDT,1,4)
+4 QUIT BPDT
+5 ;
+6 ; DUR/DUE Co-Agent Description
DCADES(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2393,"E")
+2 ;
+3 ; Unit of Prior Dispensed Qty
UPDQ(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2394,"I")
+2 ;
+3 ; Other Pharmacy ID Qualifier
OPIDQ(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2395,"E")
+2 ;
+3 ; Other Pharmacy Name
OPNAM(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2397,"E")
+2 ;
+3 ; Other Pharmacy Telephone
OPTELE(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2398,"E")
+2 ;
+3 ; Other Prescriber Last Name
OPLNAM(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2399,"E")
+2 ;
+3 ; Other Prescriber ID Qualifier
OPRIDQ(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2401,"E")
+2 ;
+3 ; Other Prescriber ID
OPRID(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2402,"E")
+2 ;
+3 ; Other Prescriber ID Phone Number
OPRPH(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2403,"E")
+2 ;
+3 ; DUR/DUE Compound Product ID
CMPPID(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2404,"E")
+2 ;
+3 ; DUR/DUE Compound Product ID Qualifier
CMPPIDQ(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2405,"E")
+2 ;
+3 ; DUR/DUE Maximum Daily Dose Qty
MAXDDQ(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2406,"E")
+2 ;
+3 ; DUR/DUE Maximum Daily Dose - Unit
MAXDDU(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2407,"I")
+2 ;
+3 ; DUR/DUE Minimum Daily Dose Qty
MINDDQ(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2408,"E")
+2 ;
+3 ; DUR/DUE Minimum Daily Dose - Unit
MINDDU(BPIEN03) ;
+1 QUIT $$GET1^DIQ(9002313.0301,"1,"_BPIEN03,2409,"I")
