IBCECOB6 ;YMG/BP - IB COB MANAGEMENT SCREEN ;26-Dec-2007
;;2.0;INTEGRATED BILLING;**377,432**;21-MAR-94;Build 192
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN ; view MRA comments - entry point from MRA Worklist
N IBDA,IBIFN
; we need to select a claim and set IBIFN
D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0)))
D:$G(IBIFN) EN^VALM("IBCEM MRA COMMENTS")
S VALMBCK="R"
Q
;
HDR ; header code
S VALMHDR(1)=$S($G(IBMRANOT):"EOB",1:"MRA")_" Claim "_$P($G(^DGCR(399,IBIFN,0)),U) ;WCJ IB*2.0*432
S:$G(IBMRANOT)=1 VALM("TITLE")="Claim Comment History"
Q
;
INIT ; init variables and list array
N CMLN,CMSTR,I,IB0,IBDATE,IBDUZ,LEN,LN,MAX,POS,STR
S LN=1
; IB*2.0*432 - if user came from new CBW, show all comments (AR & IB)
I $G(IBMRANOT)=1 D BLD^IBJTTC Q
; check if we have any comments to display - IB*2.0*432 add EOB claim comments
; I '$D(^DGCR(399,IBIFN,"TXC","B")) D Q
I '$D(^DGCR(399,IBIFN,"TXC","B"))&('$D(^DGCR(399,IBIFN,"TXC2","B"))) D Q
.S STR="",STR=$$SETFLD^VALM1("No comments found for this claim.",STR,"MESSAGE")
.D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN,"MESSAGE",IOINHI,IOINORM)
.S VALMCNT=LN
.Q
; loop through all available comments
S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1) Q:IBDATE="" D
.S I=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC",I,0),IBDUZ=$P(IB0,U,2)
.D SET^VALM10(LN,"") S LN=LN+1
.S STR="",STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
.D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN) S LN=LN+1
.; loop through comment lines
.S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC",I,1,CMLN)) Q:CMLN="" D
..S CMSTR=^DGCR(399,IBIFN,"TXC",I,1,CMLN,0) ; complete comment line
..S MAX=$P(VALMDDF("MESSAGE"),U,3) ; max. number of characters in the "MESSAGE" field
..; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
..F D Q:CMSTR=""
...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.
...S:'POS POS=MAX ; if we couldn't find a space, split at the max. number of chars
...; populate list manager array with this substring and remove it from the comment line
...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)
...Q
..Q
.Q
D EOBCM
S VALMCNT=LN-1,VALMBG=1
D CLEAN^DILF
Q
;
HELP ; help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; exit code
N COL,I,LN,STR,WIDTH,Z0,Z1,Z2,IBWRKLST ;WCJ IB*2.0*432
; update status for this claim in MRW list - could have been changed from View Comments
S (Z0,Z1)=0,Z2=""
S IBWRKLST=$S($G(IBMRANOT):"IBCEM COB MANAGEMENT",1:"IBCEM MRA MANAGEMENT") ;WCJ IB*2.0*432
S Z0=$$FIND1^DIC(409.61,,"X",IBWRKLST) ;WCJ IB*2.0*432
S:+Z0 Z1=$$FIND1^DIC(409.621,","_Z0_",","X","BILL")
S:+Z1 Z2=Z1_","_Z0_","
I Z2'="" D
.S COL=$$GET1^DIQ(409.621,Z2,.02)
.S WIDTH=$$GET1^DIQ(409.621,Z2,.03)
.Q:COL=""!(WIDTH="")
.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)
.F I=1:1:$L(STR) S $E(^TMP("IBCECOB",$J,LN,0),COL+I-1)=$E(STR,I)
.Q
; clean up variables
D CLEAR^VALM1,CLEAN^VALM10
Q
;
CMNTW ; enter MRA comments - entry point from MRA Worklist screen
; we need to select a claim and set IBIFN
N IBDA,IBIFN,MRAFLG
S MRAFLG=1
D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0))) D:$G(IBIFN) CMNT
S VALMBCK="R"
Q
;
CMNTV ; enter MRA comments - entry point from View MRA Comments screen
; IBIFN should already be defined, only need to set a flag used to rebuild list of comments
N MRAFLG,VCFLG
S (MRAFLG,VCFLG)=1 D:$G(IBIFN) CMNT
S VALMBCK="R"
Q
;
CMNT ; enter MRA comments, called from entry points CMNTV and CMNTW above. Also called from ARCA^IBJTA1 (TPJI)
N DA,DD,DIC,DIK,DLAYGO,X,Y
W !
; make sure this entry is not locked already
L +^DGCR(399,IBIFN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 Q
; IB*2.0*432 - if user came from new CBW, edit new EOB comments, not MRA
I $G(IBMRANOT)=1 D EOCMT Q
K DO S DIC="^DGCR(399,"_IBIFN_",""TXC"",",DIC(0)="L",DIC("DR")=".03",DA(1)=IBIFN,X=$$NOW^XLFDT,DLAYGO=399.077
D FILE^DICN
S DA=+Y I DA>0 D
.; if no comment has been added, delete the created entry in comments subfile
.I '$D(^DGCR(399,IBIFN,"TXC",DA,1)) S DIK=DIC D ^DIK Q
.; if we got here, comment has been added successfully
.; if called from MRA Worklist or View MRA Comments, ask if status needs to be changed
.I $G(MRAFLG) S DIE=399,DA=IBIFN,DR="28.1"_$S($G(IBMRANOT):"EOB",1:"MRA")_" REVIEW STATUS//REVIEW IN PROCESS" D ^DIE D:'$G(VCFLG) BLD^IBCECOB1 ;WCJ IB*2.0*432
.; if action was invoked from View Comments, rebuild the list of comments
.D:$G(VCFLG) CLEAN^VALM10,INIT
.Q
D CLEAN^DILF
L -^DGCR(399,IBIFN)
Q
;
STATUS ; change MRA review status
N DA,DIE,DR,IBDA,IBIFN,SEL
D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0))) G:'$G(IBIFN) STATUSX
W !
; make sure this entry is not locked already
L +^DGCR(399,IBIFN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 G STATUSX
S DIE=399,DA=IBIFN,DR="28.1"_$S($G(IBMRANOT):"EOB",1:"MRA")_" REVIEW STATUS//REVIEW IN PROCESS" D ^DIE,CLEAN^DILF ;WCJ*2.0*432
;update list manager display
D BLD^IBCECOB1
L -^DGCR(399,IBIFN)
STATUSX ;
S VALMBCK="R"
Q
EOBCM ; init variables and list array for new EOB Claim Comments IB*2.0*432
; loop through all available comments
S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC2","B",IBDATE),-1) Q:IBDATE="" D
.S I=$O(^DGCR(399,IBIFN,"TXC2","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC2",I,0),IBDUZ=$P(IB0,U,2)
.D SET^VALM10(LN,"") S LN=LN+1
.S STR="",STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
.D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN) S LN=LN+1
.; loop through comment lines
.S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC2",I,1,CMLN)) Q:CMLN="" D
..S CMSTR=^DGCR(399,IBIFN,"TXC2",I,1,CMLN,0) ; complete comment line
..S MAX=$P(VALMDDF("MESSAGE"),U,3) ; max. number of characters in the "MESSAGE" field
..; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
..F D Q:CMSTR=""
...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.
...S:'POS POS=MAX ; if we couldn't find a space, split at the max. number of chars
...; populate list manager array with this substring and remove it from the comment line
...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)
...Q
..Q
.Q
Q
;
EOCMT ; IB*2.0*432 - edit new EOB comments
K DO S DIC="^DGCR(399,"_IBIFN_",""TXC2"",",DIC(0)="L",DIC("DR")=".03",DA(1)=IBIFN,X=$$NOW^XLFDT,DLAYGO=399.078
D FILE^DICN
S DA=+Y I DA>0 D
.; if no comment has been added, delete the created entry in comments subfile
.I '$D(^DGCR(399,IBIFN,"TXC2",DA,1)) S DIK=DIC D ^DIK Q
.; if we got here, comment has been added successfully
.; if called from CBW Worklist or View CBW Comments, ask if status needs to be changed
.I $G(MRAFLG) S DIE=399,DA=IBIFN,DR="28.1"_$S($G(IBMRANOT):"EOB",1:"MRA")_" REVIEW STATUS//REVIEW IN PROCESS" D ^DIE D:'$G(VCFLG) BLD^IBCECOB1 ;WCJ IB*2.0*432
.; if action was invoked from View Comments, rebuild the list of comments
.D:$G(VCFLG) CLEAN^VALM10,INIT
.Q
D CLEAN^DILF
L -^DGCR(399,IBIFN)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECOB6 7660 printed Oct 16, 2024@18:10:24 Page 2
IBCECOB6 ;YMG/BP - IB COB MANAGEMENT SCREEN ;26-Dec-2007
+1 ;;2.0;INTEGRATED BILLING;**377,432**;21-MAR-94;Build 192
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN ; view MRA comments - entry point from MRA Worklist
+1 NEW IBDA,IBIFN
+2 ; we need to select a claim and set IBIFN
+3 DO SEL^IBCECOB2(.IBDA,1)
if $ORDER(IBDA(0))
SET IBIFN=+IBDA($ORDER(IBDA(0)))
+4 if $GET(IBIFN)
DO EN^VALM("IBCEM MRA COMMENTS")
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
HDR ; header code
+1 ;WCJ IB*2.0*432
SET VALMHDR(1)=$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" Claim "_$PIECE($GET(^DGCR(399,IBIFN,0)),U)
+2 if $GET(IBMRANOT)=1
SET VALM("TITLE")="Claim Comment History"
+3 QUIT
+4 ;
INIT ; init variables and list array
+1 NEW CMLN,CMSTR,I,IB0,IBDATE,IBDUZ,LEN,LN,MAX,POS,STR
+2 SET LN=1
+3 ; IB*2.0*432 - if user came from new CBW, show all comments (AR & IB)
+4 IF $GET(IBMRANOT)=1
DO BLD^IBJTTC
QUIT
+5 ; check if we have any comments to display - IB*2.0*432 add EOB claim comments
+6 ; I '$D(^DGCR(399,IBIFN,"TXC","B")) D Q
+7 IF '$DATA(^DGCR(399,IBIFN,"TXC","B"))&('$DATA(^DGCR(399,IBIFN,"TXC2","B")))
Begin DoDot:1
+8 SET STR=""
SET STR=$$SETFLD^VALM1("No comments found for this claim.",STR,"MESSAGE")
+9 DO SET^VALM10(LN,STR)
DO FLDCTRL^VALM10(LN,"MESSAGE",IOINHI,IOINORM)
+10 SET VALMCNT=LN
+11 QUIT
End DoDot:1
QUIT
+12 ; loop through all available comments
+13 SET IBDATE=""
FOR
SET IBDATE=$ORDER(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1)
if IBDATE=""
QUIT
Begin DoDot:1
+14 SET I=$ORDER(^DGCR(399,IBIFN,"TXC","B",IBDATE,""))
SET IB0=^DGCR(399,IBIFN,"TXC",I,0)
SET IBDUZ=$PIECE(IB0,U,2)
+15 DO SET^VALM10(LN,"")
SET LN=LN+1
+16 SET STR=""
SET STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
+17 DO SET^VALM10(LN,STR)
DO FLDCTRL^VALM10(LN)
SET LN=LN+1
+18 ; loop through comment lines
+19 SET CMLN=0
FOR
SET CMLN=$ORDER(^DGCR(399,IBIFN,"TXC",I,1,CMLN))
if CMLN=""
QUIT
Begin DoDot:2
+20 ; complete comment line
SET CMSTR=^DGCR(399,IBIFN,"TXC",I,1,CMLN,0)
+21 ; max. number of characters in the "MESSAGE" field
SET MAX=$PIECE(VALMDDF("MESSAGE"),U,3)
+22 ; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
+23 FOR
Begin DoDot:3
+24 ; try to make a split on a space char.
SET (POS,LEN)=$LENGTH(CMSTR)
IF LEN>MAX
SET POS=MAX
FOR
if POS=0
QUIT
if $EXTRACT(CMSTR,POS)=" "
QUIT
SET POS=POS-1
+25 ; if we couldn't find a space, split at the max. number of chars
if 'POS
SET POS=MAX
+26 ; populate list manager array with this substring and remove it from the comment line
+27 SET STR=""
SET STR=$$SETFLD^VALM1($EXTRACT(CMSTR,1,POS),STR,"MESSAGE")
DO SET^VALM10(LN,STR)
SET LN=LN+1
SET CMSTR=$EXTRACT(CMSTR,POS+1,LEN)
+28 QUIT
End DoDot:3
if CMSTR=""
QUIT
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 DO EOBCM
+32 SET VALMCNT=LN-1
SET VALMBG=1
+33 DO CLEAN^DILF
+34 QUIT
+35 ;
HELP ; help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; exit code
+1 ;WCJ IB*2.0*432
NEW COL,I,LN,STR,WIDTH,Z0,Z1,Z2,IBWRKLST
+2 ; update status for this claim in MRW list - could have been changed from View Comments
+3 SET (Z0,Z1)=0
SET Z2=""
+4 ;WCJ IB*2.0*432
SET IBWRKLST=$SELECT($GET(IBMRANOT):"IBCEM COB MANAGEMENT",1:"IBCEM MRA MANAGEMENT")
+5 ;WCJ IB*2.0*432
SET Z0=$$FIND1^DIC(409.61,,"X",IBWRKLST)
+6 if +Z0
SET Z1=$$FIND1^DIC(409.621,","_Z0_",","X","BILL")
+7 if +Z1
SET Z2=Z1_","_Z0_","
+8 IF Z2'=""
Begin DoDot:1
+9 SET COL=$$GET1^DIQ(409.621,Z2,.02)
+10 SET WIDTH=$$GET1^DIQ(409.621,Z2,.03)
+11 if COL=""!(WIDTH="")
QUIT
+12 SET LN=($ORDER(VALMY(""))-1)*3+2
SET STR=$EXTRACT($$BN1^PRCAFN(IBIFN)_$SELECT($PIECE($GET(^DGCR(399,IBIFN,"TX")),U,10)=1:"*",1:" "),1,WIDTH)
+13 FOR I=1:1:$LENGTH(STR)
SET $EXTRACT(^TMP("IBCECOB",$JOB,LN,0),COL+I-1)=$EXTRACT(STR,I)
+14 QUIT
End DoDot:1
+15 ; clean up variables
+16 DO CLEAR^VALM1
DO CLEAN^VALM10
+17 QUIT
+18 ;
CMNTW ; enter MRA comments - entry point from MRA Worklist screen
+1 ; we need to select a claim and set IBIFN
+2 NEW IBDA,IBIFN,MRAFLG
+3 SET MRAFLG=1
+4 DO SEL^IBCECOB2(.IBDA,1)
if $ORDER(IBDA(0))
SET IBIFN=+IBDA($ORDER(IBDA(0)))
if $GET(IBIFN)
DO CMNT
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
CMNTV ; enter MRA comments - entry point from View MRA Comments screen
+1 ; IBIFN should already be defined, only need to set a flag used to rebuild list of comments
+2 NEW MRAFLG,VCFLG
+3 SET (MRAFLG,VCFLG)=1
if $GET(IBIFN)
DO CMNT
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
CMNT ; enter MRA comments, called from entry points CMNTV and CMNTW above. Also called from ARCA^IBJTA1 (TPJI)
+1 NEW DA,DD,DIC,DIK,DLAYGO,X,Y
+2 WRITE !
+3 ; make sure this entry is not locked already
+4 LOCK +^DGCR(399,IBIFN):3
IF '$TEST
WRITE !,*7,"Sorry, another user currently editing this entry."
DO PAUSE^VALM1
QUIT
+5 ; IB*2.0*432 - if user came from new CBW, edit new EOB comments, not MRA
+6 IF $GET(IBMRANOT)=1
DO EOCMT
QUIT
+7 KILL DO
SET DIC="^DGCR(399,"_IBIFN_",""TXC"","
SET DIC(0)="L"
SET DIC("DR")=".03"
SET DA(1)=IBIFN
SET X=$$NOW^XLFDT
SET DLAYGO=399.077
+8 DO FILE^DICN
+9 SET DA=+Y
IF DA>0
Begin DoDot:1
+10 ; if no comment has been added, delete the created entry in comments subfile
+11 IF '$DATA(^DGCR(399,IBIFN,"TXC",DA,1))
SET DIK=DIC
DO ^DIK
QUIT
+12 ; if we got here, comment has been added successfully
+13 ; if called from MRA Worklist or View MRA Comments, ask if status needs to be changed
+14 ;WCJ IB*2.0*432
IF $GET(MRAFLG)
SET DIE=399
SET DA=IBIFN
SET DR="28.1"_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" REVIEW STATUS//REVIEW IN PROCESS"
DO ^DIE
if '$GET(VCFLG)
DO BLD^IBCECOB1
+15 ; if action was invoked from View Comments, rebuild the list of comments
+16 if $GET(VCFLG)
DO CLEAN^VALM10
DO INIT
+17 QUIT
End DoDot:1
+18 DO CLEAN^DILF
+19 LOCK -^DGCR(399,IBIFN)
+20 QUIT
+21 ;
STATUS ; change MRA review status
+1 NEW DA,DIE,DR,IBDA,IBIFN,SEL
+2 DO SEL^IBCECOB2(.IBDA,1)
if $ORDER(IBDA(0))
SET IBIFN=+IBDA($ORDER(IBDA(0)))
if '$GET(IBIFN)
GOTO STATUSX
+3 WRITE !
+4 ; make sure this entry is not locked already
+5 LOCK +^DGCR(399,IBIFN):3
IF '$TEST
WRITE !,*7,"Sorry, another user currently editing this entry."
DO PAUSE^VALM1
GOTO STATUSX
+6 ;WCJ*2.0*432
SET DIE=399
SET DA=IBIFN
SET DR="28.1"_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" REVIEW STATUS//REVIEW IN PROCESS"
DO ^DIE
DO CLEAN^DILF
+7 ;update list manager display
+8 DO BLD^IBCECOB1
+9 LOCK -^DGCR(399,IBIFN)
STATUSX ;
+1 SET VALMBCK="R"
+2 QUIT
EOBCM ; init variables and list array for new EOB Claim Comments IB*2.0*432
+1 ; loop through all available comments
+2 SET IBDATE=""
FOR
SET IBDATE=$ORDER(^DGCR(399,IBIFN,"TXC2","B",IBDATE),-1)
if IBDATE=""
QUIT
Begin DoDot:1
+3 SET I=$ORDER(^DGCR(399,IBIFN,"TXC2","B",IBDATE,""))
SET IB0=^DGCR(399,IBIFN,"TXC2",I,0)
SET IBDUZ=$PIECE(IB0,U,2)
+4 DO SET^VALM10(LN,"")
SET LN=LN+1
+5 SET STR=""
SET STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
+6 DO SET^VALM10(LN,STR)
DO FLDCTRL^VALM10(LN)
SET LN=LN+1
+7 ; loop through comment lines
+8 SET CMLN=0
FOR
SET CMLN=$ORDER(^DGCR(399,IBIFN,"TXC2",I,1,CMLN))
if CMLN=""
QUIT
Begin DoDot:2
+9 ; complete comment line
SET CMSTR=^DGCR(399,IBIFN,"TXC2",I,1,CMLN,0)
+10 ; max. number of characters in the "MESSAGE" field
SET MAX=$PIECE(VALMDDF("MESSAGE"),U,3)
+11 ; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
+12 FOR
Begin DoDot:3
+13 ; try to make a split on a space char.
SET (POS,LEN)=$LENGTH(CMSTR)
IF LEN>MAX
SET POS=MAX
FOR
if POS=0
QUIT
if $EXTRACT(CMSTR,POS)=" "
QUIT
SET POS=POS-1
+14 ; if we couldn't find a space, split at the max. number of chars
if 'POS
SET POS=MAX
+15 ; populate list manager array with this substring and remove it from the comment line
+16 SET STR=""
SET STR=$$SETFLD^VALM1($EXTRACT(CMSTR,1,POS),STR,"MESSAGE")
DO SET^VALM10(LN,STR)
SET LN=LN+1
SET CMSTR=$EXTRACT(CMSTR,POS+1,LEN)
+17 QUIT
End DoDot:3
if CMSTR=""
QUIT
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
EOCMT ; IB*2.0*432 - edit new EOB comments
+1 KILL DO
SET DIC="^DGCR(399,"_IBIFN_",""TXC2"","
SET DIC(0)="L"
SET DIC("DR")=".03"
SET DA(1)=IBIFN
SET X=$$NOW^XLFDT
SET DLAYGO=399.078
+2 DO FILE^DICN
+3 SET DA=+Y
IF DA>0
Begin DoDot:1
+4 ; if no comment has been added, delete the created entry in comments subfile
+5 IF '$DATA(^DGCR(399,IBIFN,"TXC2",DA,1))
SET DIK=DIC
DO ^DIK
QUIT
+6 ; if we got here, comment has been added successfully
+7 ; if called from CBW Worklist or View CBW Comments, ask if status needs to be changed
+8 ;WCJ IB*2.0*432
IF $GET(MRAFLG)
SET DIE=399
SET DA=IBIFN
SET DR="28.1"_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" REVIEW STATUS//REVIEW IN PROCESS"
DO ^DIE
if '$GET(VCFLG)
DO BLD^IBCECOB1
+9 ; if action was invoked from View Comments, rebuild the list of comments
+10 if $GET(VCFLG)
DO CLEAN^VALM10
DO INIT
+11 QUIT
End DoDot:1
+12 DO CLEAN^DILF
+13 LOCK -^DGCR(399,IBIFN)
+14 QUIT
+15 ;
