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 ---[H[J[2J[HIBY652E 2406 printed Oct 16, 2024@18:35:32 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
