Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCECOB6

IBCECOB6.m

Go to the documentation of this file.
  1. IBCECOB6 ;YMG/BP - IB COB MANAGEMENT SCREEN ;26-Dec-2007
  1. ;;2.0;INTEGRATED BILLING;**377,432**;21-MAR-94;Build 192
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. EN ; view MRA comments - entry point from MRA Worklist
  1. N IBDA,IBIFN
  1. ; we need to select a claim and set IBIFN
  1. D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0)))
  1. D:$G(IBIFN) EN^VALM("IBCEM MRA COMMENTS")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. HDR ; header code
  1. S VALMHDR(1)=$S($G(IBMRANOT):"EOB",1:"MRA")_" Claim "_$P($G(^DGCR(399,IBIFN,0)),U) ;WCJ IB*2.0*432
  1. S:$G(IBMRANOT)=1 VALM("TITLE")="Claim Comment History"
  1. Q
  1. ;
  1. INIT ; init variables and list array
  1. N CMLN,CMSTR,I,IB0,IBDATE,IBDUZ,LEN,LN,MAX,POS,STR
  1. S LN=1
  1. ; IB*2.0*432 - if user came from new CBW, show all comments (AR & IB)
  1. I $G(IBMRANOT)=1 D BLD^IBJTTC Q
  1. ; check if we have any comments to display - IB*2.0*432 add EOB claim comments
  1. ; I '$D(^DGCR(399,IBIFN,"TXC","B")) D Q
  1. I '$D(^DGCR(399,IBIFN,"TXC","B"))&('$D(^DGCR(399,IBIFN,"TXC2","B"))) D Q
  1. .S STR="",STR=$$SETFLD^VALM1("No comments found for this claim.",STR,"MESSAGE")
  1. .D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN,"MESSAGE",IOINHI,IOINORM)
  1. .S VALMCNT=LN
  1. .Q
  1. ; loop through all available comments
  1. S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE),-1) Q:IBDATE="" D
  1. .S I=$O(^DGCR(399,IBIFN,"TXC","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC",I,0),IBDUZ=$P(IB0,U,2)
  1. .D SET^VALM10(LN,"") S LN=LN+1
  1. .S STR="",STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
  1. .D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN) S LN=LN+1
  1. .; loop through comment lines
  1. .S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC",I,1,CMLN)) Q:CMLN="" D
  1. ..S CMSTR=^DGCR(399,IBIFN,"TXC",I,1,CMLN,0) ; complete comment line
  1. ..S MAX=$P(VALMDDF("MESSAGE"),U,3) ; max. number of characters in the "MESSAGE" field
  1. ..; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
  1. ..F D Q:CMSTR=""
  1. ...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.
  1. ...S:'POS POS=MAX ; if we couldn't find a space, split at the max. number of chars
  1. ...; populate list manager array with this substring and remove it from the comment line
  1. ...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)
  1. ...Q
  1. ..Q
  1. .Q
  1. D EOBCM
  1. S VALMCNT=LN-1,VALMBG=1
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. HELP ; help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; exit code
  1. N COL,I,LN,STR,WIDTH,Z0,Z1,Z2,IBWRKLST ;WCJ IB*2.0*432
  1. ; update status for this claim in MRW list - could have been changed from View Comments
  1. S (Z0,Z1)=0,Z2=""
  1. S IBWRKLST=$S($G(IBMRANOT):"IBCEM COB MANAGEMENT",1:"IBCEM MRA MANAGEMENT") ;WCJ IB*2.0*432
  1. S Z0=$$FIND1^DIC(409.61,,"X",IBWRKLST) ;WCJ IB*2.0*432
  1. S:+Z0 Z1=$$FIND1^DIC(409.621,","_Z0_",","X","BILL")
  1. S:+Z1 Z2=Z1_","_Z0_","
  1. I Z2'="" D
  1. .S COL=$$GET1^DIQ(409.621,Z2,.02)
  1. .S WIDTH=$$GET1^DIQ(409.621,Z2,.03)
  1. .Q:COL=""!(WIDTH="")
  1. .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)
  1. .F I=1:1:$L(STR) S $E(^TMP("IBCECOB",$J,LN,0),COL+I-1)=$E(STR,I)
  1. .Q
  1. ; clean up variables
  1. D CLEAR^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. CMNTW ; enter MRA comments - entry point from MRA Worklist screen
  1. ; we need to select a claim and set IBIFN
  1. N IBDA,IBIFN,MRAFLG
  1. S MRAFLG=1
  1. D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0))) D:$G(IBIFN) CMNT
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. 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
  1. N MRAFLG,VCFLG
  1. S (MRAFLG,VCFLG)=1 D:$G(IBIFN) CMNT
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CMNT ; enter MRA comments, called from entry points CMNTV and CMNTW above. Also called from ARCA^IBJTA1 (TPJI)
  1. N DA,DD,DIC,DIK,DLAYGO,X,Y
  1. W !
  1. ; make sure this entry is not locked already
  1. L +^DGCR(399,IBIFN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 Q
  1. ; IB*2.0*432 - if user came from new CBW, edit new EOB comments, not MRA
  1. I $G(IBMRANOT)=1 D EOCMT Q
  1. K DO S DIC="^DGCR(399,"_IBIFN_",""TXC"",",DIC(0)="L",DIC("DR")=".03",DA(1)=IBIFN,X=$$NOW^XLFDT,DLAYGO=399.077
  1. D FILE^DICN
  1. S DA=+Y I DA>0 D
  1. .; if no comment has been added, delete the created entry in comments subfile
  1. .I '$D(^DGCR(399,IBIFN,"TXC",DA,1)) S DIK=DIC D ^DIK Q
  1. .; if we got here, comment has been added successfully
  1. .; if called from MRA Worklist or View MRA Comments, ask if status needs to be changed
  1. .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
  1. .; if action was invoked from View Comments, rebuild the list of comments
  1. .D:$G(VCFLG) CLEAN^VALM10,INIT
  1. .Q
  1. D CLEAN^DILF
  1. L -^DGCR(399,IBIFN)
  1. Q
  1. ;
  1. STATUS ; change MRA review status
  1. N DA,DIE,DR,IBDA,IBIFN,SEL
  1. D SEL^IBCECOB2(.IBDA,1) S:$O(IBDA(0)) IBIFN=+IBDA($O(IBDA(0))) G:'$G(IBIFN) STATUSX
  1. W !
  1. ; make sure this entry is not locked already
  1. L +^DGCR(399,IBIFN):3 I '$T W !,*7,"Sorry, another user currently editing this entry." D PAUSE^VALM1 G STATUSX
  1. 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
  1. ;update list manager display
  1. D BLD^IBCECOB1
  1. L -^DGCR(399,IBIFN)
  1. STATUSX ;
  1. S VALMBCK="R"
  1. Q
  1. EOBCM ; init variables and list array for new EOB Claim Comments IB*2.0*432
  1. ; loop through all available comments
  1. S IBDATE="" F S IBDATE=$O(^DGCR(399,IBIFN,"TXC2","B",IBDATE),-1) Q:IBDATE="" D
  1. .S I=$O(^DGCR(399,IBIFN,"TXC2","B",IBDATE,"")),IB0=^DGCR(399,IBIFN,"TXC2",I,0),IBDUZ=$P(IB0,U,2)
  1. .D SET^VALM10(LN,"") S LN=LN+1
  1. .S STR="",STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2Z"),STR,"ENTERED")
  1. .D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN) S LN=LN+1
  1. .; loop through comment lines
  1. .S CMLN=0 F S CMLN=$O(^DGCR(399,IBIFN,"TXC2",I,1,CMLN)) Q:CMLN="" D
  1. ..S CMSTR=^DGCR(399,IBIFN,"TXC2",I,1,CMLN,0) ; complete comment line
  1. ..S MAX=$P(VALMDDF("MESSAGE"),U,3) ; max. number of characters in the "MESSAGE" field
  1. ..; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
  1. ..F D Q:CMSTR=""
  1. ...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.
  1. ...S:'POS POS=MAX ; if we couldn't find a space, split at the max. number of chars
  1. ...; populate list manager array with this substring and remove it from the comment line
  1. ...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)
  1. ...Q
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. EOCMT ; IB*2.0*432 - edit new EOB comments
  1. K DO S DIC="^DGCR(399,"_IBIFN_",""TXC2"",",DIC(0)="L",DIC("DR")=".03",DA(1)=IBIFN,X=$$NOW^XLFDT,DLAYGO=399.078
  1. D FILE^DICN
  1. S DA=+Y I DA>0 D
  1. .; if no comment has been added, delete the created entry in comments subfile
  1. .I '$D(^DGCR(399,IBIFN,"TXC2",DA,1)) S DIK=DIC D ^DIK Q
  1. .; if we got here, comment has been added successfully
  1. .; if called from CBW Worklist or View CBW Comments, ask if status needs to be changed
  1. .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
  1. .; if action was invoked from View Comments, rebuild the list of comments
  1. .D:$G(VCFLG) CLEAN^VALM10,INIT
  1. .Q
  1. D CLEAN^DILF
  1. L -^DGCR(399,IBIFN)
  1. Q
  1. ;