source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAUTL5.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1FBAAUTL5 ;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.
4INPUT ;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 ;
51PSA(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 ;
56EXTPV(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))
60SUB(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))
Note: See TracBrowser for help on using the repository browser.