IBJTU6 ;ALB/ESG - TPJI UTILITIES/APIs ;9/2/11
;;2.0;INTEGRATED BILLING;**452,530,642**;21-MAR-94;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
IBDSP(TYPE,IBIFN,DFN,IBCDFN,IBLMDISPA,VALMHDR) ; Build IB display array data
; The purpose of this API is to build the List Manager display array scratch global
; and return it to the calling application in the scratch global array specified.
;
; Input:
; TYPE - type of IB screen data to build, can be one of the following:
; 1 = TPJI Claim Information screen (default)
; 2 = TPJI AR Account Profile screen
; 3 = TPJI AR Comment History screen
; 4 = TPJI ECME Rx Response screen
; 5 = Patient Insurance Policy Information screen
; IBIFN - claim ien (#399) Required for any TPJI screen, otherwise optional
; DFN - patient ien (#2) Required for Insurance screen, otherwise optional
; IBCDFN - insurance type ien (#2.312) Required for Insurance screen, otherwise optional
;
; Output:
; IBLMDISPA - Destination scratch global reference in which to store the results
; Pass closed scratch global reference.
; Data will be returned in @IBLMDISPA@(LN,0), where LN is a sequential line# counter
; VALMHDR - LM display header array. Pass by reference
;
N VALMAR,IBRTN
N I,IBX,IBXARRAY,IBXARRY,IBXERR,IBXSAVE,VALMBG,VALMSG,VALMCNT,X,Y,Z,IBPOLICY,IBARCOMM
N D0,IB1ST,IBCNS,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,VALM,VALMDDF,GX,IBPPOL
K @IBLMDISPA,VALMHDR
;
I '$F(".1.2.3.4.5.","."_$G(TYPE)_".") S TYPE=1
;
I $F(".1.2.3.4.","."_TYPE_"."),'$G(IBIFN) G IBDSPX ; IBIFN required for TPJI screens
I $F(".1.2.3.4.","."_TYPE_"."),'$G(DFN) S DFN=+$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) I 'DFN G IBDSPX
I TYPE=5,'$G(DFN) G IBDSPX ; DFN required for ins
I TYPE=5,'$G(IBCDFN) G IBDSPX ; IBCDFN required for ins
;
I TYPE=1 S VALMAR=$NA(^TMP("IBJTCA",$J)),IBRTN="INIT^IBJTCA,HDR^IBJTCA" ; tpji claim info
I TYPE=2 S VALMAR=$NA(^TMP("IBJTTA",$J)),IBRTN="INIT^IBJTTA,HDR^IBJTTA" ; tpji AR acct profile
I TYPE=3 S VALMAR=$NA(^TMP("IBJTTC",$J)),IBRTN="INIT^IBJTTC,HDR^IBJTTC" ; tpji AR comment
I TYPE=4 S VALMAR=$NA(^TMP("IBJTRX",$J)),IBRTN="INIT^IBJTRX,HDR^IBJTRX" ; tpji ECME Rx
I TYPE=5 S VALMAR=$NA(^TMP("IBCNSVP",$J)),IBRTN="INIT^IBCNSP" ; pt ins policy detail
;
I TYPE=2 S VALM("IFN")=+$$FIND1^DIC(409.61,,,"IBJT AR ACCOUNT PROFILE"),GX="D COL^VALM" X GX
I TYPE=5 S IBPPOL=U_2_U_DFN_U_IBCDFN_U_$G(^DPT(DFN,.312,IBCDFN,0))
K @VALMAR
D @IBRTN
;
; merge IB display lines into target array
M @IBLMDISPA=@VALMAR
;
; clean up IB scratch arrays
K @VALMAR,^TMP($J,"IBTPJI"),^TMP("IBJTTAX",$J)
;
IBDSPX ;
Q
;
BILLREJ(BILL) ;Is the bill a reject?
; Input:
; BILL - Bill number from #399 - External Value (.01), not IEN
; Output:
; REJECT - Reject status (blank = not found, 0 = not a reject, 1 = rejected)
;
N IEN,PTR,SEV,REJECT
I BILL="" Q "" ;no bill #
S REJECT=0,IEN=$O(^DGCR(399,"B",BILL,"")) Q:'IEN ""
I '$D(^IBM(361,"B",IEN)) Q "" ;no entry in #361
S PTR=0 F S PTR=$O(^IBM(361,"B",IEN,PTR)) Q:'PTR D Q:REJECT
. S SEV=$$GET1^DIQ(361,PTR_",",.03,"I")
. I SEV="R" S REJECT=1
Q REJECT
;
; Subroutine added for IB*2.0*642
BILLREJ2(BILL) ;EP
; Does this bill contain rejects with uncompleted reviews?
; Input: BILL - Bill number from #399 - External Value (.01), not IEN
; Returns: 1 - Bill contains rejects with uncompleted reviews, 0 otherwiese
;
N IEN,PTR,REJECT,SEV
Q:BILL="" 0 ; No bill #
S REJECT=0,IEN=$O(^DGCR(399,"B",BILL,""))
Q:'IEN 0 ; Invalid bill #
Q:'$D(^IBM(361,"B",IEN)) 0 ; No messages in #361
S PTR=0
F D Q:'PTR Q:REJECT
. S PTR=$O(^IBM(361,"B",IEN,PTR))
. Q:'PTR
. S SEV=$$GET1^DIQ(361,PTR_",",.03,"I")
. Q:SEV'="R"
. Q:$D(^IBM(361,"ACSA","R",2,PTR)) ; Review is completed
. S REJECT=1
Q REJECT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTU6 3970 printed Oct 16, 2024@18:24:56 Page 2
IBJTU6 ;ALB/ESG - TPJI UTILITIES/APIs ;9/2/11
+1 ;;2.0;INTEGRATED BILLING;**452,530,642**;21-MAR-94;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
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
+2 ; and return it to the calling application in the scratch global array specified.
+3 ;
+4 ; Input:
+5 ; TYPE - type of IB screen data to build, can be one of the following:
+6 ; 1 = TPJI Claim Information screen (default)
+7 ; 2 = TPJI AR Account Profile screen
+8 ; 3 = TPJI AR Comment History screen
+9 ; 4 = TPJI ECME Rx Response screen
+10 ; 5 = Patient Insurance Policy Information screen
+11 ; IBIFN - claim ien (#399) Required for any TPJI screen, otherwise optional
+12 ; DFN - patient ien (#2) Required for Insurance screen, otherwise optional
+13 ; IBCDFN - insurance type ien (#2.312) Required for Insurance screen, otherwise optional
+14 ;
+15 ; Output:
+16 ; IBLMDISPA - Destination scratch global reference in which to store the results
+17 ; Pass closed scratch global reference.
+18 ; Data will be returned in @IBLMDISPA@(LN,0), where LN is a sequential line# counter
+19 ; VALMHDR - LM display header array. Pass by reference
+20 ;
+21 NEW VALMAR,IBRTN
+22 NEW I,IBX,IBXARRAY,IBXARRY,IBXERR,IBXSAVE,VALMBG,VALMSG,VALMCNT,X,Y,Z,IBPOLICY,IBARCOMM
+23 NEW D0,IB1ST,IBCNS,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,VALM,VALMDDF,GX,IBPPOL
+24 KILL @IBLMDISPA,VALMHDR
+25 ;
+26 IF '$FIND(".1.2.3.4.5.","."_$GET(TYPE)_".")
SET TYPE=1
+27 ;
+28 ; IBIFN required for TPJI screens
IF $FIND(".1.2.3.4.","."_TYPE_".")
IF '$GET(IBIFN)
GOTO IBDSPX
+29 IF $FIND(".1.2.3.4.","."_TYPE_".")
IF '$GET(DFN)
SET DFN=+$PIECE($GET(^DGCR(399,+$GET(IBIFN),0)),U,2)
IF 'DFN
GOTO IBDSPX
+30 ; DFN required for ins
IF TYPE=5
IF '$GET(DFN)
GOTO IBDSPX
+31 ; IBCDFN required for ins
IF TYPE=5
IF '$GET(IBCDFN)
GOTO IBDSPX
+32 ;
+33 ; tpji claim info
IF TYPE=1
SET VALMAR=$NAME(^TMP("IBJTCA",$JOB))
SET IBRTN="INIT^IBJTCA,HDR^IBJTCA"
+34 ; tpji AR acct profile
IF TYPE=2
SET VALMAR=$NAME(^TMP("IBJTTA",$JOB))
SET IBRTN="INIT^IBJTTA,HDR^IBJTTA"
+35 ; tpji AR comment
IF TYPE=3
SET VALMAR=$NAME(^TMP("IBJTTC",$JOB))
SET IBRTN="INIT^IBJTTC,HDR^IBJTTC"
+36 ; tpji ECME Rx
IF TYPE=4
SET VALMAR=$NAME(^TMP("IBJTRX",$JOB))
SET IBRTN="INIT^IBJTRX,HDR^IBJTRX"
+37 ; pt ins policy detail
IF TYPE=5
SET VALMAR=$NAME(^TMP("IBCNSVP",$JOB))
SET IBRTN="INIT^IBCNSP"
+38 ;
+39 IF TYPE=2
SET VALM("IFN")=+$$FIND1^DIC(409.61,,,"IBJT AR ACCOUNT PROFILE")
SET GX="D COL^VALM"
XECUTE GX
+40 IF TYPE=5
SET IBPPOL=U_2_U_DFN_U_IBCDFN_U_$GET(^DPT(DFN,.312,IBCDFN,0))
+41 KILL @VALMAR
+42 DO @IBRTN
+43 ;
+44 ; merge IB display lines into target array
+45 MERGE @IBLMDISPA=@VALMAR
+46 ;
+47 ; clean up IB scratch arrays
+48 KILL @VALMAR,^TMP($JOB,"IBTPJI"),^TMP("IBJTTAX",$JOB)
+49 ;
IBDSPX ;
+1 QUIT
+2 ;
BILLREJ(BILL) ;Is the bill a reject?
+1 ; Input:
+2 ; BILL - Bill number from #399 - External Value (.01), not IEN
+3 ; Output:
+4 ; REJECT - Reject status (blank = not found, 0 = not a reject, 1 = rejected)
+5 ;
+6 NEW IEN,PTR,SEV,REJECT
+7 ;no bill #
IF BILL=""
QUIT ""
+8 SET REJECT=0
SET IEN=$ORDER(^DGCR(399,"B",BILL,""))
if 'IEN
QUIT ""
+9 ;no entry in #361
IF '$DATA(^IBM(361,"B",IEN))
QUIT ""
+10 SET PTR=0
FOR
SET PTR=$ORDER(^IBM(361,"B",IEN,PTR))
if 'PTR
QUIT
Begin DoDot:1
+11 SET SEV=$$GET1^DIQ(361,PTR_",",.03,"I")
+12 IF SEV="R"
SET REJECT=1
End DoDot:1
if REJECT
QUIT
+13 QUIT REJECT
+14 ;
+15 ; Subroutine added for IB*2.0*642
BILLREJ2(BILL) ;EP
+1 ; Does this bill contain rejects with uncompleted reviews?
+2 ; Input: BILL - Bill number from #399 - External Value (.01), not IEN
+3 ; Returns: 1 - Bill contains rejects with uncompleted reviews, 0 otherwiese
+4 ;
+5 NEW IEN,PTR,REJECT,SEV
+6 ; No bill #
if BILL=""
QUIT 0
+7 SET REJECT=0
SET IEN=$ORDER(^DGCR(399,"B",BILL,""))
+8 ; Invalid bill #
if 'IEN
QUIT 0
+9 ; No messages in #361
if '$DATA(^IBM(361,"B",IEN))
QUIT 0
+10 SET PTR=0
+11 FOR
Begin DoDot:1
+12 SET PTR=$ORDER(^IBM(361,"B",IEN,PTR))
+13 if 'PTR
QUIT
+14 SET SEV=$$GET1^DIQ(361,PTR_",",.03,"I")
+15 if SEV'="R"
QUIT
+16 ; Review is completed
if $DATA(^IBM(361,"ACSA","R",2,PTR))
QUIT
+17 SET REJECT=1
End DoDot:1
if 'PTR
QUIT
if REJECT
QUIT
+18 QUIT REJECT
