- 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 Jan 18, 2025@03:59:52 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