IBJTED ;ALB/CXW - TPJI EDI STATUS SCREEN ;09-APR-1999
;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- main entry point for IBJ TP EDI STATUS
D EN^VALM("IBJT EDI STATUS")
Q
;
HDR ; -- header code
D HDR^IBJTU1(+IBIFN,+DFN,1)
Q
;
INIT ; -- init variables and list array
K ^TMP("IBJTED",$J)
I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
D BLD
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBJTED",$J)
D CLEAR^VALM1,CLEAN^VALM10
Q
;
BLD ;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
S (IBCNT,VALMCNT)=0
; 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 Q
D E364(IBZ),E361(IBY)
Q
;
E361(IBY) ; Bill Status Message
; IBY = ien of entry in file 361
N 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 ^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[HIBJTED 4180 printed Dec 13, 2024@02:23:54 Page 2
IBJTED ;ALB/CXW - TPJI EDI STATUS SCREEN ;09-APR-1999
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; -- main entry point for IBJ TP EDI STATUS
+1 DO EN^VALM("IBJT EDI STATUS")
+2 QUIT
+3 ;
HDR ; -- header code
+1 DO HDR^IBJTU1(+IBIFN,+DFN,1)
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBJTED",$JOB)
+2 IF '$GET(DFN)!'$GET(IBIFN)
SET VALMQUIT=""
GOTO INITQ
+3 DO BLD
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBJTED",$JOB)
+2 DO CLEAR^VALM1
DO CLEAN^VALM10
+3 QUIT
+4 ;
BLD ;display EDI status information
+1 NEW IBY,IBZ,CNT,COL,WD,IBD,IBX,IBDT,IBCNT,IBCH,IBT,IBCH6,IBMS,IBRD,IBSO,IBY,X,IBGS,IBNDT,IBCN2
+2 SET (IBCNT,VALMCNT)=0
+3 ; only display the latest transmit record and status message
+4 SET IBY=$ORDER(^IBM(361,"B",IBIFN,""))
+5 SET IBZ=$$LAST364^IBCEF4(IBIFN)
+6 IF 'IBY
IF 'IBZ
DO BLDQ
QUIT
+7 DO E364(IBZ)
DO E361(IBY)
+8 QUIT
+9 ;
E361(IBY) ; Bill Status Message
+1 ; IBY = ien of entry in file 361
+2 NEW 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 SET IBDT=""
SET IBCNT=0
+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 ^TMP("IBJTED",$JOB,VALMCNT,0)=X
+3 if '$GET(CNT)
QUIT
+4 SET ^TMP("IBJTED",$JOB,"IDX",VALMCNT,CNT)=""
+5 QUIT
+6 ;
SET1(IBT,IBD,COL,WD) ;
+1 SET IBD=$$SETSTR^VALM1(IBT,IBD,COL,WD)
+2 QUIT IBD
+3 ;
