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