- 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 ;
