Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (15 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
35 edited
1 copied

Legend:

Unmodified
Added
Removed

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/DGYACPT.m

    r628 r636  
    11DGYACPT ;ALB/ABR - CPT Utilities ;3/15/97
    2  ;;6.0;CPT/HCPCS;;May 19, 1997
     2 ;;6.0;CPT/HCPCS;;May 19, 1997;Build 1
    33 ;
    44 ;    ************************************************

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTAPIU.m

    r628 r636  
    11ICPTAPIU  ;ALB/DEK/KER - CPT UTILITIES FOR APIS ; 04/18/2004
    2  ;;6.0;CPT/HCPCS;**1,6,12,14,16,19,22**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**1,6,12,14,16,19,22**;May 19, 1997;Build 1
    33 ;
    44 ; External References

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTCOD.m

    r628 r636  
    1 ICPTCOD ;ALB/DEK/KER - CPT CODE APIS ;11/29/2007
    2  ;;6.0;CPT/HCPCS;**6,12,13,14,16,19,40**;May 19, 1997;Build 6
     1ICPTCOD ;ALB/DEK/KER - CPT CODE APIS ; 04/18/2004
     2 ;;6.0;CPT/HCPCS;**6,12,13,14,16,19**;May 19, 1997;Build 1
    33 ;
    44 ; External References
    … …  
    127127 .S ER="" F  S ER=$O(^DIC(81.3,"M",BR,ER)) Q:'ER  I CODA'>ER D
    128128 ..S MI=0 F  S MI=$O(^DIC(81.3,"M",BR,ER,MI)) Q:'MI  D
    129  ...N MDPS
    130129 ...S MDST=$G(^DIC(81.3,MI,0)) Q:'$L(MDST)
    131  ...S MDPS=$$MODP^ICPTMOD(CODE,+MI,"I",$G(CDT),$G(SRC)) Q:+MDPS'>0
    132130 ...I '$G(SRC) Q:$P(MDST,"^",4)="V"
    133131 ...I $G(CDT) S ACTMD="",ACTMD=$$MOD^ICPTMOD(MI,"I",CDT,$G(SRC)) Q:($P(ACTMD,"^")=-1)!($P(ACTMD,"^",7)=0)

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTCR.m

    r628 r636  
    11ICPTCR ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97
    2  ;;6.0;CPT/HCPCS;;May 19, 1997
     2 ;;6.0;CPT/HCPCS;;May 19, 1997;Build 1
    33 ;
    44 ;  VARIABLES

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTID.m

    r628 r636  
    11ICPTID ;SLC/KER - CPT IDENTIFIERS ; 04/18/2004
    2  ;;6.0;CPT/HCPCS;**19**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**19**;May 19, 1997;Build 1
    33 ;
    44 ; External References

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTIDX.m

    r628 r636  
    11ICPTIDX ;DLS/DEK - MUMPS Cross Reference Routine for History ; 04/28/2003
    2  ;;6.0;CPT/HCPCS;**14**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**14**;May 19, 1997;Build 1
    33 ;
    44 ; ICPTCOD          CPT/HCPC Code from Global

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMIDX.m

    r628 r636  
    11ICPTMIDX ;DLS/DEK - MUMPS Cross Reference Routine for History ; 04/28/2003
    2  ;;6.0;CPT/HCPCS;**14**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**14**;May 19, 1997;Build 1
    33 ;
    44 ; ICPTMOD          CPT/HCPC Code Modifier from Global

  • 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  ;             
     1ICPTMOD ; 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 ;
    84 ; External References
    9  ;    $$DT^XLFDT       DBIA  10103
    10  ;             
    11  ; External References
     5 ;   DBIA  10103  $$DT^XLFDT
    126 ;
    137 Q
    … …  
    159 ;
    1610 ; 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)
    1812 ;          MDT   Version Date, FileMan format (default = TODAY)
    1913 ;          SRC   Source Screen
    … …  
    2216 ;          DFN   Not used
    2317 ;
    24  ; Output:  10 piece string delimited by the up-arrow (^)
     18 ; Output:  Returns a 10 piece string delimited by the up-arrow (^)
    2519 ;
    2620 ;            1  IEN
    … …  
    5549 S STR=STR_"^"_EFF_"^"_$$MSG^ICPTSUPT(MDT)
    5650 S:$L(MODST) $P(STR,"^",3)=MODST
    57 MODQ ; Modifier Quit
    58  Q STR
     51MODQ Q STR
    5952 ;
    6053MODD(CODE,OUTARR,DFN,CDT)       ; returns CPT description in array
    6154 ;
    62  ; Input:   CODE   CPT Modifier, internal or external (Required)
     55 ; Input:   CODE   CPT Modifier code, internal or external (Required)
    6356 ;          ARY    Output Array Name
    6457 ;                   e.g. "ABC" or "ABC("TEST")"
    … …  
    6659 ;          DFN    Not used
    6760 ;          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
     61 ;                   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
    7265 ;
    7366 ; Output:  #      Number of lines in description
    7467 ;
    75  ;          @ARY(1:n) - Versioned Description (multiple 62)
     68 ;          @ARY(1:n) - Versioned Description (from the 62 multiple)
    7669 ;          @ARY(n+1) - blank
    77  ;          @ARY(n+1) - message: CODE TEXT MAY BE INACCURATE
     70 ;          @ARY(n+1) - a message stating: CODE TEXT MAY BE INACCURATE
    7871 ;      or
    7972 ;          -1^Error
    … …  
    9891 . S N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICPTSUPT(CDT,1)
    9992 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
     93MODDQ Q N
    10294 ;
    10395MODA(CODE,VDT,ARY) ; Return an array of Modifiers for a CPT Code
    10496 D MODA^ICPTMOD2 Q
     97 ;
    10598MODP(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 ;
    107157MODC(MOD) ; Checks modifier for range including code
    108158 D MODC^ICPTMOD2($G(MOD))
    109159 Q
     160 ;
    110161MULT ; Finds Duplicate Modifiers
    111162 D MULT^ICPTMOD2 Q
    112 CODEN(CODE)    ; Return the IEN of a CPT modifier CODE
     163 ;
     164CODEN(CODE)    ; Return the IEN of a CPT modifier
     165 ;   Input:  CPT modifier code
     166 ;  Output:  IEN
     167 ;
    113168 Q:$G(CODE)="" -1
    114169 N COD S COD=+$O(^DIC(81.3,"BA",(CODE_" "),0))
    115170 Q $S(COD>0:COD,1:-1)
     171 ;
    116172VSTCM(IEN,VDATE) ; Versioned Short Text (CPT Modifier)
    117173 N CPT0,CPTC,CPTI,CPTSTD,CPTSTI,CPTVDT,CPTTXT,CPTTD,CPTTI

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMOD2.m

    r628 r636  
    1 ICPTMOD2 ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
    2  ;;6.0;CPT/HCPCS;**30,37**;May 19, 1997;Build 25
    3  ;             
    4  ; Global Variables
    5  ;    ^DIC(81.3
    6  ;    ^ICPT(
    7  ;             
     1ICPTMOD2 ; ALB/DEK/KER - CPT MODIFIER APIS ; 09/06/2006
     2 ;;6.0;CPT/HCPCS;**30**;May 19, 1997;Build 1
     3 ;
    84 ; External References
    9  ;    $$DT^XLFDT       DBIA  10103
    10  ;    $$FMADD^XLFDT    DBIA  10103
    11  ;             
     5 ;   DBIA  10103  $$DT^XLFDT
     6 ;
    127 Q
    138MODA ; Create an array of Modifiers for a CPT Code
    … …  
    4944 . 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
    5045 . S MOD=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MOD)
    51  . S X=$$MODP(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
     46 . S X=$$MODP^ICPTMOD(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
    5247 . S:+X>0 ARY(ID,MOD)=$P(X,"^",1,2)_"^"_EFF_"^"_$P(X,"^",3,7)
    5348 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
    5449 S ST=A+I,ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
    5550 Q
    56  ;           
    57 MODP(CODE,MOD,MFT,MDT,SRC,DFN) ;  Check if modifier can be used with code (pair)
    5851 ;
    59  ; Input:
    60  ;
    61  ;    CODE   CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
    62  ;    MOD    Modifier (External or Internal)
    63  ;    MFT    Modifier Format "E" - or "I"
    64  ;    VDT    Date service provided
    65  ;    SRC    Source Screen
    66  ;               If 0 or Null, Level I and II modifiers
    67  ;               If >0, Level I, II, and III modifiers
    68  ; Output:
    69  ;
    70  ;    If pair is acceptable - Positive "^" Delimited String
    71  ;       
    72  ;        1 - IEN of CPT Modifier
    73  ;        2 - Versioned Short Text
    74  ;        3 - Beginning Code for Code Range
    75  ;        4 - Ending Code for Code Range
    76  ;        5 - Code Range Activaiton Date
    77  ;        6 - Code Range Inactivation Date
    78  ;        7 - Modifier Identifier
    79  ;       
    80  ;    If pair is unacceptable
    81  ;   
    82  ;        0 or
    83  ;       -1 with error message
    84  ; 
    85  N ADT,BEGA,BEGR,CDT,CODEA,CODN,ENDA,ENDR,ICD,IDT,LACT,LINA,MIEN,MODEFF,MODI,MODNM,MODST,ND,NSTA,RIEN,RSTA,SIEN,STA,STI,STX,TA,TEFF,TI,TIEN,VDT
    86  S:$G(MFT)="" MFT="E" Q:"^E^I^"'[("^"_MFT_"^") "-1^Invalid Modifier Format"  S VDT=$P($G(MDT),".",1)
    87  S:+VDT'?7N VDT=$$DT^XLFDT S:VDT#10000=0 VDT=VDT+101 S:VDT#100=0 VDT=VDT+1 S VDT=$S(VDT<2890101:2890101,1:VDT)
    88  Q:+VDT'>0!(VDT'?7N) "-1^Invalid Date"  I MFT="E" D  I +($G(MIEN))'>0 Q "-1^Multiple Modifiers with the same name, use IEN"
    89  . S MIEN=0 S (TIEN,TI)=0 F  S TIEN=$O(^DIC(81.3,"B",MOD,TIEN)) Q:+TIEN'>0  D
    90  . . S TEFF=$$EFF^ICPTSUPT(81.3,TIEN,VDT) Q:'$P(TEFF,"^",2)  S TI=TI+1,TA(TI)=TIEN,TA(0)=TI
    91  . S:+($G(TA(0)))=1 MIEN=+($G(TA(1)))
    92  S:MFT="I" MIEN=+MOD S CODE=$G(CODE),CODN=$S(CODE?1.N:+CODE,1:$$CODEN^ICPTCOD(CODE)) I CODN<1!'$D(^ICPT(CODN,0)) Q "-1^NO SUCH CPT CODE"
    93  S CODE=$P($G(^ICPT(CODN,0)),"^") Q:'$L(CODE) "-1^No such CPT Code"  Q:$L(CODE)'=5 "-1^Invalid Code"
    94  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"
    95  S MIEN=$G(MIEN) Q:+MIEN'>0 "-1^Invalid Modifier"  S SRC=$S(+($G(SRC))>0:1,1:0),SIEN=$O(^ICPT("BA",(CODE_" "),0)) Q:+SIEN'>0 "-3^Invalid Code"
    96  Q:$P($G(^ICPT(+SIEN,0)),"^",6)="L"&(SRC'>0) "-1^Invalid Code Source"
    97  S MODEFF=$$EFF^ICPTSUPT(81.3,MIEN,VDT) Q:'$P(MODEFF,"^",2) "-1^Modifier Inactive"
    98  S MODNM=$P($G(^DIC(81.3,MIEN,0)),"^",2) Q:'$L(MODNM) "-1^Invalid Modifier Name"
    99  S MODI=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MODI) "-1^Invalid Modifier ID"
    100  S MODST=$$VSTCM^ICPTMOD(MIEN,VDT) K STX S (STA,STI)=0 S CDT=VDT+.001
    101  S (LINA,LACT)="",RSTA=0,RIEN=0 F  S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0  D
    102  . N NSTA S NSTA=0,ND=$G(^DIC(81.3,MIEN,10,RIEN,0))
    103  . S BEGR=$P(ND,"^",1) Q:$L(BEGR)'=5  S 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
    104  . S ENDR=$P(ND,"^",2) S:$L(ENDR)'=5 ENDR=BEGR S ENDA=$S(ENDR?1N.4N:+ENDR,ENDR?4N1A:$A($E(ENDR,5))*10_$E(ENDR,1,4),1:$A(ENDR)_$E(ENDR,2,5))
    105  . Q:$L(ENDR)&(CODEA>ENDA)  S ADT=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101
    106  . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT'>0 S RSTA=1,NSTA=1 S:+ADT>0&(+ADT>(+LACT)) LACT=+ADT
    107  . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT>0,CDT>ADT,CDT'>IDT S RSTA=1,NSTA=1 S:+ADT>0&(+ADT>(+LACT)) LACT=+ADT
    108  . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT>0 S:+IDT>0&(+IDT>(+LINA)) LINA=+IDT
    109  . Q:NSTA'>0  S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) S ADT=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101
    110  . S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) S STA=+($G(STA))+1,STX(STA)=MIEN_"^"_MODST_"^"_BEGR_"^"_ENDR_"^"_ADT_"^"_ICD_"^"_MODI,STX("B",+ADT,+STA)=""
    111  S:+LACT>0&(+LINA>0)&(LINA'>CDT)&(+LINA>+LACT) RSTA=0
    112  S ADT=$O(STX("B",+CDT),-1),STA=$O(STX("B",+ADT," "),-1),MOD=$G(STX(+STA))
    113  Q:+MOD'>0 "0"  Q:+RSTA'>0 "0"
    114  Q MOD
    115  ;           
    116 MODC(MOD) ; Checks modifier for active range including code
     52MODC(MOD) ; Checks modifier for range including code, and active for date desired
    11753 ;
    11854 ; Input:
    … …  
    13268 ;
    13369MULT ; Finds iens for all modifiers with same 2-letter code
    134  ;  MOD = .01, check B x-ref for dupliate .01 fields
    135  ;  Output:
    136  ;     STR - a ";" delimited string of IENS for modifier MOD
     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 ":"
    13772 F MODN=0:0 S MODN=$O(^DIC(81.3,"B",MOD,MODN)) Q:'MODN   S STR=STR_MODN_"; "
    13873 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTPRN.m

    r628 r636  
    11ICPTPRN ;ALB/MTC,RMO,ABR,MRY - CPT PRINT-OUT DRIVER ; 1/03/03 3:21pm
    2  ;;6.0;CPT/HCPCS;**4,8,9,12,13**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**4,8,9,12,13**;May 19, 1997;Build 1
    33 ;
    44 ;modified to sort in code name order using temp global;abr 1/96

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR1.m

    r628 r636  
    11ICPTSR1 ;ALB/ABR,MRY - CPT IENS - REV CPT CODES ; 1/3/03 2:38pm
    2  ;;6.0;CPT/HCPCS;**3,4,8,9,12,13**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**3,4,8,9,12,13**;May 19, 1997;Build 1
    33 ;
    44 ;  This routine points to the ien's of the REVISED CPT codes for 2003

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR10.m

    r628 r636  
    11ICPTSR10 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR11.m

    r628 r636  
    11ICPTSR11 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR12.m

    r628 r636  
    11ICPTSR12 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR13.m

    r628 r636  
    11ICPTSR13 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR14.m

    r628 r636  
    11ICPTSR14 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR15.m

    r628 r636  
    11ICPTSR15 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR16.m

    r628 r636  
    11ICPTSR16 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR17.m

    r628 r636  
    11ICPTSR17 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR18.m

    r628 r636  
    11ICPTSR18 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR19.m

    r628 r636  
    11ICPTSR19 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR2.m

    r628 r636  
    11ICPTSR2 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**3,4,8,9,12,13**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**3,4,8,9,12,13**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR20.m

    r628 r636  
    11ICPTSR20 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR21.m

    r628 r636  
    11ICPTSR21 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR22.m

    r628 r636  
    11ICPTSR22 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR23.m

    r628 r636  
    11ICPTSR23 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR24.m

    r628 r636  
    11ICPTSR24 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR3.m

    r628 r636  
    11ICPTSR3 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**8,9,12,13**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**8,9,12,13**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR4.m

    r628 r636  
    11ICPTSR4 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1 ; 1/28/02 4:17pm
    2  ;;6.0;CPT/HCPCS;**8,9,12**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**8,9,12**;May 19, 1997;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR5.m

    r628 r636  
    11ICPTSR5 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR6.m

    r628 r636  
    11ICPTSR6 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR7.m

    r628 r636  
    11ICPTSR7 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR8.m

    r628 r636  
    11ICPTSR8 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSR9.m

    r628 r636  
    11ICPTSR9 ;CPT CODES - ICPTSRx DATA FILE FOR ICPTSR1
    2  ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001
     2 ;;6.0;CPT/HCPCS;**9,12**;Feb 27, 2001;Build 1
    33 ;
    44 Q

  • FOIAVistA/tag/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTSUPT.m

    r628 r636  
    11ICPTSUPT ;SLC/KER - CPT SUPPORT FOR APIS ; 04/18/2004
    2  ;;6.0;CPT/HCPCS;**14,19**;May 19, 1997
     2 ;;6.0;CPT/HCPCS;**14,19**;May 19, 1997;Build 1
    33 ;
    44 ; External References
Note: See TracChangeset for help on using the changeset viewer.