| [613] | 1 | ICPTSUPT ;SLC/KER - CPT SUPPORT FOR APIS ; 04/18/2004
|
|---|
| 2 | ;;6.0;CPT/HCPCS;**14,19**;May 19, 1997;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10103 $$DT^XLFDT
|
|---|
| 6 | ;
|
|---|
| 7 | EFF(FILE,CODE,EDT) ; Returns Effective Date and Status for Code/Modifier
|
|---|
| 8 | ; Input:
|
|---|
| 9 | ; FILE = file number REQUIRED
|
|---|
| 10 | ; 81 for CPT file
|
|---|
| 11 | ; 81.3 for CPT MODIFIER file
|
|---|
| 12 | ; CODE = CPT CODE ien or CPT MODIFIER ien REQUIRED
|
|---|
| 13 | ; EDT = date to check for (FileMan format) (default = today)
|
|---|
| 14 | ;
|
|---|
| 15 | ; Output: effective date^status^Inactivation Date^Active Date
|
|---|
| 16 | ; where STATUS = 1 = active
|
|---|
| 17 | ; 0 = inactive
|
|---|
| 18 | ; or -1^error message
|
|---|
| 19 | ;
|
|---|
| 20 | ; Variables:
|
|---|
| 21 | ; EFILE = indirect file reference for code
|
|---|
| 22 | ; EFF,EFFDT,EFFDOS = effective dates
|
|---|
| 23 | ; EFFN = sub-entry ien
|
|---|
| 24 | ; EFFST = effective status
|
|---|
| 25 | ; STR = output
|
|---|
| 26 | ;
|
|---|
| 27 | I $G(FILE)="" Q "-1^NO FILE SELECTED"
|
|---|
| 28 | I '(FILE=81!(FILE=81.3)) Q "-1^INVALID FILE"
|
|---|
| 29 | I $G(CODE)="" Q "-1^NO "_$S(FILE=81:"CODE",1:"MODIFIER")_" SELECTED"
|
|---|
| 30 | N EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFB,EFFDOS
|
|---|
| 31 | S EFILE=$S(FILE=81:"^ICPT(",1:"^DIC(81.3,")_CODE_",60,"
|
|---|
| 32 | S EDT=$S($G(EDT)="":$$DT^XLFDT,1:$$DTBR(EDT))+.001 ;date business rules
|
|---|
| 33 | S EFF=$O(@(EFILE_"""B"","_EDT_")"),-1)
|
|---|
| 34 | I 'EFF Q "^0^^"
|
|---|
| 35 | S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) ; node 60 (effective date) sub-entry
|
|---|
| 36 | S STR=$G(@(EFILE_EFFN_",0)"))
|
|---|
| 37 | I STR="" Q "^0^^"
|
|---|
| 38 | ;set Opposite eff. date based on status
|
|---|
| 39 | S EFFDT=$P(STR,"^"),EFFST=$P(STR,"^",2),EFFB=0,EFF=+EFF
|
|---|
| 40 | F S EFF=$O(@(EFILE_"""B"","_EFF_")"),-1) Q:'EFF!EFFB D
|
|---|
| 41 | . S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) I 'EFFN S EFFB=1 Q
|
|---|
| 42 | . S EFFDOS=$G(@(EFILE_EFFN_",0)")) I 'EFFDOS S EFFB=1 Q
|
|---|
| 43 | . S EFFB=(EFFST'=$P(EFFDOS,"^",2))
|
|---|
| 44 | S EFFDOS=$P($G(EFFDOS),"^")
|
|---|
| 45 | I EFFST S $P(STR,"^",3,4)=(EFFDOS)_"^"_EFFDT
|
|---|
| 46 | E S $P(STR,"^",3,4)=EFFDT_"^"_(EFFDOS)
|
|---|
| 47 | Q STR
|
|---|
| 48 | ;
|
|---|
| 49 | DTBR(CDT) ; Date Business Rules
|
|---|
| 50 | ; Input:
|
|---|
| 51 | ; CDT - Code Date to check (FileMan format, default=Today)
|
|---|
| 52 | ;
|
|---|
| 53 | ; Output:
|
|---|
| 54 | ; If CDT < Bus.RuleDflt., use Bus.RuleDflt.
|
|---|
| 55 | ; If CDT is year only, use first of the year
|
|---|
| 56 | ; If CDT is year and month only, use first of the month
|
|---|
| 57 | ;
|
|---|
| 58 | Q:'$G(CDT) $$DT^XLFDT ;nothing passed - use today
|
|---|
| 59 | Q:$L($P(CDT,"."))'=7 $$DT^XLFDT ;bad format - use today
|
|---|
| 60 | I CDT#10000=0 S CDT=CDT+101
|
|---|
| 61 | S:CDT#100=0 CDT=CDT+1
|
|---|
| 62 | Q $S(CDT<2890101:2890101,1:CDT)
|
|---|
| 63 | ;
|
|---|
| 64 | MSG(CDT,CS) ; Inform of Code Text Inaccuracy
|
|---|
| 65 | ;
|
|---|
| 66 | ; Input:
|
|---|
| 67 | ;
|
|---|
| 68 | ; CDT - Code Date to check (FileMan format, Default = today)
|
|---|
| 69 | ; CS - Code System (0:ICD, 1:CPT/HCPCS, 2:DRG, 3:LEX, Default=0)
|
|---|
| 70 | ;
|
|---|
| 71 | ; Output: User Alert
|
|---|
| 72 | ;
|
|---|
| 73 | S CS=+$G(CS) S:CS>3!(CS<0) CS=0
|
|---|
| 74 | S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT))
|
|---|
| 75 | N MSGTXT,MSGDAT S MSGDAT=3021001,MSGTXT="CODE TEXT MAY BE INACCURATE"
|
|---|
| 76 | I CS<3 Q $S(CDT<MSGDAT:MSGTXT,1:"")
|
|---|
| 77 | I CS=3,CDT'<3031001 Q ""
|
|---|
| 78 | Q MSGTXT
|
|---|
| 79 | ;
|
|---|
| 80 | GBL(CODE) ; return Global Node of Code
|
|---|
| 81 | Q:CODE?5N!(CODE?1U4N)!(CODE?4N1U) "^ICPT("
|
|---|
| 82 | Q:CODE?2N!(CODE?2U)!(CODE?1U1N) "^DIC(81.3,"
|
|---|
| 83 | Q ""
|
|---|
| 84 | ;
|
|---|
