- 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 Jan 18, 2025@03:25:30 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