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 Dec 13, 2024@02:10:44 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 ;
