Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBNCPDPI

IBNCPDPI.m

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