source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCECSA2.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 9.0 KB
RevLine 
[613]1IBCECSA2 ;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 ;
5EN ; -- claims status awaiting resolution detail
6 D EN^VALM("IBCEM CSA MSG")
7 Q
8 ;
9HDR ; -- 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 ;
19INIT ; -- init variables and list array
20 N I,X,Y,Z,ZZ,IBZ,IBZ0,IBX,IBCNT
21 K ^TMP("IBCECSC",$J)
22SCR 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
58INITQ Q
59 ;
60HELP ; help code
61 S X="?" D DISP^XQORM1 W !!
62 Q
63 ;
64EXIT ; exit code
65 K ^TMP("IBCECSC",$J)
66 D CLEAN^VALM10
67 Q
68 ;
69SET(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 ;
76UPDTX(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 ;
83STATUS ; 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 ;
139NOTECHG(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 ;
159STATUSQ ;
160 D PAUSE^VALM1
161 S VALMBCK="R"
162 Q
163 ;
164COM ; 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
197COMQ S VALMBCK="R"
198 Q
199 ;
200ADDCOM(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 ;
225KILLREV(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 ;
Note: See TracBrowser for help on using the repository browser.