- IBNCPDPI ;DALOI/SS - ECME SCREEN INSURANCE VIEW AND UTILITIES ;3/6/08 16:21
- ;;2.0;INTEGRATED BILLING;**276,383,384,411,435**;21-MAR-94;Build 27
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;
- EN1(DFN) ;
- I $G(DFN)'>0 Q
- N J,POP,START,X,VA,ALMBG,DIC,DT,C,CTRLCOL,DILN
- ;
- ;if the user does have IB keys to edit insurances
- I $D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))!($D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ))) D Q
- . N D1,DA,DDER,DDH,DIE,DR,I
- . N IBCH,IBCNS,IBCNSEH,IBCNT,IBCPOL,IBDT,IBDUZ,IBFILE,IBLCNT,IBN,IBNEW,IBPPOL
- . N IBTYP,IBYE,IBCDFN,IBCDFND1,IBCGN
- . D EN^VALM("IBNCPDP INSURANCE MANAGEMENT")
- ;if the user doesn't have insurance IB keys
- D
- . N D0,IBCAB,IBCDFN,IBCDFND1,IBCNS,IBCNT,IBCPOL,IBDT,IBEXP1
- . N IBEXP2,IBFILE,IBLCNT,IBN,IBPPOL
- . D EN1^IBNCPDPV(DFN)
- Q
- ;
- INIT ; -- set up initial variables
- ;DFN should be defined
- I '$D(DFN) Q
- S U="^",VALMCNT=0,VALMBG=1
- K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J)
- S IBTYP="P"
- D BLD^IBCNSM
- Q
- ;
- HDR ; -- screen header for initial screen
- D HDR^IBCNSM
- Q
- ;
- HELP ; -- help code
- Q
- ;
- EXIT ; -- exit code
- Q
- ;
- EXPND ; -- expand code
- Q
- ;
- SELINSUR(PRMTMSG,DFLTVAL) ;
- ;API for ECME (DBIA #4721)
- ;Insurance Company lookup API
- ;input:
- ; PRMTMSG - prompt message
- ; DFLTVAL - INSURANCE NAME as a default value for the prompt (optional)
- ;output:
- ; IEN^INSURANCE_NAME
- ; 0^ means ALL selected
- ; -1^ nothing was selected, timeout expired or uparrow entered
- ; where: IEN is record number in file #36.
- ;
- N Y,DUOUT,DTOUT,IBQUIT,DIROUT
- S IBQUIT=0
- N DIC
- S DIC="^DIC(36,"
- S DIC(0)="AEMNQ"
- S:$L($G(DFLTVAL))>0 DIC("B")=DFLTVAL
- S DIC("A")=PRMTMSG_": "
- D ^DIC
- I (Y=-1)!$D(DUOUT)!$D(DTOUT) S IBQUIT=1
- I IBQUIT=1 Q "-1^"
- Q Y
- ;
- RNB(IBRX,IBFL) ; Return the Claims Tracking Reason Not Billable for a Prescription
- ; API for ECME (DBIA #4729)
- ; Input: IBRX - prescription ien (required)
- ; IBFL - fill# (required)
- ; Output: function value
- ; [1] RNB ien (ptr to file# 356.8)
- ; [2] RNB description
- ; [3] RNB ECME flag
- ; [4] RNB ECME paper flag
- ; [5] RNB code
- ; [6] RNB active/inactive flag
- ; or 0 if no CT entry or if CT entry is billable
- ;
- N RNB,IBTRKRN
- S RNB=0
- S IBTRKRN=+$O(^IBT(356,"ARXFL",+$G(IBRX),+$G(IBFL),0)) I 'IBTRKRN G RNBX
- S RNB=+$P($G(^IBT(356,IBTRKRN,0)),U,19) I 'RNB G RNBX
- S RNB=RNB_U_$G(^IBE(356.8,RNB,0))
- RNBX ;
- Q RNB
- ;
- BILLINFO(IBRX,IBREF,IBPSEQ) ;
- ;API for ECME (DBIA #4729)
- ;Determine Bill# and Account Receivable information about the bill
- ;input:
- ; IBRX - pointer to file #52 (internal prescription number)
- ; IBREF - re-fill number
- ; IBPSEQ - payer sequence
- ;output:
- ;Returns a string of information about the bill requested:
- ; piece #1: Bill number (field(#.01) of file (#399))
- ; piece #2: Original Amount of bill
- ; piece #3: Current Status (pointer to file #430.3)
- ; piece #4: Current Balance
- ; piece #5: Total Collected
- ; piece #6: % Collected Returns null if no data or bill found.
- ;
- N IBIEN,IBBNUM,RCRET,IBRETV,IBARR,IBZ
- I +$G(IBPSEQ)=0 S IBPSEQ=1
- S RCRET="",IBRETV="",IBIEN=""
- I IBPSEQ=1 S IBBNUM=$$BILL^IBNCPDPU(IBRX,IBREF) ;get from the CT record
- ;find secondary bill, return null if none
- I IBPSEQ=2 S IBZ=$$RXBILL^IBNCPUT3(IBRX,IBREF,"S",,.IBARR) D Q:+IBIEN=0 "^" S IBBNUM=$P($G(IBARR(IBIEN)),U)
- . S IBIEN=$P(IBZ,U,2) Q:+IBIEN>0
- . ;if there is no active bill then get the latest bill with whatever status
- . S IBIEN=$O(IBARR(999999999),-1)
- I IBBNUM]"" D
- .I IBIEN="" S IBIEN=$O(^DGCR(399,"B",IBBNUM,"")) Q:IBIEN=""
- .S RCRET=$$BILL^RCJIBFN2(IBIEN)
- S IBRETV=IBBNUM_U_RCRET
- Q IBRETV
- ;
- ;
- TPJI(DFN) ; entry point for TPJI option of the ECME User Screen
- I DFN>0 D EN^IBJTLA
- Q
- ;
- INSNM(IBINSIEN) ; api to return insurance company name
- Q $P($G(^DIC(36,+$G(IBINSIEN),0)),"^")
- ;
- ACPHONE() ; API to return the default Pay-to provider phone#
- Q $$PRVPHONE^IBJPS3()
- ;
- INSPL(IBPL) ; api to return the insurance company IEN from the plan
- ; passed in.
- Q $P($G(^IBA(355.3,+$G(IBPL),0)),"^")
- ;
- MXTRNS(IBPLID) ; api to return MAXIMUM NCPDP TRANSACTIONS for a plan
- ; Input: IBPLID = ID from the PLAN file.
- ; Returns: Numeric value from field 10.1 of Plan file
- ; Default's to 1 if undefined.
- Q:IBPLID="" 1
- Q:$O(^IBCNR(366.03,"B",$G(IBPLID),0))']"" 1
- Q $P($G(^IBCNR(366.03,$O(^IBCNR(366.03,"B",$G(IBPLID),0)),10)),"^",10)
- ;
- EPHON() ; API to return if ePharmacy is on within IB
- ; 1 FOR Active
- ; 0 FOR Not Active
- ;
- Q +$G(^IBE(350.9,1,11))
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPDPI 4684 printed Jan 18, 2025@03:25:57 Page 2
- IBNCPDPI ;DALOI/SS - ECME SCREEN INSURANCE VIEW AND UTILITIES ;3/6/08 16:21
- +1 ;;2.0;INTEGRATED BILLING;**276,383,384,411,435**;21-MAR-94;Build 27
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;
- EN1(DFN) ;
- +1 IF $GET(DFN)'>0
- QUIT
- +2 NEW J,POP,START,X,VA,ALMBG,DIC,DT,C,CTRLCOL,DILN
- +3 ;
- +4 ;if the user does have IB keys to edit insurances
- +5 IF $DATA(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))!($DATA(^XUSEC("IB INSURANCE COMPANY ADD",DUZ)))
- Begin DoDot:1
- +6 NEW D1,DA,DDER,DDH,DIE,DR,I
- +7 NEW IBCH,IBCNS,IBCNSEH,IBCNT,IBCPOL,IBDT,IBDUZ,IBFILE,IBLCNT,IBN,IBNEW,IBPPOL
- +8 NEW IBTYP,IBYE,IBCDFN,IBCDFND1,IBCGN
- +9 DO EN^VALM("IBNCPDP INSURANCE MANAGEMENT")
- End DoDot:1
- QUIT
- +10 ;if the user doesn't have insurance IB keys
- +11 Begin DoDot:1
- +12 NEW D0,IBCAB,IBCDFN,IBCDFND1,IBCNS,IBCNT,IBCPOL,IBDT,IBEXP1
- +13 NEW IBEXP2,IBFILE,IBLCNT,IBN,IBPPOL
- +14 DO EN1^IBNCPDPV(DFN)
- End DoDot:1
- +15 QUIT
- +16 ;
- INIT ; -- set up initial variables
- +1 ;DFN should be defined
- +2 IF '$DATA(DFN)
- QUIT
- +3 SET U="^"
- SET VALMCNT=0
- SET VALMBG=1
- +4 KILL ^TMP("IBNSM",$JOB),^TMP("IBNSMDX",$JOB)
- +5 SET IBTYP="P"
- +6 DO BLD^IBCNSM
- +7 QUIT
- +8 ;
- HDR ; -- screen header for initial screen
- +1 DO HDR^IBCNSM
- +2 QUIT
- +3 ;
- HELP ; -- help code
- +1 QUIT
- +2 ;
- EXIT ; -- exit code
- +1 QUIT
- +2 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- SELINSUR(PRMTMSG,DFLTVAL) ;
- +1 ;API for ECME (DBIA #4721)
- +2 ;Insurance Company lookup API
- +3 ;input:
- +4 ; PRMTMSG - prompt message
- +5 ; DFLTVAL - INSURANCE NAME as a default value for the prompt (optional)
- +6 ;output:
- +7 ; IEN^INSURANCE_NAME
- +8 ; 0^ means ALL selected
- +9 ; -1^ nothing was selected, timeout expired or uparrow entered
- +10 ; where: IEN is record number in file #36.
- +11 ;
- +12 NEW Y,DUOUT,DTOUT,IBQUIT,DIROUT
- +13 SET IBQUIT=0
- +14 NEW DIC
- +15 SET DIC="^DIC(36,"
- +16 SET DIC(0)="AEMNQ"
- +17 if $LENGTH($GET(DFLTVAL))>0
- SET DIC("B")=DFLTVAL
- +18 SET DIC("A")=PRMTMSG_": "
- +19 DO ^DIC
- +20 IF (Y=-1)!$DATA(DUOUT)!$DATA(DTOUT)
- SET IBQUIT=1
- +21 IF IBQUIT=1
- QUIT "-1^"
- +22 QUIT Y
- +23 ;
- RNB(IBRX,IBFL) ; Return the Claims Tracking Reason Not Billable for a Prescription
- +1 ; API for ECME (DBIA #4729)
- +2 ; Input: IBRX - prescription ien (required)
- +3 ; IBFL - fill# (required)
- +4 ; Output: function value
- +5 ; [1] RNB ien (ptr to file# 356.8)
- +6 ; [2] RNB description
- +7 ; [3] RNB ECME flag
- +8 ; [4] RNB ECME paper flag
- +9 ; [5] RNB code
- +10 ; [6] RNB active/inactive flag
- +11 ; or 0 if no CT entry or if CT entry is billable
- +12 ;
- +13 NEW RNB,IBTRKRN
- +14 SET RNB=0
- +15 SET IBTRKRN=+$ORDER(^IBT(356,"ARXFL",+$GET(IBRX),+$GET(IBFL),0))
- IF 'IBTRKRN
- GOTO RNBX
- +16 SET RNB=+$PIECE($GET(^IBT(356,IBTRKRN,0)),U,19)
- IF 'RNB
- GOTO RNBX
- +17 SET RNB=RNB_U_$GET(^IBE(356.8,RNB,0))
- RNBX ;
- +1 QUIT RNB
- +2 ;
- BILLINFO(IBRX,IBREF,IBPSEQ) ;
- +1 ;API for ECME (DBIA #4729)
- +2 ;Determine Bill# and Account Receivable information about the bill
- +3 ;input:
- +4 ; IBRX - pointer to file #52 (internal prescription number)
- +5 ; IBREF - re-fill number
- +6 ; IBPSEQ - payer sequence
- +7 ;output:
- +8 ;Returns a string of information about the bill requested:
- +9 ; piece #1: Bill number (field(#.01) of file (#399))
- +10 ; piece #2: Original Amount of bill
- +11 ; piece #3: Current Status (pointer to file #430.3)
- +12 ; piece #4: Current Balance
- +13 ; piece #5: Total Collected
- +14 ; piece #6: % Collected Returns null if no data or bill found.
- +15 ;
- +16 NEW IBIEN,IBBNUM,RCRET,IBRETV,IBARR,IBZ
- +17 IF +$GET(IBPSEQ)=0
- SET IBPSEQ=1
- +18 SET RCRET=""
- SET IBRETV=""
- SET IBIEN=""
- +19 ;get from the CT record
- IF IBPSEQ=1
- SET IBBNUM=$$BILL^IBNCPDPU(IBRX,IBREF)
- +20 ;find secondary bill, return null if none
- +21 IF IBPSEQ=2
- SET IBZ=$$RXBILL^IBNCPUT3(IBRX,IBREF,"S",,.IBARR)
- Begin DoDot:1
- +22 SET IBIEN=$PIECE(IBZ,U,2)
- if +IBIEN>0
- QUIT
- +23 ;if there is no active bill then get the latest bill with whatever status
- +24 SET IBIEN=$ORDER(IBARR(999999999),-1)
- End DoDot:1
- if +IBIEN=0
- QUIT "^"
- SET IBBNUM=$PIECE($GET(IBARR(IBIEN)),U)
- +25 IF IBBNUM]""
- Begin DoDot:1
- +26 IF IBIEN=""
- SET IBIEN=$ORDER(^DGCR(399,"B",IBBNUM,""))
- if IBIEN=""
- QUIT
- +27 SET RCRET=$$BILL^RCJIBFN2(IBIEN)
- End DoDot:1
- +28 SET IBRETV=IBBNUM_U_RCRET
- +29 QUIT IBRETV
- +30 ;
- +31 ;
- TPJI(DFN) ; entry point for TPJI option of the ECME User Screen
- +1 IF DFN>0
- DO EN^IBJTLA
- +2 QUIT
- +3 ;
- INSNM(IBINSIEN) ; api to return insurance company name
- +1 QUIT $PIECE($GET(^DIC(36,+$GET(IBINSIEN),0)),"^")
- +2 ;
- ACPHONE() ; API to return the default Pay-to provider phone#
- +1 QUIT $$PRVPHONE^IBJPS3()
- +2 ;
- INSPL(IBPL) ; api to return the insurance company IEN from the plan
- +1 ; passed in.
- +2 QUIT $PIECE($GET(^IBA(355.3,+$GET(IBPL),0)),"^")
- +3 ;
- MXTRNS(IBPLID) ; api to return MAXIMUM NCPDP TRANSACTIONS for a plan
- +1 ; Input: IBPLID = ID from the PLAN file.
- +2 ; Returns: Numeric value from field 10.1 of Plan file
- +3 ; Default's to 1 if undefined.
- +4 if IBPLID=""
- QUIT 1
- +5 if $ORDER(^IBCNR(366.03,"B",$GET(IBPLID),0))']""
- QUIT 1
- +6 QUIT $PIECE($GET(^IBCNR(366.03,$ORDER(^IBCNR(366.03,"B",$GET(IBPLID),0)),10)),"^",10)
- +7 ;
- EPHON() ; API to return if ePharmacy is on within IB
- +1 ; 1 FOR Active
- +2 ; 0 FOR Not Active
- +3 ;
- +4 QUIT +$GET(^IBE(350.9,1,11))
- +5 ;