IBACCWLEE3 ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Item Expand Encounter Display (Cont.) ; 12-SEP-2023 ; 12-SEP-2023
;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;CLONED FROM RTN IBJTED - TPJI EDI STATUS SCREEN
;
BLD(IBIFN,IBLN,VALMCNT) ;display EDI status information
;N IBY,IBZ,CNT,COL,WD,IBD,IBX,IBDT,IBCNT,IBCH,IBT,IBCH6,IBMS,IBRD,IBSO,IBY,X,IBGS,IBNDT,IBCN2
N IBY,IBZ,CNT,COL,WD,IBD,IBX,IBDT,IBCNT,IBCH,IBT,IBCH6,IBMS,IBRD,IBSO,IBY,X,IBGS,IBNDT,IBCN2 ;TPF XINDEX
;S (IBCNT,VALMCNT)=0
S IBCNT=IBLN ;TPF; RESET LINE COUNTS TO OUR EE COUNTS
; only display the latest transmit record and status message
S IBY=$O(^IBM(361,"B",IBIFN,""))
S IBZ=$$LAST364^IBCEF4(IBIFN)
I 'IBY,'IBZ D BLDQ S IBLN=IBCNT Q
D E364(IBZ),E361(IBY)
S IBLN=IBCNT
Q
;
E361(IBY) ; Bill Status Message
; IBY = ien of entry in file 361
N IBCN,IBZ,IBX,IBDT,IBT
K ^TMP($J,"RET-MSG")
S IBCH=0
S IBT="EDI Bill Status Messages"
D SET($J("",(80-$L(IBT))\2)_IBT)
D CNTRL^VALM10(VALMCNT,((80-$L(IBT))\2)+1,$L(IBT),IORVON,IORVOFF)
I IBY S IBCH=1 D ; Find all messages rec'd for the bill
. N IBCH
. S IBDT="" ;,IBCNT=0
. F S IBDT=+$O(^IBM(361,"ADR",IBIFN,IBDT),-1) Q:'IBDT S IBY=0 F S IBY=+$O(^IBM(361,"ADR",IBIFN,IBDT,IBY)) Q:'IBY S IBX=$G(^IBM(361,IBY,0)) I IBX'="" D
.. N IBT1
.. S IBCNT=IBCNT+1
.. I IBCNT>1 D SET(" ")
.. S IBT1="---Message "_IBCNT_"---"
.. S IBT=$J("",32-($L(IBCNT)+1\2))_IBT1
.. S IBD=$$SET1(IBT,"",1,80) D SET(IBD)
.. D CNTRL^VALM10(VALMCNT,(33-(($L(IBCNT)+1)\2)),$L(IBT1),IOINHI,IOINORM)
.. S IBT=$J("",8)_"Date Received: "_$$FMTE^XLFDT(IBDT)
.. S IBD=$$SET1(IBT,"",1,49)
.. S IBT="Batch #: "_$$EXPAND^IBTRE(361,.05,+$P($G(^IBA(364,+$P(IBX,U,11),0)),U,2)),IBD=$$SET1(IBT,IBD,50,27)
.. D SET(IBD)
.. ;S IBT="Msg Generation Source: "_$$EXPAND^IBTRE(361,.04,$P(IBX,U,4))
.. ;S IBD=$$SET1(IBT,"",1,40)
.. S IBT="Return Msg Id: "_$P(IBX,U,6)
.. S IBD=$$SET1(IBT,"",9,40)
.. S IBT="Msg Severity: "_$$EXPAND^IBTRE(361,.03,$P(IBX,U,3))
.. S IBD=$$SET1(IBT,IBD,45,35) D SET(IBD)
.. ;S IBT="Return Msg Id: "_$P(IBX,U,6)
.. ;S IBD=$$SET1(IBT,"",9,40) D SET(IBD)
.. S (IBCH,IBCN)=0
.. F S IBCN=$O(^IBM(361,IBY,1,IBCN)) Q:'IBCN S IBD=$$SET1(^(IBCN,0),"",1,79),IBCH=1 D SET(IBD)
.. I 'IBCH S IBD=$$SET1(" No message text found","",1,25) D SET(IBD)
.. S IBT=$J("",31-($L(IBCNT)+1\2))_"---Msg "_IBCNT_" Review---"
.. S IBD=$$SET1(IBT,"",1,80) D SET(IBD)
.. S IBCN=0 F S IBCN=$O(^IBM(361,IBY,2,IBCN)) Q:'IBCN S IBGS=$G(^(IBCN,0)) D
... S IBT="Review Date: "_$$DAT1^IBOUTL($P(IBGS,U),1)
... S IBD=$$SET1(IBT,"",1,40)
... ;S IBT="Reviewed By: "_$P($G(^VA(200,+$P(IBGS,U,2),0)),U)
... ;S IBD=$$SET1(IBT,IBD,49,29)
... D SET(IBD)
... S IBCH=0
... S IBCN2=0 F S IBCN2=$O(^IBM(361,IBY,2,IBCN,1,IBCN2)) Q:'IBCN2 S IBD=$$SET1($S('IBCH:"Comments: ",1:"")_$G(^(IBCN2,0)),"",1,$S('IBCH:69,1:79)),IBCH=1 D SET(IBD)
D NONE(IBCH)
K ^TMP($J,"RET-MSG")
Q
;
E364(IBZ) ; EDI Transmit Bill
; IBZ = ien of entry in file 364
N IBY,IBT,IBX
S IBX=""
I IBZ S IBX=$G(^IBA(364,IBZ,0))
S IBT="Last EDI Transmission"
D SET($J("",(80-$L(IBT))\2)_IBT)
D CNTRL^VALM10(VALMCNT,(80-$L(IBT)\2)+1,$L(IBT),IORVON,IORVOFF)
S IBT="Transmission Status: "_$$EXPAND^IBTRE(364,.03,$P(IBX,U,3))
S IBD=$$SET1(IBT,"",3,79)
D SET(IBD)
S IBT="Status Date: "_$$FMTE^XLFDT($P(IBX,U,4))
S IBD=$$SET1(IBT,"",11,38)
S IBT="Batch #: "_$$EXPAND^IBTRE(364,.02,+$P(IBX,U,2))
S IBD=$$SET1(IBT,IBD,50,29)
D SET(IBD)
I $P(IBX,U,6) D
. S IBT="Resubmit Batch #: "_$$EXPAND^IBTRE(364,.06,+$P(IBX,U,6))
. S IBD=$$SET1(IBT,"",6,30)
. D SET(IBD)
D SET("")
Q
;
BLDQ ;
D SET(" ",0),SET("No EDI Status Messages Found For This Bill Entry.",0)
Q
;
NONE(IBCH) ;
I 'IBCH D
. S IBD=$$SET1(" None","",1,10)
. D SET(IBD)
Q
;
SET(X,CNT) ;
S VALMCNT=VALMCNT+1
S @VALMAR@(VALMCNT,0)=X
;S ^TMP("IBJTED",$J,VALMCNT,0)=X
;Q:'$G(CNT)
;S ^TMP("IBJTED",$J,"IDX",VALMCNT,CNT)=""
Q
;
SET1(IBT,IBD,COL,WD) ;
S IBD=$$SETSTR^VALM1(IBT,IBD,COL,WD)
Q IBD
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLEE3 4166 printed May 25, 2026@12:10 Page 2
IBACCWLEE3 ;EDE/TPF - ACC (Automated Community Care) Encounters - Action Item Expand Encounter Display (Cont.) ; 12-SEP-2023 ; 12-SEP-2023
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-2024;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;CLONED FROM RTN IBJTED - TPJI EDI STATUS SCREEN
+6 ;
BLD(IBIFN,IBLN,VALMCNT) ;display EDI status information
+1 ;N IBY,IBZ,CNT,COL,WD,IBD,IBX,IBDT,IBCNT,IBCH,IBT,IBCH6,IBMS,IBRD,IBSO,IBY,X,IBGS,IBNDT,IBCN2
+2 ;TPF XINDEX
NEW IBY,IBZ,CNT,COL,WD,IBD,IBX,IBDT,IBCNT,IBCH,IBT,IBCH6,IBMS,IBRD,IBSO,IBY,X,IBGS,IBNDT,IBCN2
+3 ;S (IBCNT,VALMCNT)=0
+4 ;TPF; RESET LINE COUNTS TO OUR EE COUNTS
SET IBCNT=IBLN
+5 ; only display the latest transmit record and status message
+6 SET IBY=$ORDER(^IBM(361,"B",IBIFN,""))
+7 SET IBZ=$$LAST364^IBCEF4(IBIFN)
+8 IF 'IBY
IF 'IBZ
DO BLDQ
SET IBLN=IBCNT
QUIT
+9 DO E364(IBZ)
DO E361(IBY)
+10 SET IBLN=IBCNT
+11 QUIT
+12 ;
E361(IBY) ; Bill Status Message
+1 ; IBY = ien of entry in file 361
+2 NEW IBCN,IBZ,IBX,IBDT,IBT
+3 KILL ^TMP($JOB,"RET-MSG")
+4 SET IBCH=0
+5 SET IBT="EDI Bill Status Messages"
+6 DO SET($JUSTIFY("",(80-$LENGTH(IBT))\2)_IBT)
+7 DO CNTRL^VALM10(VALMCNT,((80-$LENGTH(IBT))\2)+1,$LENGTH(IBT),IORVON,IORVOFF)
+8 ; Find all messages rec'd for the bill
IF IBY
SET IBCH=1
Begin DoDot:1
+9 NEW IBCH
+10 ;,IBCNT=0
SET IBDT=""
+11 FOR
SET IBDT=+$ORDER(^IBM(361,"ADR",IBIFN,IBDT),-1)
if 'IBDT
QUIT
SET IBY=0
FOR
SET IBY=+$ORDER(^IBM(361,"ADR",IBIFN,IBDT,IBY))
if 'IBY
QUIT
SET IBX=$GET(^IBM(361,IBY,0))
IF IBX'=""
Begin DoDot:2
+12 NEW IBT1
+13 SET IBCNT=IBCNT+1
+14 IF IBCNT>1
DO SET(" ")
+15 SET IBT1="---Message "_IBCNT_"---"
+16 SET IBT=$JUSTIFY("",32-($LENGTH(IBCNT)+1\2))_IBT1
+17 SET IBD=$$SET1(IBT,"",1,80)
DO SET(IBD)
+18 DO CNTRL^VALM10(VALMCNT,(33-(($LENGTH(IBCNT)+1)\2)),$LENGTH(IBT1),IOINHI,IOINORM)
+19 SET IBT=$JUSTIFY("",8)_"Date Received: "_$$FMTE^XLFDT(IBDT)
+20 SET IBD=$$SET1(IBT,"",1,49)
+21 SET IBT="Batch #: "_$$EXPAND^IBTRE(361,.05,+$PIECE($GET(^IBA(364,+$PIECE(IBX,U,11),0)),U,2))
SET IBD=$$SET1(IBT,IBD,50,27)
+22 DO SET(IBD)
+23 ;S IBT="Msg Generation Source: "_$$EXPAND^IBTRE(361,.04,$P(IBX,U,4))
+24 ;S IBD=$$SET1(IBT,"",1,40)
+25 SET IBT="Return Msg Id: "_$PIECE(IBX,U,6)
+26 SET IBD=$$SET1(IBT,"",9,40)
+27 SET IBT="Msg Severity: "_$$EXPAND^IBTRE(361,.03,$PIECE(IBX,U,3))
+28 SET IBD=$$SET1(IBT,IBD,45,35)
DO SET(IBD)
+29 ;S IBT="Return Msg Id: "_$P(IBX,U,6)
+30 ;S IBD=$$SET1(IBT,"",9,40) D SET(IBD)
+31 SET (IBCH,IBCN)=0
+32 FOR
SET IBCN=$ORDER(^IBM(361,IBY,1,IBCN))
if 'IBCN
QUIT
SET IBD=$$SET1(^(IBCN,0),"",1,79)
SET IBCH=1
DO SET(IBD)
+33 IF 'IBCH
SET IBD=$$SET1(" No message text found","",1,25)
DO SET(IBD)
+34 SET IBT=$JUSTIFY("",31-($LENGTH(IBCNT)+1\2))_"---Msg "_IBCNT_" Review---"
+35 SET IBD=$$SET1(IBT,"",1,80)
DO SET(IBD)
+36 SET IBCN=0
FOR
SET IBCN=$ORDER(^IBM(361,IBY,2,IBCN))
if 'IBCN
QUIT
SET IBGS=$GET(^(IBCN,0))
Begin DoDot:3
+37 SET IBT="Review Date: "_$$DAT1^IBOUTL($PIECE(IBGS,U),1)
+38 SET IBD=$$SET1(IBT,"",1,40)
+39 ;S IBT="Reviewed By: "_$P($G(^VA(200,+$P(IBGS,U,2),0)),U)
+40 ;S IBD=$$SET1(IBT,IBD,49,29)
+41 DO SET(IBD)
+42 SET IBCH=0
+43 SET IBCN2=0
FOR
SET IBCN2=$ORDER(^IBM(361,IBY,2,IBCN,1,IBCN2))
if 'IBCN2
QUIT
SET IBD=$$SET1($SELECT('IBCH:"Comments: ",1:"")_$GET(^(IBCN2,0)),"",1,$SELECT('IBCH:69,1:79))
SET IBCH=1
DO SET(IBD)
End DoDot:3
End DoDot:2
End DoDot:1
+44 DO NONE(IBCH)
+45 KILL ^TMP($JOB,"RET-MSG")
+46 QUIT
+47 ;
E364(IBZ) ; EDI Transmit Bill
+1 ; IBZ = ien of entry in file 364
+2 NEW IBY,IBT,IBX
+3 SET IBX=""
+4 IF IBZ
SET IBX=$GET(^IBA(364,IBZ,0))
+5 SET IBT="Last EDI Transmission"
+6 DO SET($JUSTIFY("",(80-$LENGTH(IBT))\2)_IBT)
+7 DO CNTRL^VALM10(VALMCNT,(80-$LENGTH(IBT)\2)+1,$LENGTH(IBT),IORVON,IORVOFF)
+8 SET IBT="Transmission Status: "_$$EXPAND^IBTRE(364,.03,$PIECE(IBX,U,3))
+9 SET IBD=$$SET1(IBT,"",3,79)
+10 DO SET(IBD)
+11 SET IBT="Status Date: "_$$FMTE^XLFDT($PIECE(IBX,U,4))
+12 SET IBD=$$SET1(IBT,"",11,38)
+13 SET IBT="Batch #: "_$$EXPAND^IBTRE(364,.02,+$PIECE(IBX,U,2))
+14 SET IBD=$$SET1(IBT,IBD,50,29)
+15 DO SET(IBD)
+16 IF $PIECE(IBX,U,6)
Begin DoDot:1
+17 SET IBT="Resubmit Batch #: "_$$EXPAND^IBTRE(364,.06,+$PIECE(IBX,U,6))
+18 SET IBD=$$SET1(IBT,"",6,30)
+19 DO SET(IBD)
End DoDot:1
+20 DO SET("")
+21 QUIT
+22 ;
BLDQ ;
+1 DO SET(" ",0)
DO SET("No EDI Status Messages Found For This Bill Entry.",0)
+2 QUIT
+3 ;
NONE(IBCH) ;
+1 IF 'IBCH
Begin DoDot:1
+2 SET IBD=$$SET1(" None","",1,10)
+3 DO SET(IBD)
End DoDot:1
+4 QUIT
+5 ;
SET(X,CNT) ;
+1 SET VALMCNT=VALMCNT+1
+2 SET @VALMAR@(VALMCNT,0)=X
+3 ;S ^TMP("IBJTED",$J,VALMCNT,0)=X
+4 ;Q:'$G(CNT)
+5 ;S ^TMP("IBJTED",$J,"IDX",VALMCNT,CNT)=""
+6 QUIT
+7 ;
SET1(IBT,IBD,COL,WD) ;
+1 SET IBD=$$SETSTR^VALM1(IBT,IBD,COL,WD)
+2 QUIT IBD
+3 ;
