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

ACPT28PA.m

Go to the documentation of this file. 
  1. ACPT28PA ;IHS/VEN/TOAD - ACPT*2.08*1 postinit ; 04/21/2008 11:06
  1.  ;;2.08;CPT FILES;**1**;DEC 17, 2007
  1.  ;
  1.  ; This is the post-init for ACPT*2.08*1, which calls it at IMPORT.
  1.  ; It imports the HCPCS 2008 data from the American Medical Association's
  1.  ; text files acpt2008.01h (HCPCS 2008 codeset) and acpt2008.01c (HCPCS
  1.  ; 2008 modifiers) and installs them in the CPT (81) and CPT Modifier
  1.  ; files (9999999.88).
  1.  ;
  1.  QUIT  ; This routine should not be called at the top or anywhere
  1.  ; else. It is only to be called at IMPORT by KIDS as the post-init
  1.  ; for ACPT*2.08*1.
  1.  ;
  1.  ; 2008 03-04 Rick Marshall rewrote this set of routines to handle ONLY
  1.  ; the HCPCS codeset. Previous versions of this routine contained code to
  1.  ; handle all three ranges of the CPT codes; for any given codeset's
  1.  ; release the code that did not apply was commented out for each patch.
  1.  ; This change was made because the shared code had grown too complex and 
  1.  ; fragile to work consistently. From now on, separate sets of routines
  1.  ; will be written for each release to keep the code clean and
  1.  ; consistent. As part of the refactoring, all unnecessary subroutines
  1.  ; were folded into the main procedure to simplify the flow of control.
  1.  ; ACPTPOST was renamed ACPT28PA to make it fit the standard for pre-
  1.  ; and post-inits (ACPT28P1 is the pre-init). LOADCODE and CLEAN were
  1.  ; split out into a new routine, ACPT28PC, to keep ACPT28PA within the
  1.  ; 10,000-character routine-portability limit. Likewise, step 3 was split 
  1.  ; out into a new routine, ACPT28PB, so it could be expanded to clean up
  1.  ; data integrity problems in existing HCPCS entries. The patch's
  1.  ; original post-init called routine ACPT27P2, which cleaned up pseudo-
  1.  ; entries in the indexes, leaving ACPTPOST to be called manually; it
  1.  ; has been folded into this routine as the second part of step 3. I also
  1.  ; have removed all prompts form this routine and replaced the prompt
  1.  ; about the files' directory with a KIDS question, whose input appears
  1.  ; in this routine in XPDQUES("POST1").
  1.  ;
  1.  ; The original unrefactored code was written by IHS/ASDST/DMJ and Shonda
  1.  ; Render (SDR).
  1.  ;
  1.  ; There are three levels of CPT codes: 1) CPT level one, 2) HCPCS, and
  1.  ; 3) CPT level three.
  1.  ;
  1.  ; CPT level-one codes are completely numeric. In VISTA's CPT file they
  1.  ; make up the first range of entries (IENs with five or fewer digits),
  1.  ; whose IENs equal their code value.
  1.  ;
  1.  ; HCPCS codes are a letter followed by four digits. In the CPT file they
  1.  ; make up the second range of entries (IENs with six digits), divided
  1.  ; into two subranges: older HCPCS codes with arbitrary IENs from 100,000 
  1.  ; to 103,863, and newer HCPCS codes that are DINUMed to their code value 
  1.  ; by replacing the lead letter with its ASCII value, yielding IENs from
  1.  ; 650,300 (for A0300) to 865,298 (for V5298), though the complete
  1.  ; possible range is from 650,001 (A0001) to 909,999 (Z9999).
  1.  ;
  1.  ; The CPT file then contains an obsolete range of entries (with seven-
  1.  ; digit IENs) made up of two subranges: local codes (IENs from 1,000,000 
  1.  ; to 9,990,000) which can no longer be used because of HIPAA, and forty-
  1.  ; four CPT level-three codes (0001T to 0044T, stored from 9,990,001 to
  1.  ; 9,990,044) that have been inactivated and replaced by corresponding
  1.  ; entries in the fourth range.
  1.  ;
  1.  ; All active CPT level-three codes are four digits followed by a letter.
  1.  ; In the CPT file they make up the fourth range of entries (IENs with
  1.  ; ten digits). The IENs for these codes are DINUMed to their code values 
  1.  ; by replacing all five characters with their ASCII code values,
  1.  ; yielding IENs from 4848484965 (for 0001A) to 5757575790 (for 9999Z).
  1.  ;
  1.  ; This version of the postinit is entirely concerned with the HCPCS
  1.  ; codes.
  1.  ;
  1.  ;
  1. IMPORT ; ACPT*2.08*1 POST-INIT: Import HCPCS Codes & Modifiers form AMA files
  1.  ;
  1.  ;
  1.  ; 1. Tell user what we are about to do
  1.  ;
  1.  ;
  1.  D BMES^XPDUTL($$T("MSG+1")) ; ACPT*2.08*1 POST-INIT
  1.  D BMES^XPDUTL($$T("MSG+2")) ; HCPCS 2008 Install (CPT Version 2.08 ...
  1.  ; CPT version 2.08 patch 1 contains HCPCS codes & Modifiers for 2008.
  1.  D MES^XPDUTL($$T("MSG+3"))
  1.  ; The install will attempt to read the the HCPCS Description file
  1.  D MES^XPDUTL($$T("MSG+4"))
  1.  ; (acpt2008.01h) and HCPCS Modifiers file (acpt2008.c) from the
  1.  D MES^XPDUTL($$T("MSG+5"))
  1.  D MES^XPDUTL($$T("MSG+6")) ; directory you specified.
  1.  ;
  1.  ;
  1.  ; 2. Get the directory containing the two files
  1.  ;
  1.  ;
  1.  N ACPTPTH S ACPTPTH=$G(XPDQUES("POST1")) ; path to files
  1.  I ACPTPTH="" D  ; for testing at programmer mode
  1.  . S ACPTPTH=$G(^XTV(8989.3,1,"DEV")) ; default directory
  1.  . D POST1^ACPT28PF(.ACPTPTH) ; input transform
  1.  ;
  1.  ;
  1.  ; 3. prep existing HCPCS entries in site's CPT file
  1.  ;
  1.  ;
  1.  ; Cleaning up existing HCPCS entries & setting Year Deleted field.
  1.  D BMES^XPDUTL($$T("MSG+7"))
  1.  N ACPTYR S ACPTYR=3080000 ; current year in FM format, important flag
  1.  D PREPCODE^ACPT28PB
  1.  ;
  1.  D BMES^XPDUTL($$T("MSG+8")) ; Cleaning out false entries.
  1.  D
  1.  . N ACPTIEN S ACPTIEN=" "
  1.  . F  S ACPTIEN=$O(^ICPT(ACPTIEN)) Q:ACPTIEN=""  D
  1.  . . Q:+ACPTIEN=ACPTIEN
  1.  . . Q:$P($G(^ICPT(ACPTIEN,0)),U)'=""
  1.  . . Q:(ACPTIEN="BA")!(ACPTIEN="C")!(ACPTIEN="D")!(ACPTIEN="I")
  1.  . . Q:(ACPTIEN="B")&'$D(^ICPT(ACPTIEN,0))  ; entries like ^ICPT("B",0)
  1.  . . D MES^XPDUTL(ACPTIEN_"   "_$G(^ICPT(ACPTIEN,0)))
  1.  . . K ^ICPT(ACPTIEN)
  1.  ;
  1.  ;
  1.  ; 4. load HCPCS 2008 codes and modifiers from AMA files
  1.  ;
  1.  ;
  1.  ; Installing 2008 HCPCS codes from file acpt2008.01h
  1.  D BMES^XPDUTL($$T("MSG+9"))
  1.  D LOADCODE^ACPT28PC ; step 4.1
  1.  ;
  1.  ; Loading 2008 HCPCS modifiers from file acpt2008.01c
  1.  D BMES^XPDUTL($$T("MSG+10"))
  1.  D LOADMOD^ACPT28PD ; step 4.2
  1.  ;
  1.  ; Reindexing CPT file (81); this will take awhile.
  1.  D BMES^XPDUTL($$T("MSG+11"))
  1.  D  ; step 4.3
  1.  . N DA,DIK S DIK="^ICPT(" ; CPT file's global root
  1.  . D IXALL^DIK ; set all cross-references for all records
  1.  . D ^ACPTCXR ; rebuild C index for all records
  1.  ;
  1.  ; Reindexing CPT Modifier file (9999999.88).
  1.  D BMES^XPDUTL($$T("MSG+12"))
  1.  D  ; step 4.4
  1.  . N DIK S DIK="^AUTTCMOD(" ; MODIFIER file's global root
  1.  . D IXALL^DIK ; set all cross-references for all records
  1.  ;
  1.  ;
  1.  ; 5. if CPT file is missing from Local Lookup file (8984.4), add it
  1.  ;
  1.  ;
  1.  I '$D(^XT(8984.4,81,0)) D  ; if an entry for CPT (81) is not defined:
  1.  . ; Adding CPT file to Local Lookup file (8984.4).
  1.  . D BMES^XPDUTL($$T("MSG+13"))
  1.  . I '$D(^DIC(8984.4)) D  Q
  1.  . . ; Cannot add CPT file because Local Lookup file is missing.
  1.  . . D MES^XPDUTL($$T("MSG+14"))
  1.  . ;
  1.  . D  Q:Y<0  ; add CPT to Local Lookup file with a LAYGO lookup
  1.  . . N DLAYGO S DLAYGO=8984.4 ; override security restrictions on LAYGO
  1.  . . N DIC S DIC="^XT(8984.4," ; global root of Local Lookup file
  1.  . . S DIC(0)="LX" ; LAYGO, exact match
  1.  . . N X S X=81 ; CPT file
  1.  . . N DA,DTOUT,DUOUT ; unused input & outputs
  1.  . . D ^DIC ; lookup
  1.  . ;
  1.  . D  ; set the .03 field of the new entry to "C"
  1.  . . N DA S DA=+Y ; entry added by LAYGO lookup
  1.  . . N DIE S DIE="^XT(8984.4," ; edit Local Lookup file
  1.  . . S DR=".03////C" ; stuff "C" as the field's value
  1.  . . N DIDEL,DTOUT ; unused input & outputs
  1.  . . D ^DIE ; edit
  1.  . ;
  1.  . D MES^XPDUTL($$T("MSG+15")) ; File 81 added.
  1.  ;
  1.  ;
  1.  ; 6. activate 2008 HCPCS codes, deactivate deleted ones
  1.  ;
  1.  ;
  1.  I ACPTYR>DT D  ; for future: queue this step if not yet time to activate
  1.  . N ZTRTN S ZTRTN="STEP6^ACPT28PE" ; entry point
  1.  . N ZTDESC ; description
  1.  . S ZTDESC="ACPT*2.08*1 post-init: activate/deactivate 2008 HCPCS codes"
  1.  . N ZTIO S ZTIO="" ; no I/O device
  1.  . N ZTDTH S ZTDTH="60996,21600" ; start time
  1.  . N ACPTRDT S ACPTRDT=$$HTE^XLFDT(ZTDTH,1) ; save start time in external
  1.  . N ZTSAVE S ZTSAVE("ACPTYR")="" ; save variable ACPTYR for the task
  1.  . N ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC ; unused inputs & outputs
  1.  . N ZTSK ; output: task # created
  1.  . D ^%ZTLOAD
  1.  . ;
  1.  . I $G(ZTSK) D  ; if the task was queued
  1.  . . ; I've taken the liberty to queue task # to run on [date]
  1.  . . D MES^XPDUTL($$T("MSG+16")_ZTSK_$$T("MSG+17")_ACPTRDT)
  1.  . . ; This routine will inactivate deleted codes & activate new ones.
  1.  . . D MES^XPDUTL($$T("MSG+18"))
  1.  . . ; If this date and time is inconvenient, you may use the Taskman
  1.  . . D MES^XPDUTL($$T("MSG+19"))
  1.  . . ; reschedule option to run at a more suitable time.
  1.  . . D MES^XPDUTL($$T("MSG+20"))
  1.  . E  D  ; if it was not
  1.  . . ; Attempt to queue routine ACPT28PE was unsuccessful. This routi...
  1.  . . D MES^XPDUTL($$T("MSG+21"))
  1.  . . ; need to be run to activate new codes and deactivate old ones a...
  1.  . . D MES^XPDUTL($$T("MSG+22"))
  1.  . . ; should be run January or February 2008.
  1.  . . D MES^XPDUTL($$T("MSG+23"))
  1.  ;
  1.  E  D  ; otherwise (if time to activate), do so now
  1.  . ; Activating 2008 codes and deactivating deleted ones.
  1.  . D BMES^XPDUTL($$T("MSG+24"))
  1.  . D STEP6^ACPT28PE
  1.  ;
  1.  ;
  1.  ; 7. update Package file (9.4)
  1.  ;
  1.  ;
  1.  N DA D  Q:'DA  ; update current version of package to 2.08
  1.  . S DA=$O(^DIC(9.4,"C","ACPT",0)) ; entry to edit
  1.  . Q:'DA  ; skip if can't find ACPT
  1.  . N DIE S DIE="^DIC(9.4," ; Package file
  1.  . N DR S DR="13///2.08" ; stuff 2.08 in Curent Version field
  1.  . D ^DIE ; edit the entry
  1.  ;
  1.  K Y D  Q:+Y<0  ; add 2.08 to subfile 22 of CPT package entry
  1.  . S DA(1)=DA ; shift focus to subfile
  1.  . N X S X=2.08
  1.  . N DIC S DIC="^DIC(9.4,DA(1),22," ; 
  1.  . S DIC(0)="LX" ; LAYGO and exact match
  1.  . N DLAYGO,DTOUT,DUOUT
  1.  . D ^DIC ; LAYGO lookup entry
  1.  ;
  1.  D
  1.  . S DA=+Y ; shift focus to new subrecord
  1.  . N DIE S DIE="^DIC(9.4,DA(1),22," ; 
  1.  . N DR S DR="1///3071231;2///"_DT_";3///`"_DUZ ; stuff three fields
  1.  . D ^DIE ; edit entry
  1.  ;
  1.  ;
  1.  ; 8. done
  1.  ;
  1.  ;
  1.  D BMES^XPDUTL($$T("MSG+25")) ; POST-INSTALL COMPLETE
  1.  ;
  1.  ;
  1.  QUIT  ; end of IMPORT
  1.  ;
  1.  ;
  1. T(TAG) QUIT $P($T(@TAG),";;",2)
  1.  ;
  1.  ;
  1. MSG ; messages to display
  1.  ;;ACPT*2.08*1 POST-INIT
  1.  ;;HCPCS 2008 Install (CPT Version 2.08 Patch 1)
  1.  ;;CPT version 2.08 patch 1 contains HCPCS codes & Modifiers for 2008.
  1.  ;;The install will attempt to read the the HCPCS Description file
  1.  ;;(acpt2008.01h) and HCPCS Modifiers file (acpt2008.c) from the
  1.  ;;directory you specified.
  1.  ;;Cleaning up existing HCPCS entries & setting Year Deleted field.
  1.  ;;Cleaning out false entries.
  1.  ;;Installing 2008 HCPCS codes from file acpt2008.01h
  1.  ;;Loading 2008 HCPCS modifiers from file acpt2008.01c
  1.  ;;Reindexing CPT file (81); this will take awhile.
  1.  ;;Reindexing CPT Modifier file (9999999.88).
  1.  ;;Adding CPT file to Local Lookup file (8984.4).
  1.  ;;Cannot add CPT file because Local Lookup file is missing.
  1.  ;;File 81 added.
  1.  ;;I've taken the liberty to queue task # 
  1.  ;; to run on 
  1.  ;;This routine will inactivate deleted codes & activate new ones.
  1.  ;;If this date and time is inconvenient, you may use the Taskman
  1.  ;;reschedule option to run at a more suitable time.
  1.  ;;Attempt to queue routine ACPT28PE was unsuccessful. This routine will
  1.  ;;need to be run to activate new codes and deactivate old ones and
  1.  ;;should be run January or February 2008.
  1.  ;;Activating 2008 codes and deactivating deleted ones.
  1.  ;;POST-INSTALL COMPLETE
  1.  ;
  1.  ;
  1.  ; end of routine ACPT28PA