XPDID ;SFISC/VYD,RSD - Display Install Progress ; Mar 28, 2022@12:48
;;8.0;KERNEL;**81,768**;Jul 10, 1995;Build 8
;Per VHA Directive 2004-038, this routine should not be modified.
Q
INIT ;initialize progress screen
N X,XPDSTR
S XPDIDVT=0 ;turn off graphic
;If not C-VT, quit
Q:IO'=IO(0)!(IOST'["C-VT")
S X="IOSTBM",XPDSTR=" 25 50 75 "
D ENDR^%ZISS
;If bottom margin is null, quit
Q:$G(IOSTBM)="" ;p768
;if graphic routine is missing, quit
Q:$T(PREP^XGF)=""
;S X="XGF" X ^%ZOSF("TEST") E S XPDIDVT=0 Q
D PREP^XGF
;everything looks good, turn on graphic
S IOTM=3,IOBM=IOSL-4,XPDIDVT=1
W @IOSTBM
D FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1)
D FRAME^XGF(IOBM,0,IOBM,IOM-1)
D FRAME^XGF(IOBM+1,10,IOBM+3,71)
D SAY^XGF(IOBM+2,11,XPDSTR)
D SAY^XGF(IOBM+2,0,$J("0",5)_"%")
D SAY^XGF(IOBM+3,0,"Complete")
D IOXY^XGF(IOTM-2,0)
Q
;
EXIT(XPDM) ;exit progress screen restore screen to normal
I $G(XPDIDVT) D
.S IOTM=1,IOBM=IOSL
.W:IOSTBM]"" @IOSTBM W:IOF]"" @IOF ;p768
.W:$G(XPDM)]"" !!,XPDM,!!
.D CLEAN^XGF
K IOTM,IOBM,IOSTBM,XPDIDCNT,XPDIDMOD,XPDIDTOT,XPDIDVT
Q
;
TITLE(X) ;display title X
Q:'XPDIDVT
N XPDOX,XPDOY
S XPDOX=$X,XPDOY=$Y
D SAY^XGF(0,0,$$CJ^XLFSTR(X,IOM_"T")),CURSOR
Q
;
SETTOT(X) ;X=file # from build
Q:'$D(XPDIDVT)
S XPDIDTOT=$S(X=4:+$P($G(^XTMP("XPDI",XPDA,"BLD",XPDBLD,4,0)),U,4),X=9.8:+$G(^XTMP("XPDI",XPDA,"RTN")),1:+$P($G(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"KRN",X,"NM",0)),U,4))
S XPDIDMOD=$S(XPDIDTOT<60:1,1:XPDIDTOT\60),XPDIDCNT=0
Q:'XPDIDVT
D UPDATE(0)
Q
;
UPDATE(XPDN) ;update the progress bar
I 'XPDIDVT W "." Q
N XPDLEN,XPDMC,XPDOX,XPDOY,XPDS,XPDSTR
S XPDOX=$X,XPDOY=$Y,XPDMC=60,XPDSTR=" 25 50 75 "
S XPDLEN=$S(XPDIDTOT:XPDN/XPDIDTOT*XPDMC\1,1:0),XPDS=$E(XPDSTR,1,XPDLEN)
D SAY^XGF(IOBM+2,11,XPDS,"R1")
S XPDS=$E(XPDSTR,XPDLEN+1,XPDMC)
D SAY^XGF(IOBM+2,11+XPDLEN,XPDS)
D SAY^XGF(IOBM+2,0,$J(XPDLEN/XPDMC*100,5,0)),CURSOR
Q
;
CURSOR ;put cursor back
S:XPDOY>(IOBM-1) XPDOY=IOBM-1
D IOXY^XGF(XPDOY,XPDOX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDID 2127 printed Dec 13, 2024@02:03:36 Page 2
XPDID ;SFISC/VYD,RSD - Display Install Progress ; Mar 28, 2022@12:48
+1 ;;8.0;KERNEL;**81,768**;Jul 10, 1995;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
INIT ;initialize progress screen
+1 NEW X,XPDSTR
+2 ;turn off graphic
SET XPDIDVT=0
+3 ;If not C-VT, quit
+4 if IO'=IO(0)!(IOST'["C-VT")
QUIT
+5 SET X="IOSTBM"
SET XPDSTR=" 25 50 75 "
+6 DO ENDR^%ZISS
+7 ;If bottom margin is null, quit
+8 ;p768
if $GET(IOSTBM)=""
QUIT
+9 ;if graphic routine is missing, quit
+10 if $TEXT(PREP^XGF)=""
QUIT
+11 ;S X="XGF" X ^%ZOSF("TEST") E S XPDIDVT=0 Q
+12 DO PREP^XGF
+13 ;everything looks good, turn on graphic
+14 SET IOTM=3
SET IOBM=IOSL-4
SET XPDIDVT=1
+15 WRITE @IOSTBM
+16 DO FRAME^XGF(IOTM-2,0,IOTM-2,IOM-1)
+17 DO FRAME^XGF(IOBM,0,IOBM,IOM-1)
+18 DO FRAME^XGF(IOBM+1,10,IOBM+3,71)
+19 DO SAY^XGF(IOBM+2,11,XPDSTR)
+20 DO SAY^XGF(IOBM+2,0,$JUSTIFY("0",5)_"%")
+21 DO SAY^XGF(IOBM+3,0,"Complete")
+22 DO IOXY^XGF(IOTM-2,0)
+23 QUIT
+24 ;
EXIT(XPDM) ;exit progress screen restore screen to normal
+1 IF $GET(XPDIDVT)
Begin DoDot:1
+2 SET IOTM=1
SET IOBM=IOSL
+3 ;p768
if IOSTBM]""
WRITE @IOSTBM
if IOF]""
WRITE @IOF
+4 if $GET(XPDM)]""
WRITE !!,XPDM,!!
+5 DO CLEAN^XGF
End DoDot:1
+6 KILL IOTM,IOBM,IOSTBM,XPDIDCNT,XPDIDMOD,XPDIDTOT,XPDIDVT
+7 QUIT
+8 ;
TITLE(X) ;display title X
+1 if 'XPDIDVT
QUIT
+2 NEW XPDOX,XPDOY
+3 SET XPDOX=$X
SET XPDOY=$Y
+4 DO SAY^XGF(0,0,$$CJ^XLFSTR(X,IOM_"T"))
DO CURSOR
+5 QUIT
+6 ;
SETTOT(X) ;X=file # from build
+1 if '$DATA(XPDIDVT)
QUIT
+2 SET XPDIDTOT=$SELECT(X=4:+$PIECE($GET(^XTMP("XPDI",XPDA,"BLD",XPDBLD,4,0)),U,4),X=9.8:+$GET(^XTMP("XPDI",XPDA,"RTN")),1:+$PIECE($GET(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"KRN",X,"NM",0)),U,4))
+3 SET XPDIDMOD=$SELECT(XPDIDTOT<60:1,1:XPDIDTOT\60)
SET XPDIDCNT=0
+4 if 'XPDIDVT
QUIT
+5 DO UPDATE(0)
+6 QUIT
+7 ;
UPDATE(XPDN) ;update the progress bar
+1 IF 'XPDIDVT
WRITE "."
QUIT
+2 NEW XPDLEN,XPDMC,XPDOX,XPDOY,XPDS,XPDSTR
+3 SET XPDOX=$X
SET XPDOY=$Y
SET XPDMC=60
SET XPDSTR=" 25 50 75 "
+4 SET XPDLEN=$SELECT(XPDIDTOT:XPDN/XPDIDTOT*XPDMC\1,1:0)
SET XPDS=$EXTRACT(XPDSTR,1,XPDLEN)
+5 DO SAY^XGF(IOBM+2,11,XPDS,"R1")
+6 SET XPDS=$EXTRACT(XPDSTR,XPDLEN+1,XPDMC)
+7 DO SAY^XGF(IOBM+2,11+XPDLEN,XPDS)
+8 DO SAY^XGF(IOBM+2,0,$JUSTIFY(XPDLEN/XPDMC*100,5,0))
DO CURSOR
+9 QUIT
+10 ;
CURSOR ;put cursor back
+1 if XPDOY>(IOBM-1)
SET XPDOY=IOBM-1
+2 DO IOXY^XGF(XPDOY,XPDOX)
+3 QUIT
