Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICPTSUPT

ICPTSUPT.m

Go to the documentation of this file. 
  1. ICPTSUPT ;SLC/KER - CPT SUPPORT FOR APIS ; 04/18/2004
  1.  ;;6.0;CPT/HCPCS;**14,19**;May 19, 1997
  1.  ;
  1.  ; External References
  1.  ;   DBIA  10103  $$DT^XLFDT
  1.  ;                     
  1. EFF(FILE,CODE,EDT) ; Returns Effective Date and Status for Code/Modifier
  1.  ; Input:
  1.  ;    FILE = file number  REQUIRED
  1.  ;           81 for CPT file
  1.  ;           81.3 for CPT MODIFIER file
  1.  ;    CODE = CPT CODE ien or CPT MODIFIER ien REQUIRED
  1.  ;    EDT = date to check for (FileMan format) (default = today)
  1.  ;
  1.  ; Output:    effective date^status^Inactivation Date^Active Date
  1.  ;          where STATUS = 1 = active
  1.  ;                         0 = inactive  
  1.  ;          or -1^error message
  1.  ;
  1.  ; Variables:
  1.  ;   EFILE = indirect file reference for code
  1.  ;   EFF,EFFDT,EFFDOS = effective dates
  1.  ;   EFFN = sub-entry ien
  1.  ;   EFFST = effective status
  1.  ;   STR = output
  1.  ;
  1.  I $G(FILE)="" Q "-1^NO FILE SELECTED"
  1.  I '(FILE=81!(FILE=81.3)) Q "-1^INVALID FILE"
  1.  I $G(CODE)="" Q "-1^NO "_$S(FILE=81:"CODE",1:"MODIFIER")_" SELECTED"
  1.  N EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFB,EFFDOS
  1.  S EFILE=$S(FILE=81:"^ICPT(",1:"^DIC(81.3,")_CODE_",60,"
  1.  S EDT=$S($G(EDT)="":$$DT^XLFDT,1:$$DTBR(EDT))+.001 ;date business rules
  1.  S EFF=$O(@(EFILE_"""B"","_EDT_")"),-1)
  1.  I 'EFF Q "^0^^"
  1.  S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) ; node 60 (effective date) sub-entry
  1.  S STR=$G(@(EFILE_EFFN_",0)"))
  1.  I STR="" Q "^0^^"
  1.  ;set Opposite eff. date based on status
  1.  S EFFDT=$P(STR,"^"),EFFST=$P(STR,"^",2),EFFB=0,EFF=+EFF
  1.  F  S EFF=$O(@(EFILE_"""B"","_EFF_")"),-1) Q:'EFF!EFFB  D
  1.  . S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) I 'EFFN S EFFB=1 Q
  1.  . S EFFDOS=$G(@(EFILE_EFFN_",0)")) I 'EFFDOS S EFFB=1 Q
  1.  . S EFFB=(EFFST'=$P(EFFDOS,"^",2))
  1.  S EFFDOS=$P($G(EFFDOS),"^")
  1.  I EFFST S $P(STR,"^",3,4)=(EFFDOS)_"^"_EFFDT
  1.  E  S $P(STR,"^",3,4)=EFFDT_"^"_(EFFDOS)
  1.  Q STR
  1.  ;
  1. DTBR(CDT) ; Date Business Rules
  1.  ; Input:
  1.  ;   CDT - Code Date to check (FileMan format, default=Today)
  1.  ;
  1.  ; Output:
  1.  ;   If CDT < Bus.RuleDflt., use Bus.RuleDflt.
  1.  ;   If CDT is year only, use first of the year
  1.  ;   If CDT is year and month only, use first of the month
  1.  ;
  1.  Q:'$G(CDT) $$DT^XLFDT ;nothing passed - use today
  1.  Q:$L($P(CDT,"."))'=7 $$DT^XLFDT ;bad format - use today
  1.  I CDT#10000=0 S CDT=CDT+101
  1.  S:CDT#100=0 CDT=CDT+1
  1.  Q $S(CDT<2890101:2890101,1:CDT)
  1.  ;
  1. MSG(CDT,CS)     ; Inform of Code Text Inaccuracy
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   CDT - Code Date to check (FileMan format, Default = today)
  1.  ;   CS - Code System (0:ICD, 1:CPT/HCPCS, 2:DRG, 3:LEX, Default=0)
  1.  ;
  1.  ; Output: User Alert
  1.  ;
  1.  S CS=+$G(CS) S:CS>3!(CS<0) CS=0
  1.  S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT))
  1.  N MSGTXT,MSGDAT S MSGDAT=3021001,MSGTXT="CODE TEXT MAY BE INACCURATE"
  1.  I CS<3 Q $S(CDT<MSGDAT:MSGTXT,1:"")
  1.  I CS=3,CDT'<3031001 Q ""
  1.  Q MSGTXT
  1.  ;
  1. GBL(CODE) ; return Global Node of Code
  1.  Q:CODE?5N!(CODE?1U4N)!(CODE?4N1U) "^ICPT("
  1.  Q:CODE?2N!(CODE?2U)!(CODE?1U1N) "^DIC(81.3,"
  1.  Q ""
  1.  ;