source: WorldVistAEHR/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMOD2.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1ICPTMOD2 ; ALB/DEK/KER - CPT MODIFIER APIS ; 09/06/2006
2 ;;6.0;CPT/HCPCS;**30**;May 19, 1997;Build 1
3 ;
4 ; External References
5 ; DBIA 10103 $$DT^XLFDT
6 ;
7 Q
8MODA ; Create an array of Modifiers for a CPT Code
9 ;
10 ; Input
11 ;
12 ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
13 ; VDT Versioning Date (date service provided)
14 ; .ARY Name of a Local Array passed by value
15 ;
16 ; Output
17 ;
18 ; ARY Only returns Active Modifiers
19 ; ARY(0) = 4 Piece String
20 ; 4 Piece String
21 ; 1 # of Modifiers found for code CODE (input)
22 ; 2 # of Modifiers w/Active Ranges
23 ; 3 # of Modifiers w/Inactive Ranges
24 ; 4 Code
25 ;
26 ; ARY(ST,MOD) = 8 Piece Output String
27 ;
28 ; ST Status A=Active I=Inactive
29 ; MOD Modifier (external format)
30 ; 8 Piece String
31 ; 1 IEN of Modifier
32 ; 2 Versioned Short Text (name)
33 ; 3 Activation date of Modifier
34 ; 4 Beginning Range Code
35 ; 5 Ending Range Code
36 ; 6 Activation Date of Range
37 ; 7 Inactivation Date of Range
38 ; 8 Modifier Identifier
39 ;
40 N A,EFF,I,ID,MIEN,MOD,SRC,ST,X K ARY
41 S CODE=$G(CODE) Q:'$D(^ICPT("BA",(CODE_" ")))
42 S VDT=$G(VDT) S:+VDT'>0 VDT=$$DT^XLFDT Q:VDT'?7N
43 S SRC=3,MIEN=0 F S MIEN=$O(^DIC(81.3,MIEN)) Q:+MIEN'>0 D
44 . S (EFF,ST)=$O(^DIC(81.3,MIEN,60,"B"," "),-1) Q:ST'>0 S ST=$O(^DIC(81.3,MIEN,60,"B",ST," "),-1) Q:ST'>0 S ST=$P($G(^DIC(81.3,MIEN,60,ST,0)),"^",2) Q:ST'>0
45 . S MOD=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MOD)
46 . S X=$$MODP^ICPTMOD(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
47 . S:+X>0 ARY(ID,MOD)=$P(X,"^",1,2)_"^"_EFF_"^"_$P(X,"^",3,7)
48 S (A,I)=0,ST="" F S ST=$O(ARY(ST)) Q:ST="" S MOD="" F S MOD=$O(ARY(ST,MOD)) Q:MOD="" S:ST="A" A=A+1 S:ST="I" I=I+1
49 S ST=A+I,ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
50 Q
51 ;
52MODC(MOD) ; Checks modifier for range including code, and active for date desired
53 ;
54 ; Input:
55 ; MOD - modifier ien
56 ;
57 N MODNM,MODEFF
58 S MODEFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
59 I '$P(MODEFF,"^",2) S STR="-1^modifier inactive" Q
60 S PR=CODEA_.0001,PR=$O(^DIC(81.3,MOD,"M",PR),-1)
61 I 'PR S STR=0 Q
62 S PRN=^DIC(81.3,MOD,"M",PR)
63 I 'PRN S STR="-1^bad modifier file entry" Q
64 I PRN<CODEA S STR=0 Q
65 S MODNM=$P($G(^DIC(81.3,MOD,0)),"^",2)
66 S STR=MOD_"^"_MODNM
67 Q
68 ;
69MULT ; Finds iens for all modifiers with same 2-letter code
70 ; MOD = .01, check B x-ref for other mods with equivalent .01 fields
71 ; output concatenates ien of each mod to STR, separated by ":"
72 F MODN=0:0 S MODN=$O(^DIC(81.3,"B",MOD,MODN)) Q:'MODN S STR=STR_MODN_"; "
73 Q
Note: See TracBrowser for help on using the repository browser.