- 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 Feb 18, 2025@23:36:08 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 ;