FBUTL3 ;WOIFO/SAB-FEE BASIS UTILITY ;6/19/2003
;;3.5;FEE BASIS;**61**;JAN 30, 1995
Q
ARCDES ; Adjustment Reason Current Description Identifier
; Called by File 161.91 "CDES" Write Identifier
N FBFMT,FBI,FBARTXT,FBX
N DIWF,DIWL,DIWR,X
;
; get current description
S FBX=$$AR^FBUTL1(Y,,,"FBARTXT")
I '$O(FBARTXT(0)) Q ; no description found
;
; reformat text into 50 character width
K ^UTILITY($J,"W")
S DIWL=1,DIWR=50,DIWF=""
S FBI=0 F S FBI=$O(FBARTXT(FBI)) Q:'FBI S X=FBARTXT(FBI) D ^DIWP
;
; 'display' idenitifer using EN^DDIOL
S FBI=0 F S FBI=$O(^UTILITY($J,"W",DIWL,FBI)) Q:'FBI D
. S FBFMT=$S(FBI=1:"?15",1:"!?15")
. S FBX=$G(^UTILITY($J,"W",DIWL,FBI,0))
. D EN^DDIOL(FBX,,FBFMT)
;
; cleanup
K ^UTILITY($J,"W")
Q
;
AGCDN ; Adjustment Group Current Descriptive Name Identifier
; Called by File 161.92 "CDN" Write Identifier
N FBX
;
; get current descriptive name
S FBX=$$AG^FBUTL1(Y)
;
; 'display' using EN^DDIOL
I $P(FBX,U,5)]"" D EN^DDIOL($P(FBX,U,5),,"?15")
;
Q
;
RRCDES ; Remittance Remarks Current Description Identifier
; Called by File 161.93 "CDES" Write Identifier
N FBFMT,FBI,FBRRTXT,FBX
N DIWF,DIWL,DIWR,X
;
; get current description
S FBX=$$RR^FBUTL1(Y,,,"FBRRTXT")
I '$O(FBRRTXT(0)) Q ; no description found
;
; reformat text into 50 character width
K ^UTILITY($J,"W")
S DIWL=1,DIWR=50,DIWF=""
S FBI=0 F S FBI=$O(FBRRTXT(FBI)) Q:'FBI S X=FBRRTXT(FBI) D ^DIWP
;
; 'display' idenitifer using EN^DDIOL
S FBI=0 F S FBI=$O(^UTILITY($J,"W",DIWL,FBI)) Q:'FBI D
. S FBFMT=$S(FBI=1:"?15",1:"!?15")
. S FBX=$G(^UTILITY($J,"W",DIWL,FBI,0))
. D EN^DDIOL(FBX,,FBFMT)
;
; cleanup
K ^UTILITY($J,"W")
Q
;
;FBUTL3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUTL3 1749 printed Dec 13, 2024@02:00:44 Page 2
FBUTL3 ;WOIFO/SAB-FEE BASIS UTILITY ;6/19/2003
+1 ;;3.5;FEE BASIS;**61**;JAN 30, 1995
+2 QUIT
ARCDES ; Adjustment Reason Current Description Identifier
+1 ; Called by File 161.91 "CDES" Write Identifier
+2 NEW FBFMT,FBI,FBARTXT,FBX
+3 NEW DIWF,DIWL,DIWR,X
+4 ;
+5 ; get current description
+6 SET FBX=$$AR^FBUTL1(Y,,,"FBARTXT")
+7 ; no description found
IF '$ORDER(FBARTXT(0))
QUIT
+8 ;
+9 ; reformat text into 50 character width
+10 KILL ^UTILITY($JOB,"W")
+11 SET DIWL=1
SET DIWR=50
SET DIWF=""
+12 SET FBI=0
FOR
SET FBI=$ORDER(FBARTXT(FBI))
if 'FBI
QUIT
SET X=FBARTXT(FBI)
DO ^DIWP
+13 ;
+14 ; 'display' idenitifer using EN^DDIOL
+15 SET FBI=0
FOR
SET FBI=$ORDER(^UTILITY($JOB,"W",DIWL,FBI))
if 'FBI
QUIT
Begin DoDot:1
+16 SET FBFMT=$SELECT(FBI=1:"?15",1:"!?15")
+17 SET FBX=$GET(^UTILITY($JOB,"W",DIWL,FBI,0))
+18 DO EN^DDIOL(FBX,,FBFMT)
End DoDot:1
+19 ;
+20 ; cleanup
+21 KILL ^UTILITY($JOB,"W")
+22 QUIT
+23 ;
AGCDN ; Adjustment Group Current Descriptive Name Identifier
+1 ; Called by File 161.92 "CDN" Write Identifier
+2 NEW FBX
+3 ;
+4 ; get current descriptive name
+5 SET FBX=$$AG^FBUTL1(Y)
+6 ;
+7 ; 'display' using EN^DDIOL
+8 IF $PIECE(FBX,U,5)]""
DO EN^DDIOL($PIECE(FBX,U,5),,"?15")
+9 ;
+10 QUIT
+11 ;
RRCDES ; Remittance Remarks Current Description Identifier
+1 ; Called by File 161.93 "CDES" Write Identifier
+2 NEW FBFMT,FBI,FBRRTXT,FBX
+3 NEW DIWF,DIWL,DIWR,X
+4 ;
+5 ; get current description
+6 SET FBX=$$RR^FBUTL1(Y,,,"FBRRTXT")
+7 ; no description found
IF '$ORDER(FBRRTXT(0))
QUIT
+8 ;
+9 ; reformat text into 50 character width
+10 KILL ^UTILITY($JOB,"W")
+11 SET DIWL=1
SET DIWR=50
SET DIWF=""
+12 SET FBI=0
FOR
SET FBI=$ORDER(FBRRTXT(FBI))
if 'FBI
QUIT
SET X=FBRRTXT(FBI)
DO ^DIWP
+13 ;
+14 ; 'display' idenitifer using EN^DDIOL
+15 SET FBI=0
FOR
SET FBI=$ORDER(^UTILITY($JOB,"W",DIWL,FBI))
if 'FBI
QUIT
Begin DoDot:1
+16 SET FBFMT=$SELECT(FBI=1:"?15",1:"!?15")
+17 SET FBX=$GET(^UTILITY($JOB,"W",DIWL,FBI,0))
+18 DO EN^DDIOL(FBX,,FBFMT)
End DoDot:1
+19 ;
+20 ; cleanup
+21 KILL ^UTILITY($JOB,"W")
+22 QUIT
+23 ;
+24 ;FBUTL3
