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

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1IBCECOB4 ;ALB/CXW - IB EM MANAGEMENT - REVIEW STATUS SCREEN ;16-MAY-2000
2 ;;2.0;INTEGRATED BILLING;**137,181,348,349**;21-MAR-1994;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; -- main entry point for claims status awaiting resolution detail
6 S VALMCNT=0,VALMBG=1
7 D EN^VALM("IBCEM EOB REVIEW")
8 Q
9 ;
10HDR ; -- header code
11 ;IBDA - ien EOB selection screen
12 N IBST
13 S IBST=$P($G(^IBM(361.1,IBDA,0)),U,16)
14 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")
15 Q
16 ;
17INIT ; -- init variables and list array
18 N I,X,Y,Z,IBZ,IBFST,IBPAT
19 K ^TMP("IBCECOC",$J)
20SCR S VALMCNT=0
21 ; IBCMT = the data extracted into ^TMP("IBCECOB1",$J)
22 ; IBIFN = the ien of the bill
23 ; IBDA = the ien of the entry in 361.1
24 S Z=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0))
25 S IBPAT=$E($P(Z,U),1,25)_"/"_$E($P(Z,U,9),6,9)
26 S X=""
27 S X=$$SETFLD^VALM1($$BN1^PRCAFN(IBIFN),X,"BILL")
28 S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCMT,U)),X,"SERVICE")
29 S X=$$SETFLD^VALM1(IBPAT,X,"PATNM")
30 S X=$$SETFLD^VALM1(" "_$P("PRI^SEC^TER",U,+$P(IBCMT,U,16)),X,"SEQ")
31 S X=$$SETFLD^VALM1(" "_$$TYPE^IBJTLA1($P(IBCMT,U,5))_"/"_$S(+$P(IBCMT,U,6)=2:"CMS-1500",1:"UB-04"),X,"BTYPE")
32 D SET(X)
33 S Z=0 F S Z=$O(^IBM(361.1,IBDA,21,Z)) Q:'Z S I=$G(^(Z,0)) D
34 . S X=$$SETSTR^VALM1("Review Date/Time: "_$$EXPAND^IBTRE(361.121,.01,+I),"",2,40)
35 . D SET(X)
36 . 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)
37 . S (IBFST,Y)=0 F S Y=$O(^IBM(361.1,IBDA,21,Z,1,Y)) Q:'Y D
38 .. S X=$$SETSTR^VALM1($S('IBFST:"Comments: ",1:"")_$G(^IBM(361.1,IBDA,21,Z,1,Y,0)),"",2,$S('IBFST:140,1:150))
39 .. D SET(X)
40 .. S IBFST=1
41 . D SET("")
42INITQ Q
43 ;
44HELP ; -- help code
45 S X="?" D DISP^XQORM1 W !!
46 Q
47 ;
48EXIT ; -- exit code
49 K ^TMP("IBCECOC",$J)
50 D CLEAN^VALM10
51 Q
52 ;
53SET(X) ;
54 S VALMCNT=VALMCNT+1
55 S ^TMP("IBCECOC",$J,VALMCNT,0)=X
56 S ^TMP("IBCECOC",$J,"IDX",VALMCNT,1)=""
57 S ^TMP("IBCECOC",$J,1)=VALMCNT
58 Q
59 ;
60STATUS ; Edit review status
61 ;IBDA - EOB ien
62 N DA,DIE,DR,IBOLD,DIC,DO,DD,DLAYGO,IBFINAL,IBO,IBNEW,IBFACT
63 D FULL^VALM1
64 S DIE="^IBM(361.1,"
65 S DA=IBDA
66 G:'DA STATUSQ
67 S IBOLD=$P($G(^IBM(361.1,DA,0)),U,16),IBFINAL=0,IBO=$S(IBOLD'="":"/"_IBOLD,1:"@")
68 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"
69 L +^IBM(361.1,IBDA):3 I '$T D G STATUSQ
70 . W !,"Sorry, another user currently editing this entry (#"_IBDA_")."
71 D ^DIE
72 ;
73 I $G(IBFINAL) D ;Final status selected - let remarks be entered
74 . N Z
75 . S Z=IBDA
76 . N IBDA,Q,DIE,DR,DA,X,Y
77 . S IBDA(1)=Z,IBDA=""
78 . D ADDCOM(.IBDA,.DUZ,.IBCOM)
79 . 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
80 .. 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)
81 .. I IBDA D
82 ... ; Delete entry if just entered without a comment
83 ... D KILLREV(.IBDA)
84 .. 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
85 S IBNEW=$P($G(^IBM(361.1,DA,0)),U,16)
86 ;if time out-no change in review status
87 S IBFACT=$P($G(^IBM(361.1,DA,0)),U,20)
88 I $G(IBFINAL),IBFACT="",IBNEW>1 D G STATUSQ
89 . W !,"The review status was not changed because no final status was selected"
90 . S DR=".16////"_IBOLD,DIE="^IBM(361.1," D ^DIE
91 I IBNEW>1,$P(^IBM(361.1,DA,0),U,19) D
92 . I "CR"'[IBFACT D
93 .. N DIR,X,Y
94 .. 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"
95 .. S DIR("A")="DO YOU WANT TO CLOSE THE TRANSMISSION RECORD FOR THIS CLAIM?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR
96 .. I Y>0 S IBFACT="N"
97 . I "NCR"[IBFACT D UPDEDI^IBCEM(+$P(^IBM(361.1,DA,0),U,19),IBFACT) Q
98 I IBOLD'=IBNEW D ;Note the change and who made it
99 . N IBIEN,IBTEXT,DA
100 . S DA(1)=IBDA,DIC="^IBM(361.1,"_DA(1)_",21,",DIC(0)="L",DLAYGO=361.121
101 . S X=$$NOW^XLFDT
102 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,21)
103 . D FILE^DICN K DIC,DD,DO,DLAYGO
104 . Q:Y'>0
105 . 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))
106 . D WP^DIE(361.121,IBIEN,1,,"IBTEXT") K ^TMP("DIERR",$J)
107 . D HDR,INIT
108 L -^IBM(361.1,DA)
109STATUSQ ;
110 D PAUSE^VALM1
111 S VALMBCK="R"
112 Q
113 ;
114ADDCOM(IBDA,DUZ,IBCOM,ADD) ; Add review comment to file 361.1
115 ; IBDA = array containing the DA references for the file add -
116 ; pass by reference
117 ; DUZ = ien of the user
118 ; ADD = flag when set to 1 says the review date exists,
119 ; just allow comment entry
120 ; Returns IBDA = the entry # of the comment
121 ; and IBCOM array referencing any comments added by the user
122 ;
123 N DA,DIC,DD,DO,DLAYGO,X,Y
124 S DR=$S($G(DUZ):".02////"_DUZ_";",1:"")_"1"
125 I '$G(ADD) D
126 . K DO,DD
127 . S DIC="^IBM(361.1,"_IBDA(1)_",21,",DA(1)=IBDA(1),X=$$NOW^XLFDT
128 . W !,"New Review Date: "_$$FMTE^XLFDT(X,2)
129 . S DIC("DR")=DR,DLAYGO=361.121
130 . S DIC(0)="L",DIC("P")=$$GETSPEC^IBEFUNC(361.1,21)
131 . D FILE^DICN K DIC,DD,DO,DLAYGO
132 . S IBDA=+Y
133 I IBDA>0 D
134 . I $G(ADD) S DIE="^IBM(361.1,"_IBDA(1)_",21,",DA(1)=IBDA(1),DA=IBDA D ^DIE
135 . I '$O(^IBM(361.1,IBDA(1),21,IBDA,0)) D KILLREV(.IBDA) Q
136 . S IBCOM(DUZ,IBDA)=""
137 Q
138 ;
139KILLREV(IBDA) ; Deletes a review date if no comments entered
140 N DA,DIK
141 S DA=IBDA,DA(1)=IBDA(1),DIK="^IBM(361.1,"_IBDA(1)_",21,"
142 K IBCOM(DUZ,IBDA)
143 D ^DIK
144 Q
145 ;
Note: See TracBrowser for help on using the repository browser.