64 lines
3.0 KiB
Mathematica
64 lines
3.0 KiB
Mathematica
FBUCUTL4 ;ALBISC/TET - UTILITY CONTINUATION ;5/14/93 15:06
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
PRIME(FBDA,FBUCP) ;determine if claim is a primary (points to itself)
|
|
;INPUT: FBDA = ien of unauthorized claim
|
|
; FBUCP = zero node of fbda
|
|
;OUTPUT: 1 if yes, 0 if no
|
|
Q $S('+$G(FBDA):0,$G(FBUCP)']"":0,FBDA=$P(FBUCP,U,20):1,1:0)
|
|
;
|
|
SECOND(FBDA,FBUCP) ;determine if claim is a secondary (points to another)
|
|
;INPUT: FBDA = ien of unauthorized claim
|
|
; FBUCP = zero node of fbda
|
|
;OUTPUT: 1 if yes, 0 if no
|
|
Q $S('+$G(FBDA):0,$G(FBUCP)']"":0,FBDA'=$P(FBUCP,U,20):1,1:0)
|
|
;
|
|
LINK(FBDA,FBUCP) ;is this a claim which can be linked to a primary?
|
|
;claims which can be linked are only primaries with no secondaries OR only secondaries
|
|
;INPUT: FBDA = ien of unauthorized claim
|
|
; FBUCP = zero node of unauthorized claim
|
|
;OUTPUT: 1 if yes, 0 if no
|
|
I $S('+$G(FBDA):1,$G(FBUCP)']"":1,1:0) Q 0
|
|
Q $S($$SECOND(FBDA,FBUCP):1,$$PRIME(FBDA,FBUCP)&('+$O(^FB583("AMS",+$P(FBUCP,U,20),0))):1,1:0)
|
|
;
|
|
LINKTO(FBDA,FBUCP,FBLINK) ;is this a primary claim to which a secondary can be linked?
|
|
;claim which is a primary and not claim selected to be linked
|
|
;INPUT: FBDA = ien of unauthorized claim
|
|
; FBUCP = zero node of unauthorized claim
|
|
; FBLINK = claim ien which is to be linked
|
|
;OUTPUT: 1 if yes, 0 if no
|
|
I $S('+$G(FBDA):1,$G(FBUCP)']"":1,'+$G(FBLINK):1,1:0) Q 0
|
|
Q $S($$PRIME(FBDA,FBUCP)&(FBDA'=FBLINK):1,1:0)
|
|
;
|
|
ID ;display identifiers
|
|
N FBZ S FBZ=$$FBZ^FBUCUTL(+Y) Q:Y']"" W ?15,$E($$VET^FBUCUTL(+$P(FBZ,U,4)),1,20),?38,$E($$VEN^FBUCUTL(+$P(FBZ,U,3)),1,20)
|
|
W ?61,$E($$PROG^FBUCUTL(+$P(FBZ,U,2)),1,14),!,$E($P($$PTR^FBUCUTL("^FB(162.92,",+$P(FBZ,U,24)),U),1,16)
|
|
W ?19,"TREATMENT FROM: ",$$DATX^FBAAUTL(+$P(FBZ,U,5)),?44,"TREATMENT TO: ",$$DATX^FBAAUTL(+$P(FBZ,U,6))
|
|
W ! Q
|
|
PARSE(FBARY) ;set piece positions variable, and get # of pieces for printing
|
|
;INPUT: FBARY = (not subscripted) - piece positions
|
|
;OUTPUT: FBW = piece positions
|
|
; FBPL = # of pieces
|
|
S FBARY=$G(FBARY),FBW=$P(FBARY,";",2),FBPL=($L(FBW,"^"))-1
|
|
Q
|
|
LINE(FBARY,FBI,FBPL,FBW) ;write line
|
|
;INPUT: FBPL = # of pieces
|
|
; FBW = piece positions
|
|
; FBARY = specific array entry
|
|
;OUTPUT: write line of info
|
|
N FBP,FBY S FBY=$P(FBARY,";",2) W:$L(FBARY,"^")>5 ! W !,$S($L(FBI)<2:" ",1:""),FBI F FBP=1:1:FBPL Q:$P(FBY,U,FBP)']"" D
|
|
.I $P(FBY,U,FBP)="!" W ! I FBP>1 S FBW=$P(FBW,U,1,FBP-1)_U_"!"_U_$P(FBW,U,FBP,FBPL)
|
|
.I $P(FBY,U,FBP)'="!" W ?($P(FBW,U,FBP)),$P(FBY,U,FBP)
|
|
Q
|
|
FBO() ;set fbo string if 0 or not defined
|
|
N FBI,Z S FBI=0 F S FBI=$O(^FB(162.92,FBI)) Q:'FBI S Z=$G(^FB(162.92,FBI,0)) I $P(Z,U,2),$P(Z,U,4) S FBO=$S(+$G(FBO):FBO_$P(Z,U,4)_U,1:$P(Z,U,4)_U)
|
|
Q $G(FBO)
|
|
;
|
|
PAD(L,V,C,O) ;set fixed length field
|
|
;INPUT: L=length of field/V=variable/C=character to append/O=order
|
|
; 1 for beginning,2 for ending
|
|
;OUTPUT: fixed length field
|
|
N X S $P(X,C,L)="" I O=2 S V=V_($E(X,1,(L-$L(V))))
|
|
I O=1 S V=($E(X,1,(L-$L(V))))_V
|
|
Q $G(V)
|