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

ACPT29P1.m

Go to the documentation of this file. 
  1. ACPT29P1 ;IHS/SD/SDR - ACPT*2.09*1 install ; 12/21/2008 00:29
  1.  ;;2.09;CPT FILES;**1**;JAN 8, 2009
  1.  ;
  1. IMPORT ; Import CPTs from AMA files
  1.  ;
  1.  S ACPTYR=3090101
  1.  D BMES^XPDUTL("CPT 2009 Patch 1 Install (CPT v2.09 p1)")
  1.  D MES^XPDUTL("CPT v2.09 p1 contains 2009 HCPCS codes and modifiers")
  1.  D MES^XPDUTL("The install will attempt to read the HCPCS file")
  1.  D MES^XPDUTL("acpt2009.01h from the directory you specified")
  1.  ;
  1.  ;Get the directory containing the two files
  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(.ACPTPTH) ; input transform
  1.  ;
  1.  ; Installing 2009 CPTs from file acpt2009.01h
  1.  D BMES^XPDUTL("Loading 2009 HCPCSs from file acpt2009.01h")
  1.  D IMPORT^ACPT291L  ;all codes (adds/edits/deletes)
  1.  ;
  1.  ; Reindexing CPT file (81); this will take awhile.
  1.  D BMES^XPDUTL("Reindexing CPT file (81); this will take awhile.")
  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("Reindexing CPT Modifier file (9999999.88)")
  1.  S DIK="^AUTTCMOD(" ; MODIFIER file's global root
  1.  D IXALL^DIK ; set all cross-references for all records
  1.  ;
  1.  ;
  1.  ;activate 2009 CPT codes, deactivate deleted ones
  1.  ;I ACPTYR>DT D  ; for future: queue this step if not yet time to activate
  1.  ;.N ZTRTN S ZTRTN="EN^ACPT29AD" ; entry point
  1.  ;.N ZTDESC ; description
  1.  ;.S ZTDESC="ACPT v2.09 post-init: activate/deactivate 2009 CPT codes"
  1.  ;.N ZTIO S ZTIO="" ; no I/O device
  1.  ;.;N ZTDTH S ZTDTH="61362,21600" ; start time
  1.  ;.N ZTDTH S ZTDTH="61342,21600" ; start time  FOR TESTING
  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.  ;..D MES^XPDUTL("I've taken the liberty to queue task #"_ZTSK_" to run on"_ACPTRDT)
  1.  ;..D MES^XPDUTL("This routine will inactivate deleted codes & activate new ones.")
  1.  ;..D MES^XPDUTL("If this date and time is inconvenient, you may use the Taskman")
  1.  ;..D MES^XPDUTL("reschedule option to run at a more suitable time.")
  1.  ;.E  D  ; if it was not
  1.  ;..D MES^XPDUTL("Attempt to queue routine ACPT29AD was unsuccessful. This routine will")
  1.  ;..D MES^XPDUTL("need to be run to activate new codes and deactivate old ones and")
  1.  ;..D MES^XPDUTL("should be run January 2009.")
  1.  ;
  1.  ;E  D  ; otherwise (if time to activate), do so now
  1.  ;.D BMES^XPDUTL("Activating 2009 codes and deactivating deleted ones.")
  1.  ;.D EN^ACPT29AD
  1.  Q
  1. POST1(ACPTDIR) ; input transform for KIDS question POST1
  1.  ;
  1.  ; .ACPTDIR, passed by reference, is X from the Fileman Reader, the
  1.  ; input to this input transform.
  1.  ;
  1.  I $ZV["UNIX" D  ; if unix, ensure proper syntax for unix
  1.  .S ACPTDIR=$TR(ACPTDIR,"\","/") ; forward slash should delimit
  1.  .S:$E(ACPTDIR)'="/" ACPTDIR="/"_ACPTDIR ; start with root (/)
  1.  .S:$E(ACPTDIR,$L(ACPTDIR))'="/" ACPTDIR=ACPTDIR_"/" ; ensure trailing /
  1.  ;
  1.  E  D  ; otherwise, ensure proper syntax for other operating systems
  1.  .S ACPTDIR=$TR(ACPTDIR,"/","\") ; back slash should delimit
  1.  .I $E(ACPTDIR)'="\",ACPTDIR'[":" D
  1.  ..S ACPTDIR="\"_ACPTDIR ; start with \ if not using : (?)
  1.  .S:$E(ACPTDIR,$L(ACPTDIR))'="\" ACPTDIR=ACPTDIR_"\" ; ensure trailing \
  1.  ;
  1.  W !!,"Checking directory ",ACPTDIR," ..."
  1.  ;
  1.  N ACPTFIND S ACPTFIND=0 ; do we find our files in that directory?
  1.  ; find out whether that directory contains those files
  1.  K ACPTFILE
  1.  S ACPTFILE("acpt2009.01h")=""  ;HCPCS file
  1.  N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
  1.  D  Q:ACPTFIND  ;format for most platforms:
  1.  .Q:'$D(ACPTFIND("acpt2009.01h"))
  1.  .S ACPTFIND=1
  1.  ; format for Cache on UNIX
  1.  Q:'$D(ACPTFIND(ACPTDIR_"acpt2009.01h"))
  1.  S ACPTFIND=1
  1.  ;
  1.  I $D(ACPTFIND("acpt2009.01h"))!$D(ACPTFIND(ACPTDIR_"acpt2009.01h")) D
  1.  .W !,"HCPCS file acpt2009.01h found."
  1.  ;
  1.  I ACPTFIND D  Q  ; if they picked a valid directory
  1.  .W !,"Proceeding with the install of ACPT 2.09 patch 1."
  1.  ;
  1.  W !!,"I'm sorry, but that cannot be correct."
  1.  W !,"Directory ",ACPTDIR," does not contain that file."
  1.  ;
  1.  N ACPTFILE S ACPTFILE("*")=""
  1.  N ACPTLIST
  1.  N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
  1.  W !!,"Directory ",ACPTDIR," contains the following files:"
  1.  S ACPTF=""
  1.  F  S ACPTF=$O(ACPTLIST(ACPTF)) Q:ACPTF=""  D
  1.  .W !?5,ACPTF
  1.  ;
  1.  W !!,"Please select a directory that contains the HCPCS file."
  1.  K ACPTDIR
  1.  ;
  1.  Q