ACPT28PF.m

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