| 1 | FBUCUTL4 ;ALBISC/TET - UTILITY CONTINUATION ;5/14/93 15:06
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | PRIME(FBDA,FBUCP) ;determine if claim is a primary (points to itself)
|
|---|
| 5 | ;INPUT: FBDA = ien of unauthorized claim
|
|---|
| 6 | ; FBUCP = zero node of fbda
|
|---|
| 7 | ;OUTPUT: 1 if yes, 0 if no
|
|---|
| 8 | Q $S('+$G(FBDA):0,$G(FBUCP)']"":0,FBDA=$P(FBUCP,U,20):1,1:0)
|
|---|
| 9 | ;
|
|---|
| 10 | SECOND(FBDA,FBUCP) ;determine if claim is a secondary (points to another)
|
|---|
| 11 | ;INPUT: FBDA = ien of unauthorized claim
|
|---|
| 12 | ; FBUCP = zero node of fbda
|
|---|
| 13 | ;OUTPUT: 1 if yes, 0 if no
|
|---|
| 14 | Q $S('+$G(FBDA):0,$G(FBUCP)']"":0,FBDA'=$P(FBUCP,U,20):1,1:0)
|
|---|
| 15 | ;
|
|---|
| 16 | LINK(FBDA,FBUCP) ;is this a claim which can be linked to a primary?
|
|---|
| 17 | ;claims which can be linked are only primaries with no secondaries OR only secondaries
|
|---|
| 18 | ;INPUT: FBDA = ien of unauthorized claim
|
|---|
| 19 | ; FBUCP = zero node of unauthorized claim
|
|---|
| 20 | ;OUTPUT: 1 if yes, 0 if no
|
|---|
| 21 | I $S('+$G(FBDA):1,$G(FBUCP)']"":1,1:0) Q 0
|
|---|
| 22 | Q $S($$SECOND(FBDA,FBUCP):1,$$PRIME(FBDA,FBUCP)&('+$O(^FB583("AMS",+$P(FBUCP,U,20),0))):1,1:0)
|
|---|
| 23 | ;
|
|---|
| 24 | LINKTO(FBDA,FBUCP,FBLINK) ;is this a primary claim to which a secondary can be linked?
|
|---|
| 25 | ;claim which is a primary and not claim selected to be linked
|
|---|
| 26 | ;INPUT: FBDA = ien of unauthorized claim
|
|---|
| 27 | ; FBUCP = zero node of unauthorized claim
|
|---|
| 28 | ; FBLINK = claim ien which is to be linked
|
|---|
| 29 | ;OUTPUT: 1 if yes, 0 if no
|
|---|
| 30 | I $S('+$G(FBDA):1,$G(FBUCP)']"":1,'+$G(FBLINK):1,1:0) Q 0
|
|---|
| 31 | Q $S($$PRIME(FBDA,FBUCP)&(FBDA'=FBLINK):1,1:0)
|
|---|
| 32 | ;
|
|---|
| 33 | ID ;display identifiers
|
|---|
| 34 | 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)
|
|---|
| 35 | 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)
|
|---|
| 36 | W ?19,"TREATMENT FROM: ",$$DATX^FBAAUTL(+$P(FBZ,U,5)),?44,"TREATMENT TO: ",$$DATX^FBAAUTL(+$P(FBZ,U,6))
|
|---|
| 37 | W ! Q
|
|---|
| 38 | PARSE(FBARY) ;set piece positions variable, and get # of pieces for printing
|
|---|
| 39 | ;INPUT: FBARY = (not subscripted) - piece positions
|
|---|
| 40 | ;OUTPUT: FBW = piece positions
|
|---|
| 41 | ; FBPL = # of pieces
|
|---|
| 42 | S FBARY=$G(FBARY),FBW=$P(FBARY,";",2),FBPL=($L(FBW,"^"))-1
|
|---|
| 43 | Q
|
|---|
| 44 | LINE(FBARY,FBI,FBPL,FBW) ;write line
|
|---|
| 45 | ;INPUT: FBPL = # of pieces
|
|---|
| 46 | ; FBW = piece positions
|
|---|
| 47 | ; FBARY = specific array entry
|
|---|
| 48 | ;OUTPUT: write line of info
|
|---|
| 49 | 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
|
|---|
| 50 | .I $P(FBY,U,FBP)="!" W ! I FBP>1 S FBW=$P(FBW,U,1,FBP-1)_U_"!"_U_$P(FBW,U,FBP,FBPL)
|
|---|
| 51 | .I $P(FBY,U,FBP)'="!" W ?($P(FBW,U,FBP)),$P(FBY,U,FBP)
|
|---|
| 52 | Q
|
|---|
| 53 | FBO() ;set fbo string if 0 or not defined
|
|---|
| 54 | 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)
|
|---|
| 55 | Q $G(FBO)
|
|---|
| 56 | ;
|
|---|
| 57 | PAD(L,V,C,O) ;set fixed length field
|
|---|
| 58 | ;INPUT: L=length of field/V=variable/C=character to append/O=order
|
|---|
| 59 | ; 1 for beginning,2 for ending
|
|---|
| 60 | ;OUTPUT: fixed length field
|
|---|
| 61 | N X S $P(X,C,L)="" I O=2 S V=V_($E(X,1,(L-$L(V))))
|
|---|
| 62 | I O=1 S V=($E(X,1,(L-$L(V))))_V
|
|---|
| 63 | Q $G(V)
|
|---|
