XBENHANC.m

XBENHANC ; IHS/ADC/GTH - DISPLAY/PRINT ENHANCEMENTS FIELD IN PACKAGE FILE ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; Print enhancements to a package, from the entry in the

 ; PACKAGE file.  Entry point EN^XBENHANC(ns) is used, with

 ; the caller providing the namespace of the package.

 ;

EN(XB) ;PEP - XB = Namespace of package to print enhancements.

 Q:'($G(XB)]"")

 D HOME^%ZIS,DT^DICRW

DEV ;

 S %ZIS="OPQ"

 D ^%ZIS

 I POP S IOP=$I D ^%ZIS G K

 G:'$D(IO("Q")) START

 KILL IO("Q")

 I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV

 S ZTRTN="START^XBENHANC",ZTDESC=$P($P($T(XBENHANC),"-",2),";",2),ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("XB")=""

 D ^%ZTLOAD

 G:'$D(ZTSK) DEV

K ;

 KILL ZTSK

 D ^%ZISC

 Q

 ;

START ;EP - TaskMan.

 NEW A,B,DIRUT,DIWL,DIWR,DIWF,XBHDR,XBPG

 S A=$O(^DIC(9.4,"C",XB,0))

 Q:'A

 Q:'$D(^DIC(9.4,A,"VERSION"))

 S B=$O(^DIC(9.4,A,22,"B",^DIC(9.4,A,"VERSION"),0))

 Q:'B

 S XBHDR="Enhancements to "_$P(^DIC(9.4,A,0),U)_", Version "_^DIC(9.4,A,"VERSION")

 KILL ^UTILITY($J,"W")

 S DIWL=5,DIWR=IOM-6,DIWF="W"

 U IO

 D TOF

 S %=0

 F  S %=$O(^DIC(9.4,A,22,B,1,%)) Q:'%   D DIWP(^(%,0)),TOF:$Y>(IOSL-6) Q:$D(DIRUT)

 D:'$D(DIRUT) ^DIWW

 KILL ^UTILITY($J,"W")

 D ^%ZISC

 Q

 ;

DIWP(X) ;

 NEW %,A,B

 D ^DIWP

 Q

 ;

TOF ;

 NEW %,A,B

 S XBPG=$G(XBPG)+1

 W !!

 I '$D(ZTQUEUED),'$D(IO("S")),IO=IO(0),$$DIR^XBDIR("E")

 Q:$D(DIRUT)

 W @IOF,!!,?DIWL-1,XBHDR,?(DIWR-$L("Page "_XBPG)-1),"Page ",XBPG,!?DIWL-1,$$REPEAT^XLFSTR("-",DIWR-DIWL),!!

 Q

 ;

XBENHANC  ; IHS/ADC/GTH - DISPLAY/PRINT ENHANCEMENTS FIELD IN PACKAGE FILE ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; Print enhancements to a package, from the entry in the

 +4       ; PACKAGE file.  Entry point EN^XBENHANC(ns) is used, with

 +5       ; the caller providing the namespace of the package.

 +6       ;

EN(XB)    ;PEP - XB = Namespace of package to print enhancements.

 +1        IF '($GET(XB)]"")

               QUIT 

 +2        DO HOME^%ZIS

           DO DT^DICRW

DEV       ;

 +1        SET %ZIS="OPQ"

 +2        DO ^%ZIS

 +3        IF POP

               SET IOP=$IO

               DO ^%ZIS

               GOTO K

 +4        IF '$DATA(IO("Q"))

               GOTO START

 +5        KILL IO("Q")

 +6        IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               WRITE *7,!,"Please queue to system printers."

               DO ^%ZISC

               GOTO DEV

 +7        SET ZTRTN="START^XBENHANC"

           SET ZTDESC=$PIECE($PIECE($TEXT(XBENHANC),"-",2),";",2)

           SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL

           SET ZTSAVE("XB")=""

 +8        DO ^%ZTLOAD

 +9        IF '$DATA(ZTSK)

               GOTO DEV

K         ;

 +1        KILL ZTSK

 +2        DO ^%ZISC

 +3        QUIT 

 +4       ;

START     ;EP - TaskMan.

 +1        NEW A,B,DIRUT,DIWL,DIWR,DIWF,XBHDR,XBPG

 +2        SET A=$ORDER(^DIC(9.4,"C",XB,0))

 +3        IF 'A

               QUIT 

 +4        IF '$DATA(^DIC(9.4,A,"VERSION"))

               QUIT 

 +5        SET B=$ORDER(^DIC(9.4,A,22,"B",^DIC(9.4,A,"VERSION"),0))

 +6        IF 'B

               QUIT 

 +7        SET XBHDR="Enhancements to "_$PIECE(^DIC(9.4,A,0),U)_", Version "_^DIC(9.4,A,"VERSION")

 +8        KILL ^UTILITY($JOB,"W")

 +9        SET DIWL=5

           SET DIWR=IOM-6

           SET DIWF="W"

 +10       USE IO

 +11       DO TOF

 +12       SET %=0

 +13       FOR 

               SET %=$ORDER(^DIC(9.4,A,22,B,1,%))

               IF '%

                   QUIT 

               DO DIWP(^(%,0))

               IF $Y>(IOSL-6)

                   DO TOF

               IF $DATA(DIRUT)

                   QUIT 

 +14       IF '$DATA(DIRUT)

               DO ^DIWW

 +15       KILL ^UTILITY($JOB,"W")

 +16       DO ^%ZISC

 +17       QUIT 

 +18      ;

DIWP(X)   ;

 +1        NEW %,A,B

 +2        DO ^DIWP

 +3        QUIT 

 +4       ;

TOF       ;

 +1        NEW %,A,B

 +2        SET XBPG=$GET(XBPG)+1

 +3        WRITE !!

 +4        IF '$DATA(ZTQUEUED)

               IF '$DATA(IO("S"))

                   IF IO=IO(0)

                       IF $$DIR^XBDIR("E")

 +5        IF $DATA(DIRUT)

               QUIT 

 +6        WRITE @IOF,!!,?DIWL-1,XBHDR,?(DIWR-$LENGTH("Page "_XBPG)-1),"Page ",XBPG,!?DIWL-1,$$REPEAT^XLFSTR("-",DIWR-DIWL),!!

 +7        QUIT 

 +8       ;