- IBNCPNB ;OAK/ELZ - UTILITIES FOR NCPCP ;5/22/08 15:23
- ;;2.0;INTEGRATED BILLING;**276,342,384,452**;21-MAR-94;Build 26
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;NCPDP PHASE III
- Q
- ;
- ;
- NONBR(DFN,IBRX,IBFIL,IBADT,IBCR,IBPAP,IBRC,IBCC,IBUSER) ; Set non-billable reason to CT
- ; input:
- ; DFN - Patient
- ; IBRX - Rx IEN
- ; IBFIL - fill#
- ; IBADT - Date of Service
- ; IBCR - Close Claim Reason (#356.8)
- ; IBPAP - Autobillable flag (billable (1) / non-billable (0) flag)
- ; IBRC - Release Copay (entered by OPECC)
- ; IBCC - Close Reason Comment (entered by OPECC)
- ; IBUSER - DUZ of user triggering the billing event
- N IBTRKRN,DIE,IBRESN,DR,DA,IBRMARK,IBLOCK,IBEABD,IBEABD,IBACT,IBFDA
- ; update claims tracking
- S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRX,IBFIL,0))
- I 'IBTRKRN D ; if it doesn't exist - create it
- . N IBTRKR
- . S IBTRKR=$G(^IBE(350.9,1,6)) ; claims tracking info
- . ; date can't be before parameters
- . S $P(IBTRKR,U)=$S('$P(IBTRKR,U,4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT)
- . I 'IBTRKR Q ; CT Disabled
- . D CT^IBNCPDPU(DFN,IBRX,IBFIL,IBADT,$G(IBCR))
- . S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRX,IBFIL,0))
- I 'IBTRKRN Q ; CT disabled
- L +^IBT(356,IBTRKRN):10 S IBLOCK=$T
- S DIE="^IBT(356,",DA=IBTRKRN
- ;
- ;
- ; if Billable - set EABD+60
- I '$G(IBCR) D G NONBRQ
- .Q:$$GET1^DIQ(356,IBTRKRN_",",.19,"I") ;quit if non-billable
- .S IBEABD=$$EABD^IBTUTL($O(^IBE(356.6,"AC",4,0)),IBADT)
- .I IBEABD S IBEABD=$$FMADD^XLFDT(IBEABD,60)
- .S DR=".17////^S X=IBEABD" D ^DIE
- ;
- ; if still billable, set the EABD.
- ;
- ; Don't check for the 2nd insurance in Phase 3 --
- ; allow the claim to become non-billable, ECME has already warned
- ; the user and provided information about the 2nd insurance
- ; in the User Screen
- ; I IBPAP!$$MOREINS(DFN,IBADT) D G NONBRQ
- ;
- I IBPAP D G NONBRQ
- . S IBEABD=$$EABD^IBTUTL($O(^IBE(356.6,"AC",4,0)),IBADT)
- . I IBEABD<DT S IBEABD=DT
- . S DR=".19///@" D ^DIE ; it re-sets .17 (trigger in #356)
- . S DR=".17////^S X=IBEABD"
- . S IBRMARK=$$REASON^IBNCPDPU(IBCR)
- . I IBCC'="" S IBRMARK=IBRMARK_"; "_IBCC
- . I $L($G(IBCC))>2 S DR=DR_";1.08////^S X=$E(IBRMARK,1,80)"
- . D ^DIE
- ;
- ; set non-billable reason
- S IBRMARK=$$REASON^IBNCPDPU(IBCR)
- I IBRMARK="" S IBRMARK="OTHER" S IBCC="Unknown NBR '"_IBCR_"'. "_$G(IBCC)
- S DR=".19///"_IBRMARK
- I $L($G(IBCC))>2 S DR=DR_";1.08////^S X=$E(IBCC,1,80)"
- D ^DIE
- ;
- NONBRQ ;
- I $G(IBRC) D ; Release Copay
- . S IBACT=+$$RELCOPAY(DFN,IBRX,IBFIL,1,IBADT,0) ; release copay charges off hold
- . ;if 0 (not found on HOLD) we will have one more attempt, it was scheduled inside RELCOPAY
- . ; so doesn't make sense to send "NOT RELEASED" e-mail
- . ; if the 2nd attempt fails then e-mail will be send from RCTASK
- . ;we send e-mail only if -1 i.e. if charge was found on hold but
- . ; ^IBR gave an error when we tried to release it
- . I IBACT=-1 D RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,IBACT,IBCR,$G(IBCC),0,1)
- . ;if -2 (there is no copay) then do nothing
- S IBFDA(356,IBTRKRN_",",1.03)=DT ; date last edited
- S IBFDA(356,IBTRKRN_",",1.04)=IBUSER ; last edited by
- D FILE^DIE("","IBFDA"),MSG^DIALOG()
- I IBLOCK L -^IBT(356,IBTRKRN)
- Q
- ;
- ;
- RELCOPAY(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN) ; Release copay charges on hold
- ; Input:
- ; DFN - Patient IEN
- ; IBRX - Rx IEN
- ; IBFIL - fill/refill #
- ; IBRETRY - retry flag
- ; IBADT - Date of Service
- ; IBIFN - 3rd party bill IEN
- ; output:
- ; -2 == there is no any copay
- ; -1^error code if unsuccessful == if ^IBR error
- ; 0 == charge was not found (and depends on IBRETRY another attempt can be scheduled)
- ; >0 == charge was released from HOLD
- ; this procedure will be called if the Payer agreed to pay 0.00
- ; or the claim was closed as non-billable by the OPECC.
- ; if patient exempt from RX copay then there is nothing to release from HOLD - quit
- I +$$RXEXMT^IBARXEU0(DFN,IBADT)=1 Q -2
- N IBACT,IBZ,IBFOUND,IBX,IBSEQNO,IBNOS,Y,IBDUZ,RCDUZ
- ; Schedule the task to speed up the whole process
- I 'IBRETRY D RCTASK(DFN,IBRX,IBFIL,+IBRETRY,IBADT,IBIFN) Q 0
- S IBFOUND=0
- S IBACT="A" F S IBACT=$O(^IB("AH",DFN,IBACT),-1) Q:'IBACT D Q:IBFOUND
- . S IBZ=$G(^IB(IBACT,0)) Q:IBZ=""
- . S IBX=$P(IBZ,U,4)
- . I +IBX'=52 Q ; not an Rx
- . I +$P(IBX,":",2)'=IBRX Q ; other Rx
- . I +$P(IBX,":",3)'=IBFIL Q ; other fill
- . S IBFOUND=IBACT
- I 'IBFOUND D RCTASK(DFN,IBRX,IBFIL,+$G(IBRETRY),IBADT,IBIFN) Q 0
- S IBSEQNO=1,IBNOS=IBFOUND
- S IBDUZ=$P($G(^IB(IBFOUND,1)),U) ; who entered the copay charge?
- S RCDUZ=IBDUZ
- D ^IBR I Y<0 Q Y
- Q IBFOUND
- ;
- ;Called by TaskMan
- RELCRG ;
- N IBACT
- S IBACT=+$$RELCOPAY(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN)
- ;if 0 (not found on HOLD) we will have another attempt
- ;we send e-mail only if -1 (^IBR error)
- I IBACT=-1 D RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,IBACT,0,"",IBIFN,IBRETRY)
- ;
- Q
- ;
- ;Schedule Release Copay
- RCTASK(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN) ;
- N I,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO
- S IBRETRY=IBRETRY+1
- I IBRETRY>2 D Q ; Only two extra attempts
- . ;if all attempts were unsuccessful then send e-mail, set IBACT=0 since we do not have it
- . D RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,0,0,"",IBIFN,2)
- S ZTRTN="RELCRG^IBNCPNB"
- F I="DFN","IBRX","IBFIL","IBRETRY","IBADT","IBIFN" S ZTSAVE(I)=""
- S ZTDESC="RELEASE COPAY RX IEN# "_IBRX
- S ZTIO=""
- S ZTDTH=$$HADD^XLFDT($H,0,0,0,$S(IBRETRY=1:10,1:600))
- D ^%ZTLOAD
- Q
- ;
- ;
- ; does the pat have >1 billable insur with pharm coverage?
- MOREINS(DFN,IBADT) ;
- ; DFN - ptr to the patient
- ; IBADT - the effective date
- N IBANY,IBX,IBINS,IBT,IBRES,IBCAT
- S IBRES=0 ; No by default
- S IBCAT=$O(^IBE(355.31,"B","PHARMACY",0))
- ; -- look up insurance for patient
- D ALL^IBCNS1(DFN,"IBINS",1,IBADT,1)
- S IBX=0 F S IBX=$O(IBINS("S",IBX)) Q:'IBX D Q:IBRES>1
- . S IBT=0 F S IBT=$O(IBINS("S",IBX,IBT)) Q:'IBT D Q:IBRES>1
- . . N IBPL
- . . S IBPL=+$P($G(IBINS(IBT,0)),U,18) Q:'IBPL
- . . I '$$PLCOV^IBCNSU3(IBPL,IBADT,IBCAT) Q
- . . S IBRES=IBRES+1
- ;
- Q (IBRES>1)
- ;
- ;Relocated from IBNCPDPU
- NDC(X) ; Massage the NDC as it is stored in Pharmacy
- ; Input: X -- The NDC as it is stored in Pharmacy
- ; Output: X -- The NDC in the format 5N 1"-" 4N 1"-" 2N
- ;
- I $G(X)="" S X="" G NDCQ
- ;
- N LEN,PCE,Y,Z
- ;
- S Z(1)=5,Z(2)=4,Z(3)=2
- S PCE=0 F S PCE=$O(Z(PCE)) Q:'PCE S LEN=Z(PCE) D
- .S Y=$P(X,"-",PCE)
- .I $L(Y)>LEN S Y=$E(Y,2,LEN+1)
- .I $L(+Y)<LEN S Y=$$FILL^IBNCPDPU(Y,LEN)
- .S $P(X,"-",PCE)=Y
- ;
- NDCQ Q X
- ;
- ERMSG(IBSTL) ; Inactive status reason
- N IBSTA,IBI,IBARR,IBTXT
- D STATAR^IBCNRU1(.IBARR)
- F IBI=1:1:$L(IBSTL,",")+1 S IBSTA=+$P(IBSTL,",",IBI) Q:"^100^200^300^400^"'[(U_IBSTA_U)
- S IBTXT=$G(IBARR(+IBSTA),"Plan is not active.")
- Q IBTXT
- ;
- PAPERBIL(IBTRKRN) ; 'paper' bill in CT?
- N IBZ,IBIFN
- S IBZ=$G(^IBT(356,IBTRKRN,0)) I IBZ="" Q 0
- S IBIFN=+$P(IBZ,U,11) I 'IBIFN Q 0
- I $P($G(^DGCR(399,IBIFN,0)),U,13)=7 Q 0 ; cancelled
- I $P($G(^DGCR(399,IBIFN,"M1")),U,8)'="" Q 0 ; ecme bill
- Q 1
- ;IBNCPNB
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPNB 7080 printed Feb 18, 2025@23:51:33 Page 2
- IBNCPNB ;OAK/ELZ - UTILITIES FOR NCPCP ;5/22/08 15:23
- +1 ;;2.0;INTEGRATED BILLING;**276,342,384,452**;21-MAR-94;Build 26
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;NCPDP PHASE III
- +5 QUIT
- +6 ;
- +7 ;
- NONBR(DFN,IBRX,IBFIL,IBADT,IBCR,IBPAP,IBRC,IBCC,IBUSER) ; Set non-billable reason to CT
- +1 ; input:
- +2 ; DFN - Patient
- +3 ; IBRX - Rx IEN
- +4 ; IBFIL - fill#
- +5 ; IBADT - Date of Service
- +6 ; IBCR - Close Claim Reason (#356.8)
- +7 ; IBPAP - Autobillable flag (billable (1) / non-billable (0) flag)
- +8 ; IBRC - Release Copay (entered by OPECC)
- +9 ; IBCC - Close Reason Comment (entered by OPECC)
- +10 ; IBUSER - DUZ of user triggering the billing event
- +11 NEW IBTRKRN,DIE,IBRESN,DR,DA,IBRMARK,IBLOCK,IBEABD,IBEABD,IBACT,IBFDA
- +12 ; update claims tracking
- +13 SET IBTRKRN=+$ORDER(^IBT(356,"ARXFL",IBRX,IBFIL,0))
- +14 ; if it doesn't exist - create it
- IF 'IBTRKRN
- Begin DoDot:1
- +15 NEW IBTRKR
- +16 ; claims tracking info
- SET IBTRKR=$GET(^IBE(350.9,1,6))
- +17 ; date can't be before parameters
- +18 SET $PIECE(IBTRKR,U)=$SELECT('$PIECE(IBTRKR,U,4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT)
- +19 ; CT Disabled
- IF 'IBTRKR
- QUIT
- +20 DO CT^IBNCPDPU(DFN,IBRX,IBFIL,IBADT,$GET(IBCR))
- +21 SET IBTRKRN=+$ORDER(^IBT(356,"ARXFL",IBRX,IBFIL,0))
- End DoDot:1
- +22 ; CT disabled
- IF 'IBTRKRN
- QUIT
- +23 LOCK +^IBT(356,IBTRKRN):10
- SET IBLOCK=$TEST
- +24 SET DIE="^IBT(356,"
- SET DA=IBTRKRN
- +25 ;
- +26 ;
- +27 ; if Billable - set EABD+60
- +28 IF '$GET(IBCR)
- Begin DoDot:1
- +29 ;quit if non-billable
- if $$GET1^DIQ(356,IBTRKRN_",",.19,"I")
- QUIT
- +30 SET IBEABD=$$EABD^IBTUTL($ORDER(^IBE(356.6,"AC",4,0)),IBADT)
- +31 IF IBEABD
- SET IBEABD=$$FMADD^XLFDT(IBEABD,60)
- +32 SET DR=".17////^S X=IBEABD"
- DO ^DIE
- End DoDot:1
- GOTO NONBRQ
- +33 ;
- +34 ; if still billable, set the EABD.
- +35 ;
- +36 ; Don't check for the 2nd insurance in Phase 3 --
- +37 ; allow the claim to become non-billable, ECME has already warned
- +38 ; the user and provided information about the 2nd insurance
- +39 ; in the User Screen
- +40 ; I IBPAP!$$MOREINS(DFN,IBADT) D G NONBRQ
- +41 ;
- +42 IF IBPAP
- Begin DoDot:1
- +43 SET IBEABD=$$EABD^IBTUTL($ORDER(^IBE(356.6,"AC",4,0)),IBADT)
- +44 IF IBEABD<DT
- SET IBEABD=DT
- +45 ; it re-sets .17 (trigger in #356)
- SET DR=".19///@"
- DO ^DIE
- +46 SET DR=".17////^S X=IBEABD"
- +47 SET IBRMARK=$$REASON^IBNCPDPU(IBCR)
- +48 IF IBCC'=""
- SET IBRMARK=IBRMARK_"; "_IBCC
- +49 IF $LENGTH($GET(IBCC))>2
- SET DR=DR_";1.08////^S X=$E(IBRMARK,1,80)"
- +50 DO ^DIE
- End DoDot:1
- GOTO NONBRQ
- +51 ;
- +52 ; set non-billable reason
- +53 SET IBRMARK=$$REASON^IBNCPDPU(IBCR)
- +54 IF IBRMARK=""
- SET IBRMARK="OTHER"
- SET IBCC="Unknown NBR '"_IBCR_"'. "_$GET(IBCC)
- +55 SET DR=".19///"_IBRMARK
- +56 IF $LENGTH($GET(IBCC))>2
- SET DR=DR_";1.08////^S X=$E(IBCC,1,80)"
- +57 DO ^DIE
- +58 ;
- NONBRQ ;
- +1 ; Release Copay
- IF $GET(IBRC)
- Begin DoDot:1
- +2 ; release copay charges off hold
- SET IBACT=+$$RELCOPAY(DFN,IBRX,IBFIL,1,IBADT,0)
- +3 ;if 0 (not found on HOLD) we will have one more attempt, it was scheduled inside RELCOPAY
- +4 ; so doesn't make sense to send "NOT RELEASED" e-mail
- +5 ; if the 2nd attempt fails then e-mail will be send from RCTASK
- +6 ;we send e-mail only if -1 i.e. if charge was found on hold but
- +7 ; ^IBR gave an error when we tried to release it
- +8 IF IBACT=-1
- DO RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,IBACT,IBCR,$GET(IBCC),0,1)
- +9 ;if -2 (there is no copay) then do nothing
- End DoDot:1
- +10 ; date last edited
- SET IBFDA(356,IBTRKRN_",",1.03)=DT
- +11 ; last edited by
- SET IBFDA(356,IBTRKRN_",",1.04)=IBUSER
- +12 DO FILE^DIE("","IBFDA")
- DO MSG^DIALOG()
- +13 IF IBLOCK
- LOCK -^IBT(356,IBTRKRN)
- +14 QUIT
- +15 ;
- +16 ;
- RELCOPAY(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN) ; Release copay charges on hold
- +1 ; Input:
- +2 ; DFN - Patient IEN
- +3 ; IBRX - Rx IEN
- +4 ; IBFIL - fill/refill #
- +5 ; IBRETRY - retry flag
- +6 ; IBADT - Date of Service
- +7 ; IBIFN - 3rd party bill IEN
- +8 ; output:
- +9 ; -2 == there is no any copay
- +10 ; -1^error code if unsuccessful == if ^IBR error
- +11 ; 0 == charge was not found (and depends on IBRETRY another attempt can be scheduled)
- +12 ; >0 == charge was released from HOLD
- +13 ; this procedure will be called if the Payer agreed to pay 0.00
- +14 ; or the claim was closed as non-billable by the OPECC.
- +15 ; if patient exempt from RX copay then there is nothing to release from HOLD - quit
- +16 IF +$$RXEXMT^IBARXEU0(DFN,IBADT)=1
- QUIT -2
- +17 NEW IBACT,IBZ,IBFOUND,IBX,IBSEQNO,IBNOS,Y,IBDUZ,RCDUZ
- +18 ; Schedule the task to speed up the whole process
- +19 IF 'IBRETRY
- DO RCTASK(DFN,IBRX,IBFIL,+IBRETRY,IBADT,IBIFN)
- QUIT 0
- +20 SET IBFOUND=0
- +21 SET IBACT="A"
- FOR
- SET IBACT=$ORDER(^IB("AH",DFN,IBACT),-1)
- if 'IBACT
- QUIT
- Begin DoDot:1
- +22 SET IBZ=$GET(^IB(IBACT,0))
- if IBZ=""
- QUIT
- +23 SET IBX=$PIECE(IBZ,U,4)
- +24 ; not an Rx
- IF +IBX'=52
- QUIT
- +25 ; other Rx
- IF +$PIECE(IBX,":",2)'=IBRX
- QUIT
- +26 ; other fill
- IF +$PIECE(IBX,":",3)'=IBFIL
- QUIT
- +27 SET IBFOUND=IBACT
- End DoDot:1
- if IBFOUND
- QUIT
- +28 IF 'IBFOUND
- DO RCTASK(DFN,IBRX,IBFIL,+$GET(IBRETRY),IBADT,IBIFN)
- QUIT 0
- +29 SET IBSEQNO=1
- SET IBNOS=IBFOUND
- +30 ; who entered the copay charge?
- SET IBDUZ=$PIECE($GET(^IB(IBFOUND,1)),U)
- +31 SET RCDUZ=IBDUZ
- +32 DO ^IBR
- IF Y<0
- QUIT Y
- +33 QUIT IBFOUND
- +34 ;
- +35 ;Called by TaskMan
- RELCRG ;
- +1 NEW IBACT
- +2 SET IBACT=+$$RELCOPAY(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN)
- +3 ;if 0 (not found on HOLD) we will have another attempt
- +4 ;we send e-mail only if -1 (^IBR error)
- +5 IF IBACT=-1
- DO RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,IBACT,0,"",IBIFN,IBRETRY)
- +6 ;
- +7 QUIT
- +8 ;
- +9 ;Schedule Release Copay
- RCTASK(DFN,IBRX,IBFIL,IBRETRY,IBADT,IBIFN) ;
- +1 NEW I,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO
- +2 SET IBRETRY=IBRETRY+1
- +3 ; Only two extra attempts
- IF IBRETRY>2
- Begin DoDot:1
- +4 ;if all attempts were unsuccessful then send e-mail, set IBACT=0 since we do not have it
- +5 DO RELBUL^IBNCPEB(DFN,IBRX,IBFIL,IBADT,0,0,"",IBIFN,2)
- End DoDot:1
- QUIT
- +6 SET ZTRTN="RELCRG^IBNCPNB"
- +7 FOR I="DFN","IBRX","IBFIL","IBRETRY","IBADT","IBIFN"
- SET ZTSAVE(I)=""
- +8 SET ZTDESC="RELEASE COPAY RX IEN# "_IBRX
- +9 SET ZTIO=""
- +10 SET ZTDTH=$$HADD^XLFDT($HOROLOG,0,0,0,$SELECT(IBRETRY=1:10,1:600))
- +11 DO ^%ZTLOAD
- +12 QUIT
- +13 ;
- +14 ;
- +15 ; does the pat have >1 billable insur with pharm coverage?
- MOREINS(DFN,IBADT) ;
- +1 ; DFN - ptr to the patient
- +2 ; IBADT - the effective date
- +3 NEW IBANY,IBX,IBINS,IBT,IBRES,IBCAT
- +4 ; No by default
- SET IBRES=0
- +5 SET IBCAT=$ORDER(^IBE(355.31,"B","PHARMACY",0))
- +6 ; -- look up insurance for patient
- +7 DO ALL^IBCNS1(DFN,"IBINS",1,IBADT,1)
- +8 SET IBX=0
- FOR
- SET IBX=$ORDER(IBINS("S",IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +9 SET IBT=0
- FOR
- SET IBT=$ORDER(IBINS("S",IBX,IBT))
- if 'IBT
- QUIT
- Begin DoDot:2
- +10 NEW IBPL
- +11 SET IBPL=+$PIECE($GET(IBINS(IBT,0)),U,18)
- if 'IBPL
- QUIT
- +12 IF '$$PLCOV^IBCNSU3(IBPL,IBADT,IBCAT)
- QUIT
- +13 SET IBRES=IBRES+1
- End DoDot:2
- if IBRES>1
- QUIT
- End DoDot:1
- if IBRES>1
- QUIT
- +14 ;
- +15 QUIT (IBRES>1)
- +16 ;
- +17 ;Relocated from IBNCPDPU
- NDC(X) ; Massage the NDC as it is stored in Pharmacy
- +1 ; Input: X -- The NDC as it is stored in Pharmacy
- +2 ; Output: X -- The NDC in the format 5N 1"-" 4N 1"-" 2N
- +3 ;
- +4 IF $GET(X)=""
- SET X=""
- GOTO NDCQ
- +5 ;
- +6 NEW LEN,PCE,Y,Z
- +7 ;
- +8 SET Z(1)=5
- SET Z(2)=4
- SET Z(3)=2
- +9 SET PCE=0
- FOR
- SET PCE=$ORDER(Z(PCE))
- if 'PCE
- QUIT
- SET LEN=Z(PCE)
- Begin DoDot:1
- +10 SET Y=$PIECE(X,"-",PCE)
- +11 IF $LENGTH(Y)>LEN
- SET Y=$EXTRACT(Y,2,LEN+1)
- +12 IF $LENGTH(+Y)<LEN
- SET Y=$$FILL^IBNCPDPU(Y,LEN)
- +13 SET $PIECE(X,"-",PCE)=Y
- End DoDot:1
- +14 ;
- NDCQ QUIT X
- +1 ;
- ERMSG(IBSTL) ; Inactive status reason
- +1 NEW IBSTA,IBI,IBARR,IBTXT
- +2 DO STATAR^IBCNRU1(.IBARR)
- +3 FOR IBI=1:1:$LENGTH(IBSTL,",")+1
- SET IBSTA=+$PIECE(IBSTL,",",IBI)
- if "^100^200^300^400^"'[(U_IBSTA_U)
- QUIT
- +4 SET IBTXT=$GET(IBARR(+IBSTA),"Plan is not active.")
- +5 QUIT IBTXT
- +6 ;
- PAPERBIL(IBTRKRN) ; 'paper' bill in CT?
- +1 NEW IBZ,IBIFN
- +2 SET IBZ=$GET(^IBT(356,IBTRKRN,0))
- IF IBZ=""
- QUIT 0
- +3 SET IBIFN=+$PIECE(IBZ,U,11)
- IF 'IBIFN
- QUIT 0
- +4 ; cancelled
- IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=7
- QUIT 0
- +5 ; ecme bill
- IF $PIECE($GET(^DGCR(399,IBIFN,"M1")),U,8)'=""
- QUIT 0
- +6 QUIT 1
- +7 ;IBNCPNB