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

IBJTU6.m

Go to the documentation of this file.
  1. IBJTU6 ;ALB/ESG - TPJI UTILITIES/APIs ;9/2/11
  1. ;;2.0;INTEGRATED BILLING;**452,530,642**;21-MAR-94;Build 22
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. IBDSP(TYPE,IBIFN,DFN,IBCDFN,IBLMDISPA,VALMHDR) ; Build IB display array data
  1. ; The purpose of this API is to build the List Manager display array scratch global
  1. ; and return it to the calling application in the scratch global array specified.
  1. ;
  1. ; Input:
  1. ; TYPE - type of IB screen data to build, can be one of the following:
  1. ; 1 = TPJI Claim Information screen (default)
  1. ; 2 = TPJI AR Account Profile screen
  1. ; 3 = TPJI AR Comment History screen
  1. ; 4 = TPJI ECME Rx Response screen
  1. ; 5 = Patient Insurance Policy Information screen
  1. ; IBIFN - claim ien (#399) Required for any TPJI screen, otherwise optional
  1. ; DFN - patient ien (#2) Required for Insurance screen, otherwise optional
  1. ; IBCDFN - insurance type ien (#2.312) Required for Insurance screen, otherwise optional
  1. ;
  1. ; Output:
  1. ; IBLMDISPA - Destination scratch global reference in which to store the results
  1. ; Pass closed scratch global reference.
  1. ; Data will be returned in @IBLMDISPA@(LN,0), where LN is a sequential line# counter
  1. ; VALMHDR - LM display header array. Pass by reference
  1. ;
  1. N VALMAR,IBRTN
  1. N I,IBX,IBXARRAY,IBXARRY,IBXERR,IBXSAVE,VALMBG,VALMSG,VALMCNT,X,Y,Z,IBPOLICY,IBARCOMM
  1. N D0,IB1ST,IBCNS,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,VALM,VALMDDF,GX,IBPPOL
  1. K @IBLMDISPA,VALMHDR
  1. ;
  1. I '$F(".1.2.3.4.5.","."_$G(TYPE)_".") S TYPE=1
  1. ;
  1. I $F(".1.2.3.4.","."_TYPE_"."),'$G(IBIFN) G IBDSPX ; IBIFN required for TPJI screens
  1. I $F(".1.2.3.4.","."_TYPE_"."),'$G(DFN) S DFN=+$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) I 'DFN G IBDSPX
  1. I TYPE=5,'$G(DFN) G IBDSPX ; DFN required for ins
  1. I TYPE=5,'$G(IBCDFN) G IBDSPX ; IBCDFN required for ins
  1. ;
  1. I TYPE=1 S VALMAR=$NA(^TMP("IBJTCA",$J)),IBRTN="INIT^IBJTCA,HDR^IBJTCA" ; tpji claim info
  1. I TYPE=2 S VALMAR=$NA(^TMP("IBJTTA",$J)),IBRTN="INIT^IBJTTA,HDR^IBJTTA" ; tpji AR acct profile
  1. I TYPE=3 S VALMAR=$NA(^TMP("IBJTTC",$J)),IBRTN="INIT^IBJTTC,HDR^IBJTTC" ; tpji AR comment
  1. I TYPE=4 S VALMAR=$NA(^TMP("IBJTRX",$J)),IBRTN="INIT^IBJTRX,HDR^IBJTRX" ; tpji ECME Rx
  1. I TYPE=5 S VALMAR=$NA(^TMP("IBCNSVP",$J)),IBRTN="INIT^IBCNSP" ; pt ins policy detail
  1. ;
  1. I TYPE=2 S VALM("IFN")=+$$FIND1^DIC(409.61,,,"IBJT AR ACCOUNT PROFILE"),GX="D COL^VALM" X GX
  1. I TYPE=5 S IBPPOL=U_2_U_DFN_U_IBCDFN_U_$G(^DPT(DFN,.312,IBCDFN,0))
  1. K @VALMAR
  1. D @IBRTN
  1. ;
  1. ; merge IB display lines into target array
  1. M @IBLMDISPA=@VALMAR
  1. ;
  1. ; clean up IB scratch arrays
  1. K @VALMAR,^TMP($J,"IBTPJI"),^TMP("IBJTTAX",$J)
  1. ;
  1. IBDSPX ;
  1. Q
  1. ;
  1. BILLREJ(BILL) ;Is the bill a reject?
  1. ; Input:
  1. ; BILL - Bill number from #399 - External Value (.01), not IEN
  1. ; Output:
  1. ; REJECT - Reject status (blank = not found, 0 = not a reject, 1 = rejected)
  1. ;
  1. N IEN,PTR,SEV,REJECT
  1. I BILL="" Q "" ;no bill #
  1. S REJECT=0,IEN=$O(^DGCR(399,"B",BILL,"")) Q:'IEN ""
  1. I '$D(^IBM(361,"B",IEN)) Q "" ;no entry in #361
  1. S PTR=0 F S PTR=$O(^IBM(361,"B",IEN,PTR)) Q:'PTR D Q:REJECT
  1. . S SEV=$$GET1^DIQ(361,PTR_",",.03,"I")
  1. . I SEV="R" S REJECT=1
  1. Q REJECT
  1. ;
  1. ; Subroutine added for IB*2.0*642
  1. BILLREJ2(BILL) ;EP
  1. ; Does this bill contain rejects with uncompleted reviews?
  1. ; Input: BILL - Bill number from #399 - External Value (.01), not IEN
  1. ; Returns: 1 - Bill contains rejects with uncompleted reviews, 0 otherwiese
  1. ;
  1. N IEN,PTR,REJECT,SEV
  1. Q:BILL="" 0 ; No bill #
  1. S REJECT=0,IEN=$O(^DGCR(399,"B",BILL,""))
  1. Q:'IEN 0 ; Invalid bill #
  1. Q:'$D(^IBM(361,"B",IEN)) 0 ; No messages in #361
  1. S PTR=0
  1. F D Q:'PTR Q:REJECT
  1. . S PTR=$O(^IBM(361,"B",IEN,PTR))
  1. . Q:'PTR
  1. . S SEV=$$GET1^DIQ(361,PTR_",",.03,"I")
  1. . Q:SEV'="R"
  1. . Q:$D(^IBM(361,"ACSA","R",2,PTR)) ; Review is completed
  1. . S REJECT=1
  1. Q REJECT