XPDDI ;SFISC/RSD - Display an Install ; 29 Feb 96 13:10
;;8.0;KERNEL;**21**;Jul 10, 1995
EN1 ;print from Install file
N DIC,D0,XPD,Y,Z
S DIC="^XPD(9.7,",DIC(0)="AEMQZ" D ^DIC Q:Y'>0
S D0=+Y,XPD("D0")="",Y="PNT^XPDDI",Z="Install File Print"
D EN^XUTMDEVQ(Y,Z,.XPD)
Q
;
PNT ;print a package
N X,XPD,XPDDT,XPDI,XPDJ,XPD0,XPDPG,XPDQ,XPDUL
Q:'$D(^XPD(9.7,D0,0)) S XPD0=^(0),XPDJ=$G(^(1)),XPDPG=1,$P(XPDUL,"-",IOM)="",XPDDT=$$HTE^XLFDT($H,"1PM")
W:$E(IOST,1,2)="C-" @IOF D HDR
W "STATUS: ",$$EXTERNAL^DILFD(9.7,.02,"",$P(XPD0,U,9)),?42,"DATE LOADED: ",$$EXTERNAL^DILFD(9.7,2,"",$P(XPD0,U,3))
W !,"INSTALLED BY: ",$$EXTERNAL^DILFD(9.7,9,"",$P(XPD0,U,11))
W !,"NATIONAL PACKAGE: ",$$EXTERNAL^DILFD(9.7,1,"",$P(XPD0,U,2))
W !!,"INSTALL STARTED: ",$$EXTERNAL^DILFD(9.7,11,"",$P(XPDJ,U))
W:$P(XPDJ,U,3) ?45,$P($$EXTERNAL^DILFD(9.7,17,"",$P(XPDJ,U,3)),"@",2),?65,$$DIFF($P(XPDJ,U,3),$P(XPDJ,U))
;XPD is start date/time
S XPD=+$P(XPDJ,U)
W !!,"ROUTINES:",?45,$P($$EXTERNAL^DILFD(9.7,12,"",$P(XPDJ,U,2)),"@",2),?65,$$DIFF($P(XPDJ,U,2),XPD),!
;XPD is the last complete time, it is also the next start time
S XPDQ=0 S:$P(XPDJ,U,2) XPD=$P(XPDJ,U,2)
I $O(^XPD(9.7,D0,"INI",1)) D
.W !,"PRE-INIT CHECK POINTS:",! S XPDI=1
.F S XPDI=$O(^XPD(9.7,D0,"INI",XPDI)) Q:'XPDI S X=^(XPDI,0) D Q:XPDQ
..W $P(X,U),?45,$P($$EXTERNAL^DILFD(9.713,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
..S XPDQ=$$CHK(4)
.Q:XPDQ S X=^XPD(9.7,D0,"INI",1,0)
.W $P(X,U),?45,$P($$EXTERNAL^DILFD(9.713,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
.S XPDQ=$$CHK(4)
Q:XPDQ
I $O(^XPD(9.7,D0,4,0)) D
.W !,"FILES:",! S XPDI=0
.F S XPDI=$O(^XPD(9.7,D0,4,XPDI)) Q:'XPDI S X=^(XPDI,0) D Q:XPDQ
..W $P($G(^DIC(+$P(X,U),0)),U),?45,$P($$EXTERNAL^DILFD(9.714,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
..S XPDQ=$$CHK(4)
Q:XPDQ
I $O(^XPD(9.7,D0,"KRN","AC",0)) D
.W ! S XPDI=0
.F S XPDI=$O(^XPD(9.7,D0,"KRN","AC",XPDI)) Q:'XPDI S XPDJ=$O(^(XPDI,0)) D Q:XPDQ
..Q:'$D(^XPD(9.7,D0,"KRN",XPDJ,0)) S X=^(0)
..Q:'$D(^DIC(XPDJ,0))#2 W $P(^(0),U)
..W ?45,$P($$EXTERNAL^DILFD(9.715,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
..S XPDQ=$$CHK(4)
Q:XPDQ
I $O(^XPD(9.7,D0,"GLO",0)) D
.W !,"GLOBALS:",! S XPDI=0
.F S XPDI=$O(^XPD(9.7,D0,"GLO",XPDI)) Q:'XPDI S X=^(XPDI,0) D Q:XPDQ
..W $P(X,U),?45,$P($$EXTERNAL^DILFD(9.718,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
..S XPDQ=$$CHK(4)
Q:XPDQ
I $O(^XPD(9.7,D0,"INIT",1)) D
.W !,"POST-INIT CHECK POINTS:",! S XPDI=1
.F S XPDI=$O(^XPD(9.7,D0,"INIT",XPDI)) Q:'XPDI S X=^(XPDI,0) D Q:XPDQ
..W $P(X,U),?45,$P($$EXTERNAL^DILFD(9.716,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
..S XPDQ=$$CHK(4)
.Q:XPDQ S X=^XPD(9.7,D0,"INIT",1,0)
.W $P(X,U),?45,$P($$EXTERNAL^DILFD(9.716,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),XPD),!
.S XPDQ=$$CHK(4)
I $O(^XPD(9.7,D0,"VOL",0)) D
.W !,"OTHER CPUs:",! S XPDI=0
.F S XPDI=$O(^XPD(9.7,D0,"VOL",XPDI)) Q:'XPDI S X=^(XPDI,0) D Q:XPDQ
..W $P(X,U)," STARTED ",$P($$EXTERNAL^DILFD(9.703,2,"",$P(X,U,3)),"@",2)
..W ?45,$P($$EXTERNAL^DILFD(9.703,1,"",$P(X,U,2)),"@",2),?65,$$DIFF($P(X,U,2),$P(X,U,3)),!
..S XPDQ=$$CHK(4)
Q:XPDQ
I $O(^XPD(9.7,D0,"QUES",0)) D
.W !,"INSTALL QUESTION PROMPT",?70,"ANSWER",! S XPDI=0
.F S XPDI=$O(^XPD(9.7,D0,"QUES",XPDI)) Q:'XPDI S X=$P(^(XPDI,0),U),XPD=$G(^("A")),XPDJ=$G(^("B")) D Q:XPDQ
..W !,X," ",XPD,?70,XPDJ
..S XPDQ=$$CHK(4)
Q:XPDQ
W !,"MESSAGES:",!
S XPDI=0
F S XPDI=$O(^XPD(9.7,D0,"MES",XPDI)) Q:'XPDI I $D(^(XPDI,0)) W ^(0),! S XPDQ=$$CHK(4) Q:XPDQ
Q
;
CHK(Y) ;Y=excess lines, return 1 to exit
Q:$Y<(IOSL-Y) 0
I $E(IOST,1,2)="C-" D Q:'Y 1
.N DIR,I,J,K,X
.S DIR(0)="E" D ^DIR
S XPDPG=XPDPG+1
W @IOF D HDR
Q 0
;
DIFF(X,Y) ;returns diff of X-Y
I 'X Q ""
S XPD=X
Q $$FMDIFF^XLFDT(X,Y,3)
;
HDR W !,"PACKAGE: ",$P(XPD0,U)," ",XPDDT,?70,"PAGE ",XPDPG,!,?45,"COMPLETED",?65,"ELAPSED",!,XPDUL,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDDI 3982 printed Dec 13, 2024@02:03:20 Page 2
XPDDI ;SFISC/RSD - Display an Install ; 29 Feb 96 13:10
+1 ;;8.0;KERNEL;**21**;Jul 10, 1995
EN1 ;print from Install file
+1 NEW DIC,D0,XPD,Y,Z
+2 SET DIC="^XPD(9.7,"
SET DIC(0)="AEMQZ"
DO ^DIC
if Y'>0
QUIT
+3 SET D0=+Y
SET XPD("D0")=""
SET Y="PNT^XPDDI"
SET Z="Install File Print"
+4 DO EN^XUTMDEVQ(Y,Z,.XPD)
+5 QUIT
+6 ;
PNT ;print a package
+1 NEW X,XPD,XPDDT,XPDI,XPDJ,XPD0,XPDPG,XPDQ,XPDUL
+2 if '$DATA(^XPD(9.7,D0,0))
QUIT
SET XPD0=^(0)
SET XPDJ=$GET(^(1))
SET XPDPG=1
SET $PIECE(XPDUL,"-",IOM)=""
SET XPDDT=$$HTE^XLFDT($HOROLOG,"1PM")
+3 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HDR
+4 WRITE "STATUS: ",$$EXTERNAL^DILFD(9.7,.02,"",$PIECE(XPD0,U,9)),?42,"DATE LOADED: ",$$EXTERNAL^DILFD(9.7,2,"",$PIECE(XPD0,U,3))
+5 WRITE !,"INSTALLED BY: ",$$EXTERNAL^DILFD(9.7,9,"",$PIECE(XPD0,U,11))
+6 WRITE !,"NATIONAL PACKAGE: ",$$EXTERNAL^DILFD(9.7,1,"",$PIECE(XPD0,U,2))
+7 WRITE !!,"INSTALL STARTED: ",$$EXTERNAL^DILFD(9.7,11,"",$PIECE(XPDJ,U))
+8 if $PIECE(XPDJ,U,3)
WRITE ?45,$PIECE($$EXTERNAL^DILFD(9.7,17,"",$PIECE(XPDJ,U,3)),"@",2),?65,$$DIFF($PIECE(XPDJ,U,3),$PIECE(XPDJ,U))
+9 ;XPD is start date/time
+10 SET XPD=+$PIECE(XPDJ,U)
+11 WRITE !!,"ROUTINES:",?45,$PIECE($$EXTERNAL^DILFD(9.7,12,"",$PIECE(XPDJ,U,2)),"@",2),?65,$$DIFF($PIECE(XPDJ,U,2),XPD),!
+12 ;XPD is the last complete time, it is also the next start time
+13 SET XPDQ=0
if $PIECE(XPDJ,U,2)
SET XPD=$PIECE(XPDJ,U,2)
+14 IF $ORDER(^XPD(9.7,D0,"INI",1))
Begin DoDot:1
+15 WRITE !,"PRE-INIT CHECK POINTS:",!
SET XPDI=1
+16 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"INI",XPDI))
if 'XPDI
QUIT
SET X=^(XPDI,0)
Begin DoDot:2
+17 WRITE $PIECE(X,U),?45,$PIECE($$EXTERNAL^DILFD(9.713,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+18 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
+19 if XPDQ
QUIT
SET X=^XPD(9.7,D0,"INI",1,0)
+20 WRITE $PIECE(X,U),?45,$PIECE($$EXTERNAL^DILFD(9.713,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+21 SET XPDQ=$$CHK(4)
End DoDot:1
+22 if XPDQ
QUIT
+23 IF $ORDER(^XPD(9.7,D0,4,0))
Begin DoDot:1
+24 WRITE !,"FILES:",!
SET XPDI=0
+25 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,4,XPDI))
if 'XPDI
QUIT
SET X=^(XPDI,0)
Begin DoDot:2
+26 WRITE $PIECE($GET(^DIC(+$PIECE(X,U),0)),U),?45,$PIECE($$EXTERNAL^DILFD(9.714,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+27 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
End DoDot:1
+28 if XPDQ
QUIT
+29 IF $ORDER(^XPD(9.7,D0,"KRN","AC",0))
Begin DoDot:1
+30 WRITE !
SET XPDI=0
+31 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"KRN","AC",XPDI))
if 'XPDI
QUIT
SET XPDJ=$ORDER(^(XPDI,0))
Begin DoDot:2
+32 if '$DATA(^XPD(9.7,D0,"KRN",XPDJ,0))
QUIT
SET X=^(0)
+33 if '$DATA(^DIC(XPDJ,0))#2
QUIT
WRITE $PIECE(^(0),U)
+34 WRITE ?45,$PIECE($$EXTERNAL^DILFD(9.715,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+35 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
End DoDot:1
+36 if XPDQ
QUIT
+37 IF $ORDER(^XPD(9.7,D0,"GLO",0))
Begin DoDot:1
+38 WRITE !,"GLOBALS:",!
SET XPDI=0
+39 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"GLO",XPDI))
if 'XPDI
QUIT
SET X=^(XPDI,0)
Begin DoDot:2
+40 WRITE $PIECE(X,U),?45,$PIECE($$EXTERNAL^DILFD(9.718,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+41 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
End DoDot:1
+42 if XPDQ
QUIT
+43 IF $ORDER(^XPD(9.7,D0,"INIT",1))
Begin DoDot:1
+44 WRITE !,"POST-INIT CHECK POINTS:",!
SET XPDI=1
+45 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"INIT",XPDI))
if 'XPDI
QUIT
SET X=^(XPDI,0)
Begin DoDot:2
+46 WRITE $PIECE(X,U),?45,$PIECE($$EXTERNAL^DILFD(9.716,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+47 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
+48 if XPDQ
QUIT
SET X=^XPD(9.7,D0,"INIT",1,0)
+49 WRITE $PIECE(X,U),?45,$PIECE($$EXTERNAL^DILFD(9.716,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),XPD),!
+50 SET XPDQ=$$CHK(4)
End DoDot:1
+51 IF $ORDER(^XPD(9.7,D0,"VOL",0))
Begin DoDot:1
+52 WRITE !,"OTHER CPUs:",!
SET XPDI=0
+53 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"VOL",XPDI))
if 'XPDI
QUIT
SET X=^(XPDI,0)
Begin DoDot:2
+54 WRITE $PIECE(X,U)," STARTED ",$PIECE($$EXTERNAL^DILFD(9.703,2,"",$PIECE(X,U,3)),"@",2)
+55 WRITE ?45,$PIECE($$EXTERNAL^DILFD(9.703,1,"",$PIECE(X,U,2)),"@",2),?65,$$DIFF($PIECE(X,U,2),$PIECE(X,U,3)),!
+56 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
End DoDot:1
+57 if XPDQ
QUIT
+58 IF $ORDER(^XPD(9.7,D0,"QUES",0))
Begin DoDot:1
+59 WRITE !,"INSTALL QUESTION PROMPT",?70,"ANSWER",!
SET XPDI=0
+60 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"QUES",XPDI))
if 'XPDI
QUIT
SET X=$PIECE(^(XPDI,0),U)
SET XPD=$GET(^("A"))
SET XPDJ=$GET(^("B"))
Begin DoDot:2
+61 WRITE !,X," ",XPD,?70,XPDJ
+62 SET XPDQ=$$CHK(4)
End DoDot:2
if XPDQ
QUIT
End DoDot:1
+63 if XPDQ
QUIT
+64 WRITE !,"MESSAGES:",!
+65 SET XPDI=0
+66 FOR
SET XPDI=$ORDER(^XPD(9.7,D0,"MES",XPDI))
if 'XPDI
QUIT
IF $DATA(^(XPDI,0))
WRITE ^(0),!
SET XPDQ=$$CHK(4)
if XPDQ
QUIT
+67 QUIT
+68 ;
CHK(Y) ;Y=excess lines, return 1 to exit
+1 if $Y<(IOSL-Y)
QUIT 0
+2 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 NEW DIR,I,J,K,X
+4 SET DIR(0)="E"
DO ^DIR
End DoDot:1
if 'Y
QUIT 1
+5 SET XPDPG=XPDPG+1
+6 WRITE @IOF
DO HDR
+7 QUIT 0
+8 ;
DIFF(X,Y) ;returns diff of X-Y
+1 IF 'X
QUIT ""
+2 SET XPD=X
+3 QUIT $$FMDIFF^XLFDT(X,Y,3)
+4 ;
HDR WRITE !,"PACKAGE: ",$PIECE(XPD0,U)," ",XPDDT,?70,"PAGE ",XPDPG,!,?45,"COMPLETED",?65,"ELAPSED",!,XPDUL,!
+1 QUIT
