VistA-WorldVistAEHR/r/FEE_BASIS-FB/FBUTL3.m

65 lines
1.6 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
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