| 1 | FBAAUTL5 ;ACAMPUS/DMK-UTILITY ROUTINE ;4/17/2000
|
|---|
| 2 | ;;3.5;FEE BASIS;**3,4,21**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | INPUT ;called from input transform of 163.99 to determine if CPT and
|
|---|
| 5 | ;or modifier is a valid entry in appropriate file.
|
|---|
| 6 | Q:'$D(X)
|
|---|
| 7 | N A,B,FBI,FBMOD,FBMODA,FBMODX
|
|---|
| 8 | ;
|
|---|
| 9 | S A=$P(X,"-"),B=$P(X,"-",2)
|
|---|
| 10 | ;
|
|---|
| 11 | ;sort modifiers so lookups will work
|
|---|
| 12 | I B]"" D S $P(X,"-",2)=B
|
|---|
| 13 | . F FBI=1:1 S FBMOD=$P(B,",",FBI) Q:FBMOD="" S FBMODA(FBMOD)=""
|
|---|
| 14 | . S (FBMOD,B)=""
|
|---|
| 15 | . F S FBMOD=$O(FBMODA(FBMOD)) Q:FBMOD="" S B=B_","_FBMOD
|
|---|
| 16 | . S:$E(B)="," B=$E(B,2,999)
|
|---|
| 17 | ;
|
|---|
| 18 | ; check for valid pattern
|
|---|
| 19 | I ('(X?5AN)&'(X?5AN1"-"2AN.17(1","2AN,1""))) K X Q
|
|---|
| 20 | ;
|
|---|
| 21 | ;check for valid CPT code
|
|---|
| 22 | I $P($$CPT^ICPTCOD(A,"",1),U)'>0 D EN^DDIOL("CPT code not valid!") K X Q
|
|---|
| 23 | ;
|
|---|
| 24 | ; check for valid modifiers
|
|---|
| 25 | I B]"" F FBI=1:1 S FBMOD=$P(B,",",FBI) Q:FBMOD="" D
|
|---|
| 26 | . S FBMODX=$$MOD^ICPTMOD(FBMOD,"E")
|
|---|
| 27 | . ; if modifier data not obtained then try another API to resolve it
|
|---|
| 28 | . ; since there can be duplicate modifiers with same external value
|
|---|
| 29 | . I $P(FBMODX,U)'>0 D
|
|---|
| 30 | . . N FBY
|
|---|
| 31 | . . S FBY=$$MODP^ICPTMOD(A,FBMOD,"E")
|
|---|
| 32 | . . I $P(FBY,U)>0 S FBMODX=$$MOD^ICPTMOD($P(FBY,U),"I")
|
|---|
| 33 | . I $P(FBMODX,U)'>0 D EN^DDIOL("CPT Modifier "_FBMOD_" not valid!") K X
|
|---|
| 34 | Q:'$D(X)
|
|---|
| 35 | ;
|
|---|
| 36 | ;display
|
|---|
| 37 | S FBX="CPT: "_$P($$CPT^ICPTCOD(A,"",1),U,3)
|
|---|
| 38 | D EN^DDIOL(FBX,"","!?20")
|
|---|
| 39 | I B]"" F FBI=1:1 S FBMOD=$P(B,",",FBI) Q:FBMOD="" D
|
|---|
| 40 | . S FBMODX=$$MOD^ICPTMOD(FBMOD,"E")
|
|---|
| 41 | . ; if modifier data not obtained then try another API to resolve it
|
|---|
| 42 | . ; since there can be duplicate modifiers with same external value
|
|---|
| 43 | . I $P(FBMODX,U)'>0 D
|
|---|
| 44 | . . N FBY
|
|---|
| 45 | . . S FBY=$$MODP^ICPTMOD(A,FBMOD,"E")
|
|---|
| 46 | . . I $P(FBY,U)>0 S FBMODX=$$MOD^ICPTMOD($P(FBY,U),"I")
|
|---|
| 47 | . S FBX="MOD: "_FBMOD_" "_$P(FBMODX,U,3)
|
|---|
| 48 | . D EN^DDIOL(FBX,"","!?20")
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | PSA(X) ;get psa from institution
|
|---|
| 52 | ;input X = ien of psa
|
|---|
| 53 | ;output station number from instutution file\
|
|---|
| 54 | Q $S($D(^DIC(4,+$G(X),99)):$E(^(99),1,3),1:"")
|
|---|
| 55 | ;
|
|---|
| 56 | EXTPV(X) ;call used to determine Purpose of Visit Austin code
|
|---|
| 57 | ; x = pointer to 161.82
|
|---|
| 58 | ; Output = Austin code
|
|---|
| 59 | Q $S('$G(X):"",1:$P($G(^FBAA(161.82,+X,0)),U,3))
|
|---|
| 60 | SUB(X) ;used to get station number and substation if one exists
|
|---|
| 61 | ;from the IFCAP software. This call is used during
|
|---|
| 62 | ;transmission of payment batches to Austin.
|
|---|
| 63 | ;
|
|---|
| 64 | ; X = "STATION NUMBER-OBLIGATION NUMBER"
|
|---|
| 65 | ; EXAMPLE: 699-C12345
|
|---|
| 66 | I '+$G(X) Q ""
|
|---|
| 67 | N PRCS,Y
|
|---|
| 68 | S PRCS("X")=X,PRCS("TYPE")="FB"
|
|---|
| 69 | D EN1^PRCS58 ;call to IFCAP to get obligation information
|
|---|
| 70 | K PRCSCPAN
|
|---|
| 71 | I Y=-1 Q ""
|
|---|
| 72 | Q $S($P(Y,U,10)]"":$P(Y,U,10),1:$E($P(Y,U,2),1,3))
|
|---|
