XPDDPCK ;SFISC/RSD - Display a Package file information ;10/03/96 10:15
;;8.0;KERNEL;**44**;Jul 05, 1995
EN1 ;print all Patches for Package version
N DIC,DIR,DIRUT,XPD,XPD0,XPDFL,XPDNM,XPDV,Y,Z
S DIC="^DIC(9.4,",DIC(0)="AEMQZ" D ^DIC Q:Y'>0
I '$D(^DIC(9.4,+Y,22,0)) W !!,"This Package has no VERSION multiple",! Q
S XPD0=+Y,DIC=DIC_XPD0_",22," S:$G(^DIC(9.4,XPD0,"VERSION")) DIC("B")=$P(^("VERSION"),U)
D ^DIC Q:Y'>0
S XPDV=+Y,DIR(0)="Y",DIR("A")="Do you want to see the Descriptions",DIR("B")="NO"
D ^DIR Q:$D(DIRUT)
S XPDFL=Y,X="PNT^XPDDPCK",Z="Package File Print"
F Y="XPD0","XPDFL","XPDV" S XPD(Y)=""
D EN^XUTMDEVQ(X,Z,.XPD)
Q
;
PNT ;print a package
N DIRUT,I,J,K,X,XPD,XPDDT,XPDI,XPDPG,XPDUL,XPDV0
Q:'$G(XPD0)!'$G(XPDV)!'$D(XPDFL)
Q:'$D(^DIC(9.4,XPD0,0)) S XPDNM=$P(^(0),U) Q:'$D(^(22,XPDV,0)) S XPDV0=^(0)
S XPDPG=1,$P(XPDUL,"-",IOM)="",XPDDT=$$HTE^XLFDT($H,"1PM")
W:$E(IOST,1,2)="C-" @IOF D HDR
W "VERSION: ",$P(XPDV0,U),?20,$$EXTERNAL^DILFD(9.49,2,"",$P(XPDV0,U,3)),?50,$$EXTERNAL^DILFD(9.49,3,"",$P(XPDV0,U,4))
;diplay version description
I XPDFL W ! D DES("^DIC(9.4,"_XPD0_",22,"_XPDV_",1)") Q:$D(DIRUT)
W ! S XPDI=0
F S XPDI=$O(^DIC(9.4,XPD0,22,XPDV,"PAH",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(4) D Q:$D(DIRUT)
.;patch history
.W !?3,$P(XPD,U),?20,$$EXTERNAL^DILFD(9.4901,.02,"",$P(XPD,U,2)),?50,$$EXTERNAL^DILFD(9.4901,.03,"",$P(XPD,U,3))
.I XPDFL W ! D DES("^DIC(9.4,"_XPD0_",22,"_XPDV_",""PAH"","_XPDI_",1)")
W ! Q
;
CHK(Y) ;Y=excess lines, return 1 to exit & DIRUT is set
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
;
DES(XPDGR) ;display description, XPDGR=global root
N XPDI S XPDI=0
F S XPDI=$O(@XPDGR@(XPDI)) Q:'XPDI I $D(^(XPDI,0)) W ^(0),! Q:$$CHK(4)
Q
;
HDR W !,"PACKAGE: ",XPDNM," ",XPDDT,?70,"PAGE ",XPDPG,!,"PATCH #",?20,"INSTALLED",?50,"INSTALLED BY"
W:XPDFL !?5,"DESCRIPTION"
W !,XPDUL,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDDPCK 1998 printed Dec 13, 2024@02:03:23 Page 2
XPDDPCK ;SFISC/RSD - Display a Package file information ;10/03/96 10:15
+1 ;;8.0;KERNEL;**44**;Jul 05, 1995
EN1 ;print all Patches for Package version
+1 NEW DIC,DIR,DIRUT,XPD,XPD0,XPDFL,XPDNM,XPDV,Y,Z
+2 SET DIC="^DIC(9.4,"
SET DIC(0)="AEMQZ"
DO ^DIC
if Y'>0
QUIT
+3 IF '$DATA(^DIC(9.4,+Y,22,0))
WRITE !!,"This Package has no VERSION multiple",!
QUIT
+4 SET XPD0=+Y
SET DIC=DIC_XPD0_",22,"
if $GET(^DIC(9.4,XPD0,"VERSION"))
SET DIC("B")=$PIECE(^("VERSION"),U)
+5 DO ^DIC
if Y'>0
QUIT
+6 SET XPDV=+Y
SET DIR(0)="Y"
SET DIR("A")="Do you want to see the Descriptions"
SET DIR("B")="NO"
+7 DO ^DIR
if $DATA(DIRUT)
QUIT
+8 SET XPDFL=Y
SET X="PNT^XPDDPCK"
SET Z="Package File Print"
+9 FOR Y="XPD0","XPDFL","XPDV"
SET XPD(Y)=""
+10 DO EN^XUTMDEVQ(X,Z,.XPD)
+11 QUIT
+12 ;
PNT ;print a package
+1 NEW DIRUT,I,J,K,X,XPD,XPDDT,XPDI,XPDPG,XPDUL,XPDV0
+2 if '$GET(XPD0)!'$GET(XPDV)!'$DATA(XPDFL)
QUIT
+3 if '$DATA(^DIC(9.4,XPD0,0))
QUIT
SET XPDNM=$PIECE(^(0),U)
if '$DATA(^(22,XPDV,0))
QUIT
SET XPDV0=^(0)
+4 SET XPDPG=1
SET $PIECE(XPDUL,"-",IOM)=""
SET XPDDT=$$HTE^XLFDT($HOROLOG,"1PM")
+5 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO HDR
+6 WRITE "VERSION: ",$PIECE(XPDV0,U),?20,$$EXTERNAL^DILFD(9.49,2,"",$PIECE(XPDV0,U,3)),?50,$$EXTERNAL^DILFD(9.49,3,"",$PIECE(XPDV0,U,4))
+7 ;diplay version description
+8 IF XPDFL
WRITE !
DO DES("^DIC(9.4,"_XPD0_",22,"_XPDV_",1)")
if $DATA(DIRUT)
QUIT
+9 WRITE !
SET XPDI=0
+10 FOR
SET XPDI=$ORDER(^DIC(9.4,XPD0,22,XPDV,"PAH",XPDI))
if 'XPDI
QUIT
SET XPD=$GET(^(XPDI,0))
if $$CHK(4)
QUIT
Begin DoDot:1
+11 ;patch history
+12 WRITE !?3,$PIECE(XPD,U),?20,$$EXTERNAL^DILFD(9.4901,.02,"",$PIECE(XPD,U,2)),?50,$$EXTERNAL^DILFD(9.4901,.03,"",$PIECE(XPD,U,3))
+13 IF XPDFL
WRITE !
DO DES("^DIC(9.4,"_XPD0_",22,"_XPDV_",""PAH"","_XPDI_",1)")
End DoDot:1
if $DATA(DIRUT)
QUIT
+14 WRITE !
QUIT
+15 ;
CHK(Y) ;Y=excess lines, return 1 to exit & DIRUT is set
+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 ;
DES(XPDGR) ;display description, XPDGR=global root
+1 NEW XPDI
SET XPDI=0
+2 FOR
SET XPDI=$ORDER(@XPDGR@(XPDI))
if 'XPDI
QUIT
IF $DATA(^(XPDI,0))
WRITE ^(0),!
if $$CHK(4)
QUIT
+3 QUIT
+4 ;
HDR WRITE !,"PACKAGE: ",XPDNM," ",XPDDT,?70,"PAGE ",XPDPG,!,"PATCH #",?20,"INSTALLED",?50,"INSTALLED BY"
+1 if XPDFL
WRITE !?5,"DESCRIPTION"
+2 WRITE !,XPDUL,!
+3 QUIT
