- 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 Feb 18, 2025@23:50:17 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 ;