| 1 | IBCECSA2 ;ALB/CXW - IB CLAIMS STATUS AWAITING RESOLUTION SCREEN ;28-JUL-1999
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,181,197,320**;21-MAR-1994
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- claims status awaiting resolution detail
|
|---|
| 6 | D EN^VALM("IBCEM CSA MSG")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | ; IBA - EOB ien from summary selection
|
|---|
| 11 | N IBST,IBST0
|
|---|
| 12 | Q:'$G(IBA)
|
|---|
| 13 | S IBST0=$G(^IBM(361,+$P(IBA,U,2),0)),IBST=$P(IBST0,U,9)
|
|---|
| 14 | S VALMHDR(2)="Message Status = "_$$EXPAND^IBTRE(361,.09,IBST)
|
|---|
| 15 | I $P(IBST0,U,14) S VALMHDR(2)=VALMHDR(2)_" (AUTOMATICALLY REVIEWED)"
|
|---|
| 16 | S VALMHDR(1)=$J("",23)_"CLAIMS STATUS AWAITING RESOLUTION-DETAIL"
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | INIT ; -- init variables and list array
|
|---|
| 20 | N I,X,Y,Z,ZZ,IBZ,IBZ0,IBX,IBCNT
|
|---|
| 21 | K ^TMP("IBCECSC",$J)
|
|---|
| 22 | SCR S VALMCNT=0,IBCNT=1
|
|---|
| 23 | S IBA=+$O(IBDAX(0)),IBA=$G(IBDAX(IBA))
|
|---|
| 24 | Q:IBA=""
|
|---|
| 25 | S X=""
|
|---|
| 26 | S IBX=$S($D(^TMP("IBCECSB",$J)):$G(^TMP("IBCECSB",$J,$P(IBA,U,3),$P(IBA,U,4),$P(IBA,U,6),$P(IBA,U,2))),1:"")
|
|---|
| 27 | D SETL1^IBCECSA1(IBX,.X)
|
|---|
| 28 | D SET(X,IBCNT)
|
|---|
| 29 | D SET("",IBCNT) ; blank line
|
|---|
| 30 | ;
|
|---|
| 31 | S X=$E(" Svc Loc: "_$P(IBX,U,7)_$J("",30),1,30)_$J("",14)_"Division: "_$E($P(IBX,U,8),1,26)
|
|---|
| 32 | D SET(X,IBCNT)
|
|---|
| 33 | S X=$E(" Biller Name: "_$P($P(IBX,U,9),"~")_$J("",30),1,30)_$J("",10)_"Days Pending: "_$P(IBX,U,11)
|
|---|
| 34 | D SET(X,IBCNT)
|
|---|
| 35 | S IBZ=$P(IBA,U,2),IBZ0=$G(^IBM(361,IBZ,0))
|
|---|
| 36 | S X=$E(" Date Rec'd: "_$$FMTE^XLFDT($P(IBZ0,U,2),"2Z")_$J("",30),1,30)_$J("",10)_"Dt Generated: "_$S($P(IBZ0,U,12):$$FMTE^XLFDT($P(IBZ0,U,12),"2Z"),1:"")
|
|---|
| 37 | D SET(X,IBCNT),SET("",IBCNT)
|
|---|
| 38 | ;
|
|---|
| 39 | D SET("Message Text:",IBCNT)
|
|---|
| 40 | S X=0 F S X=$O(^IBM(361,IBZ,1,X)) Q:'X D
|
|---|
| 41 | . S Y=" "_$G(^IBM(361,IBZ,1,X,0))
|
|---|
| 42 | . D SET(Y,IBCNT)
|
|---|
| 43 | . Q
|
|---|
| 44 | D SET("",IBCNT)
|
|---|
| 45 | ;
|
|---|
| 46 | S ZZ="" F S ZZ=$O(^IBM(361,IBZ,2,"B",ZZ),-1) Q:ZZ="" S Z=0 F S Z=$O(^IBM(361,IBZ,2,"B",ZZ,Z)) Q:'Z D
|
|---|
| 47 | . S I=$G(^IBM(361,IBZ,2,Z,0))
|
|---|
| 48 | . S Y=$$SETSTR^VALM1("Review Date: "_$$EXTERNAL^DILFD(361.02,.01,,ZZ),"",2,40)
|
|---|
| 49 | . D SET(Y,IBCNT)
|
|---|
| 50 | . I $P(I,U,2) S Y=$$SETSTR^VALM1("Reviewed By: "_$P($G(^VA(200,+$P(I,U,2),0)),U,1),"",2,70) D SET(Y,IBCNT)
|
|---|
| 51 | . D SET(" Comments:",IBCNT)
|
|---|
| 52 | . S X=0 F S X=$O(^IBM(361,IBZ,2,Z,1,X)) Q:'X D
|
|---|
| 53 | .. S Y=" "_$G(^IBM(361,IBZ,2,Z,1,X,0))
|
|---|
| 54 | .. D SET(Y,IBCNT)
|
|---|
| 55 | .. Q
|
|---|
| 56 | . D SET("",IBCNT)
|
|---|
| 57 | . Q
|
|---|
| 58 | INITQ Q
|
|---|
| 59 | ;
|
|---|
| 60 | HELP ; help code
|
|---|
| 61 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | EXIT ; exit code
|
|---|
| 65 | K ^TMP("IBCECSC",$J)
|
|---|
| 66 | D CLEAN^VALM10
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | SET(X,CNT) ;
|
|---|
| 70 | S VALMCNT=VALMCNT+1
|
|---|
| 71 | S ^TMP("IBCECSC",$J,VALMCNT,0)=X
|
|---|
| 72 | S ^TMP("IBCECSC",$J,"IDX",VALMCNT,CNT)=""
|
|---|
| 73 | S ^TMP("IBCECSC",$J,CNT)=VALMCNT
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | UPDTX(IBDA,IBST) ; Update transmit bill record
|
|---|
| 77 | ; IBDA = ien of entry in 364
|
|---|
| 78 | ; IBST = status to stuff
|
|---|
| 79 | N X,Y,DR,DIE,DA
|
|---|
| 80 | S DR=".03////"_IBST_";.04///NOW",DA=IBDA,DIE="^IBA(364," D:DA ^DIE
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | STATUS ; Edit rev stat
|
|---|
| 84 | ;IBA - EOB ien
|
|---|
| 85 | N DA,DIE,DR,IBOLD,DIC,DO,DD,DLAYGO,IBDA,IBFINAL,IBO,IBNEW,IBFACT
|
|---|
| 86 | D FULL^VALM1
|
|---|
| 87 | S DIE="^IBM(361,"
|
|---|
| 88 | S (IBDA,DA)=$P(IBA,U,2)
|
|---|
| 89 | G:'DA STATUSQ
|
|---|
| 90 | S IBOLD=$P($G(^IBM(361,DA,0)),U,9),IBFINAL=0,IBO=$S(IBOLD'="":"/"_IBOLD,1:"@")
|
|---|
| 91 | S DR="@1;.09;I +X<2 S IBFINAL=0,Y=""@99"";S IBFINAL=1;.1;I X="""" W !,""For a final status, this field is required"" S Y=""@98"";S Y=""@99"";@98;.09///"_IBO_";S Y=""@1"";@99"
|
|---|
| 92 | L +^IBM(361,IBDA):3 I '$T D G STATUSQ
|
|---|
| 93 | . W !,"Sorry, another user currently editing this entry (#"_IBDA_")."
|
|---|
| 94 | D ^DIE
|
|---|
| 95 | ;
|
|---|
| 96 | I $G(IBFINAL) D ;Final status selected - enter remarks
|
|---|
| 97 | . N Z
|
|---|
| 98 | . S Z=IBDA
|
|---|
| 99 | . N IBDA,Q,DIE,DR,DA,X,Y
|
|---|
| 100 | . S IBDA(1)=Z,IBDA=""
|
|---|
| 101 | . D ADDCOM(.IBDA,.DUZ,.IBCOM)
|
|---|
| 102 | . I $P($G(^IBM(361,IBDA(1),0)),U,10)="O",'$O(^IBM(361,IBDA(1),2,+IBDA,0)) D ; Require remarks for 'OTHER ACTION' final status
|
|---|
| 103 | .. W !,"Since OTHER ACTION final status was selected, you must enter a",!," comment explaining the OTHER ACTION" D ADDCOM(.IBDA,.DUZ,.IBCOM,1)
|
|---|
| 104 | .. I IBDA D
|
|---|
| 105 | ... ; Delete entry without a comment
|
|---|
| 106 | ... D KILLREV(.IBDA)
|
|---|
| 107 | .. I '$O(^IBM(361,IBDA(1),2,+IBDA,0)) S DIE="^IBM(361,",DA=IBDA(1),DR=".20///@;.09///"_IBO D ^DIE W !,"The review status was not changed because no comment was entered",! Q
|
|---|
| 108 | S IBNEW=$P($G(^IBM(361,DA,0)),U,9)
|
|---|
| 109 | ;if time out-no change in review status
|
|---|
| 110 | S IBFACT=$P($G(^IBM(361,DA,0)),U,10)
|
|---|
| 111 | I $G(IBFINAL),IBFACT="",IBNEW>1 D G STATUSQ
|
|---|
| 112 | . W !,"The review status was not changed because no final status was selected"
|
|---|
| 113 | . S DR=".09////"_IBOLD,DIE="^IBM(361," D ^DIE
|
|---|
| 114 | I IBNEW>1,$P(^IBM(361,DA,0),U,11) D
|
|---|
| 115 | . I "CR"'[IBFACT D
|
|---|
| 116 | .. W !,"NO FURTHER ACTION WILL BE ALLOWED REGARDING THIS ELECTRONIC MESSAGE"
|
|---|
| 117 | .. I $$PRINTUPD^IBCEU0("",$P(^IBM(361,DA,0),U,11)) D Q
|
|---|
| 118 | ... W !," SINCE THIS CLAIM WAS PRINTED AT THE CLEARINGHOUSE"
|
|---|
| 119 | ... S IBFACT="N"
|
|---|
| 120 | .. S DIR(0)="YA",DIR("A")="IS THIS THE FINAL ELECTRONIC MESSAGE YOU EXPECT TO RECEIVE FOR THIS BILL?: ",DIR("B")="NO"
|
|---|
| 121 | .. S DIR("?",1)="If you respond YES to this prompt, the transmit status of this bill will",DIR("?",2)=" be set to CLOSED. No further electronic processing of this bill will be"
|
|---|
| 122 | ..S DIR("?",3)=" allowed. If you respond NO to this prompt, this electronic message will",DIR("?",4)=" be filed as reviewed, but the bill's transmit status will not be changed."
|
|---|
| 123 | .. S DIR("?",5)=" You may wish to periodically print a list of bills with a non-final",DIR("?",6)=" (closed/cancelled/etc) status to ensure the electronic processing of all"
|
|---|
| 124 | .. S DIR("?",7)=" bills has been completed. Closing the transmit bill record here will",DIR("?")=" eliminate the bill from this list."
|
|---|
| 125 | .. W ! D ^DIR K DIR W !
|
|---|
| 126 | .. Q:Y'=1
|
|---|
| 127 | .. S DIR("A",1)="SINCE YOU HAVE INDICATED THIS BILL HAS RECEIVED ITS FINAL ELECTRONIC MESSAGE",DIR("A",2)=" AND NO FURTHER ACTION WILL BE TAKEN ON IT, THE STATUS OF THE TRANSMIT",DIR("A",3)=" RECORD FOR THIS BILL WILL BE CHANGED TO CLOSED"
|
|---|
| 128 | .. S DIR("A")="IS THIS WHAT YOU MEANT TO DO?: ",DIR("B")="YES",DIR(0)="YA" W ! D ^DIR W ! K DIR
|
|---|
| 129 | .. Q:Y'=1
|
|---|
| 130 | .. S IBFACT="N"
|
|---|
| 131 | . I "NCR"[IBFACT D UPDEDI^IBCEM(+$P(^IBM(361,DA,0),U,11),IBFACT) Q
|
|---|
| 132 | S $P(IBX,U,12)=$S(IBNEW=1:"*",1:"")
|
|---|
| 133 | I IBOLD'=IBNEW D ;Note the change and who made it
|
|---|
| 134 | . D NOTECHG(IBDA,0),HDR,INIT
|
|---|
| 135 | L -^IBM(361,DA)
|
|---|
| 136 | S VALMBCK="R"
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
| 139 | NOTECHG(IBDA,IBAUTO,IBNTEXT,IBUSER) ; Enter who/when review stat change was entered
|
|---|
| 140 | ; IBDA = ien of entry in file 361
|
|---|
| 141 | ; IBAUTO = flag to say auto-review was used (1=used, 0=not used)
|
|---|
| 142 | ; IBNTEXT = array containing the lines of text to store if not using the
|
|---|
| 143 | ; default text IBNTEXT = # of lines
|
|---|
| 144 | ; IBUSER = flag which says to also stuff the .02 reviewed by field
|
|---|
| 145 | N IBIEN,IBTEXT,DA,X,Y,DIC,DO,DLAYGO,DD
|
|---|
| 146 | S DA(1)=IBDA,DIC="^IBM(361,"_DA(1)_",2,",DIC(0)="L",DLAYGO=361.02
|
|---|
| 147 | S X=$$NOW^XLFDT
|
|---|
| 148 | I $G(IBUSER),$G(DUZ) S DIC("DR")=".02////"_$G(DUZ)
|
|---|
| 149 | D FILE^DICN K DIC,DD,DO,DLAYGO
|
|---|
| 150 | Q:Y'>0
|
|---|
| 151 | S DA(2)=DA(1),DA(1)=+Y,IBIEN=DA(1)_","_DA(2)_","
|
|---|
| 152 | I $G(IBNTEXT) D
|
|---|
| 153 | . M IBTEXT=IBNTEXT
|
|---|
| 154 | E D
|
|---|
| 155 | . S IBTEXT(1)="REVIEW STATUS "_$S($G(IBAUTO):"AUTOMATICALLY ",1:"")_"CHANGED TO '"_$$EXTERNAL^DILFD(361,.09,,$P(^IBM(361,DA(2),0),U,9))_"' BY: "_$$EXTERNAL^DILFD(361.02,.02,,+$G(DUZ))
|
|---|
| 156 | D WP^DIE(361.02,IBIEN,.03,,"IBTEXT") K ^TMP("DIERR",$J)
|
|---|
| 157 | Q
|
|---|
| 158 | ;
|
|---|
| 159 | STATUSQ ;
|
|---|
| 160 | D PAUSE^VALM1
|
|---|
| 161 | S VALMBCK="R"
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | COM ; Enter/Edit Review Comments
|
|---|
| 165 | ; IBA - EOB ien
|
|---|
| 166 | N DA,DIC,X,Y,DO,DD,DLAYGO,IBDA,IB0,IBNEW,IBCOM
|
|---|
| 167 | D FULL^VALM1
|
|---|
| 168 | W !
|
|---|
| 169 | S (IBDA(1),DA(1))=+$P(IBA,U,2)
|
|---|
| 170 | L +^IBM(361,IBDA(1)):3 I '$T D G COMQ
|
|---|
| 171 | . W !,*7,"Sorry, another user currently editing this entry."
|
|---|
| 172 | . D PAUSE^VALM1
|
|---|
| 173 | ;
|
|---|
| 174 | S Z=0 F S Z=$O(^IBM(361,IBDA(1),2,Z)) Q:'Z I $P($G(^(Z,0)),U,2)=DUZ S IBCOM(DUZ,Z)=""
|
|---|
| 175 | S IBNEW=0
|
|---|
| 176 | I '$D(IBCOM(DUZ)) D
|
|---|
| 177 | . N DO,DD,DIC,DLAYGO,DIR,X,Y
|
|---|
| 178 | . S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="There are no comments previously entered by you",DIR("A")="Do you want to add a new comment?: "
|
|---|
| 179 | . S DIR("?",1)="You are only allowed to edit your own comments."
|
|---|
| 180 | . S DIR("?")="You may enter a new comment here."
|
|---|
| 181 | . D ^DIR K DIR
|
|---|
| 182 | . W !
|
|---|
| 183 | . I Y'=1 S IBDA=-1 Q
|
|---|
| 184 | . D ADDCOM(.IBDA,.DUZ,.IBCOM)
|
|---|
| 185 | ;
|
|---|
| 186 | E D
|
|---|
| 187 | . S DIC="^IBM(361,"_IBDA(1)_",2,",DIC("S")="I $P(^(0),U,2)=DUZ",DIC(0)="AEMQ",DIC("A")="Select REVIEW DATE to edit or press ENTER to add a new comment: " D ^DIC K DIC S IBDA=+Y
|
|---|
| 188 | . I IBDA>0 D Q ;User selected an existing entry
|
|---|
| 189 | .. D ADDCOM(.IBDA,.DUZ,.IBCOM,1)
|
|---|
| 190 | .. I $D(^IBM(361,IBDA(1),2,IBDA)),'$O(^IBM(361,IBDA(1),2,IBDA,1,0)) D KILLREV(.IBDA)
|
|---|
| 191 | . S DIR(0)="YAO",DIR("A")="DO YOU WANT TO ADD A NEW REVIEW COMMENT?: ",DIR("B")="NO" D ^DIR K DIR Q:Y'=1
|
|---|
| 192 | . D ADDCOM(.IBDA,.DUZ,.IBCOM)
|
|---|
| 193 | L -^IBM(361,IBDA(1))
|
|---|
| 194 | G:IBDA'>0 COMQ
|
|---|
| 195 | D PAUSE^VALM1
|
|---|
| 196 | D HDR,INIT
|
|---|
| 197 | COMQ S VALMBCK="R"
|
|---|
| 198 | Q
|
|---|
| 199 | ;
|
|---|
| 200 | ADDCOM(IBDA,DUZ,IBCOM,ADD) ; Add review comment to file 361
|
|---|
| 201 | ; IBDA = array containing the DA references for the file add -
|
|---|
| 202 | ; pass by reference
|
|---|
| 203 | ; DUZ = ien of the user
|
|---|
| 204 | ; ADD = flag when set to 1 says the review date exists,
|
|---|
| 205 | ; just allow comment entry
|
|---|
| 206 | ; Returns IBDA = the entry # of the comment
|
|---|
| 207 | ; and IBCOM array referencing any comments added by the user
|
|---|
| 208 | ;
|
|---|
| 209 | N DA,DIC,DD,DO,DLAYGO,X,Y
|
|---|
| 210 | S DR=$S($G(DUZ):".02////"_DUZ_";",1:"")_".03"
|
|---|
| 211 | I '$G(ADD) D
|
|---|
| 212 | . K DO,DD
|
|---|
| 213 | . S DIC="^IBM(361,"_IBDA(1)_",2,",DA(1)=IBDA(1),X=$$NOW^XLFDT
|
|---|
| 214 | . W !,"New Review Date: "_$$FMTE^XLFDT(X,"2Z")
|
|---|
| 215 | . S DIC("DR")=DR,DLAYGO=361.02
|
|---|
| 216 | . S DIC(0)="L",DIC("P")=$$GETSPEC^IBEFUNC(361,2)
|
|---|
| 217 | . D FILE^DICN K DIC,DD,DO,DLAYGO
|
|---|
| 218 | . S IBDA=+Y
|
|---|
| 219 | I IBDA>0 D
|
|---|
| 220 | . I $G(ADD) S DIE="^IBM(361,"_IBDA(1)_",2,",DA(1)=IBDA(1),DA=IBDA D ^DIE
|
|---|
| 221 | . I '$O(^IBM(361,IBDA(1),2,IBDA,0)) D KILLREV(.IBDA) Q
|
|---|
| 222 | . S IBCOM(DUZ,IBDA)=""
|
|---|
| 223 | Q
|
|---|
| 224 | ;
|
|---|
| 225 | KILLREV(IBDA) ; Deletes a review date if no comments entered
|
|---|
| 226 | N DA,DIK
|
|---|
| 227 | S DA=IBDA,DA(1)=IBDA(1),DIK="^IBM(361,"_IBDA(1)_",2,"
|
|---|
| 228 | K IBCOM(DUZ,IBDA)
|
|---|
| 229 | D ^DIK
|
|---|
| 230 | Q
|
|---|
| 231 | ;
|
|---|
