source: FOIAVistA/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMOD.m@ 894

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1ICPTMOD ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
2 ;;6.0;CPT/HCPCS;**6,12,13,14,19,30,37**;May 19, 1997;Build 25
3 ;
4 ; Global Variables
5 ; ^DIC(81.3
6 ; ^TMP("ICPTD" SACC 2.3.2.5.1
7 ;
8 ; External References
9 ; $$DT^XLFDT DBIA 10103
10 ;
11 ; External References
12 ;
13 Q
14MOD(MOD,MFT,MDT,SRC,DFN) ; returns basic info on CPT MODIFIERs
15 ;
16 ; Input: MOD Modifier, Internal or External (Required)
17 ; MFT Format "I"=IEN "E"=.01 field (Default)
18 ; MDT Version Date, FileMan format (default = TODAY)
19 ; SRC Source Screen
20 ; If 0 or Null, Level I and II only
21 ; If >0, Level I, II, and III
22 ; DFN Not used
23 ;
24 ; Output: 10 piece string delimited by the up-arrow (^)
25 ;
26 ; 1 IEN
27 ; 2 Modifier (0;1)
28 ; 3 Versioned Name (61, 0;1)
29 ; 4 Code (0;3)
30 ; 5 Source (0;4)
31 ; 6 Effective Date (60, 0;1)
32 ; 7 Status (60, 0;2) 0:inactive; 1:active
33 ; 8 Inactivation Date (60, 0;1)
34 ; 9 Activation Date (60, 0;1)
35 ; 10 Message
36 ; or
37 ; -1^Error
38 ;
39 N DATA,EFF,EFFX,EFFS,STR,MODN,MODST
40 I $G(MOD)="" S STR="-1^NO MODIFIER SELECTED" G MODQ
41 I $G(MFT)="" S MFT="E"
42 I "E^I"'[MFT S STR="-1^INVALID MODIFIER FORMAT" G MODQ
43 S MDT=$S($G(MDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT(MDT))
44 I MFT="E" S MODN=$O(^DIC(81.3,"B",MOD,0)) I $O(^(MODN)) S STR="-1^Multiple modifiers w/same name. Select IEN: " D MULT G MODQ
45 I MFT="E" S MOD=MODN
46 S MOD=+MOD
47 I 'MOD!'$D(^DIC(81.3,MOD)) S STR="-1^NO SUCH MODIFIER" G MODQ
48 S DATA=$G(^DIC(81.3,MOD,0))
49 S MODST=$$VSTCM(MOD,MDT)
50 I '$L(DATA) S STR="-1^NO DATA" G MODQ
51 S STR=MOD_"^"_$P(DATA,"^",1,4)
52 I '$G(SRC),$P(STR,"^",5)="V" Q "-1^VA LOCAL MODIFIER SELECTED"
53 S EFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
54 I EFF<1 S $P(EFF,"^",2)=0
55 S STR=STR_"^"_EFF_"^"_$$MSG^ICPTSUPT(MDT)
56 S:$L(MODST) $P(STR,"^",3)=MODST
57MODQ ; Modifier Quit
58 Q STR
59 ;
60MODD(CODE,OUTARR,DFN,CDT) ; returns CPT description in array
61 ;
62 ; Input: CODE CPT Modifier, internal or external (Required)
63 ; ARY Output Array Name
64 ; e.g. "ABC" or "ABC("TEST")"
65 ; Default = ^TMP("ICPTD",$J)
66 ; DFN Not used
67 ; CDT Versioning Date (default = TODAY)
68 ; If prior to 1/1/1989, 1/1/1989 will be used
69 ; If year only, use first of that year
70 ; If month/year only, use first of the month
71 ; If later than today, TODAY will be used
72 ;
73 ; Output: # Number of lines in description
74 ;
75 ; @ARY(1:n) - Versioned Description (multiple 62)
76 ; @ARY(n+1) - blank
77 ; @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE
78 ; or
79 ; -1^Error
80 ;
81 ; ** User must initialize ^TMP("ICPTD",$J), if used **
82 ;
83 N ARR,END,CTV,I,N
84 I $G(CODE)="" S N="-1^NO CODE SELECTED" G MODDQ
85 I $G(OUTARR)="" S OUTARR="^TMP(""ICPTD"",$J,"
86 I OUTARR'["(" S OUTARR=OUTARR_"("
87 I OUTARR[")" S OUTARR=$P(OUTARR,")")
88 S END=$E(OUTARR,$L(OUTARR)) I END'="("&(END'=",") S OUTARR=OUTARR_","
89 I OUTARR="^TMP(""ICPTD"",$J," K ^TMP("ICPTD",$J)
90 S CODE=$S(CODE?1.N:+CODE,1:$$CODEN(CODE)),I=0,N=0
91 I CODE<1!'$D(^DIC(81.3,CODE)) S N="-1^NO SUCH CODE" G MODDQ
92 S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT(CDT))
93 D VLTCM(+CODE,CDT,.CTV)
94 S (N,I)=0 F S I=$O(CTV(I)) Q:+I=0 D
95 . S N=N+1,ARR=OUTARR_N_")",@ARR=$$TRIM($G(CTV(I)))
96 I +N>0 D
97 . S N=N+1,ARR=OUTARR_N_")",@ARR=" "
98 . S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICPTSUPT(CDT,1)
99 I +N'>0 S N="-1^VERSIONED DESCRIPTION NOT FOUND FOR MODIFIER "_$P($G(^DIC(81.3,+CODE,0)),"^",1)
100MODDQ ; Modifier Description Quit
101 Q N
102 ;
103MODA(CODE,VDT,ARY) ; Return an array of Modifiers for a CPT Code
104 D MODA^ICPTMOD2 Q
105MODP(CODE,MOD,MFT,MDT,SRC,DFN) ; Check if modifier can be used with code
106 Q $$MODP^ICPTMOD2($G(CODE),$G(MOD),$G(MFT),$G(MDT),$G(SRC),$G(DFN))
107MODC(MOD) ; Checks modifier for range including code
108 D MODC^ICPTMOD2($G(MOD))
109 Q
110MULT ; Finds Duplicate Modifiers
111 D MULT^ICPTMOD2 Q
112CODEN(CODE) ; Return the IEN of a CPT modifier CODE
113 Q:$G(CODE)="" -1
114 N COD S COD=+$O(^DIC(81.3,"BA",(CODE_" "),0))
115 Q $S(COD>0:COD,1:-1)
116VSTCM(IEN,VDATE) ; Versioned Short Text (CPT Modifier)
117 N CPT0,CPTC,CPTI,CPTSTD,CPTSTI,CPTVDT,CPTTXT,CPTTD,CPTTI
118 S CPTI=+($G(IEN)) Q:+CPTI'>0 "" Q:'$D(^DIC(81.3,+CPTI)) ""
119 S CPTVDT=$G(VDATE) S:'$L(CPTVDT)!(+CPTVDT'>0) CPTVDT=$$DT^XLFDT Q:$P(CPTVDT,".",1)'?7N ""
120 S CPT0=$G(^DIC(81.3,+CPTI,0)),CPTC=$P(CPT0,"^",1) Q:'$L(CPTC) ""
121 S CPTSTD=0 S CPTTD=CPTVDT+.000001 F S CPTTD=$O(^DIC(81.3,"AST",(CPTC_" "),CPTTD),-1) Q:+CPTTD=0 Q:+CPTSTD>0 D
122 . S CPTTI=$O(^DIC(81.3,"AST",(CPTC_" "),CPTTD," "),-1) S:CPTTI=CPTI CPTSTD=CPTTD
123 I +CPTSTD>0 D Q:$L($G(CPTTXT)) $G(CPTTXT)
124 . S CPTSTI=$O(^DIC(81.3,"AST",(CPTC_" "),CPTSTD,+CPTI," "),-1),CPTTXT=$P($G(^DIC(81.3,+CPTI,61,+CPTSTI,0)),"^",2)
125 S CPTSTD=$O(^DIC(81.3,+CPTI,61,"B",0)) I +CPTSTD>0 D Q:$L($G(CPTTXT)) $G(CPTTXT)
126 . S CPTSTI=$O(^DIC(81.3,+CPTI,61,"B",CPTSTD,0)),CPTTXT=$P($G(^DIC(81.3,+CPTI,61,+CPTSTI,0)),"^",2)
127 Q $$TRIM($P(CPT0,"^",2))
128VLTCM(IEN,VDATE,ARY) ; Versioned Description - Long Text (CPT Modifier)
129 N CPT0,CPTC,CPTD,CPTI,CPTSTD,CPTSTI,CPTT,CPTVDT,CPTTXT,CPTTD,CPTTI
130 S CPTI=+($G(IEN)) Q:+CPTI'>0 Q:'$D(^DIC(81.3,+CPTI))
131 S CPTVDT=$G(VDATE) S:'$L(CPTVDT)!(+CPTVDT'>0) CPTVDT=$$DT^XLFDT Q:$P(CPTVDT,".",1)'?7N
132 S CPT0=$G(^DIC(81.3,+CPTI,0)),CPTC=$P(CPT0,"^",1) Q:'$L(CPTC)
133 S CPTSTD=0 S CPTTD=CPTVDT+.000001 F S CPTTD=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTTD),-1) Q:+CPTTD=0 Q:+CPTSTD>0 D
134 . S CPTTI=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTTD," "),-1) S:CPTTI=CPTI CPTSTD=CPTTD
135 I +CPTSTD>0 D Q:+($O(ARY(0)))>0
136 . S CPTSTI=$O(^DIC(81.3,"ADS",(CPTC_" "),CPTSTD,+CPTI," "),-1)
137 . S (CPTD,CPTT)=0 F S CPTD=$O(^DIC(81.3,+CPTI,62,CPTSTI,1,CPTD)) Q:+CPTD=0 D
138 . . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,+CPTI,62,+CPTSTI,1,+CPTD,0))),ARY(0)=CPTT
139 S CPTSTD=$O(^DIC(81.3,+CPTI,62,"B",0)) I +CPTSTD>0 D Q:+($O(ARY(0)))>0
140 . S CPTSTI=$O(^DIC(81.3,+CPTI,62,"B",CPTSTD,0))
141 . S (CPTD,CPTT)=0 F S CPTD=$O(^DIC(81.3,+CPTI,62,CPTSTI,1,CPTD)) Q:+CPTD=0 D
142 . . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,+CPTI,62,+CPTSTI,1,+CPTD,0))),ARY(0)=CPTT
143 K ARY S (CPTD,CPTT)=0 F S CPTD=$O(^DIC(81.3,CPTI,"D",CPTD)) Q:+CPTD=0 D
144 . S CPTT=CPTT+1,ARY(CPTT)=$$TRIM($G(^DIC(81.3,CPTI,"D",CPTD,0))),ARY(0)=CPTT
145 Q
146TRIM(X) ; Trim Spaces
147 S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
148 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
149 F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,229)
150 Q X
151MO(X) ; Modifier X = Modifier IEN
152 Q $P($G(^DIC(81.3,+($G(X)),0)),"^",1)
Note: See TracBrowser for help on using the repository browser.