DGVPP ;ALB/MTC - DG PRE-PRE-INIT DRIVER ; 05 JUN 87
;;5.3;Registration;;Aug 13, 1993
;
EN ; -- main entry point
S XQABT1=$H
D H^DGUTL S IOP="HOME" D ^%ZIS
D USER,VERS:$D(DIFQ),DPT:$D(DIFQ),ALR:$D(DIFQ),ROU:$D(DIFQ)
I $D(DIFQ) S DGVFLD=100 D PKG I $D(DIFQ),DGVCUR D EN^DGV53PP
I '$D(DIFQ) W !!,"'DG' INITIALIZATION ABORTED!!" G Q
S XQABT2=$H
ENQ Q
;
Q K DGVFLD,DGI,DGVCUR,DGVNEW,DGVNEWVR,DGVREQ,DGVREL,DGTIME,DGDATE,SDVCUR,DGER,DGDIU,J,ON
K DFN,DGDAY,DGDJ,DGDOCFL,DGDOMB,DGENDT,DGSTDT,STIME,CT,CURPT,DMRG,I2,XCNP,XMZ,DPTIME,DGCFLBD,DGCFLCN,DGTOTBD,DGTOTCN
Q
;
USER I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,'$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !!?3,"The variable DUZ must be set to an active user code and the variable",!?3,"DUZ(0) must equal '@' to initialize.",! K DIFQ
Q
;
VERS ;Set-up variables for Current, New and Required versions of PIMS
S DGVCUR=+$S($D(^DG(43,1,"VERSION")):^("VERSION"),1:"")
S DGVREQ=$$REQ()
S DGVREL=$$REL()
S DGVNEWVR=$P($T(DGVPP+1),";",3),DGVNEW=+DGVNEWVR
S SDVCUR=$S($D(^DG(43,1,"SCLR")):$P(^("SCLR"),"^",5),1:0)
;
I DGVCUR,(DGVCUR<DGVREQ) D MSG G VERSQ
;
I DGVCUR>DGVNEW W !!,"Current version (",DGVCUR,") is greater than this version (",DGVNEW,")." K DIFQ
VERSQ Q
;
REQ() ; -- release required
Q 5.2
;
REL() ; -- this release's final version
Q 5.3
;
MSG ;Print message if this version of PIMS can not be installed
W !!,*7,"A search of your system indicates that the Version of the PIMS module which you",!,"are currently running on this system is Version ",DGVCUR,"."
W !!,"This initialization requires that Version ",DGVREQ,", or higher, of the PIMS module be installed",!,"prior to installing this release."
W !!,"If you do not have a copy of the necessary previous release(s) of MAS, which",!,"must be installed prior to this release of the module, please contact your",!,"local Information Systems Center for assistance." K DIFQ
Q
;
DPT ;Check if DPTINIT has been installed prior to installing DG
I $S('$D(^DG(48,DGVREL,"R")):1,$P(^("R"),"^",8)']"":1,1:0) W !!,"'DPTINIT' must be run before initializing 'DG'!!" K DIFQ
Q
;
ALR ;Check if this version of PIMS has already been installed
S %=1
I DGVCUR=DGVNEWVR W !!,"YOU'VE ALREADY INSTALLED VERSION ",DGVNEW," ONCE.",!,"DO YOU REALLY WANT TO REINSTALL" S %=2 D YN^DICN
I '% W !!?3,"Enter 'YES' to reinstall, or 'NO' not to." G ALR
K:%<0!(%=2) DIFQ
Q
PKG ;Check other packages required for this version of PIMS
I '$D(^ORD(100.99)) D
.W !!,">>> You must install ORDER ENTRY/RESULTS REPORTING (OR*) before"
.W !," running this installation.",!
.K DIFQ
;
N X S X="IBARXEU" X ^%ZOSF("TEST") I '$T D
.W !!,">>> Copay-Exemption patches must be installed before running"
.W !," this installation. Patches: IB*1.5*9"
.W !," DG*5.2*22"
.W !," SD*5.2*9"
.W !," PRCA*3.7*8"
.K DIFQ
;
I '$D(^HL(770,0)) D
.W !!,">>> You must install the DHCP HL7 package before running this"
.W !," installation.",!
.K DIFQ
Q
;
ROU ;Check compiled routine size parameter
I $G(^DD("ROU"))<4000 D K DIFQ
.W !!,*7,"Your FileMan compiled routine size parameter [^DD(""ROU"")] is too small."
.W !,"It is currently set to '",+^DD("ROU"),"'."
.W !!,"Please use ^DIEZ to reset this value to 4000 or higher."
Q
;
LINE ; -- write separator line
N X
S $P(X,"_",81)="" W !,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGVPP 3403 printed Nov 22, 2024@18:09:10 Page 2
DGVPP ;ALB/MTC - DG PRE-PRE-INIT DRIVER ; 05 JUN 87
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
EN ; -- main entry point
+1 SET XQABT1=$HOROLOG
+2 DO H^DGUTL
SET IOP="HOME"
DO ^%ZIS
+3 DO USER
if $DATA(DIFQ)
DO VERS
if $DATA(DIFQ)
DO DPT
if $DATA(DIFQ)
DO ALR
if $DATA(DIFQ)
DO ROU
+4 IF $DATA(DIFQ)
SET DGVFLD=100
DO PKG
IF $DATA(DIFQ)
IF DGVCUR
DO EN^DGV53PP
+5 IF '$DATA(DIFQ)
WRITE !!,"'DG' INITIALIZATION ABORTED!!"
GOTO Q
+6 SET XQABT2=$HOROLOG
ENQ QUIT
+1 ;
Q KILL DGVFLD,DGI,DGVCUR,DGVNEW,DGVNEWVR,DGVREQ,DGVREL,DGTIME,DGDATE,SDVCUR,DGER,DGDIU,J,ON
+1 KILL DFN,DGDAY,DGDJ,DGDOCFL,DGDOMB,DGENDT,DGSTDT,STIME,CT,CURPT,DMRG,I2,XCNP,XMZ,DPTIME,DGCFLBD,DGCFLCN,DGTOTBD,DGTOTCN
+2 QUIT
+3 ;
USER IF $SELECT('($DATA(DUZ)#2):1,'$DATA(^VA(200,+DUZ,0)):1,'$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)
WRITE !!?3,"The variable DUZ must be set to an active user code and the variable",!?3,"DUZ(0) must equal '@' to initialize.",!
KILL DIFQ
+1 QUIT
+2 ;
VERS ;Set-up variables for Current, New and Required versions of PIMS
+1 SET DGVCUR=+$SELECT($DATA(^DG(43,1,"VERSION")):^("VERSION"),1:"")
+2 SET DGVREQ=$$REQ()
+3 SET DGVREL=$$REL()
+4 SET DGVNEWVR=$PIECE($TEXT(DGVPP+1),";",3)
SET DGVNEW=+DGVNEWVR
+5 SET SDVCUR=$SELECT($DATA(^DG(43,1,"SCLR")):$PIECE(^("SCLR"),"^",5),1:0)
+6 ;
+7 IF DGVCUR
IF (DGVCUR<DGVREQ)
DO MSG
GOTO VERSQ
+8 ;
+9 IF DGVCUR>DGVNEW
WRITE !!,"Current version (",DGVCUR,") is greater than this version (",DGVNEW,")."
KILL DIFQ
VERSQ QUIT
+1 ;
REQ() ; -- release required
+1 QUIT 5.2
+2 ;
REL() ; -- this release's final version
+1 QUIT 5.3
+2 ;
MSG ;Print message if this version of PIMS can not be installed
+1 WRITE !!,*7,"A search of your system indicates that the Version of the PIMS module which you",!,"are currently running on this system is Version ",DGVCUR,"."
+2 WRITE !!,"This initialization requires that Version ",DGVREQ,", or higher, of the PIMS module be installed",!,"prior to installing this release."
+3 WRITE !!,"If you do not have a copy of the necessary previous release(s) of MAS, which",!,"must be installed prior to this release of the module, please contact your",!,"local Information Systems Center for assistance."
KILL DIFQ
+4 QUIT
+5 ;
DPT ;Check if DPTINIT has been installed prior to installing DG
+1 IF $SELECT('$DATA(^DG(48,DGVREL,"R")):1,$PIECE(^("R"),"^",8)']"":1,1:0)
WRITE !!,"'DPTINIT' must be run before initializing 'DG'!!"
KILL DIFQ
+2 QUIT
+3 ;
ALR ;Check if this version of PIMS has already been installed
+1 SET %=1
+2 IF DGVCUR=DGVNEWVR
WRITE !!,"YOU'VE ALREADY INSTALLED VERSION ",DGVNEW," ONCE.",!,"DO YOU REALLY WANT TO REINSTALL"
SET %=2
DO YN^DICN
+3 IF '%
WRITE !!?3,"Enter 'YES' to reinstall, or 'NO' not to."
GOTO ALR
+4 if %<0!(%=2)
KILL DIFQ
+5 QUIT
PKG ;Check other packages required for this version of PIMS
+1 IF '$DATA(^ORD(100.99))
Begin DoDot:1
+2 WRITE !!,">>> You must install ORDER ENTRY/RESULTS REPORTING (OR*) before"
+3 WRITE !," running this installation.",!
+4 KILL DIFQ
End DoDot:1
+5 ;
+6 NEW X
SET X="IBARXEU"
XECUTE ^%ZOSF("TEST")
IF '$TEST
Begin DoDot:1
+7 WRITE !!,">>> Copay-Exemption patches must be installed before running"
+8 WRITE !," this installation. Patches: IB*1.5*9"
+9 WRITE !," DG*5.2*22"
+10 WRITE !," SD*5.2*9"
+11 WRITE !," PRCA*3.7*8"
+12 KILL DIFQ
End DoDot:1
+13 ;
+14 IF '$DATA(^HL(770,0))
Begin DoDot:1
+15 WRITE !!,">>> You must install the DHCP HL7 package before running this"
+16 WRITE !," installation.",!
+17 KILL DIFQ
End DoDot:1
+18 QUIT
+19 ;
ROU ;Check compiled routine size parameter
+1 IF $GET(^DD("ROU"))<4000
Begin DoDot:1
+2 WRITE !!,*7,"Your FileMan compiled routine size parameter [^DD(""ROU"")] is too small."
+3 WRITE !,"It is currently set to '",+^DD("ROU"),"'."
+4 WRITE !!,"Please use ^DIEZ to reset this value to 4000 or higher."
End DoDot:1
KILL DIFQ
+5 QUIT
+6 ;
LINE ; -- write separator line
+1 NEW X
+2 SET $PIECE(X,"_",81)=""
WRITE !,X
+3 QUIT
