ACPT29P1 ;IHS/SD/SDR - ACPT*2.09*1 install ; 12/21/2008 00:29
;;2.09;CPT FILES;**1**;JAN 8, 2009
;
IMPORT ; Import CPTs from AMA files
;
S ACPTYR=3090101
D BMES^XPDUTL("CPT 2009 Patch 1 Install (CPT v2.09 p1)")
D MES^XPDUTL("CPT v2.09 p1 contains 2009 HCPCS codes and modifiers")
D MES^XPDUTL("The install will attempt to read the HCPCS file")
D MES^XPDUTL("acpt2009.01h from the directory you specified")
;
;Get the directory containing the two files
N ACPTPTH S ACPTPTH=$G(XPDQUES("POST1")) ; path to files
I ACPTPTH="" D ; for testing at programmer mode
.S ACPTPTH=$G(^XTV(8989.3,1,"DEV")) ; default directory
.D POST1(.ACPTPTH) ; input transform
;
; Installing 2009 CPTs from file acpt2009.01h
D BMES^XPDUTL("Loading 2009 HCPCSs from file acpt2009.01h")
D IMPORT^ACPT291L ;all codes (adds/edits/deletes)
;
; Reindexing CPT file (81); this will take awhile.
D BMES^XPDUTL("Reindexing CPT file (81); this will take awhile.")
N DA,DIK S DIK="^ICPT(" ; CPT file's global root
D IXALL^DIK ; set all cross-references for all records
D ^ACPTCXR ; rebuild C index for all records
;
; Reindexing CPT Modifier file (9999999.88).
D BMES^XPDUTL("Reindexing CPT Modifier file (9999999.88)")
S DIK="^AUTTCMOD(" ; MODIFIER file's global root
D IXALL^DIK ; set all cross-references for all records
;
;
;activate 2009 CPT codes, deactivate deleted ones
;I ACPTYR>DT D ; for future: queue this step if not yet time to activate
;.N ZTRTN S ZTRTN="EN^ACPT29AD" ; entry point
;.N ZTDESC ; description
;.S ZTDESC="ACPT v2.09 post-init: activate/deactivate 2009 CPT codes"
;.N ZTIO S ZTIO="" ; no I/O device
;.;N ZTDTH S ZTDTH="61362,21600" ; start time
;.N ZTDTH S ZTDTH="61342,21600" ; start time FOR TESTING
;.N ACPTRDT S ACPTRDT=$$HTE^XLFDT(ZTDTH,1) ; save start time in external
;.N ZTSAVE S ZTSAVE("ACPTYR")="" ; save variable ACPTYR for the task
;.N ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC ; unused inputs & outputs
;.N ZTSK ; output: task # created
;.D ^%ZTLOAD
;.;
;.I $G(ZTSK) D ; if the task was queued
;..D MES^XPDUTL("I've taken the liberty to queue task #"_ZTSK_" to run on"_ACPTRDT)
;..D MES^XPDUTL("This routine will inactivate deleted codes & activate new ones.")
;..D MES^XPDUTL("If this date and time is inconvenient, you may use the Taskman")
;..D MES^XPDUTL("reschedule option to run at a more suitable time.")
;.E D ; if it was not
;..D MES^XPDUTL("Attempt to queue routine ACPT29AD was unsuccessful. This routine will")
;..D MES^XPDUTL("need to be run to activate new codes and deactivate old ones and")
;..D MES^XPDUTL("should be run January 2009.")
;
;E D ; otherwise (if time to activate), do so now
;.D BMES^XPDUTL("Activating 2009 codes and deactivating deleted ones.")
;.D EN^ACPT29AD
Q
POST1(ACPTDIR) ; input transform for KIDS question POST1
;
; .ACPTDIR, passed by reference, is X from the Fileman Reader, the
; input to this input transform.
;
I $ZV["UNIX" D ; if unix, ensure proper syntax for unix
.S ACPTDIR=$TR(ACPTDIR,"\","/") ; forward slash should delimit
.S:$E(ACPTDIR)'="/" ACPTDIR="/"_ACPTDIR ; start with root (/)
.S:$E(ACPTDIR,$L(ACPTDIR))'="/" ACPTDIR=ACPTDIR_"/" ; ensure trailing /
;
E D ; otherwise, ensure proper syntax for other operating systems
.S ACPTDIR=$TR(ACPTDIR,"/","\") ; back slash should delimit
.I $E(ACPTDIR)'="\",ACPTDIR'[":" D
..S ACPTDIR="\"_ACPTDIR ; start with \ if not using : (?)
.S:$E(ACPTDIR,$L(ACPTDIR))'="\" ACPTDIR=ACPTDIR_"\" ; ensure trailing \
;
W !!,"Checking directory ",ACPTDIR," ..."
;
N ACPTFIND S ACPTFIND=0 ; do we find our files in that directory?
; find out whether that directory contains those files
K ACPTFILE
S ACPTFILE("acpt2009.01h")="" ;HCPCS file
N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
D Q:ACPTFIND ;format for most platforms:
.Q:'$D(ACPTFIND("acpt2009.01h"))
.S ACPTFIND=1
; format for Cache on UNIX
Q:'$D(ACPTFIND(ACPTDIR_"acpt2009.01h"))
S ACPTFIND=1
;
I $D(ACPTFIND("acpt2009.01h"))!$D(ACPTFIND(ACPTDIR_"acpt2009.01h")) D
.W !,"HCPCS file acpt2009.01h found."
;
I ACPTFIND D Q ; if they picked a valid directory
.W !,"Proceeding with the install of ACPT 2.09 patch 1."
;
W !!,"I'm sorry, but that cannot be correct."
W !,"Directory ",ACPTDIR," does not contain that file."
;
N ACPTFILE S ACPTFILE("*")=""
N ACPTLIST
N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
W !!,"Directory ",ACPTDIR," contains the following files:"
S ACPTF=""
F S ACPTF=$O(ACPTLIST(ACPTF)) Q:ACPTF="" D
.W !?5,ACPTF
;
W !!,"Please select a directory that contains the HCPCS file."
K ACPTDIR
;
Q
ACPT29P1 ;IHS/SD/SDR - ACPT*2.09*1 install ; 12/21/2008 00:29
+1 ;;2.09;CPT FILES;**1**;JAN 8, 2009
+2 ;
IMPORT ; Import CPTs from AMA files
+1 ;
+2 SET ACPTYR=3090101
+3 DO BMES^XPDUTL("CPT 2009 Patch 1 Install (CPT v2.09 p1)")
+4 DO MES^XPDUTL("CPT v2.09 p1 contains 2009 HCPCS codes and modifiers")
+5 DO MES^XPDUTL("The install will attempt to read the HCPCS file")
+6 DO MES^XPDUTL("acpt2009.01h from the directory you specified")
+7 ;
+8 ;Get the directory containing the two files
+9 ; path to files
NEW ACPTPTH
SET ACPTPTH=$GET(XPDQUES("POST1"))
+10 ; for testing at programmer mode
IF ACPTPTH=""
Begin DoDot:1
+11 ; default directory
SET ACPTPTH=$GET(^XTV(8989.3,1,"DEV"))
+12 ; input transform
DO POST1(.ACPTPTH)
End DoDot:1
+13 ;
+14 ; Installing 2009 CPTs from file acpt2009.01h
+15 DO BMES^XPDUTL("Loading 2009 HCPCSs from file acpt2009.01h")
+16 ;all codes (adds/edits/deletes)
DO IMPORT^ACPT291L
+17 ;
+18 ; Reindexing CPT file (81); this will take awhile.
+19 DO BMES^XPDUTL("Reindexing CPT file (81); this will take awhile.")
+20 ; CPT file's global root
NEW DA,DIK
SET DIK="^ICPT("
+21 ; set all cross-references for all records
DO IXALL^DIK
+22 ; rebuild C index for all records
DO ^ACPTCXR
+23 ;
+24 ; Reindexing CPT Modifier file (9999999.88).
+25 DO BMES^XPDUTL("Reindexing CPT Modifier file (9999999.88)")
+26 ; MODIFIER file's global root
SET DIK="^AUTTCMOD("
+27 ; set all cross-references for all records
DO IXALL^DIK
+28 ;
+29 ;
+30 ;activate 2009 CPT codes, deactivate deleted ones
+31 ;I ACPTYR>DT D ; for future: queue this step if not yet time to activate
+32 ;.N ZTRTN S ZTRTN="EN^ACPT29AD" ; entry point
+33 ;.N ZTDESC ; description
+34 ;.S ZTDESC="ACPT v2.09 post-init: activate/deactivate 2009 CPT codes"
+35 ;.N ZTIO S ZTIO="" ; no I/O device
+36 ;.;N ZTDTH S ZTDTH="61362,21600" ; start time
+37 ;.N ZTDTH S ZTDTH="61342,21600" ; start time FOR TESTING
+38 ;.N ACPTRDT S ACPTRDT=$$HTE^XLFDT(ZTDTH,1) ; save start time in external
+39 ;.N ZTSAVE S ZTSAVE("ACPTYR")="" ; save variable ACPTYR for the task
+40 ;.N ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC ; unused inputs & outputs
+41 ;.N ZTSK ; output: task # created
+42 ;.D ^%ZTLOAD
+43 ;.;
+44 ;.I $G(ZTSK) D ; if the task was queued
+45 ;..D MES^XPDUTL("I've taken the liberty to queue task #"_ZTSK_" to run on"_ACPTRDT)
+46 ;..D MES^XPDUTL("This routine will inactivate deleted codes & activate new ones.")
+47 ;..D MES^XPDUTL("If this date and time is inconvenient, you may use the Taskman")
+48 ;..D MES^XPDUTL("reschedule option to run at a more suitable time.")
+49 ;.E D ; if it was not
+50 ;..D MES^XPDUTL("Attempt to queue routine ACPT29AD was unsuccessful. This routine will")
+51 ;..D MES^XPDUTL("need to be run to activate new codes and deactivate old ones and")
+52 ;..D MES^XPDUTL("should be run January 2009.")
+53 ;
+54 ;E D ; otherwise (if time to activate), do so now
+55 ;.D BMES^XPDUTL("Activating 2009 codes and deactivating deleted ones.")
+56 ;.D EN^ACPT29AD
+57 QUIT
POST1(ACPTDIR) ; input transform for KIDS question POST1
+1 ;
+2 ; .ACPTDIR, passed by reference, is X from the Fileman Reader, the
+3 ; input to this input transform.
+4 ;
+5 ; if unix, ensure proper syntax for unix
IF $ZV["UNIX"
Begin DoDot:1
+6 ; forward slash should delimit
SET ACPTDIR=$TRANSLATE(ACPTDIR,"\","/")
+7 ; start with root (/)
IF $EXTRACT(ACPTDIR)'="/"
SET ACPTDIR="/"_ACPTDIR
+8 ; ensure trailing /
IF $EXTRACT(ACPTDIR,$LENGTH(ACPTDIR))'="/"
SET ACPTDIR=ACPTDIR_"/"
End DoDot:1
+9 ;
+10 ; otherwise, ensure proper syntax for other operating systems
IF '$TEST
Begin DoDot:1
+11 ; back slash should delimit
SET ACPTDIR=$TRANSLATE(ACPTDIR,"/","\")
+12 IF $EXTRACT(ACPTDIR)'="\"
IF ACPTDIR'[":"
Begin DoDot:2
+13 ; start with \ if not using : (?)
SET ACPTDIR="\"_ACPTDIR
End DoDot:2
+14 ; ensure trailing \
IF $EXTRACT(ACPTDIR,$LENGTH(ACPTDIR))'="\"
SET ACPTDIR=ACPTDIR_"\"
End DoDot:1
+15 ;
+16 WRITE !!,"Checking directory ",ACPTDIR," ..."
+17 ;
+18 ; do we find our files in that directory?
NEW ACPTFIND
SET ACPTFIND=0
+19 ; find out whether that directory contains those files
+20 KILL ACPTFILE
+21 ;HCPCS file
SET ACPTFILE("acpt2009.01h")=""
+22 NEW Y
SET Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
+23 ;format for most platforms:
Begin DoDot:1
+24 IF '$DATA(ACPTFIND("acpt2009.01h"))
QUIT
+25 SET ACPTFIND=1
End DoDot:1
IF ACPTFIND
QUIT
+26 ; format for Cache on UNIX
+27 IF '$DATA(ACPTFIND(ACPTDIR_"acpt2009.01h"))
QUIT
+28 SET ACPTFIND=1
+29 ;
+30 IF $DATA(ACPTFIND("acpt2009.01h"))!$DATA(ACPTFIND(ACPTDIR_"acpt2009.01h"))
Begin DoDot:1
+31 WRITE !,"HCPCS file acpt2009.01h found."
End DoDot:1
+32 ;
+33 ; if they picked a valid directory
IF ACPTFIND
Begin DoDot:1
+34 WRITE !,"Proceeding with the install of ACPT 2.09 patch 1."
End DoDot:1
QUIT
+35 ;
+36 WRITE !!,"I'm sorry, but that cannot be correct."
+37 WRITE !,"Directory ",ACPTDIR," does not contain that file."
+38 ;
+39 NEW ACPTFILE
SET ACPTFILE("*")=""
+40 NEW ACPTLIST
+41 NEW Y
SET Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
+42 WRITE !!,"Directory ",ACPTDIR," contains the following files:"
+43 SET ACPTF=""
+44 FOR
SET ACPTF=$ORDER(ACPTLIST(ACPTF))
IF ACPTF=""
QUIT
Begin DoDot:1
+45 WRITE !?5,ACPTF
End DoDot:1
+46 ;
+47 WRITE !!,"Please select a directory that contains the HCPCS file."
+48 KILL ACPTDIR
+49 ;
+50 QUIT
