ACPT28PF ;IHS/VEN/TOAD - ACPT*2.08*1 POST1 question ; 04/21/2008 13:35
;;2.08;CPT FILES;**1**;DEC 17, 2007
;
; This is the input transform for question POST1 of the post-init for
; ACPT*2.08*1. The input transform is called at POST1 by KIDS at the
; beginning of the installation of this patch.
;
QUIT ; This routine should not be called at the top or anywhere
; else. It is only to be called at POST1 by KIDS during installation of
; ACPT*2.08*1.
;
; 2008 04 21 Rick Marshall wrote this routine to improve the directory
; prompt, which was originally in the main post-init routine (ACPTPOST,
; now called ACPT28PA). The question was moved out into the KIDS build
; definition as an installation question, and this routine was created
; to house the expanded input transform. Prior to this, no validation
; was performed to ensure that the selected directory actually contained
; the two files (acpt2008.01h and acpt2008.01c), leading to many errors
; during testing. This expanded input transform does just that. Also
; worked around a bug in all Cache for UNIX sites in RPMS, in which
; their ^%ZOSF("OS") instead says Cache for NT. Also worked around a bug
; in $$LIST^%ZISH in which the output array's format is different on
; Cache on UNIX, presumably also because of ^%ZOSF("OS") being wrong.
;
; The original unrefactored code was written by IHS/ASDST/DMJ and Shonda
; Render (SDR).
;
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?
D ; find out whether that directory contains those files
. N ACPTFILE S ACPTFILE("acpt2008.01h")="" ; HCPCS description file
. S ACPTFILE("acpt2008.01c")="" ; HCPCS modifiers file
. N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
. D Q:ACPTFIND ; format for most platforms:
. . Q:'$D(ACPTFIND("acpt2008.01h"))
. . Q:'$D(ACPTFIND("acpt2008.01c"))
. . S ACPTFIND=1
. D ; format for Cache on UNIX
. . Q:'$D(ACPTFIND(ACPTDIR_"acpt2008.01h"))
. . Q:'$D(ACPTFIND(ACPTDIR_"acpt2008.01c"))
. . S ACPTFIND=1
;
I $D(ACPTFIND("acpt2008.01h"))!$D(ACPTFIND(ACPTDIR_"acpt2008.01h")) D
. W !,"HCPCS Description file acpt2008.01h found."
I $D(ACPTFIND("acpt2008.01c"))!$D(ACPTFIND(ACPTDIR_"acpt2008.01c")) D
. W !,"HCPCS Modifiers file acpt2008.01c found."
;
I ACPTFIND D Q ; if they picked a valid directory
. W !!,"Thank you. Both files are in that directory."
. W !,"Proceeding with the install of ACPT*2.08*1."
;
W !!,"I'm sorry, but that cannot be correct."
W !,"Directory ",ACPTDIR," does not contain both files."
;
D
. N ACPTFILE S ACPTFILE("*")=""
. N ACPTLIST
. N Y S Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
. W !!,"Directory ",ACPTDIR," contains the following files:"
. N ACPTF S ACPTF="" F S ACPTF=$O(ACPTLIST(ACPTF)) Q:ACPTF="" D
. . W !?5,ACPTF
;
W !!,"Please select a directory that contains both HCPCS files."
K ACPTDIR
;
QUIT ; end of POST1
;
;
; end of routine ACPT28PF
ACPT28PF ;IHS/VEN/TOAD - ACPT*2.08*1 POST1 question ; 04/21/2008 13:35
+1 ;;2.08;CPT FILES;**1**;DEC 17, 2007
+2 ;
+3 ; This is the input transform for question POST1 of the post-init for
+4 ; ACPT*2.08*1. The input transform is called at POST1 by KIDS at the
+5 ; beginning of the installation of this patch.
+6 ;
+7 ; This routine should not be called at the top or anywhere
QUIT
+8 ; else. It is only to be called at POST1 by KIDS during installation of
+9 ; ACPT*2.08*1.
+10 ;
+11 ; 2008 04 21 Rick Marshall wrote this routine to improve the directory
+12 ; prompt, which was originally in the main post-init routine (ACPTPOST,
+13 ; now called ACPT28PA). The question was moved out into the KIDS build
+14 ; definition as an installation question, and this routine was created
+15 ; to house the expanded input transform. Prior to this, no validation
+16 ; was performed to ensure that the selected directory actually contained
+17 ; the two files (acpt2008.01h and acpt2008.01c), leading to many errors
+18 ; during testing. This expanded input transform does just that. Also
+19 ; worked around a bug in all Cache for UNIX sites in RPMS, in which
+20 ; their ^%ZOSF("OS") instead says Cache for NT. Also worked around a bug
+21 ; in $$LIST^%ZISH in which the output array's format is different on
+22 ; Cache on UNIX, presumably also because of ^%ZOSF("OS") being wrong.
+23 ;
+24 ; The original unrefactored code was written by IHS/ASDST/DMJ and Shonda
+25 ; Render (SDR).
+26 ;
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
Begin DoDot:1
+20 ; HCPCS description file
NEW ACPTFILE
SET ACPTFILE("acpt2008.01h")=""
+21 ; HCPCS modifiers file
SET ACPTFILE("acpt2008.01c")=""
+22 NEW Y
SET Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTFIND")
+23 ; format for most platforms:
Begin DoDot:2
+24 IF '$DATA(ACPTFIND("acpt2008.01h"))
QUIT
+25 IF '$DATA(ACPTFIND("acpt2008.01c"))
QUIT
+26 SET ACPTFIND=1
End DoDot:2
IF ACPTFIND
QUIT
+27 ; format for Cache on UNIX
Begin DoDot:2
+28 IF '$DATA(ACPTFIND(ACPTDIR_"acpt2008.01h"))
QUIT
+29 IF '$DATA(ACPTFIND(ACPTDIR_"acpt2008.01c"))
QUIT
+30 SET ACPTFIND=1
End DoDot:2
End DoDot:1
+31 ;
+32 IF $DATA(ACPTFIND("acpt2008.01h"))!$DATA(ACPTFIND(ACPTDIR_"acpt2008.01h"))
Begin DoDot:1
+33 WRITE !,"HCPCS Description file acpt2008.01h found."
End DoDot:1
+34 IF $DATA(ACPTFIND("acpt2008.01c"))!$DATA(ACPTFIND(ACPTDIR_"acpt2008.01c"))
Begin DoDot:1
+35 WRITE !,"HCPCS Modifiers file acpt2008.01c found."
End DoDot:1
+36 ;
+37 ; if they picked a valid directory
IF ACPTFIND
Begin DoDot:1
+38 WRITE !!,"Thank you. Both files are in that directory."
+39 WRITE !,"Proceeding with the install of ACPT*2.08*1."
End DoDot:1
QUIT
+40 ;
+41 WRITE !!,"I'm sorry, but that cannot be correct."
+42 WRITE !,"Directory ",ACPTDIR," does not contain both files."
+43 ;
+44 Begin DoDot:1
+45 NEW ACPTFILE
SET ACPTFILE("*")=""
+46 NEW ACPTLIST
+47 NEW Y
SET Y=$$LIST^%ZISH(ACPTDIR,"ACPTFILE","ACPTLIST")
+48 WRITE !!,"Directory ",ACPTDIR," contains the following files:"
+49 NEW ACPTF
SET ACPTF=""
FOR
SET ACPTF=$ORDER(ACPTLIST(ACPTF))
IF ACPTF=""
QUIT
Begin DoDot:2
+50 WRITE !?5,ACPTF
End DoDot:2
End DoDot:1
+51 ;
+52 WRITE !!,"Please select a directory that contains both HCPCS files."
+53 KILL ACPTDIR
+54 ;
+55 ; end of POST1
QUIT
+56 ;
+57 ;
+58 ; end of routine ACPT28PF
