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

ICPTAPIU.m

Go to the documentation of this file.
  1. ICPTAPIU ;ALB/DEK/KER - CPT UTILITIES FOR APIS ; 04/18/2004
  1. ;;6.0;CPT/HCPCS;**1,6,12,14,16,19,22**;May 19, 1997
  1. ;
  1. ; External References
  1. ; DBIA 10011 ^DIWP
  1. ; DBIA 10029 ^DIWW
  1. ; DBIA 10103 $$DT^XLFDT
  1. ;
  1. CPTDIST() ; Distribution Date
  1. ; Input: none (extrinsic variable)
  1. ; Output: returns DISTRIBUTION DATE, date codes effective in Austin
  1. Q $P($G(^DIC(81.2,1,0)),"^",2)
  1. ;
  1. CAT(CAT,DFN) ; Return CATEGORY NAME given IEN
  1. ; Input: CAT = category ien REQUIRED
  1. ; DFN - not in use but included in anticipation of future need
  1. ;
  1. ; Output: STR = CATEGORY NAME^SOURCE (C or H)^MAJOR CATEGORY IEN^MAJOR CATEGORY NAME
  1. ; STR = -1^error message, if error condition occurred
  1. ;
  1. N CATN,STR,MCATIEN,MCATNM
  1. S (MCATIEN,MCATNM)=""
  1. I $G(CAT)="" S STR="-1^NO CATEGORY SELECTED" G CATQ
  1. I '$G(CAT) S STR="-1^INVALID CATEGORY FORMAT" G CATQ
  1. S STR=$G(^DIC(81.1,+CAT,0))
  1. I '$L(STR) S STR="-1^NO SUCH CATEGORY" G CATQ
  1. I $P(STR,"^",2)="" S STR="-1^TYPE OF CATEGORY UNSPECIFIED" G CATQ
  1. S CATN=$P(STR,"^")
  1. I $P(STR,"^",2)="m" S MCATNM=CATN,MCATIEN=+CAT
  1. I $P(STR,"^",2)="s" D
  1. . S MCATIEN=$P(STR,"^",3)
  1. . I MCATIEN S MCATNM=$P($G(^DIC(81.1,MCATIEN,0)),"^")
  1. S STR=CATN_"^"_$P(STR,"^",6)_"^"_MCATIEN_"^"_MCATNM
  1. CATQ Q STR
  1. ;
  1. NUM(Y) ; Convert CPT/HCPCS Code to Numeric
  1. ; Convert HCPCS to $A() of Alpha _ Numeric Portion
  1. ;
  1. ; Input: Y - CPT or HCPCS code
  1. ;
  1. ; Output: 'plussed' value for CPT code,
  1. ; numeric for HCPCS based on $A of 1st character (alpha)
  1. ; concatenated with the 4-digit portion of code
  1. ;
  1. ; **This does not convert to ien**
  1. ; This converts to a numeric that may be used for range sorting
  1. ;
  1. ;Q $S(Y:+Y,1:$A(Y)_$E(Y,2,5))
  1. ; modified in 2002 to handle few CPT codes that end with "T"
  1. ; needed to add multiplier to create higher and unique number
  1. ; e.g. "Z9999"=909999 and "0001T"=8400001
  1. Q $S(Y?1.N:+Y,Y?4N1A:$A($E(Y,5))*10_$E(Y,1,4),1:$A(Y)_$E(Y,2,5))
  1. ;
  1. COPY ; API to Print Copyright Information
  1. ;
  1. N DIR,DIWL,DIWR,DIWF,VARR,VAXX,X
  1. Q:'$D(^DIC(81.2,1)) K ^UTILITY($J,"W")
  1. W !!! S DIWL=1,DIWR=80,DIWF="W"
  1. F VARR=0:0 S VARR=$O(^DIC(81.2,1,1,VARR)) Q:VARR'>0 S VAXX=^(VARR,0),X=VAXX D ^DIWP
  1. D:$D(VAXX) ^DIWW
  1. Q
  1. ;
  1. STATCHK(CODE,CDT) ; Check Status of CPT Code or Modifier
  1. ; Input:
  1. ; CODE - CPT Code/Modifier REQUIRED
  1. ; CDT - Date to screen against (FileMan format, default = today)
  1. ;
  1. ; Output:
  1. ; 2-Piece String containing the status of the code/modifier
  1. ; and the IEN if the code/modifier exists, else -1.
  1. ; The following are possible outputs:
  1. ; 1 ^ IEN Active Code/Modifier
  1. ; 0 ^ IEN Inactive Code/Modifier
  1. ; 0 ^ -1 Code/Modifier not Found
  1. ;
  1. ; This API requires the ACT Cross-Reference
  1. ; ^ICPT("ACT",<code>,<status>,<date>,<ien>)
  1. ; ^DIC(81.3,"ACT",<code>,<status>,<date>,<ien>)
  1. ;
  1. N ICPTC,ICPTD,ICPTIEN,ICPTA,ICPTI,X,ICPTG,ICPTR,ICPTD
  1. S ICPTC=$G(CODE) Q:'$L(ICPTC) "0^-1"
  1. ; Case 1: Not Valid 0^-1
  1. ; Fails Pattern Match for Code
  1. S ICPTG=$$GBL^ICPTSUPT(ICPTC) Q:ICPTG="" "0^-1"
  1. ; Case 2: Never Active 0^IEN
  1. ; No In/Active Date
  1. S ICPTD=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICPTSUPT($G(CDT))),ICPTD=ICPTD+.001
  1. S ICPTR=$$ACT(ICPTG,ICPTC,1,ICPTD),ICPTA=$O(@(ICPTR_")"),-1)
  1. I '$L(ICPTA) D Q X
  1. . S ICPTA=$O(@(ICPTR_")")),X="0^-1" Q:'$L(ICPTA)
  1. . S ICPTR=$$ACT(ICPTG,ICPTC,1,ICPTA)
  1. . S ICPTIEN=$O(@(ICPTR_",0)")) S:+ICPTIEN<1 ICPTIEN=-1
  1. . S X="0^"_ICPTIEN
  1. ; Case 3: Active, Never Inactive 1^IEN
  1. ; Has an Activation Date
  1. ; No Inactivation Date
  1. S ICPTR=$$ACT(ICPTG,ICPTC,0,ICPTD),ICPTI=$O(@(ICPTR_")"),-1)
  1. I $L(ICPTA),'$L(ICPTI) D Q X
  1. . S ICPTR=$$ACT(ICPTG,ICPTC,1,ICPTA),ICPTIEN=$O(@(ICPTR_",0)"))
  1. . S X=$S(+ICPTIEN=0:"0^-1",1:"1^"_ICPTIEN)
  1. ; Case 4: Active, but later Inactivated 0^IEN
  1. ; Has an In/Activation Date
  1. I $L(ICPTA),$L(ICPTI),ICPTI>ICPTA,ICPTI<ICPTD D Q X
  1. . S ICPTR=$$ACT(ICPTG,ICPTC,0,ICPTI),ICPTIEN=$O(@(ICPTR_",0)"))
  1. . S X=$S(+ICPTIEN=0:"0^-1",1:"0^"_ICPTIEN)
  1. ; Case 5: Active, and not later Inactivated 1^IEN
  1. ; Has an In/Activation Date
  1. ; Has a Newer Activation Date
  1. I $L(ICPTA),$L(ICPTI),ICPTI'>ICPTA D Q X
  1. . S ICPTR=$$ACT(ICPTG,ICPTC,0,ICPTI),ICPTIEN=$O(@(ICPTR_",1)"))
  1. . S X=$S(+$O(@(ICPTR_",0)"))=0:"0^-1",1:"1^"_ICPTIEN)
  1. ; Case 6: Fails Time Test 0^-1
  1. Q ("0^"_$S(+($G(ICPTIEN))>0:+($G(ICPTIEN)),1:"-1"))
  1. ;
  1. NEXT(CODE) ; Next CPT Code or Modifier (active or inactive)
  1. ; Input:
  1. ; CODE = CPT Code/Modifier REQUIRED
  1. ;
  1. ; Output:
  1. ; The Next CPT Code/Modifier, Null if none
  1. ;
  1. N ICPTC,ICPTG
  1. S ICPTC=$G(CODE) Q:'$L(ICPTC) ""
  1. S ICPTG=$$GBL^ICPTSUPT(ICPTC) Q:'$L(ICPTG) ""
  1. S ICPTC=$O(@(ICPTG_"""BA"","""_ICPTC_" "")"))
  1. Q $S(ICPTC="":"",1:$E(ICPTC,1,$L(ICPTC)-1))
  1. ;
  1. PREV(CODE) ; Previous CPT Code or Modifier (active or inactive)
  1. ; Input:
  1. ; CODE = CPT Code/Modifier REQUIRED
  1. ;
  1. ; Output:
  1. ; The Previous CPT Code/Modifier, Null if none
  1. ;
  1. N ICPTC,ICPTG
  1. S ICPTC=$G(CODE) Q:'$L(ICPTC) ""
  1. S ICPTG=$$GBL^ICPTSUPT(ICPTC) Q:'$L(ICPTG) ""
  1. S ICPTC=$O(@(ICPTG_"""BA"","""_ICPTC_" "")"),-1)
  1. Q $S(ICPTC="":"",1:$E(ICPTC,1,$L(ICPTC)-1))
  1. ;
  1. HIST(CODE,ARY) ; Activation History
  1. ; Input:
  1. ; CODE - CPT Code or Modifier REQUIRED
  1. ; .ARY - Array, passed by Reference REQUIRED
  1. ;
  1. ; Output: Mirrors ARY(0) (or, -1 on error)
  1. ; ARY(0) = Number of Activation History Entries
  1. ; ARY(<date>) = status where: 1 is Active
  1. ; ARY("IEN") = <ien>
  1. ;
  1. Q:$G(CODE)="" -1
  1. N ICPTC,ICPTI,ICPTN,ICPTD,ICPTG,ICPTF,ICPTO
  1. S ICPTG=$$GBL^ICPTSUPT(CODE) Q:'$L(ICPTG) -1
  1. S ICPTI=$O(@(ICPTG_"""BA"","""_CODE_" "",0)")) Q:'$L(ICPTI) -1
  1. S ARY("IEN")=ICPTI,ICPTO="" M ICPTO=@(ICPTG_ICPTI_",60)")
  1. K ICPT0("B") S ARY(0)=+($P($G(ICPTO(0)),"^",4))
  1. S:+ARY(0)=0 ARY(0)=-1 K:ARY(0)=-1 ARY("IEN")
  1. S (ICPTI,ICPTC)=0 F S ICPTI=$O(ICPTO(ICPTI)) Q:+ICPTI=0 D
  1. . S ICPTD=$P($G(ICPTO(ICPTI,0)),"^",1) Q:+ICPTD=0
  1. . S ICPTF=$P($G(ICPTO(ICPTI,0)),"^",2) Q:'$L(ICPTF)
  1. . S ICPTC=ICPTC+1,ARY(0)=ICPTC,ARY(ICPTD)=ICPTF
  1. Q ARY(0)
  1. ;
  1. PERIOD(CODE,ARY) ; return Activation/Inactivation Period in ARY
  1. ;
  1. ; Output: ARY(0) = String: IEN^Selectable
  1. ;
  1. ; Where the pieces are:
  1. ;
  1. ; 1 Internal Entry Number of code in ^ICPT or ^DIC(81.3,
  1. ; 2 0:unselectable; 1:selectable
  1. ;
  1. ; ARY(Activation Date) = Inactivation Date^Short Name
  1. ; Where the Short Name is the Versioned text (field 1 of the 61
  1. ; multiple), and the text is versioned as follows:
  1. ;
  1. ; Period is active - Versioned text for TODAY's date
  1. ; Period is inactive - Versioned text for inactivation date
  1. ;
  1. ; or
  1. ;
  1. ; -1^0 (no period or error)
  1. ;
  1. I $G(CODE)="" S ARY(0)="-1^0" Q
  1. N ICPTC,ICPTI,ICPTA,ICPTG,ICPTF,ICPTBA,ICPTBI,ICPTST,ICPTS,ICPTZ,ICPTV,ICPTN,ICPTCA
  1. S ICPTG=$$GBL^ICPTSUPT(CODE) I ICPTG="" S ARY(0)="-1^0" Q
  1. S ICPTC=$O(@(ICPTG_"""BA"","""_CODE_" "",0)")) I ICPTC="" S ARY(0)="-1^0" Q
  1. S (ARY(0),ICPTC)=+ICPTC,ICPTZ=$G(@(ICPTG_ICPTC_",0)")),ICPTS=$P(ICPTZ,"^",2)
  1. S $P(ARY(0),"^",2)=$S(ICPTG="^ICPT(":$P(ICPTZ,"^",6)'="L",1:$P(ICPTZ,"^",4)'="V")
  1. S (ICPTA,ICPTBA)=0,ICPTG=ICPTG_ICPTC_",60,"
  1. ; Versioned text for TODAY
  1. S ICPTN=$$VST^ICPTCOD(ICPTC,$$DT^XLFDT,ICPTG)
  1. F Q:ICPTBA D
  1. . S ICPTA=$O(@(ICPTG_"""B"","_ICPTA_")"))
  1. . I ICPTA="" S ICPTBA=1 Q
  1. . S ICPTF=$O(@(ICPTG_"""B"","_ICPTA_",0)"))
  1. . I '+ICPTF S ICPTBA=1 Q
  1. . S ICPTST=$P($G(@(ICPTG_ICPTF_",0)")),"^",2)
  1. . Q:'ICPTST ;outer loop looks for active
  1. . ; Versioned text for activation date
  1. . S ICPTV=$$VST^ICPTCOD(ICPTC,ICPTA,ICPTG),ICPTCA=1
  1. . S ARY(ICPTA)="^"_ICPTS,ICPTBI=0,ICPTI=ICPTA
  1. . S:$L(ICPTV) $P(ARY(ICPTA),"^",2)=ICPTV
  1. . F Q:ICPTBI D
  1. . . S ICPTI=$O(@(ICPTG_"""B"","_ICPTI_")"))
  1. . . ; If no inactivation date for ICPTA then use TODAY's text
  1. . . I ICPTI="" S ARY(ICPTA)="^"_ICPTN,(ICPTBI,ICPTBA)=1 Q
  1. . . S ICPTF=$O(@(ICPTG_"""B"","_ICPTI_",0)"))
  1. . . ; If no effective date ICPTF for ICPTI then use TODAY's text
  1. . . I '+ICPTF S ARY(ICPTA)="^"_ICPTN,(ICPTBI,ICPTBA)=1 Q
  1. . . S ICPTST=$P($G(@(ICPTG_ICPTF_",0)")),"^",2)
  1. . . ; If Status ICPTST not Inactive then use TODAY's text
  1. . . I ICPTST S ARY(ICPTA)="^"_ICPTN,ICPTBI=1 Q
  1. . . ; Versioned text for inactive date
  1. . . S ICPTV=$$VST^ICPTCOD(ICPTC,ICPTI,ICPTG)
  1. . . S $P(ARY(ICPTA),"^")=ICPTI
  1. . . S:$L(ICPTV) $P(ARY(ICPTA),"^",2)=ICPTV
  1. . . S ICPTCA=0,ICPTBI=1,ICPTA=ICPTI
  1. Q
  1. ;
  1. ACT(ICPTG,ICPTC,ICPTS,ICPTD) ; return "ACT" root
  1. Q ICPTG_"""ACT"","""_ICPTC_" "","_ICPTS_","_ICPTD