IBCEM01 ;ALB/TMP - BATCH BILLS LIST TEMPLATE ;11-SEP-96
;;2.0;INTEGRATED BILLING;**137,296**;21-MAR-94
;
INIT ; -- set up inital variables
S VALMCNT=0,VALMBG=1
D BLD
Q
;
BLD ; -- build list of bills for batch entry # IBBDA
Q:'$G(IBBDA)
D REBLD
Q
;
REBLD ; Set up formatted global
;
N IB,IBCNT,X,IB0,IB00,IBX,IBIFN,IBSTAT,IBSTAT1,IBZ
K ^TMP("IBCEM-BABI",$J),^TMP("IBCEM-BABIDX",$J)
S (VALMCNT,IBCNT)=0,IB=""
F S IB=$O(^IBA(364,"ABABI",IBBDA,IB)) Q:IB="" S IBZ=0 F S IBZ=$O(^IBA(364,"ABABI",IBBDA,IB,IBZ)) Q:'IBZ S IB0=$G(^IBA(364,IBZ,0)),IB00=$G(^DGCR(399,+IB0,0)) D
. S IBIFN=+$P(IB00,U,2),IBSTAT=$P(IB0,U,3),IBSTAT1=$P(IB00,U,13)
. S IB("S")=$G(^DGCR(399,+IB0,"U"))
. ; -- add to list
. S IBCNT=IBCNT+1,X="" W:'(IBCNT#25) "."
. S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
. S X=$$SETFLD^VALM1($S('$G(IBCEFUNC):"",1:$S($D(^TMP("IBNOT",$J,IBZ)):"*",$G(^TMP("IBEDI_TEST_BATCH",$J)):" ","RD"[IBSTAT!'IBSTAT1!(IBSTAT1=7):"#",1:" "))_$P(IB00,U),X,"BILLNO")
. S X=$$SETFLD^VALM1($$EXPAND^IBTRE(399,.02,$P(IB00,U,2)),X,"PAT")
. S X=$$SETFLD^VALM1($P($G(^DPT(+$P(IB00,U,2),0)),U,9),X,"SSN")
. S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB("S"),U),2)_"-"_$$FMTE^XLFDT($P(IB("S"),U,2),2),X,"DATES")
. S X=$$SETFLD^VALM1($$EXPAND^IBTRE(399,.05,$P(IB00,U,5)),X,"TYPE")
. S X=$$SETFLD^VALM1($$EXPAND^IBTRE(364,.03,$P(IB0,U,3)),X,"TSTAT")
. D SET(X)
;
I '$D(^TMP("IBCEM-BABI",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCEM-BABI",$J,1,0)=" ",^TMP("IBCEM-BABI",$J,2,0)=" No bills found for batch",^TMP("IBCEM-BABI",$J,"IDX",1,1)="",^TMP("IBCEM-BABI",$J,"IDX",2,2)=""
Q
;
EXIT ; -- Clean up list
K ^TMP("IBCEM-BABIDX",$J),^TMP("IBCEM-BABI",$J),IBCEFUNC
D CLEAR^VALM1,CLEAN^VALM10
Q
;
HDR ; -- Sets up header
N Z
S Z=$G(^IBA(364.1,IBBDA,0))
S VALMHDR(1)="BATCH #: "_$P(Z,U)_" "_$P(Z,U,8)
S VALMHDR(2)=$S(IBCEFUNC:" * = Bill excluded"_$S(IBCEFUNC=1:" # = Bill not in correct status for resubmit",1:""),1:" * = Bill not able to be edited")
S VALMSG=$G(IBCE("VALMSG"))
Q
;
SET(X) ; -- set arrays for 837 return messages
S VALMCNT=VALMCNT+1,^TMP("IBCEM-BABI",$J,VALMCNT,0)=X
S ^TMP("IBCEM-BABI",$J,"IDX",VALMCNT,IBCNT)=""
S ^TMP("IBCEM-BABIDX",$J,IBCNT)=VALMCNT_U_IB0
Q
;
SEL ; Select batch bill entry(ies) from list
N IBVAR,IBCT
K IBDAB
I $G(IBCEFUNC) D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)))
S (IBCT,IBDAB)=0 F S IBDAB=$O(VALMY(IBDAB)) Q:'IBDAB S IBVAR=$G(^TMP("IBCEM-BABIDX",$J,IBDAB)),IBDAB(IBDAB)=$P(IBVAR,U,2) I $G(IBCEFUNC) D
. N Z,Z0,IBSTAT
. S IBSTAT=$P($G(^DGCR(399,+IBDAB(IBDAB),0)),U,13)
. S Z=+$O(^IBA(364,"ABABI",IBBDA,IBDAB(IBDAB),"")),Z0=$P($G(^DGCR(399,IBDAB(IBDAB),0)),U)
. I $G(IBCEFUNC)'=2,"RD"[$P(IBVAR,U,4)!'IBSTAT!(IBSTAT=7) K IBDAB(IBDAB) W !,"Bill #: ",Z0," already excluded (not in correct status for resubmit)" Q
. I $D(^TMP("IBNOT",$J,Z)) W !,"Bill #: ",Z0," has been included again" K ^TMP("IBNOT",$J,Z) S IBCT=IBCT-1 Q
. S ^TMP("IBNOT",$J,Z)=IBDAB(IBDAB),IBCT=IBCT+1 W !,"Bill #: ",Z0," will be excluded"
I $G(IBCEFUNC) D PAUSE^VALM1
S VALMBCK=$S('$G(IBCEFUNC):"Q",1:$S($O(VALMY("")):"R",1:"Q"))
S ^TMP("IBNOT",$J)=IBCT
I VALMBCK'="Q" D HDR,REBLD
I VALMBCK="Q" D EXIT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM01 3216 printed Dec 13, 2024@02:10:41 Page 2
IBCEM01 ;ALB/TMP - BATCH BILLS LIST TEMPLATE ;11-SEP-96
+1 ;;2.0;INTEGRATED BILLING;**137,296**;21-MAR-94
+2 ;
INIT ; -- set up inital variables
+1 SET VALMCNT=0
SET VALMBG=1
+2 DO BLD
+3 QUIT
+4 ;
BLD ; -- build list of bills for batch entry # IBBDA
+1 if '$GET(IBBDA)
QUIT
+2 DO REBLD
+3 QUIT
+4 ;
REBLD ; Set up formatted global
+1 ;
+2 NEW IB,IBCNT,X,IB0,IB00,IBX,IBIFN,IBSTAT,IBSTAT1,IBZ
+3 KILL ^TMP("IBCEM-BABI",$JOB),^TMP("IBCEM-BABIDX",$JOB)
+4 SET (VALMCNT,IBCNT)=0
SET IB=""
+5 FOR
SET IB=$ORDER(^IBA(364,"ABABI",IBBDA,IB))
if IB=""
QUIT
SET IBZ=0
FOR
SET IBZ=$ORDER(^IBA(364,"ABABI",IBBDA,IB,IBZ))
if 'IBZ
QUIT
SET IB0=$GET(^IBA(364,IBZ,0))
SET IB00=$GET(^DGCR(399,+IB0,0))
Begin DoDot:1
+6 SET IBIFN=+$PIECE(IB00,U,2)
SET IBSTAT=$PIECE(IB0,U,3)
SET IBSTAT1=$PIECE(IB00,U,13)
+7 SET IB("S")=$GET(^DGCR(399,+IB0,"U"))
+8 ; -- add to list
+9 SET IBCNT=IBCNT+1
SET X=""
if '(IBCNT#25)
WRITE "."
+10 SET X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
+11 SET X=$$SETFLD^VALM1($SELECT('$GET(IBCEFUNC):"",1:$SELECT($DATA(^TMP("IBNOT",$JOB,IBZ)):"*",$GET(^TMP("IBEDI_TEST_BATCH",$JOB)):" ","RD"[IBSTAT!'IBSTAT1!(IBSTAT1=7):"#",1:" "))_$PIECE(IB00,U),X,"BILLNO")
+12 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(399,.02,$PIECE(IB00,U,2)),X,"PAT")
+13 SET X=$$SETFLD^VALM1($PIECE($GET(^DPT(+$PIECE(IB00,U,2),0)),U,9),X,"SSN")
+14 SET X=$$SETFLD^VALM1($$FMTE^XLFDT($PIECE(IB("S"),U),2)_"-"_$$FMTE^XLFDT($PIECE(IB("S"),U,2),2),X,"DATES")
+15 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(399,.05,$PIECE(IB00,U,5)),X,"TYPE")
+16 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(364,.03,$PIECE(IB0,U,3)),X,"TSTAT")
+17 DO SET(X)
End DoDot:1
+18 ;
+19 IF '$DATA(^TMP("IBCEM-BABI",$JOB))
SET VALMCNT=2
SET IBCNT=2
SET ^TMP("IBCEM-BABI",$JOB,1,0)=" "
SET ^TMP("IBCEM-BABI",$JOB,2,0)=" No bills found for batch"
SET ^TMP("IBCEM-BABI",$JOB,"IDX",1,1)=""
SET ^TMP("IBCEM-BABI",$JOB,"IDX",2,2)=""
+20 QUIT
+21 ;
EXIT ; -- Clean up list
+1 KILL ^TMP("IBCEM-BABIDX",$JOB),^TMP("IBCEM-BABI",$JOB),IBCEFUNC
+2 DO CLEAR^VALM1
DO CLEAN^VALM10
+3 QUIT
+4 ;
HDR ; -- Sets up header
+1 NEW Z
+2 SET Z=$GET(^IBA(364.1,IBBDA,0))
+3 SET VALMHDR(1)="BATCH #: "_$PIECE(Z,U)_" "_$PIECE(Z,U,8)
+4 SET VALMHDR(2)=$SELECT(IBCEFUNC:" * = Bill excluded"_$SELECT(IBCEFUNC=1:" # = Bill not in correct status for resubmit",1:""),1:" * = Bill not able to be edited")
+5 SET VALMSG=$GET(IBCE("VALMSG"))
+6 QUIT
+7 ;
SET(X) ; -- set arrays for 837 return messages
+1 SET VALMCNT=VALMCNT+1
SET ^TMP("IBCEM-BABI",$JOB,VALMCNT,0)=X
+2 SET ^TMP("IBCEM-BABI",$JOB,"IDX",VALMCNT,IBCNT)=""
+3 SET ^TMP("IBCEM-BABIDX",$JOB,IBCNT)=VALMCNT_U_IB0
+4 QUIT
+5 ;
SEL ; Select batch bill entry(ies) from list
+1 NEW IBVAR,IBCT
+2 KILL IBDAB
+3 IF $GET(IBCEFUNC)
DO FULL^VALM1
+4 DO EN^VALM2($GET(XQORNOD(0)))
+5 SET (IBCT,IBDAB)=0
FOR
SET IBDAB=$ORDER(VALMY(IBDAB))
if 'IBDAB
QUIT
SET IBVAR=$GET(^TMP("IBCEM-BABIDX",$JOB,IBDAB))
SET IBDAB(IBDAB)=$PIECE(IBVAR,U,2)
IF $GET(IBCEFUNC)
Begin DoDot:1
+6 NEW Z,Z0,IBSTAT
+7 SET IBSTAT=$PIECE($GET(^DGCR(399,+IBDAB(IBDAB),0)),U,13)
+8 SET Z=+$ORDER(^IBA(364,"ABABI",IBBDA,IBDAB(IBDAB),""))
SET Z0=$PIECE($GET(^DGCR(399,IBDAB(IBDAB),0)),U)
+9 IF $GET(IBCEFUNC)'=2
IF "RD"[$PIECE(IBVAR,U,4)!'IBSTAT!(IBSTAT=7)
KILL IBDAB(IBDAB)
WRITE !,"Bill #: ",Z0," already excluded (not in correct status for resubmit)"
QUIT
+10 IF $DATA(^TMP("IBNOT",$JOB,Z))
WRITE !,"Bill #: ",Z0," has been included again"
KILL ^TMP("IBNOT",$JOB,Z)
SET IBCT=IBCT-1
QUIT
+11 SET ^TMP("IBNOT",$JOB,Z)=IBDAB(IBDAB)
SET IBCT=IBCT+1
WRITE !,"Bill #: ",Z0," will be excluded"
End DoDot:1
+12 IF $GET(IBCEFUNC)
DO PAUSE^VALM1
+13 SET VALMBCK=$SELECT('$GET(IBCEFUNC):"Q",1:$SELECT($ORDER(VALMY("")):"R",1:"Q"))
+14 SET ^TMP("IBNOT",$JOB)=IBCT
+15 IF VALMBCK'="Q"
DO HDR
DO REBLD
+16 IF VALMBCK="Q"
DO EXIT
+17 QUIT
+18 ;
