- 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 Feb 18, 2025@23:29:45 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
