- 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 Jan 18, 2025@03:01:57 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