ICPTSUPT ;SLC/KER - CPT SUPPORT FOR APIS ; 04/18/2004
;;6.0;CPT/HCPCS;**14,19**;May 19, 1997
;
; External References
; DBIA 10103 $$DT^XLFDT
;
EFF(FILE,CODE,EDT) ; Returns Effective Date and Status for Code/Modifier
; Input:
; FILE = file number REQUIRED
; 81 for CPT file
; 81.3 for CPT MODIFIER file
; CODE = CPT CODE ien or CPT MODIFIER ien REQUIRED
; EDT = date to check for (FileMan format) (default = today)
;
; Output: effective date^status^Inactivation Date^Active Date
; where STATUS = 1 = active
; 0 = inactive
; or -1^error message
;
; Variables:
; EFILE = indirect file reference for code
; EFF,EFFDT,EFFDOS = effective dates
; EFFN = sub-entry ien
; EFFST = effective status
; STR = output
;
I $G(FILE)="" Q "-1^NO FILE SELECTED"
I '(FILE=81!(FILE=81.3)) Q "-1^INVALID FILE"
I $G(CODE)="" Q "-1^NO "_$S(FILE=81:"CODE",1:"MODIFIER")_" SELECTED"
N EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFB,EFFDOS
S EFILE=$S(FILE=81:"^ICPT(",1:"^DIC(81.3,")_CODE_",60,"
S EDT=$S($G(EDT)="":$$DT^XLFDT,1:$$DTBR(EDT))+.001 ;date business rules
S EFF=$O(@(EFILE_"""B"","_EDT_")"),-1)
I 'EFF Q "^0^^"
S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) ; node 60 (effective date) sub-entry
S STR=$G(@(EFILE_EFFN_",0)"))
I STR="" Q "^0^^"
;set Opposite eff. date based on status
S EFFDT=$P(STR,"^"),EFFST=$P(STR,"^",2),EFFB=0,EFF=+EFF
F S EFF=$O(@(EFILE_"""B"","_EFF_")"),-1) Q:'EFF!EFFB D
. S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) I 'EFFN S EFFB=1 Q
. S EFFDOS=$G(@(EFILE_EFFN_",0)")) I 'EFFDOS S EFFB=1 Q
. S EFFB=(EFFST'=$P(EFFDOS,"^",2))
S EFFDOS=$P($G(EFFDOS),"^")
I EFFST S $P(STR,"^",3,4)=(EFFDOS)_"^"_EFFDT
E S $P(STR,"^",3,4)=EFFDT_"^"_(EFFDOS)
Q STR
;
DTBR(CDT) ; Date Business Rules
; Input:
; CDT - Code Date to check (FileMan format, default=Today)
;
; Output:
; If CDT < Bus.RuleDflt., use Bus.RuleDflt.
; If CDT is year only, use first of the year
; If CDT is year and month only, use first of the month
;
Q:'$G(CDT) $$DT^XLFDT ;nothing passed - use today
Q:$L($P(CDT,"."))'=7 $$DT^XLFDT ;bad format - use today
I CDT#10000=0 S CDT=CDT+101
S:CDT#100=0 CDT=CDT+1
Q $S(CDT<2890101:2890101,1:CDT)
;
MSG(CDT,CS) ; Inform of Code Text Inaccuracy
;
; Input:
;
; CDT - Code Date to check (FileMan format, Default = today)
; CS - Code System (0:ICD, 1:CPT/HCPCS, 2:DRG, 3:LEX, Default=0)
;
; Output: User Alert
;
S CS=+$G(CS) S:CS>3!(CS<0) CS=0
S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT))
N MSGTXT,MSGDAT S MSGDAT=3021001,MSGTXT="CODE TEXT MAY BE INACCURATE"
I CS<3 Q $S(CDT<MSGDAT:MSGTXT,1:"")
I CS=3,CDT'<3031001 Q ""
Q MSGTXT
;
GBL(CODE) ; return Global Node of Code
Q:CODE?5N!(CODE?1U4N)!(CODE?4N1U) "^ICPT("
Q:CODE?2N!(CODE?2U)!(CODE?1U1N) "^DIC(81.3,"
Q ""
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPTSUPT 2937 printed Dec 13, 2024@01:46:11 Page 2
ICPTSUPT ;SLC/KER - CPT SUPPORT FOR APIS ; 04/18/2004
+1 ;;6.0;CPT/HCPCS;**14,19**;May 19, 1997
+2 ;
+3 ; External References
+4 ; DBIA 10103 $$DT^XLFDT
+5 ;
EFF(FILE,CODE,EDT) ; Returns Effective Date and Status for Code/Modifier
+1 ; Input:
+2 ; FILE = file number REQUIRED
+3 ; 81 for CPT file
+4 ; 81.3 for CPT MODIFIER file
+5 ; CODE = CPT CODE ien or CPT MODIFIER ien REQUIRED
+6 ; EDT = date to check for (FileMan format) (default = today)
+7 ;
+8 ; Output: effective date^status^Inactivation Date^Active Date
+9 ; where STATUS = 1 = active
+10 ; 0 = inactive
+11 ; or -1^error message
+12 ;
+13 ; Variables:
+14 ; EFILE = indirect file reference for code
+15 ; EFF,EFFDT,EFFDOS = effective dates
+16 ; EFFN = sub-entry ien
+17 ; EFFST = effective status
+18 ; STR = output
+19 ;
+20 IF $GET(FILE)=""
QUIT "-1^NO FILE SELECTED"
+21 IF '(FILE=81!(FILE=81.3))
QUIT "-1^INVALID FILE"
+22 IF $GET(CODE)=""
QUIT "-1^NO "_$SELECT(FILE=81:"CODE",1:"MODIFIER")_" SELECTED"
+23 NEW EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFB,EFFDOS
+24 SET EFILE=$SELECT(FILE=81:"^ICPT(",1:"^DIC(81.3,")_CODE_",60,"
+25 ;date business rules
SET EDT=$SELECT($GET(EDT)="":$$DT^XLFDT,1:$$DTBR(EDT))+.001
+26 SET EFF=$ORDER(@(EFILE_"""B"","_EDT_")"),-1)
+27 IF 'EFF
QUIT "^0^^"
+28 ; node 60 (effective date) sub-entry
SET EFFN=$ORDER(@(EFILE_"""B"","_EFF_",0)"))
+29 SET STR=$GET(@(EFILE_EFFN_",0)"))
+30 IF STR=""
QUIT "^0^^"
+31 ;set Opposite eff. date based on status
+32 SET EFFDT=$PIECE(STR,"^")
SET EFFST=$PIECE(STR,"^",2)
SET EFFB=0
SET EFF=+EFF
+33 FOR
SET EFF=$ORDER(@(EFILE_"""B"","_EFF_")"),-1)
if 'EFF!EFFB
QUIT
Begin DoDot:1
+34 SET EFFN=$ORDER(@(EFILE_"""B"","_EFF_",0)"))
IF 'EFFN
SET EFFB=1
QUIT
+35 SET EFFDOS=$GET(@(EFILE_EFFN_",0)"))
IF 'EFFDOS
SET EFFB=1
QUIT
+36 SET EFFB=(EFFST'=$PIECE(EFFDOS,"^",2))
End DoDot:1
+37 SET EFFDOS=$PIECE($GET(EFFDOS),"^")
+38 IF EFFST
SET $PIECE(STR,"^",3,4)=(EFFDOS)_"^"_EFFDT
+39 IF '$TEST
SET $PIECE(STR,"^",3,4)=EFFDT_"^"_(EFFDOS)
+40 QUIT STR
+41 ;
DTBR(CDT) ; Date Business Rules
+1 ; Input:
+2 ; CDT - Code Date to check (FileMan format, default=Today)
+3 ;
+4 ; Output:
+5 ; If CDT < Bus.RuleDflt., use Bus.RuleDflt.
+6 ; If CDT is year only, use first of the year
+7 ; If CDT is year and month only, use first of the month
+8 ;
+9 ;nothing passed - use today
if '$GET(CDT)
QUIT $$DT^XLFDT
+10 ;bad format - use today
if $LENGTH($PIECE(CDT,"."))'=7
QUIT $$DT^XLFDT
+11 IF CDT#10000=0
SET CDT=CDT+101
+12 if CDT#100=0
SET CDT=CDT+1
+13 QUIT $SELECT(CDT<2890101:2890101,1:CDT)
+14 ;
MSG(CDT,CS) ; Inform of Code Text Inaccuracy
+1 ;
+2 ; Input:
+3 ;
+4 ; CDT - Code Date to check (FileMan format, Default = today)
+5 ; CS - Code System (0:ICD, 1:CPT/HCPCS, 2:DRG, 3:LEX, Default=0)
+6 ;
+7 ; Output: User Alert
+8 ;
+9 SET CS=+$GET(CS)
if CS>3!(CS<0)
SET CS=0
+10 SET CDT=$SELECT($GET(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT))
+11 NEW MSGTXT,MSGDAT
SET MSGDAT=3021001
SET MSGTXT="CODE TEXT MAY BE INACCURATE"
+12 IF CS<3
QUIT $SELECT(CDT<MSGDAT:MSGTXT,1:"")
+13 IF CS=3
IF CDT'<3031001
QUIT ""
+14 QUIT MSGTXT
+15 ;
GBL(CODE) ; return Global Node of Code
+1 if CODE?5N!(CODE?1U4N)!(CODE?4N1U)
QUIT "^ICPT("
+2 if CODE?2N!(CODE?2U)!(CODE?1U1N)
QUIT "^DIC(81.3,"
+3 QUIT ""
+4 ;
