ECXINENV ;ALB/JAP - Environment Check for DSS Install ;Nov 03, 1997
;;3.0;DSS EXTRACTS;;Dec 22, 1997
EN ;entry point
N Y,J,JJ,DIR,DTOUT,DUOUT,DIRUT,ECX,MSG,MSG1,MSG2,MSG2B,MSG3,FILE,FILENM,TEXT
K XPDQUIT,XPDABORT
F J=1:1:12 S TEXT=$P($T(MSG1+J),";",3),MSG1(J)=TEXT
F J=1:1:4 S TEXT=$P($T(MSG2+J),";",3),MSG2(J)=TEXT
F J=1:1:8 S TEXT=$P($T(MSG2B+J),";",3),MSG2B(J)=TEXT
F J=1:1:8 S TEXT=$P($T(MSG3+J),";",3),MSG3(J)=TEXT
;is this is not a first time install provide user warning
I $O(^ECX(728,0)) D MES^XPDUTL(.MSG1) D
.W ! S DIR(0)="Y",DIR("A")="Continue with the installation",DIR("B")="NO",DIR("?")="Answer YES to install DSS EXTRACTS v3.0 or NO to stop."
.D ^DIR
.I Y=0!($G(DIRUT)) S XPDQUIT=1 D MES^XPDUTL("Installation aborted...")
.K DIR,DIRUT,DTOUT,DUOUT W !
Q:$G(XPDQUIT)
D MES^XPDUTL(">>> Checking Environment --")
D MES^XPDUTL(" ")
I +$G(DUZ)'>0!($G(DUZ(0))'="@")!($G(U)'="^")!('$D(DT))!('$D(IOSL)) D
.S XPDQUIT=2
.D MES^XPDUTL("You must first initialize Programmer Environment by running ^XUP.")
.D MES^XPDUTL(.MSG2)
.D MES^XPDUTL(" ") S DIR(0)="E" D ^DIR K DIR
Q:$G(XPDQUIT)
;don't bother checking files if this is first-time install of dss
Q:'$O(^ECX(728,0))
;if this is a re-install of v3.0, don't insist that data in files be deleted
D FILE^DID(728,,"VERSION","ECX")
;only do this check if version is 2
;see if there's any extract data still in files from v2.0t11
I ECX("VERSION")'["3.0" D
.F J=1:1:20 S FILE=$P($T(FILES+J),";",3),FILENM=$P($T(FILES+J),";",4) D
..S JJ=$O(^ECX(FILE,0)) I +JJ>0 D
...S MSG=" Data still exists in file "_FILENM_" (#"_FILE_")."
...D:($Y+3>IOSL) PAUSE
...D MES^XPDUTL(MSG) S XPDQUIT=2
I $G(XPDQUIT) D Q
.D:($Y+8>IOSL) PAUSE
.D MES^XPDUTL(.MSG2B)
.F J=1:1:20 S FILE=$P($T(FILES+J),";",3),FILENM=$P($T(FILES+J),";",4) D
..S JJ=$O(^ECX(FILE,0)) I +JJ>0 D
...S MSG=" "_FILENM_" (#"_FILE_")"
...D:($Y+3>IOSL) PAUSE
...D MES^XPDUTL(MSG)
.D:($Y+5>IOSL) PAUSE
.D MES^XPDUTL(.MSG2)
.D:($Y+12>IOSL) PAUSE
.D MES^XPDUTL(.MSG3)
D MES^XPDUTL("Environment check completed... OK.")
Q
;
PAUSE ;screen pause
N Y,JJ,SS
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.D MES^XPDUTL(" ") S DIR(0)="E" D ^DIR K DIR
W:$Y!($E(IOST)="C") @IOF
Q
;
CLEAN ;allow site to cleanup old extract records
N FF,J,JJ,JJJ,DIC,DR,DA,DIQ,FILE,EXTRACT,ECX,TYPE,START,PURGE,ABORT,OUT,DATA,CLEAN1,CLEAN2,REM,MSG
F J=1:1:8 S TEXT=$P($T(CLEAN1+J),";",3),CLEAN1(J)=TEXT
F J=1:1:6 S TEXT=$P($T(CLEAN2+J),";",3),CLEAN2(J)=TEXT
W !!
D FILE^DID(728,,"VERSION","ECX")
I ECX("VERSION")["3.0" D Q
.D:($Y+3>IOSL) PAUSE D MES^XPDUTL(.CLEAN1)
;if v3 not installed then continue
S ABORT=0,DATA=0
F FF=1:1:20 S FILE=$P($T(FILES+FF),";",3),FILENM=$P($T(FILES+FF),";",4),JJ=0 D Q:ABORT=1
.F S JJ=$O(^ECX(FILE,JJ)) Q:+JJ<1 I +JJ>0 D Q:ABORT=1
..S OUT=0
..S EXTRACT=$P(^ECX(FILE,JJ,0),"^",3),DIC=727,DR="2;3;9",DIQ(0)="I",DIQ="ECX"
..K ECX S DA=EXTRACT D EN^DIQ1
..S TYPE=$G(ECX(727,DA,2,"I")),START=$G(ECX(727,DA,3,"I")),PURGE=$G(ECX(727,DA,9,"I"))
..;if this extract was not previously purged, don't proceed
..I PURGE="" D Q
...S ABORT=1
...D:($Y+3>IOSL) PAUSE D MES^XPDUTL(.CLEAN2)
..S REM(1)=" Data will now be deleted from:"
..S REM(2)=" File #"_FILE_" - Extract #"_EXTRACT
..S DATA=1
..D:($Y+3>IOSL) PAUSE D MES^XPDUTL(.REM)
..S JJJ=JJ-1
..F S JJJ=$O(^ECX(FILE,JJJ)) Q:+JJJ<1 I +JJJ>0 D Q:OUT=1
...S EXTRX=$P(^ECX(FILE,JJJ,0),"^",3)
...I EXTRX'=EXTRACT S OUT=1
...Q:OUT=1
...S DIK="^ECX("_FILE_",",DA=JJJ D ^DIK
...S MSG=" Record #"_JJJ_" in File #"_FILE_" deleted."
...D:($Y+3>IOSL) PAUSE D MES^XPDUTL(MSG)
..W !!
I ABORT=0,DATA=1 D
.S MSG=" Clean-up of old extract data complete."
.D:($Y+3>IOSL) PAUSE D MES^XPDUTL(MSG)
I ABORT=0,DATA=0 D
.S MSG=" There are no old extract records which can be deleted."
.D:($Y+3>IOSL) PAUSE D MES^XPDUTL(MSG)
W !!
Q
;
FILES ;files to be checked for existing data
;;727.802;ADMISSION EXTRACT
;;727.803;CLINIC EXTRACT
;;727.804;CLINIC NOSHOW EXTRACT
;;727.805;NURSING EXTRACT
;;727.806;DENTAL EXTRACT
;;727.808;PHYSICAL MOVEMENT EXTRACT
;;727.809;UNIT DOSE LOCAL EXTRACT
;;727.81;PRESCRIPTION EXTRACT
;;727.811;SURGERY EXTRACT
;;727.813;LABORATORY EXTRACT
;;727.814;RADIOLOGY EXTRACT
;;727.815;EVENT CAPTURE LOCAL EXTRACT
;;727.817;TREATING SPECIALTY CHANGE EXTRACT
;;727.819;IV DETAIL EXTRACT
;;727.82;ADMISSION SETUP EXTRACT
;;727.821;PHYSICAL MOVEMENT SETUP EXTRACT
;;727.822;TREATING SPECIALTY CHANGE SETUP EXTRACT
;;727.823;PAI EXTRACT
;;727.824;LAB RESULTS EXTRACT
;;727.825;QUASAR EXTRACT
;
MSG1 ;
;;
;; ********** WARNING **********
;;
;;DO NOT INSTALL DSS EXTRACTS V3.0 unless your site has
;;extracted, transmitted, and received transmission
;;confirmation from the Austin Automation Center for ALL
;;FY97 data. Prior approval for this installation should
;;have been received from the local DSS Site Manager.
;;
;; Answer YES to install DSS EXTRACTS v3.0.
;; Answer NO to stop the installation process now.
;;
MSG2 ;post abort message
;;
;;
;;Installation aborted...
;;
MSG2B ;more post abort info if data in files
;;
;;Before continuing with this installation, you should verify with
;;the DSS Site Manager that all FY97 data has been transmitted and
;;transmission confirmation has been received from the Austin
;;Automation Center. Then data from the following files should be
;;purged by the DSS Site Manager using the Purge Data from Extract
;;Files [ECXPURG] option:
;;
MSG3 ;;restart info
;;
;;When you wish to continue with this installation, simply select
;;the Install Package(s) [XPD INSTALL BUILD] option from the Kernel
;;Installation & Distribution System menu. You do not need to
;;reload the KIDS distribution file. (The package build has not
;;been deleted from the ^XTMP global.)
;;
;;
CLEAN1 ;;can't cleanup global if v3 installed
;;
;;DSS EXTRACTS v3.0 has already been installed on this system.
;;This file clean-up cannot be performed after installation of
;;the new version.
;;
;;If you are having difficulty, please contact the Customer Support
;;Help Desk.
;;
CLEAN2 ;;unpurged extract file
;;
;;Cannot continue -- an unpurged extract file has been found.
;;
;;Please advise the DSS Site Manager to complete purging of all
;;previously extracted data from files #727.802 through #727.825
;;by using the DSS option Purge Data from Extract Files [ECXPURG].
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXINENV 6639 printed Apr 09, 2024@20:55:21 Page 2
ECXINENV ;ALB/JAP - Environment Check for DSS Install ;Nov 03, 1997
+1 ;;3.0;DSS EXTRACTS;;Dec 22, 1997
EN ;entry point
+1 NEW Y,J,JJ,DIR,DTOUT,DUOUT,DIRUT,ECX,MSG,MSG1,MSG2,MSG2B,MSG3,FILE,FILENM,TEXT
+2 KILL XPDQUIT,XPDABORT
+3 FOR J=1:1:12
SET TEXT=$PIECE($TEXT(MSG1+J),";",3)
SET MSG1(J)=TEXT
+4 FOR J=1:1:4
SET TEXT=$PIECE($TEXT(MSG2+J),";",3)
SET MSG2(J)=TEXT
+5 FOR J=1:1:8
SET TEXT=$PIECE($TEXT(MSG2B+J),";",3)
SET MSG2B(J)=TEXT
+6 FOR J=1:1:8
SET TEXT=$PIECE($TEXT(MSG3+J),";",3)
SET MSG3(J)=TEXT
+7 ;is this is not a first time install provide user warning
+8 IF $ORDER(^ECX(728,0))
DO MES^XPDUTL(.MSG1)
Begin DoDot:1
+9 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Continue with the installation"
SET DIR("B")="NO"
SET DIR("?")="Answer YES to install DSS EXTRACTS v3.0 or NO to stop."
+10 DO ^DIR
+11 IF Y=0!($GET(DIRUT))
SET XPDQUIT=1
DO MES^XPDUTL("Installation aborted...")
+12 KILL DIR,DIRUT,DTOUT,DUOUT
WRITE !
End DoDot:1
+13 if $GET(XPDQUIT)
QUIT
+14 DO MES^XPDUTL(">>> Checking Environment --")
+15 DO MES^XPDUTL(" ")
+16 IF +$GET(DUZ)'>0!($GET(DUZ(0))'="@")!($GET(U)'="^")!('$DATA(DT))!('$DATA(IOSL))
Begin DoDot:1
+17 SET XPDQUIT=2
+18 DO MES^XPDUTL("You must first initialize Programmer Environment by running ^XUP.")
+19 DO MES^XPDUTL(.MSG2)
+20 DO MES^XPDUTL(" ")
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+21 if $GET(XPDQUIT)
QUIT
+22 ;don't bother checking files if this is first-time install of dss
+23 if '$ORDER(^ECX(728,0))
QUIT
+24 ;if this is a re-install of v3.0, don't insist that data in files be deleted
+25 DO FILE^DID(728,,"VERSION","ECX")
+26 ;only do this check if version is 2
+27 ;see if there's any extract data still in files from v2.0t11
+28 IF ECX("VERSION")'["3.0"
Begin DoDot:1
+29 FOR J=1:1:20
SET FILE=$PIECE($TEXT(FILES+J),";",3)
SET FILENM=$PIECE($TEXT(FILES+J),";",4)
Begin DoDot:2
+30 SET JJ=$ORDER(^ECX(FILE,0))
IF +JJ>0
Begin DoDot:3
+31 SET MSG=" Data still exists in file "_FILENM_" (#"_FILE_")."
+32 if ($Y+3>IOSL)
DO PAUSE
+33 DO MES^XPDUTL(MSG)
SET XPDQUIT=2
End DoDot:3
End DoDot:2
End DoDot:1
+34 IF $GET(XPDQUIT)
Begin DoDot:1
+35 if ($Y+8>IOSL)
DO PAUSE
+36 DO MES^XPDUTL(.MSG2B)
+37 FOR J=1:1:20
SET FILE=$PIECE($TEXT(FILES+J),";",3)
SET FILENM=$PIECE($TEXT(FILES+J),";",4)
Begin DoDot:2
+38 SET JJ=$ORDER(^ECX(FILE,0))
IF +JJ>0
Begin DoDot:3
+39 SET MSG=" "_FILENM_" (#"_FILE_")"
+40 if ($Y+3>IOSL)
DO PAUSE
+41 DO MES^XPDUTL(MSG)
End DoDot:3
End DoDot:2
+42 if ($Y+5>IOSL)
DO PAUSE
+43 DO MES^XPDUTL(.MSG2)
+44 if ($Y+12>IOSL)
DO PAUSE
+45 DO MES^XPDUTL(.MSG3)
End DoDot:1
QUIT
+46 DO MES^XPDUTL("Environment check completed... OK.")
+47 QUIT
+48 ;
PAUSE ;screen pause
+1 NEW Y,JJ,SS
+2 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+3 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+4 DO MES^XPDUTL(" ")
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+5 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
+6 QUIT
+7 ;
CLEAN ;allow site to cleanup old extract records
+1 NEW FF,J,JJ,JJJ,DIC,DR,DA,DIQ,FILE,EXTRACT,ECX,TYPE,START,PURGE,ABORT,OUT,DATA,CLEAN1,CLEAN2,REM,MSG
+2 FOR J=1:1:8
SET TEXT=$PIECE($TEXT(CLEAN1+J),";",3)
SET CLEAN1(J)=TEXT
+3 FOR J=1:1:6
SET TEXT=$PIECE($TEXT(CLEAN2+J),";",3)
SET CLEAN2(J)=TEXT
+4 WRITE !!
+5 DO FILE^DID(728,,"VERSION","ECX")
+6 IF ECX("VERSION")["3.0"
Begin DoDot:1
+7 if ($Y+3>IOSL)
DO PAUSE
DO MES^XPDUTL(.CLEAN1)
End DoDot:1
QUIT
+8 ;if v3 not installed then continue
+9 SET ABORT=0
SET DATA=0
+10 FOR FF=1:1:20
SET FILE=$PIECE($TEXT(FILES+FF),";",3)
SET FILENM=$PIECE($TEXT(FILES+FF),";",4)
SET JJ=0
Begin DoDot:1
+11 FOR
SET JJ=$ORDER(^ECX(FILE,JJ))
if +JJ<1
QUIT
IF +JJ>0
Begin DoDot:2
+12 SET OUT=0
+13 SET EXTRACT=$PIECE(^ECX(FILE,JJ,0),"^",3)
SET DIC=727
SET DR="2;3;9"
SET DIQ(0)="I"
SET DIQ="ECX"
+14 KILL ECX
SET DA=EXTRACT
DO EN^DIQ1
+15 SET TYPE=$GET(ECX(727,DA,2,"I"))
SET START=$GET(ECX(727,DA,3,"I"))
SET PURGE=$GET(ECX(727,DA,9,"I"))
+16 ;if this extract was not previously purged, don't proceed
+17 IF PURGE=""
Begin DoDot:3
+18 SET ABORT=1
+19 if ($Y+3>IOSL)
DO PAUSE
DO MES^XPDUTL(.CLEAN2)
End DoDot:3
QUIT
+20 SET REM(1)=" Data will now be deleted from:"
+21 SET REM(2)=" File #"_FILE_" - Extract #"_EXTRACT
+22 SET DATA=1
+23 if ($Y+3>IOSL)
DO PAUSE
DO MES^XPDUTL(.REM)
+24 SET JJJ=JJ-1
+25 FOR
SET JJJ=$ORDER(^ECX(FILE,JJJ))
if +JJJ<1
QUIT
IF +JJJ>0
Begin DoDot:3
+26 SET EXTRX=$PIECE(^ECX(FILE,JJJ,0),"^",3)
+27 IF EXTRX'=EXTRACT
SET OUT=1
+28 if OUT=1
QUIT
+29 SET DIK="^ECX("_FILE_","
SET DA=JJJ
DO ^DIK
+30 SET MSG=" Record #"_JJJ_" in File #"_FILE_" deleted."
+31 if ($Y+3>IOSL)
DO PAUSE
DO MES^XPDUTL(MSG)
End DoDot:3
if OUT=1
QUIT
+32 WRITE !!
End DoDot:2
if ABORT=1
QUIT
End DoDot:1
if ABORT=1
QUIT
+33 IF ABORT=0
IF DATA=1
Begin DoDot:1
+34 SET MSG=" Clean-up of old extract data complete."
+35 if ($Y+3>IOSL)
DO PAUSE
DO MES^XPDUTL(MSG)
End DoDot:1
+36 IF ABORT=0
IF DATA=0
Begin DoDot:1
+37 SET MSG=" There are no old extract records which can be deleted."
+38 if ($Y+3>IOSL)
DO PAUSE
DO MES^XPDUTL(MSG)
End DoDot:1
+39 WRITE !!
+40 QUIT
+41 ;
FILES ;files to be checked for existing data
+1 ;;727.802;ADMISSION EXTRACT
+2 ;;727.803;CLINIC EXTRACT
+3 ;;727.804;CLINIC NOSHOW EXTRACT
+4 ;;727.805;NURSING EXTRACT
+5 ;;727.806;DENTAL EXTRACT
+6 ;;727.808;PHYSICAL MOVEMENT EXTRACT
+7 ;;727.809;UNIT DOSE LOCAL EXTRACT
+8 ;;727.81;PRESCRIPTION EXTRACT
+9 ;;727.811;SURGERY EXTRACT
+10 ;;727.813;LABORATORY EXTRACT
+11 ;;727.814;RADIOLOGY EXTRACT
+12 ;;727.815;EVENT CAPTURE LOCAL EXTRACT
+13 ;;727.817;TREATING SPECIALTY CHANGE EXTRACT
+14 ;;727.819;IV DETAIL EXTRACT
+15 ;;727.82;ADMISSION SETUP EXTRACT
+16 ;;727.821;PHYSICAL MOVEMENT SETUP EXTRACT
+17 ;;727.822;TREATING SPECIALTY CHANGE SETUP EXTRACT
+18 ;;727.823;PAI EXTRACT
+19 ;;727.824;LAB RESULTS EXTRACT
+20 ;;727.825;QUASAR EXTRACT
+21 ;
MSG1 ;
+1 ;;
+2 ;; ********** WARNING **********
+3 ;;
+4 ;;DO NOT INSTALL DSS EXTRACTS V3.0 unless your site has
+5 ;;extracted, transmitted, and received transmission
+6 ;;confirmation from the Austin Automation Center for ALL
+7 ;;FY97 data. Prior approval for this installation should
+8 ;;have been received from the local DSS Site Manager.
+9 ;;
+10 ;; Answer YES to install DSS EXTRACTS v3.0.
+11 ;; Answer NO to stop the installation process now.
+12 ;;
MSG2 ;post abort message
+1 ;;
+2 ;;
+3 ;;Installation aborted...
+4 ;;
MSG2B ;more post abort info if data in files
+1 ;;
+2 ;;Before continuing with this installation, you should verify with
+3 ;;the DSS Site Manager that all FY97 data has been transmitted and
+4 ;;transmission confirmation has been received from the Austin
+5 ;;Automation Center. Then data from the following files should be
+6 ;;purged by the DSS Site Manager using the Purge Data from Extract
+7 ;;Files [ECXPURG] option:
+8 ;;
MSG3 ;;restart info
+1 ;;
+2 ;;When you wish to continue with this installation, simply select
+3 ;;the Install Package(s) [XPD INSTALL BUILD] option from the Kernel
+4 ;;Installation & Distribution System menu. You do not need to
+5 ;;reload the KIDS distribution file. (The package build has not
+6 ;;been deleted from the ^XTMP global.)
+7 ;;
+8 ;;
CLEAN1 ;;can't cleanup global if v3 installed
+1 ;;
+2 ;;DSS EXTRACTS v3.0 has already been installed on this system.
+3 ;;This file clean-up cannot be performed after installation of
+4 ;;the new version.
+5 ;;
+6 ;;If you are having difficulty, please contact the Customer Support
+7 ;;Help Desk.
+8 ;;
CLEAN2 ;;unpurged extract file
+1 ;;
+2 ;;Cannot continue -- an unpurged extract file has been found.
+3 ;;
+4 ;;Please advise the DSS Site Manager to complete purging of all
+5 ;;previously extracted data from files #727.802 through #727.825
+6 ;;by using the DSS option Purge Data from Extract Files [ECXPURG].
+7 ;;
