Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGVPP

DGVPP.m

Go to the documentation of this file.
  1. DGVPP ;ALB/MTC - DG PRE-PRE-INIT DRIVER ; 05 JUN 87
  1. ;;5.3;Registration;;Aug 13, 1993
  1. ;
  1. EN ; -- main entry point
  1. S XQABT1=$H
  1. D H^DGUTL S IOP="HOME" D ^%ZIS
  1. D USER,VERS:$D(DIFQ),DPT:$D(DIFQ),ALR:$D(DIFQ),ROU:$D(DIFQ)
  1. I $D(DIFQ) S DGVFLD=100 D PKG I $D(DIFQ),DGVCUR D EN^DGV53PP
  1. I '$D(DIFQ) W !!,"'DG' INITIALIZATION ABORTED!!" G Q
  1. S XQABT2=$H
  1. ENQ Q
  1. ;
  1. Q K DGVFLD,DGI,DGVCUR,DGVNEW,DGVNEWVR,DGVREQ,DGVREL,DGTIME,DGDATE,SDVCUR,DGER,DGDIU,J,ON
  1. K DFN,DGDAY,DGDJ,DGDOCFL,DGDOMB,DGENDT,DGSTDT,STIME,CT,CURPT,DMRG,I2,XCNP,XMZ,DPTIME,DGCFLBD,DGCFLCN,DGTOTBD,DGTOTCN
  1. Q
  1. ;
  1. 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
  1. Q
  1. ;
  1. VERS ;Set-up variables for Current, New and Required versions of PIMS
  1. S DGVCUR=+$S($D(^DG(43,1,"VERSION")):^("VERSION"),1:"")
  1. S DGVREQ=$$REQ()
  1. S DGVREL=$$REL()
  1. S DGVNEWVR=$P($T(DGVPP+1),";",3),DGVNEW=+DGVNEWVR
  1. S SDVCUR=$S($D(^DG(43,1,"SCLR")):$P(^("SCLR"),"^",5),1:0)
  1. ;
  1. I DGVCUR,(DGVCUR<DGVREQ) D MSG G VERSQ
  1. ;
  1. I DGVCUR>DGVNEW W !!,"Current version (",DGVCUR,") is greater than this version (",DGVNEW,")." K DIFQ
  1. VERSQ Q
  1. ;
  1. REQ() ; -- release required
  1. Q 5.2
  1. ;
  1. REL() ; -- this release's final version
  1. Q 5.3
  1. ;
  1. MSG ;Print message if this version of PIMS can not be installed
  1. 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,"."
  1. W !!,"This initialization requires that Version ",DGVREQ,", or higher, of the PIMS module be installed",!,"prior to installing this release."
  1. 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
  1. Q
  1. ;
  1. DPT ;Check if DPTINIT has been installed prior to installing DG
  1. I $S('$D(^DG(48,DGVREL,"R")):1,$P(^("R"),"^",8)']"":1,1:0) W !!,"'DPTINIT' must be run before initializing 'DG'!!" K DIFQ
  1. Q
  1. ;
  1. ALR ;Check if this version of PIMS has already been installed
  1. S %=1
  1. I DGVCUR=DGVNEWVR W !!,"YOU'VE ALREADY INSTALLED VERSION ",DGVNEW," ONCE.",!,"DO YOU REALLY WANT TO REINSTALL" S %=2 D YN^DICN
  1. I '% W !!?3,"Enter 'YES' to reinstall, or 'NO' not to." G ALR
  1. K:%<0!(%=2) DIFQ
  1. Q
  1. PKG ;Check other packages required for this version of PIMS
  1. I '$D(^ORD(100.99)) D
  1. .W !!,">>> You must install ORDER ENTRY/RESULTS REPORTING (OR*) before"
  1. .W !," running this installation.",!
  1. .K DIFQ
  1. ;
  1. N X S X="IBARXEU" X ^%ZOSF("TEST") I '$T D
  1. .W !!,">>> Copay-Exemption patches must be installed before running"
  1. .W !," this installation. Patches: IB*1.5*9"
  1. .W !," DG*5.2*22"
  1. .W !," SD*5.2*9"
  1. .W !," PRCA*3.7*8"
  1. .K DIFQ
  1. ;
  1. I '$D(^HL(770,0)) D
  1. .W !!,">>> You must install the DHCP HL7 package before running this"
  1. .W !," installation.",!
  1. .K DIFQ
  1. Q
  1. ;
  1. ROU ;Check compiled routine size parameter
  1. I $G(^DD("ROU"))<4000 D K DIFQ
  1. .W !!,*7,"Your FileMan compiled routine size parameter [^DD(""ROU"")] is too small."
  1. .W !,"It is currently set to '",+^DD("ROU"),"'."
  1. .W !!,"Please use ^DIEZ to reset this value to 4000 or higher."
  1. Q
  1. ;
  1. LINE ; -- write separator line
  1. N X
  1. S $P(X,"_",81)="" W !,X
  1. Q