Changeset 636 for FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMOD.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMOD.m
r628 r636 1 ICPTMOD ;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 ; 1 ICPTMOD ; ALB/DEK/KER - CPT MODIFIER APIS ; 09/06/2006 2 ;;6.0;CPT/HCPCS;**6,12,13,14,19,30**;May 19, 1997;Build 1 3 ; 8 4 ; External References 9 ; $$DT^XLFDT DBIA 10103 10 ; 11 ; External References 5 ; DBIA 10103 $$DT^XLFDT 12 6 ; 13 7 Q … … 15 9 ; 16 10 ; Input: MOD Modifier, Internal or External (Required) 17 ; MFT Format "I"=IEN "E"=.01 field (Default)11 ; MFT Modifier Format "I" = IEN "E" = .01 field (Default) 18 12 ; MDT Version Date, FileMan format (default = TODAY) 19 13 ; SRC Source Screen … … 22 16 ; DFN Not used 23 17 ; 24 ; Output: 10 piece string delimited by the up-arrow (^)18 ; Output: Returns a 10 piece string delimited by the up-arrow (^) 25 19 ; 26 20 ; 1 IEN … … 55 49 S STR=STR_"^"_EFF_"^"_$$MSG^ICPTSUPT(MDT) 56 50 S:$L(MODST) $P(STR,"^",3)=MODST 57 MODQ ; Modifier Quit 58 Q STR 51 MODQ Q STR 59 52 ; 60 53 MODD(CODE,OUTARR,DFN,CDT) ; returns CPT description in array 61 54 ; 62 ; Input: CODE CPT Modifier , internal or external (Required)55 ; Input: CODE CPT Modifier code, internal or external (Required) 63 56 ; ARY Output Array Name 64 57 ; e.g. "ABC" or "ABC("TEST")" … … 66 59 ; DFN Not used 67 60 ; CDT Versioning Date (default = TODAY) 68 ; If prior to 1/1/1989, 1/1/1989 will be used69 ; If year only, use first of that year70 ; If month/year only, use first of the month71 ; If later than today, TODAY will be used61 ; If CDT is prior to 1/1/1989, 1/1/1989 will be used 62 ; If CDT is year only, the first of that year will be used 63 ; If CDT is month/year only, the first of month will be used 64 ; If CDT is later than today, TODAY will be used 72 65 ; 73 66 ; Output: # Number of lines in description 74 67 ; 75 ; @ARY(1:n) - Versioned Description ( multiple 62)68 ; @ARY(1:n) - Versioned Description (from the 62 multiple) 76 69 ; @ARY(n+1) - blank 77 ; @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE70 ; @ARY(n+1) - a message stating: CODE TEXT MAY BE INACCURATE 78 71 ; or 79 72 ; -1^Error … … 98 91 . S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICPTSUPT(CDT,1) 99 92 I +N'>0 S N="-1^VERSIONED DESCRIPTION NOT FOUND FOR MODIFIER "_$P($G(^DIC(81.3,+CODE,0)),"^",1) 100 MODDQ ; Modifier Description Quit 101 Q N 93 MODDQ Q N 102 94 ; 103 95 MODA(CODE,VDT,ARY) ; Return an array of Modifiers for a CPT Code 104 96 D MODA^ICPTMOD2 Q 97 ; 105 98 MODP(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)) 99 ; 100 ; Input: 101 ; 102 ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A 103 ; MOD Modifier (External or Internal) 104 ; MFT Modifier Format "E" - or "I" 105 ; VDT Date service provided 106 ; SRC Source Screen 107 ; If 0 or Null, Level I and II modifiers 108 ; If >0, Level I, II, and III modifiers 109 ; Output: 110 ; 111 ; If pair is acceptable - Positive 7 Piece "^" Delimited String 112 ; 113 ; 1 - IEN of CPT Modifier 114 ; 2 - Versioned Short Text 115 ; 3 - Beginning Code for Code Range 116 ; 4 - Ending Code for Code Range 117 ; 5 - Code Range Activaiton Date 118 ; 6 - Code Range Inactivation Date 119 ; 7 - Modifier Identifier 120 ; 121 ; If pair is unacceptable 122 ; 123 ; 0 124 ; 125 N ACD,ADT,BEGA,BEGR,CDT,CODEA,CPTS,ENDA,ENDR,ICD,IDT,MIEN,MODEFF,MODI,MODNM,MODST,NEXT,NN,ND,PR,PRN,RIEN,SIEN,SRC,STA,STI,STX,TA,TEFF,TI,TIEN,VDT 126 S:$G(MFT)="" MFT="E" Q:"^E^I^"'[("^"_MFT_"^") "-1^Invalid Modifier Format" 127 S VDT=$P($G(MDT),".",1) Q:+VDT'>0!(VDT'?7N) "-1^Invalid Date" 128 I MFT="E" D I +($G(MIEN))'>0 Q "-1^Multiple Modifiers with the same name, use IEN" 129 . S MIEN=0 S (TIEN,TI)=0 F S TIEN=$O(^DIC(81.3,"B",MOD,TIEN)) Q:+TIEN'>0 D 130 . . S TEFF=$$EFF^ICPTSUPT(81.3,TIEN,VDT) Q:'$P(TEFF,"^",2) 131 . . S TI=TI+1,TA(TI)=TIEN,TA(0)=TI 132 . S:+($G(TA(0)))=1 MIEN=+($G(TA(1))) 133 S:MFT="I" MIEN=+MOD S CODE=$G(CODE) 134 S CODN=$S(CODE?1.N:+CODE,1:$$CODEN^ICPTCOD(CODE)) 135 I CODN<1!'$D(^ICPT(CODN,0)) Q "-1^NO SUCH CPT CODE" 136 S CODE=$P($G(^ICPT(CODN,0)),"^") I '$L(CODE) Q:"-1^NO SUCH CPT CODE " 137 Q:$L(CODE)'=5 "-1^Invalid Code" 138 S CODEA=$S(CODE?1N.4N:+CODE,CODE?4N1A:$A($E(CODE,5))*10_$E(CODE,1,4),1:$A(CODE)_$E(CODE,2,5)) Q:+CODEA'>0 "-1^Invalid Code Source" 139 S MIEN=$G(MIEN) Q:+MIEN'>0 "-1^Invalid Modifier" 140 S SRC=+($G(SRC)) S SRC=$S(+SRC>0:1,1:0) 141 S SIEN=$O(^ICPT("BA",(CODE_" "),0)) Q:+SIEN'>0 "-3^Invalid Code" 142 S CPTS=$P($G(^ICPT(+SIEN,0)),"^",6) Q:CPTS="L"&(SRC'>0) "-1^Invalid Code Source" 143 S MODEFF=$$EFF^ICPTSUPT(81.3,MIEN,VDT) Q:'$P(MODEFF,"^",2) "-1^Modifier Inactive" 144 S MODNM=$P($G(^DIC(81.3,MIEN,0)),"^",2) Q:'$L(MODNM) "-1^Invalid Modifier Name" 145 S MODI=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MODI) "-1^Invalid Modifier ID" 146 S MODST=$$VSTCM^ICPTMOD(MIEN,VDT) K STX S (STA,STI)=0 S CDT=($$DTBR^ICPTSUPT(VDT))+.001 147 S RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D 148 . S ND=$G(^DIC(81.3,MIEN,10,RIEN,0)) 149 . S BEGR=$P(ND,"^",1),BEGA=$S(BEGR?1N.4N:+BEGR,BEGR?4N1A:$A($E(BEGR,5))*10_$E(BEGR,1,4),1:$A(BEGR)_$E(BEGR,2,5)) Q:CODEA<BEGA 150 . S ENDR=$P(ND,"^",2),ENDA=$S(ENDR?1N.4N:+ENDR,ENDR?4N1A:$A($E(ENDR,5))*10_$E(ENDR,1,4),1:$A(ENDR)_$E(ENDR,2,5)) Q:CODEA>ENDA 151 . S (ACD,ADT)=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101 S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) 152 . S NN="^DIC(81.3,"_MIEN_",10,"_RIEN_",0)" 153 . S STA=+($G(STA))+1,STX(STA)=MIEN_"^"_MODST_"^"_BEGR_"^"_ENDR_"^"_ADT_"^"_ICD_"^"_MODI,STX("B",+ADT,+STA)="" 154 S ADT=$O(STX("B",+CDT),-1),STA=$O(STX("B",+ADT," "),-1),MOD=$G(STX(+STA)) Q:+MOD'>0 "0" 155 Q MOD 156 ; 107 157 MODC(MOD) ; Checks modifier for range including code 108 158 D MODC^ICPTMOD2($G(MOD)) 109 159 Q 160 ; 110 161 MULT ; Finds Duplicate Modifiers 111 162 D MULT^ICPTMOD2 Q 112 CODEN(CODE) ; Return the IEN of a CPT modifier CODE 163 ; 164 CODEN(CODE) ; Return the IEN of a CPT modifier 165 ; Input: CPT modifier code 166 ; Output: IEN 167 ; 113 168 Q:$G(CODE)="" -1 114 169 N COD S COD=+$O(^DIC(81.3,"BA",(CODE_" "),0)) 115 170 Q $S(COD>0:COD,1:-1) 171 ; 116 172 VSTCM(IEN,VDATE) ; Versioned Short Text (CPT Modifier) 117 173 N CPT0,CPTC,CPTI,CPTSTD,CPTSTI,CPTVDT,CPTTXT,CPTTD,CPTTI
Note:
See TracChangeset
for help on using the changeset viewer.