IBCECOB4 ;ALB/CXW - IB EM MANAGEMENT - REVIEW STATUS SCREEN ;16-MAY-2000
;;2.0;INTEGRATED BILLING;**137,181,348,349,592**;21-MAR-1994;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for claims status awaiting resolution detail
S VALMCNT=0,VALMBG=1
D EN^VALM("IBCEM EOB REVIEW")
Q
;
HDR ; -- header code
;IBDA - ien EOB selection screen
N IBST
S IBST=$P($G(^IBM(361.1,IBDA,0)),U,16)
S VALMHDR(2)="Review Status= "_$S(IBST=1:"REVIEW IN PROCESS",IBST=2:"ACCEPTED-INTERIM EOB",IBST=3:"ACCEPTED-COMPLETE EOB",IBST=4:"REJECTED",IBST=9:"CLAIM CANCELLED",1:"NOT REVIEWED")
Q
;
INIT ; -- init variables and list array
N I,X,Y,Z,IBZ,IBFST,IBPAT
K ^TMP("IBCECOC",$J)
SCR S VALMCNT=0
; IBCMT = the data extracted into ^TMP("IBCECOB1",$J)
; IBIFN = the ien of the bill
; IBDA = the ien of the entry in 361.1
S Z=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0))
S IBPAT=$E($P(Z,U),1,25)_"/"_$E($P(Z,U,9),6,9)
S X=""
S X=$$SETFLD^VALM1($$BN1^PRCAFN(IBIFN),X,"BILL")
S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCMT,U)),X,"SERVICE")
S X=$$SETFLD^VALM1(IBPAT,X,"PATNM")
S X=$$SETFLD^VALM1(" "_$P("PRI^SEC^TER",U,+$P(IBCMT,U,16)),X,"SEQ")
;JWS;IB*2.0*592:Dental form #7 J430D
S X=$$SETFLD^VALM1(" "_$$TYPE^IBJTLA1($P(IBCMT,U,5))_"/"_$S(+$P(IBCMT,U,6)=2:"CMS-1500",$P(IBCMT,U,6)=7:"J430D",1:"UB-04"),X,"BTYPE")
D SET(X)
S Z=0 F S Z=$O(^IBM(361.1,IBDA,21,Z)) Q:'Z S I=$G(^(Z,0)) D
. S X=$$SETSTR^VALM1("Review Date/Time: "_$$EXPAND^IBTRE(361.121,.01,+I),"",2,40)
. D SET(X)
. I $P($G(^VA(200,+$P(I,U,2),0)),U)'="" S X=$$SETSTR^VALM1("Reviewed By: "_$P($G(^VA(200,+$P(I,U,2),0)),U),"",2,50) D SET(X)
. S (IBFST,Y)=0 F S Y=$O(^IBM(361.1,IBDA,21,Z,1,Y)) Q:'Y D
.. S X=$$SETSTR^VALM1($S('IBFST:"Comments: ",1:"")_$G(^IBM(361.1,IBDA,21,Z,1,Y,0)),"",2,$S('IBFST:140,1:150))
.. D SET(X)
.. S IBFST=1
. D SET("")
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCECOC",$J)
D CLEAN^VALM10
Q
;
SET(X) ;
S VALMCNT=VALMCNT+1
S ^TMP("IBCECOC",$J,VALMCNT,0)=X
S ^TMP("IBCECOC",$J,"IDX",VALMCNT,1)=""
S ^TMP("IBCECOC",$J,1)=VALMCNT
Q
;
STATUS ; Edit review status
;IBDA - EOB ien
N DA,DIE,DR,IBOLD,DIC,DO,DD,DLAYGO,IBFINAL,IBO,IBNEW,IBFACT
D FULL^VALM1
S DIE="^IBM(361.1,"
S DA=IBDA
G:'DA STATUSQ
S IBOLD=$P($G(^IBM(361.1,DA,0)),U,16),IBFINAL=0,IBO=$S(IBOLD'="":"/"_IBOLD,1:"@")
S DR="@1;.16;I +X<3 S IBFINAL=0,Y=""@99"";S IBFINAL=1;.2;I X="""" W !,""For a final status, this field is required"" S Y=""@98"";S Y=""@99"";@98;.16///"_IBO_";S Y=""@1"";@99"
L +^IBM(361.1,IBDA):3 I '$T D G STATUSQ
. W !,"Sorry, another user currently editing this entry (#"_IBDA_")."
D ^DIE
;
I $G(IBFINAL) D ;Final status selected - let remarks be entered
. N Z
. S Z=IBDA
. N IBDA,Q,DIE,DR,DA,X,Y
. S IBDA(1)=Z,IBDA=""
. D ADDCOM(.IBDA,.DUZ,.IBCOM)
. I $P($G(^IBM(361.1,IBDA(1),0)),U,20)="F",'$O(^IBM(361.1,IBDA(1),21,+IBDA,0)) D ; Require remarks for 'OTHER ACTION' final status
.. W !,"Since FILED - NO ACTION final status was selected, you must enter a",!," comment explaining the FILED - NO ACTION" D ADDCOM(.IBDA,.DUZ,.IBCOM,1)
.. I IBDA D
... ; Delete entry if just entered without a comment
... D KILLREV(.IBDA)
.. I '$O(^IBM(361.1,IBDA(1),21,+IBDA,0)) S DIE="^IBM(361.1,",DA=IBDA(1),DR=".20///@;.16///"_IBO D ^DIE W !,"The review status was not changed because no comment was entered",! Q
S IBNEW=$P($G(^IBM(361.1,DA,0)),U,16)
;if time out-no change in review status
S IBFACT=$P($G(^IBM(361.1,DA,0)),U,20)
I $G(IBFINAL),IBFACT="",IBNEW>1 D G STATUSQ
. W !,"The review status was not changed because no final status was selected"
. S DR=".16////"_IBOLD,DIE="^IBM(361.1," D ^DIE
I IBNEW>1,$P(^IBM(361.1,DA,0),U,19) D
. I "CR"'[IBFACT D
.. N DIR,X,Y
.. S DIR("?",1)="IF THIS BILL HAS RECEIVED ITS FINAL ELECTRONIC MESSAGE AND NO FURTHER ACTION",DIR("?",2)="WILL BE TAKEN ON IT, ANSWER YES"
.. S DIR("A")="DO YOU WANT TO CLOSE THE TRANSMISSION RECORD FOR THIS CLAIM?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR
.. I Y>0 S IBFACT="N"
. I "NCR"[IBFACT D UPDEDI^IBCEM(+$P(^IBM(361.1,DA,0),U,19),IBFACT) Q
I IBOLD'=IBNEW D ;Note the change and who made it
. N IBIEN,IBTEXT,DA
. S DA(1)=IBDA,DIC="^IBM(361.1,"_DA(1)_",21,",DIC(0)="L",DLAYGO=361.121
. S X=$$NOW^XLFDT
. S DIC("P")=$$GETSPEC^IBEFUNC(361.1,21)
. D FILE^DICN K DIC,DD,DO,DLAYGO
. Q:Y'>0
. S DA(2)=DA(1),DA(1)=+Y,IBIEN=DA(1)_","_DA(2)_",",IBTEXT(1)="REVIEW STATUS CHANGED TO '"_$$EXPAND^IBTRE(361.1,.16,$P(^IBM(361.1,DA(2),0),U,16))_"' BY: "_$$EXPAND^IBTRE(361.121,.02,+$G(DUZ))
. D WP^DIE(361.121,IBIEN,1,,"IBTEXT") K ^TMP("DIERR",$J)
. D HDR,INIT
L -^IBM(361.1,DA)
STATUSQ ;
D PAUSE^VALM1
S VALMBCK="R"
Q
;
ADDCOM(IBDA,DUZ,IBCOM,ADD) ; Add review comment to file 361.1
; IBDA = array containing the DA references for the file add -
; pass by reference
; DUZ = ien of the user
; ADD = flag when set to 1 says the review date exists,
; just allow comment entry
; Returns IBDA = the entry # of the comment
; and IBCOM array referencing any comments added by the user
;
N DA,DIC,DD,DO,DLAYGO,X,Y
S DR=$S($G(DUZ):".02////"_DUZ_";",1:"")_"1"
I '$G(ADD) D
. K DO,DD
. S DIC="^IBM(361.1,"_IBDA(1)_",21,",DA(1)=IBDA(1),X=$$NOW^XLFDT
. W !,"New Review Date: "_$$FMTE^XLFDT(X,2)
. S DIC("DR")=DR,DLAYGO=361.121
. S DIC(0)="L",DIC("P")=$$GETSPEC^IBEFUNC(361.1,21)
. D FILE^DICN K DIC,DD,DO,DLAYGO
. S IBDA=+Y
I IBDA>0 D
. I $G(ADD) S DIE="^IBM(361.1,"_IBDA(1)_",21,",DA(1)=IBDA(1),DA=IBDA D ^DIE
. I '$O(^IBM(361.1,IBDA(1),21,IBDA,0)) D KILLREV(.IBDA) Q
. S IBCOM(DUZ,IBDA)=""
Q
;
KILLREV(IBDA) ; Deletes a review date if no comments entered
N DA,DIK
S DA=IBDA,DA(1)=IBDA(1),DIK="^IBM(361.1,"_IBDA(1)_",21,"
K IBCOM(DUZ,IBDA)
D ^DIK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECOB4 5923 printed Sep 23, 2025@19:45:55 Page 2
IBCECOB4 ;ALB/CXW - IB EM MANAGEMENT - REVIEW STATUS SCREEN ;16-MAY-2000
+1 ;;2.0;INTEGRATED BILLING;**137,181,348,349,592**;21-MAR-1994;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for claims status awaiting resolution detail
+1 SET VALMCNT=0
SET VALMBG=1
+2 DO EN^VALM("IBCEM EOB REVIEW")
+3 QUIT
+4 ;
HDR ; -- header code
+1 ;IBDA - ien EOB selection screen
+2 NEW IBST
+3 SET IBST=$PIECE($GET(^IBM(361.1,IBDA,0)),U,16)
+4 SET VALMHDR(2)="Review Status= "_$SELECT(IBST=1:"REVIEW IN PROCESS",IBST=2:"ACCEPTED-INTERIM EOB",IBST=3:"ACCEPTED-COMPLETE EOB",IBST=4:"REJECTED",IBST=9:"CLAIM CANCELLED",1:"NOT REVIEWED")
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 NEW I,X,Y,Z,IBZ,IBFST,IBPAT
+2 KILL ^TMP("IBCECOC",$JOB)
SCR SET VALMCNT=0
+1 ; IBCMT = the data extracted into ^TMP("IBCECOB1",$J)
+2 ; IBIFN = the ien of the bill
+3 ; IBDA = the ien of the entry in 361.1
+4 SET Z=$GET(^DPT(+$PIECE($GET(^DGCR(399,IBIFN,0)),U,2),0))
+5 SET IBPAT=$EXTRACT($PIECE(Z,U),1,25)_"/"_$EXTRACT($PIECE(Z,U,9),6,9)
+6 SET X=""
+7 SET X=$$SETFLD^VALM1($$BN1^PRCAFN(IBIFN),X,"BILL")
+8 SET X=$$SETFLD^VALM1($$DAT1^IBOUTL($PIECE(IBCMT,U)),X,"SERVICE")
+9 SET X=$$SETFLD^VALM1(IBPAT,X,"PATNM")
+10 SET X=$$SETFLD^VALM1(" "_$PIECE("PRI^SEC^TER",U,+$PIECE(IBCMT,U,16)),X,"SEQ")
+11 ;JWS;IB*2.0*592:Dental form #7 J430D
+12 SET X=$$SETFLD^VALM1(" "_$$TYPE^IBJTLA1($PIECE(IBCMT,U,5))_"/"_$SELECT(+$PIECE(IBCMT,U,6)=2:"CMS-1500",$PIECE(IBCMT,U,6)=7:"J430D",1:"UB-04"),X,"BTYPE")
+13 DO SET(X)
+14 SET Z=0
FOR
SET Z=$ORDER(^IBM(361.1,IBDA,21,Z))
if 'Z
QUIT
SET I=$GET(^(Z,0))
Begin DoDot:1
+15 SET X=$$SETSTR^VALM1("Review Date/Time: "_$$EXPAND^IBTRE(361.121,.01,+I),"",2,40)
+16 DO SET(X)
+17 IF $PIECE($GET(^VA(200,+$PIECE(I,U,2),0)),U)'=""
SET X=$$SETSTR^VALM1("Reviewed By: "_$PIECE($GET(^VA(200,+$PIECE(I,U,2),0)),U),"",2,50)
DO SET(X)
+18 SET (IBFST,Y)=0
FOR
SET Y=$ORDER(^IBM(361.1,IBDA,21,Z,1,Y))
if 'Y
QUIT
Begin DoDot:2
+19 SET X=$$SETSTR^VALM1($SELECT('IBFST:"Comments: ",1:"")_$GET(^IBM(361.1,IBDA,21,Z,1,Y,0)),"",2,$SELECT('IBFST:140,1:150))
+20 DO SET(X)
+21 SET IBFST=1
End DoDot:2
+22 DO SET("")
End DoDot:1
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCECOC",$JOB)
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
SET(X) ;
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCECOC",$JOB,VALMCNT,0)=X
+3 SET ^TMP("IBCECOC",$JOB,"IDX",VALMCNT,1)=""
+4 SET ^TMP("IBCECOC",$JOB,1)=VALMCNT
+5 QUIT
+6 ;
STATUS ; Edit review status
+1 ;IBDA - EOB ien
+2 NEW DA,DIE,DR,IBOLD,DIC,DO,DD,DLAYGO,IBFINAL,IBO,IBNEW,IBFACT
+3 DO FULL^VALM1
+4 SET DIE="^IBM(361.1,"
+5 SET DA=IBDA
+6 if 'DA
GOTO STATUSQ
+7 SET IBOLD=$PIECE($GET(^IBM(361.1,DA,0)),U,16)
SET IBFINAL=0
SET IBO=$SELECT(IBOLD'="":"/"_IBOLD,1:"@")
+8 SET DR="@1;.16;I +X<3 S IBFINAL=0,Y=""@99"";S IBFINAL=1;.2;I X="""" W !,""For a final status, this field is required"" S Y=""@98"";S Y=""@99"";@98;.16///"_IBO_";S Y=""@1"";@99"
+9 LOCK +^IBM(361.1,IBDA):3
IF '$TEST
Begin DoDot:1
+10 WRITE !,"Sorry, another user currently editing this entry (#"_IBDA_")."
End DoDot:1
GOTO STATUSQ
+11 DO ^DIE
+12 ;
+13 ;Final status selected - let remarks be entered
IF $GET(IBFINAL)
Begin DoDot:1
+14 NEW Z
+15 SET Z=IBDA
+16 NEW IBDA,Q,DIE,DR,DA,X,Y
+17 SET IBDA(1)=Z
SET IBDA=""
+18 DO ADDCOM(.IBDA,.DUZ,.IBCOM)
+19 ; Require remarks for 'OTHER ACTION' final status
IF $PIECE($GET(^IBM(361.1,IBDA(1),0)),U,20)="F"
IF '$ORDER(^IBM(361.1,IBDA(1),21,+IBDA,0))
Begin DoDot:2
+20 WRITE !,"Since FILED - NO ACTION final status was selected, you must enter a",!," comment explaining the FILED - NO ACTION"
DO ADDCOM(.IBDA,.DUZ,.IBCOM,1)
+21 IF IBDA
Begin DoDot:3
+22 ; Delete entry if just entered without a comment
+23 DO KILLREV(.IBDA)
End DoDot:3
+24 IF '$ORDER(^IBM(361.1,IBDA(1),21,+IBDA,0))
SET DIE="^IBM(361.1,"
SET DA=IBDA(1)
SET DR=".20///@;.16///"_IBO
DO ^DIE
WRITE !,"The review status was not changed because no comment was entered",!
QUIT
End DoDot:2
End DoDot:1
+25 SET IBNEW=$PIECE($GET(^IBM(361.1,DA,0)),U,16)
+26 ;if time out-no change in review status
+27 SET IBFACT=$PIECE($GET(^IBM(361.1,DA,0)),U,20)
+28 IF $GET(IBFINAL)
IF IBFACT=""
IF IBNEW>1
Begin DoDot:1
+29 WRITE !,"The review status was not changed because no final status was selected"
+30 SET DR=".16////"_IBOLD
SET DIE="^IBM(361.1,"
DO ^DIE
End DoDot:1
GOTO STATUSQ
+31 IF IBNEW>1
IF $PIECE(^IBM(361.1,DA,0),U,19)
Begin DoDot:1
+32 IF "CR"'[IBFACT
Begin DoDot:2
+33 NEW DIR,X,Y
+34 SET DIR("?",1)="IF THIS BILL HAS RECEIVED ITS FINAL ELECTRONIC MESSAGE AND NO FURTHER ACTION"
SET DIR("?",2)="WILL BE TAKEN ON IT, ANSWER YES"
+35 SET DIR("A")="DO YOU WANT TO CLOSE THE TRANSMISSION RECORD FOR THIS CLAIM?: "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
+36 IF Y>0
SET IBFACT="N"
End DoDot:2
+37 IF "NCR"[IBFACT
DO UPDEDI^IBCEM(+$PIECE(^IBM(361.1,DA,0),U,19),IBFACT)
QUIT
End DoDot:1
+38 ;Note the change and who made it
IF IBOLD'=IBNEW
Begin DoDot:1
+39 NEW IBIEN,IBTEXT,DA
+40 SET DA(1)=IBDA
SET DIC="^IBM(361.1,"_DA(1)_",21,"
SET DIC(0)="L"
SET DLAYGO=361.121
+41 SET X=$$NOW^XLFDT
+42 SET DIC("P")=$$GETSPEC^IBEFUNC(361.1,21)
+43 DO FILE^DICN
KILL DIC,DD,DO,DLAYGO
+44 if Y'>0
QUIT
+45 SET DA(2)=DA(1)
SET DA(1)=+Y
SET IBIEN=DA(1)_","_DA(2)_","
SET IBTEXT(1)="REVIEW STATUS CHANGED TO '"_$$EXPAND^IBTRE(361.1,.16,$PIECE(^IBM(361.1,DA(2),0),U,16))_"' BY: "_$$EXPAND^IBTRE(361.121,.02,+$GET(DUZ))
+46 DO WP^DIE(361.121,IBIEN,1,,"IBTEXT")
KILL ^TMP("DIERR",$JOB)
+47 DO HDR
DO INIT
End DoDot:1
+48 LOCK -^IBM(361.1,DA)
STATUSQ ;
+1 DO PAUSE^VALM1
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
ADDCOM(IBDA,DUZ,IBCOM,ADD) ; Add review comment to file 361.1
+1 ; IBDA = array containing the DA references for the file add -
+2 ; pass by reference
+3 ; DUZ = ien of the user
+4 ; ADD = flag when set to 1 says the review date exists,
+5 ; just allow comment entry
+6 ; Returns IBDA = the entry # of the comment
+7 ; and IBCOM array referencing any comments added by the user
+8 ;
+9 NEW DA,DIC,DD,DO,DLAYGO,X,Y
+10 SET DR=$SELECT($GET(DUZ):".02////"_DUZ_";",1:"")_"1"
+11 IF '$GET(ADD)
Begin DoDot:1
+12 KILL DO,DD
+13 SET DIC="^IBM(361.1,"_IBDA(1)_",21,"
SET DA(1)=IBDA(1)
SET X=$$NOW^XLFDT
+14 WRITE !,"New Review Date: "_$$FMTE^XLFDT(X,2)
+15 SET DIC("DR")=DR
SET DLAYGO=361.121
+16 SET DIC(0)="L"
SET DIC("P")=$$GETSPEC^IBEFUNC(361.1,21)
+17 DO FILE^DICN
KILL DIC,DD,DO,DLAYGO
+18 SET IBDA=+Y
End DoDot:1
+19 IF IBDA>0
Begin DoDot:1
+20 IF $GET(ADD)
SET DIE="^IBM(361.1,"_IBDA(1)_",21,"
SET DA(1)=IBDA(1)
SET DA=IBDA
DO ^DIE
+21 IF '$ORDER(^IBM(361.1,IBDA(1),21,IBDA,0))
DO KILLREV(.IBDA)
QUIT
+22 SET IBCOM(DUZ,IBDA)=""
End DoDot:1
+23 QUIT
+24 ;
KILLREV(IBDA) ; Deletes a review date if no comments entered
+1 NEW DA,DIK
+2 SET DA=IBDA
SET DA(1)=IBDA(1)
SET DIK="^IBM(361.1,"_IBDA(1)_",21,"
+3 KILL IBCOM(DUZ,IBDA)
+4 DO ^DIK
+5 QUIT
+6 ;
