Routine: IBCECOB4

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")

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")

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 !!

EXIT ; -- exit code

 K ^TMP("IBCECOC",$J)

 D CLEAN^VALM10

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

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"

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)=""

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECOB4   5923     printed  Feb 18, 2025@23:36:06                                                                                                                                                                                                    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       ;

IBCECOB4.m