- 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 Feb 18, 2025@23:19:35 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")