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 Apr 09, 2024@21:22:18 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 ;
