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

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1IBCECOB6 ;YMG/BP - IB COB MANAGEMENT SCREEN ;26-Dec-2007
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; view MRA comments - entry point from MRA Worklist
6 N IBDA,IBIFN
7 ; we need to select a claim and set IBIFN
8 D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0)))
9 D:$G(IBIFN) EN^VALM("IBCEM MRA COMMENTS")
10 S VALMBCK="R"
11 Q
12 ;
13HDR ; header code
14 S VALMHDR(1)="MRA Claim "_$P($G(^DGCR(399,IBIFN,0)),U)
15 Q
16 ;
17INIT ; init variables and list array
18 N CMLN,CMSTR,I,IB0,IBDATE,IBDUZ,LEN,LN,MAX,POS,STR
19 S LN=1
20 ; check if we have any comments to display
21 I '$D(^DGCR(399,IBIFN,"TXC","B")) D Q
22 .S STR="",STR=$$SETFLD^VALM1("No comments found for this claim.",STR,"MESSAGE")
23 .D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN,"MESSAGE",IOINHI,IOINORM)
24 .S VALMCNT=LN
25 .Q
26 ; loop through all available comments
27 S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1) Q:IBDATE="" D
28 .S I=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC",I,0),IBDUZ=$P(IB0,U,2)
29 .D SET^VALM10(LN,"") S LN=LN+1
30 .S STR="",STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
31 .D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN) S LN=LN+1
32 .; loop through comment lines
33 .S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC",I,1,CMLN)) Q:CMLN="" D
34 ..S CMSTR=^DGCR(399,IBIFN,"TXC",I,1,CMLN,0) ; complete comment line
35 ..S MAX=$P(VALMDDF("MESSAGE"),U,3) ; max. number of characters in the "MESSAGE" field
36 ..; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
37 ..F D Q:CMSTR=""
38 ...S (POS,LEN)=$L(CMSTR) I LEN>MAX S POS=MAX F Q:POS=0 Q:$E(CMSTR,POS)=" " S POS=POS-1 ; try to make a split on a space char.
39 ...S:'POS POS=MAX ; if we couldn't find a space, split at the max. number of chars
40 ...; populate list manager array with this substring and remove it from the comment line
41 ...S STR="",STR=$$SETFLD^VALM1($E(CMSTR,1,POS),STR,"MESSAGE") D SET^VALM10(LN,STR) S LN=LN+1,CMSTR=$E(CMSTR,POS+1,LEN)
42 ...Q
43 ..Q
44 .Q
45 S VALMCNT=LN-1,VALMBG=1
46 D CLEAN^DILF
47 Q
48 ;
49HELP ; help code
50 S X="?" D DISP^XQORM1 W !!
51 Q
52 ;
53EXIT ; exit code
54 N COL,I,LN,STR,WIDTH,Z0,Z1,Z2
55 ; update status for this claim in MRW list - could have been changed from View Comments
56 S (Z0,Z1)=0,Z2=""
57 S Z0=$$FIND1^DIC(409.61,,"X","IBCEM MRA MANAGEMENT")
58 S:+Z0 Z1=$$FIND1^DIC(409.621,","_Z0_",","X","BILL")
59 S:+Z1 Z2=Z1_","_Z0_","
60 I Z2'="" D
61 .S COL=$$GET1^DIQ(409.621,Z2,.02)
62 .S WIDTH=$$GET1^DIQ(409.621,Z2,.03)
63 .Q:COL=""!(WIDTH="")
64 .S LN=($O(VALMY(""))-1)*3+2,STR=$E($$BN1^PRCAFN(IBIFN)_$S($P($G(^DGCR(399,IBIFN,"TX")),U,10)=1:"*",1:" "),1,WIDTH)
65 .F I=1:1:$L(STR) S $E(^TMP("IBCECOB",$J,LN,0),COL+I-1)=$E(STR,I)
66 .Q
67 ; clean up variables
68 D CLEAR^VALM1,CLEAN^VALM10
69 Q
70 ;
71CMNTW ; enter MRA comments - entry point from MRA Worklist screen
72 ; we need to select a claim and set IBIFN
73 N IBDA,IBIFN,MRAFLG
74 S MRAFLG=1
75 D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0))) D:$G(IBIFN) CMNT
76 S VALMBCK="R"
77 Q
78 ;
79CMNTV ; enter MRA comments - entry point from View MRA Comments screen
80 ; IBIFN should already be defined, only need to set a flag used to rebuild list of comments
81 N MRAFLG,VCFLG
82 S (MRAFLG,VCFLG)=1 D:$G(IBIFN) CMNT
83 S VALMBCK="R"
84 Q
85 ;
86CMNT ; enter MRA comments, called from entry points CMNTV and CMNTW above. Also called from ARCA^IBJTA1 (TPJI)
87 N DA,DD,DIC,DIK,DLAYGO,X,Y
88 W !
89 ; make sure this entry is not locked already
90 L +^DGCR(399,IBIFN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 Q
91 K DO S DIC="^DGCR(399,"_IBIFN_",""TXC"",",DIC(0)="L",DIC("DR")=".03",DA(1)=IBIFN,X=$$NOW^XLFDT,DLAYGO=399.077
92 D FILE^DICN
93 S DA=+Y I DA>0 D
94 .; if no comment has been added, delete the created entry in comments subfile
95 .I '$D(^DGCR(399,IBIFN,"TXC",DA,1)) S DIK=DIC D ^DIK Q
96 .; if we got here, comment has been added successfully
97 .; if called from MRA Worklist or View MRA Comments, ask if status needs to be changed
98 .I $G(MRAFLG) S DIE=399,DA=IBIFN,DR="28.1//REVIEW IN PROCESS" D ^DIE D:'$G(VCFLG) BLD^IBCECOB1
99 .; if action was invoked from View Comments, rebuild the list of comments
100 .D:$G(VCFLG) CLEAN^VALM10,INIT
101 .Q
102 D CLEAN^DILF
103 L -^DGCR(399,IBIFN)
104 Q
105 ;
106STATUS ; change MRA review status
107 N DA,DIE,DR,IBDA,IBIFN,SEL
108 D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0))) G:'$G(IBIFN) STATUSX
109 W !
110 ; make sure this entry is not locked already
111 L +^DGCR(399,IBIFN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 G STATUSX
112 S DIE=399,DA=IBIFN,DR="28.1//REVIEW IN PROCESS" D ^DIE,CLEAN^DILF
113 ;update list manager display
114 D BLD^IBCECOB1
115 L -^DGCR(399,IBIFN)
116STATUSX ;
117 S VALMBCK="R"
118 Q
Note: See TracBrowser for help on using the repository browser.