- IBCEM1 ;ALB/TMP - 837 EDI RETURN MESSAGE MAIN LIST TEMPLATE ;02-MAY-96
- ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
- ;
- EN ; Main entry point
- D DT^DICRW
- K XQORS,VALMEVL,IBFASTXT,IBDA
- D EN^VALM("IBCEM 837 MESSAGE LIST")
- K IBFASTXT,IBDA
- Q
- ;
- INIT ; -- set up inital variables
- S U="^",VALMCNT=0,VALMBG=1
- D BLD
- Q
- ;
- REBLD ; Set up formatted global
- ;
- BLD ; -- build list of messages
- N IBCNT,IBEOB,IBMSGT,IBMSG,X,IB0
- K ^TMP("IBCEM-837",$J),^TMP("IBCEM-837DX",$J)
- S (IBCNT,IBMSG,VALMCNT)=0,IBEOB=+$O(^IBE(364.3,"B","835EOB",0))
- F S IBMSG=$O(^IBA(364.2,IBMSG)) Q:'IBMSG S IB0=$G(^(IBMSG,0)) D
- . N IBSTOP
- . S IBSTOP=0
- . S IBMSGT=$P(IB0,U,2)
- . I IBMSGT,IBEOB,IBMSGT=IBEOB D Q:IBSTOP
- .. N Z,Z0 ; Only allow MRA EOB's to be viewed
- .. S Z=0 F S Z=$O(^IBA(364.2,IBMSG,2,Z)) Q:'Z!(IBSTOP) S Z0=$G(^(Z,0)) I $E(Z0,1,12)="##RAW DATA: ",$E(Z0,13,18)="835EOB",$P(Z0,U,5)'="Y" S IBSTOP=1 Q
- . ; -- add to list
- . S IBCNT=IBCNT+1,X=""
- . S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
- . S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB0,U,3),2),X,"DATEREC")
- . I IB0'="" S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB0,U,10),2),X,"DATEMSG")
- . S X=$$SETFLD^VALM1(+IB0,X,"MENTRY")
- . S Z=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U,6) S:Z="EOB" Z="MRA"
- . S X=$$SETFLD^VALM1($E(Z_$J("",6),1,6),X,"TYPE")
- . S X=$$SETFLD^VALM1($P($G(^IBA(364.1,+$P(IB0,U,4),0)),U),X,"BATCH")
- . S X=$$SETFLD^VALM1($$BILLNO($P(IB0,U,5)),X,"BILL")
- . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6)),X,"STATUS")
- . D SET(X)
- ;
- I '$D(^TMP("IBCEM-837",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCEM-837",$J,1,0)=" ",^TMP("IBCEM-837",$J,2,0)=" All Incoming EDI Messages For Billing Have Filed - No Action Needed"
- Q
- ;
- FNL ; -- Clean up list
- K ^TMP("IBCEM-837DX",$J)
- D CLEAN^VALM10
- K IBFASTXT
- Q
- ;
- SET(X) ; -- set arrays for 837 return messages
- S VALMCNT=VALMCNT+1,^TMP("IBCEM-837",$J,VALMCNT,0)=X
- S ^TMP("IBCEM-837",$J,"IDX",VALMCNT,IBCNT)=""
- S ^TMP("IBCEM-837DX",$J,IBCNT)=VALMCNT_U_IBMSG
- Q
- ;
- BILLNO(DA) ; Return bill # from entry in file 364
- N Z
- S Z=$P($G(^DGCR(399,+$P($G(^IBA(364,+DA,0)),U),0)),U)
- Q $S($L(Z):Z,1:DA)
- ;
- BATNO(DA) ; Return batch # from entry in file 364
- Q $P($G(^IBA(364.1,+$P($G(^IBA(364,+DA,0)),U,2),0)),U)
- ;
- HDR ;
- S VALMHDR(1)=$J("",17)_"RETURN MESSAGES NEEDING TO BE FILED"
- S VALMHDR(2)=" "
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM1 2352 printed Mar 13, 2025@21:15:34 Page 2
- IBCEM1 ;ALB/TMP - 837 EDI RETURN MESSAGE MAIN LIST TEMPLATE ;02-MAY-96
- +1 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-94
- +2 ;
- EN ; Main entry point
- +1 DO DT^DICRW
- +2 KILL XQORS,VALMEVL,IBFASTXT,IBDA
- +3 DO EN^VALM("IBCEM 837 MESSAGE LIST")
- +4 KILL IBFASTXT,IBDA
- +5 QUIT
- +6 ;
- INIT ; -- set up inital variables
- +1 SET U="^"
- SET VALMCNT=0
- SET VALMBG=1
- +2 DO BLD
- +3 QUIT
- +4 ;
- REBLD ; Set up formatted global
- +1 ;
- BLD ; -- build list of messages
- +1 NEW IBCNT,IBEOB,IBMSGT,IBMSG,X,IB0
- +2 KILL ^TMP("IBCEM-837",$JOB),^TMP("IBCEM-837DX",$JOB)
- +3 SET (IBCNT,IBMSG,VALMCNT)=0
- SET IBEOB=+$ORDER(^IBE(364.3,"B","835EOB",0))
- +4 FOR
- SET IBMSG=$ORDER(^IBA(364.2,IBMSG))
- if 'IBMSG
- QUIT
- SET IB0=$GET(^(IBMSG,0))
- Begin DoDot:1
- +5 NEW IBSTOP
- +6 SET IBSTOP=0
- +7 SET IBMSGT=$PIECE(IB0,U,2)
- +8 IF IBMSGT
- IF IBEOB
- IF IBMSGT=IBEOB
- Begin DoDot:2
- +9 ; Only allow MRA EOB's to be viewed
- NEW Z,Z0
- +10 SET Z=0
- FOR
- SET Z=$ORDER(^IBA(364.2,IBMSG,2,Z))
- if 'Z!(IBSTOP)
- QUIT
- SET Z0=$GET(^(Z,0))
- IF $EXTRACT(Z0,1,12)="##RAW DATA: "
- IF $EXTRACT(Z0,13,18)="835EOB"
- IF $PIECE(Z0,U,5)'="Y"
- SET IBSTOP=1
- QUIT
- End DoDot:2
- if IBSTOP
- QUIT
- +11 ; -- add to list
- +12 SET IBCNT=IBCNT+1
- SET X=""
- +13 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
- +14 SET X=$$SETFLD^VALM1($$FMTE^XLFDT($PIECE(IB0,U,3),2),X,"DATEREC")
- +15 IF IB0'=""
- SET X=$$SETFLD^VALM1($$FMTE^XLFDT($PIECE(IB0,U,10),2),X,"DATEMSG")
- +16 SET X=$$SETFLD^VALM1(+IB0,X,"MENTRY")
- +17 SET Z=$PIECE($GET(^IBE(364.3,+$PIECE(IB0,U,2),0)),U,6)
- if Z="EOB"
- SET Z="MRA"
- +18 SET X=$$SETFLD^VALM1($EXTRACT(Z_$JUSTIFY("",6),1,6),X,"TYPE")
- +19 SET X=$$SETFLD^VALM1($PIECE($GET(^IBA(364.1,+$PIECE(IB0,U,4),0)),U),X,"BATCH")
- +20 SET X=$$SETFLD^VALM1($$BILLNO($PIECE(IB0,U,5)),X,"BILL")
- +21 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.2,.06,$PIECE(IB0,U,6)),X,"STATUS")
- +22 DO SET(X)
- End DoDot:1
- +23 ;
- +24 IF '$DATA(^TMP("IBCEM-837",$JOB))
- SET VALMCNT=2
- SET IBCNT=2
- SET ^TMP("IBCEM-837",$JOB,1,0)=" "
- SET ^TMP("IBCEM-837",$JOB,2,0)=" All Incoming EDI Messages For Billing Have Filed - No Action Needed"
- +25 QUIT
- +26 ;
- FNL ; -- Clean up list
- +1 KILL ^TMP("IBCEM-837DX",$JOB)
- +2 DO CLEAN^VALM10
- +3 KILL IBFASTXT
- +4 QUIT
- +5 ;
- SET(X) ; -- set arrays for 837 return messages
- +1 SET VALMCNT=VALMCNT+1
- SET ^TMP("IBCEM-837",$JOB,VALMCNT,0)=X
- +2 SET ^TMP("IBCEM-837",$JOB,"IDX",VALMCNT,IBCNT)=""
- +3 SET ^TMP("IBCEM-837DX",$JOB,IBCNT)=VALMCNT_U_IBMSG
- +4 QUIT
- +5 ;
- BILLNO(DA) ; Return bill # from entry in file 364
- +1 NEW Z
- +2 SET Z=$PIECE($GET(^DGCR(399,+$PIECE($GET(^IBA(364,+DA,0)),U),0)),U)
- +3 QUIT $SELECT($LENGTH(Z):Z,1:DA)
- +4 ;
- BATNO(DA) ; Return batch # from entry in file 364
- +1 QUIT $PIECE($GET(^IBA(364.1,+$PIECE($GET(^IBA(364,+DA,0)),U,2),0)),U)
- +2 ;
- HDR ;
- +1 SET VALMHDR(1)=$JUSTIFY("",17)_"RETURN MESSAGES NEEDING TO BE FILED"
- +2 SET VALMHDR(2)=" "
- +3 QUIT
- +4 ;
