IBRFIN ;ALB/JWS - RFAI Message Detail Worklist; 21-OCT-2015
;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;;
EN ; -- main entry point for IBRFI COMMENTS
N VALMCNT,VALMBG,VALMHDR
S VALMCNT=0,VALMBG=1
D EN^VALM("IBRFI COMMENTS")
S VALMBCK="R"
Q
;
HDR ; -- header code
N IBCLAIM
S IBCLAIM=$$GET1^DIQ(368,RFAIEN,111.01)
S:IBCLAIM="" IBCLAIM=$$GET1^DIQ(368,RFAIEN,11.01)
;S VALMHDR(1)="RFAI Claim Comment History"
S VALMHDR(1)=IBCLAIM
Q
;
INIT ; -- init variables and list array
N LN,CO1,CO0,IBDUZ,IBDATE,STR,CMT,CMT0,MAX,POS,LEN
K @VALMAR
S LN=1
; check if we have any comments to display
; loop through all available comments
S CO1=0 F S CO1=$O(^IBA(368,RFAIEN,201,CO1)) Q:CO1'=+CO1 D
. S CO0=$G(^IBA(368,RFAIEN,201,CO1,0)) I CO0="" Q
. S IBDUZ=$P(CO0,U,2),IBDATE=$P(CO0,U)
. D SET^VALM10(LN,"") S LN=LN+1
. S STR="",STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2ZM"),STR,"ENTERED")
. D SET^VALM10(LN,STR),FLDCTRL^VALM10(LN) S LN=LN+1
. S CMT=0 F S CMT=$O(^IBA(368,RFAIEN,201,CO1,1,CMT)) Q:CMT'=+CMT D
.. S CMT0=$G(^IBA(368,RFAIEN,201,CO1,1,CMT,0)) I CMT0="" Q
.. 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:CMT0=""
... S (POS,LEN)=$L(CMT0) I LEN>MAX S POS=MAX F Q:POS=0 Q:$E(CMT0,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(CMT0,1,POS),STR,"MESSAGE") D SET^VALM10(LN,STR) S LN=LN+1,CMT0=$E(CMT0,POS+1,LEN)
... Q
.. Q
. Q
S VALMCNT=LN-1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K @VALMAR
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRFIN 2038 printed Dec 13, 2024@02:26:49 Page 2
IBRFIN ;ALB/JWS - RFAI Message Detail Worklist; 21-OCT-2015
+1 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
EN ; -- main entry point for IBRFI COMMENTS
+1 NEW VALMCNT,VALMBG,VALMHDR
+2 SET VALMCNT=0
SET VALMBG=1
+3 DO EN^VALM("IBRFI COMMENTS")
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW IBCLAIM
+2 SET IBCLAIM=$$GET1^DIQ(368,RFAIEN,111.01)
+3 if IBCLAIM=""
SET IBCLAIM=$$GET1^DIQ(368,RFAIEN,11.01)
+4 ;S VALMHDR(1)="RFAI Claim Comment History"
+5 SET VALMHDR(1)=IBCLAIM
+6 QUIT
+7 ;
INIT ; -- init variables and list array
+1 NEW LN,CO1,CO0,IBDUZ,IBDATE,STR,CMT,CMT0,MAX,POS,LEN
+2 KILL @VALMAR
+3 SET LN=1
+4 ; check if we have any comments to display
+5 ; loop through all available comments
+6 SET CO1=0
FOR
SET CO1=$ORDER(^IBA(368,RFAIEN,201,CO1))
if CO1'=+CO1
QUIT
Begin DoDot:1
+7 SET CO0=$GET(^IBA(368,RFAIEN,201,CO1,0))
IF CO0=""
QUIT
+8 SET IBDUZ=$PIECE(CO0,U,2)
SET IBDATE=$PIECE(CO0,U)
+9 DO SET^VALM10(LN,"")
SET LN=LN+1
+10 SET STR=""
SET STR=$$SETFLD^VALM1("Entered by "_$$GET1^DIQ(200,IBDUZ,.01)_" on "_$$FMTE^XLFDT(IBDATE,"2ZM"),STR,"ENTERED")
+11 DO SET^VALM10(LN,STR)
DO FLDCTRL^VALM10(LN)
SET LN=LN+1
+12 SET CMT=0
FOR
SET CMT=$ORDER(^IBA(368,RFAIEN,201,CO1,1,CMT))
if CMT'=+CMT
QUIT
Begin DoDot:2
+13 SET CMT0=$GET(^IBA(368,RFAIEN,201,CO1,1,CMT,0))
IF CMT0=""
QUIT
+14 ; max. number of characters in the "MESSAGE" field
SET MAX=$PIECE(VALMDDF("MESSAGE"),U,3)
+15 ; if comment line is too long, split it into chunks that fit in the "MESSAGE" field
+16 FOR
Begin DoDot:3
+17 ; try to make a split on a space char.
SET (POS,LEN)=$LENGTH(CMT0)
IF LEN>MAX
SET POS=MAX
FOR
if POS=0
QUIT
if $EXTRACT(CMT0,POS)=" "
QUIT
SET POS=POS-1
+18 ; if we couldn't find a space, split at the max. number of chars
if 'POS
SET POS=MAX
+19 ; populate list manager array with this substring and remove it from the comment line
+20 SET STR=""
SET STR=$$SETFLD^VALM1($EXTRACT(CMT0,1,POS),STR,"MESSAGE")
DO SET^VALM10(LN,STR)
SET LN=LN+1
SET CMT0=$EXTRACT(CMT0,POS+1,LEN)
+21 QUIT
End DoDot:3
if CMT0=""
QUIT
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 SET VALMCNT=LN-1
+25 QUIT
+26 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL @VALMAR
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
