IBY652E.m

IBY652E ;AITC/TAZ-Environment Check Routine for Patch 652;10 Jun 19

 ;;2.0;INTEGRATED BILLING;**652**;21-MAR-94;Build 23

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 N DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,FILENAME,INSTCMP,IOCSITE,OK,POP,PROD,SITE,SITESYS,X,Y

 ;

 S XPDQUIT=0  ; Default to OK to install

 ;

 S XPDNOQUE=1   ; Do NOT allow Queueing

 ;

 S SITESYS=$P($$SITE^VASITE,U,3)

 ;

 I (DT>3200131) G EXIT                 ;Past the compliance date, no longer processing files.

 ;

 ;If site is Manila, skip environment checking.

 I SITESYS=358 G EXIT

 ;

 S PROD=$$PROD^XUPROD(1)

 S INSTCMP=$$GET1^DIQ(9.7,$O(^XPD(9.7,"B","IB*2.0*652",""),-1)_",",.02,"I")=3

 F SITE=405,515,518,585,662 S IOCSITE(SITE)=""

 ;

 I 'PROD,'$D(IOCSITE(SITESYS)) G EXIT      ;Test account and not an IOC site

 ; Only IOC TEST sites and all PROD sites get here

 I INSTCMP,'$D(IOCSITE(SITESYS)) G EXIT    ;Already installed once and not an IOC site

 ;

 S DIR(0)="FA",DIR("A")="Enter the path to the file you downloaded: "

 S DIR("A",1)="Enter the directory where you placed the downloaded file."

 S DIR("A",2)="Example: /home/directory A/directory B/"

 S DIR("A",3)="Do NOT include the filename."

 S DIR("A",4)=" "

 S DIR("?")="This is the directory where you downloaded the file required for patch IB*2.0*652."

 W ! D ^DIR K DIR I $D(DIRUT)!$D(DIROUT)!$D(DUOUT)!$D(DTOUT) S XPDQUIT=1 G EXIT

 S PATH=Y I $E(PATH,$L(PATH))'="/" S PATH=PATH_"/"

 ;

 S FILENAME="va"_SITESYS_".txt"

 ;

 ; Does the file exist & can I read it?

 D OPEN^%ZISH("INPUT",PATH,FILENAME,"R")

 I POP D   G EXIT

 . S XPDQUIT=1  ;Don't load patch

 . W !,"Can't open File. Please check that you have the file in the "

 . W !,"proper directory and re-install the patch."

 U IO R X:5

 I ($P($P(X,":",2),U)'=SITESYS) D

 . S XPDQUIT=1  ;Don't load patch

 . U 0 W !,"File is for a different site.  Retrieve proper file and re-install patch."

 D CLOSE^%ZISH("INPUT")

 I XPDQUIT=1 G EXIT

 W !,"File exists and can be read."

 ;

 S FILENAME="va"_SITESYS_"-results.txt"

 D OPEN^%ZISH("OUTPUT",PATH,FILENAME,"W")

 I POP D

 . S XPDQUIT=1 W !,"Could not create file. Please check that the path has proper settings to write a file then re-install patch." G EXIT

 U IO W "Site:"_SITESYS_"^Results of IB*2.0*652 installed on "_$$FMTE^XLFDT(DT),!

 D CLOSE^%ZISH("OUTPUT")

 ;

EXIT ;End of routine.

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY652E   2406     printed  Mar 13, 2025@21:40:06                                                                                                                                                                                                     Page 2

IBY652E   ;AITC/TAZ-Environment Check Routine for Patch 652;10 Jun 19

 +1       ;;2.0;INTEGRATED BILLING;**652**;21-MAR-94;Build 23

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4        NEW DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT,FILENAME,INSTCMP,IOCSITE,OK,POP,PROD,SITE,SITESYS,X,Y

 +5       ;

 +6       ; Default to OK to install

           SET XPDQUIT=0

 +7       ;

 +8       ; Do NOT allow Queueing

           SET XPDNOQUE=1

 +9       ;

 +10       SET SITESYS=$PIECE($$SITE^VASITE,U,3)

 +11      ;

 +12      ;Past the compliance date, no longer processing files.

           IF (DT>3200131)

               GOTO EXIT

 +13      ;

 +14      ;If site is Manila, skip environment checking.

 +15       IF SITESYS=358

               GOTO EXIT

 +16      ;

 +17       SET PROD=$$PROD^XUPROD(1)

 +18       SET INSTCMP=$$GET1^DIQ(9.7,$ORDER(^XPD(9.7,"B","IB*2.0*652",""),-1)_",",.02,"I")=3

 +19       FOR SITE=405,515,518,585,662

               SET IOCSITE(SITE)=""

 +20      ;

 +21      ;Test account and not an IOC site

           IF 'PROD

               IF '$DATA(IOCSITE(SITESYS))

                   GOTO EXIT

 +22      ; Only IOC TEST sites and all PROD sites get here

 +23      ;Already installed once and not an IOC site

           IF INSTCMP

               IF '$DATA(IOCSITE(SITESYS))

                   GOTO EXIT

 +24      ;

 +25       SET DIR(0)="FA"

           SET DIR("A")="Enter the path to the file you downloaded: "

 +26       SET DIR("A",1)="Enter the directory where you placed the downloaded file."

 +27       SET DIR("A",2)="Example: /home/directory A/directory B/"

 +28       SET DIR("A",3)="Do NOT include the filename."

 +29       SET DIR("A",4)=" "

 +30       SET DIR("?")="This is the directory where you downloaded the file required for patch IB*2.0*652."

 +31       WRITE !

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)

               SET XPDQUIT=1

               GOTO EXIT

 +32       SET PATH=Y

           IF $EXTRACT(PATH,$LENGTH(PATH))'="/"

               SET PATH=PATH_"/"

 +33      ;

 +34       SET FILENAME="va"_SITESYS_".txt"

 +35      ;

 +36      ; Does the file exist & can I read it?

 +37       DO OPEN^%ZISH("INPUT",PATH,FILENAME,"R")

 +38       IF POP

               Begin DoDot:1

 +39      ;Don't load patch

                   SET XPDQUIT=1

 +40               WRITE !,"Can't open File. Please check that you have the file in the "

 +41               WRITE !,"proper directory and re-install the patch."

               End DoDot:1

               GOTO EXIT

 +42       USE IO

           READ X:5

 +43       IF ($PIECE($PIECE(X,":",2),U)'=SITESYS)

               Begin DoDot:1

 +44      ;Don't load patch

                   SET XPDQUIT=1

 +45               USE 0

                   WRITE !,"File is for a different site.  Retrieve proper file and re-install patch."

               End DoDot:1

 +46       DO CLOSE^%ZISH("INPUT")

 +47       IF XPDQUIT=1

               GOTO EXIT

 +48       WRITE !,"File exists and can be read."

 +49      ;

 +50       SET FILENAME="va"_SITESYS_"-results.txt"

 +51       DO OPEN^%ZISH("OUTPUT",PATH,FILENAME,"W")

 +52       IF POP

               Begin DoDot:1

 +53               SET XPDQUIT=1

                   WRITE !,"Could not create file. Please check that the path has proper settings to write a file then re-install patch."

                   GOTO EXIT

               End DoDot:1

 +54       USE IO

           WRITE "Site:"_SITESYS_"^Results of IB*2.0*652 installed on "_$$FMTE^XLFDT(DT),!

 +55       DO CLOSE^%ZISH("OUTPUT")

 +56      ;

EXIT      ;End of routine.

 +1        QUIT