[613] | 1 | IBCECOB6 ;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 | ;
|
---|
| 5 | EN ; 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 | ;
|
---|
| 13 | HDR ; header code
|
---|
| 14 | S VALMHDR(1)="MRA Claim "_$P($G(^DGCR(399,IBIFN,0)),U)
|
---|
| 15 | Q
|
---|
| 16 | ;
|
---|
| 17 | INIT ; 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 | ;
|
---|
| 49 | HELP ; help code
|
---|
| 50 | S X="?" D DISP^XQORM1 W !!
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|
| 53 | EXIT ; 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 | ;
|
---|
| 71 | CMNTW ; 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 | ;
|
---|
| 79 | CMNTV ; 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 | ;
|
---|
| 86 | CMNT ; 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 | ;
|
---|
| 106 | STATUS ; 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)
|
---|
| 116 | STATUSX ;
|
---|
| 117 | S VALMBCK="R"
|
---|
| 118 | Q
|
---|