DIP4.m

DIP4 ;SFISC/XAK-QUEUE & DEQUEUE ;12:34 PM  13 Apr 2000 [ 04/02/2003   8:25 AM ]

 ;;22.0;VA FileMan;**1001**;APR 1, 2003

 ;;22.0;VA FileMan;**34**;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 S:('$D(DQTIME)#2)&($D(ZTQUEUED)) DQTIME="NOW"

 S:($G(DDXP)=4)&($D(IO("Q"))) DDXPQ=1 K IO("Q") S %DT="TEX",X="" I $D(DQTIME)#2 S X=DQTIME,%DT="XT"

W I '$D(DQTIME) S %DT("A")="Requested Time To Print: ",%DT("B")="NOW"

 S:$D(DQTIME) X=DQTIME

 S %DT="FRX" S:'$D(DQTIME) %DT=%DT_"AE" S %DT(0)="NOW" D ^%DT K %DT G:Y<1 X^DIP3:$D(DQTIME),X^DIP3:X[U,X^DIP3:$D(DTOUT),W S X=+Y D H^%DTC S Y=%H_","_%T

 W:'$D(ZTQUEUED) ! S ZTDTH=Y X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="ZTSK^DIP4",ZTDESC=DHD

 S ZTSAVE("^UTILITY(""DIP2"",$J,")=""

 I $P($G(DPP(0,"IX")),U,2)["$J" S ZTSAVE("^"_$P(DPP(0,"IX"),U,2))=""

 I $G(DPP(1,"IX"))["^UTILITY(" S ZTSAVE("^UTILITY(U,$J,")=""

 S ZTIO=$S($D(ION)#2:ION,1:IO) I $G(IOST)]"" S ZTIO=ZTIO_";"_IOST

 I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_IO("DOC") G ZTM

 I $G(IOM) S ZTIO=ZTIO_";"_IOM I $G(IOSL) S ZTIO=ZTIO_";"_IOSL

ZTM S ZTSAVE("*")="" D ^%ZTLOAD

 K ^UTILITY("DIP2",$J),^UTILITY(U,$J),DIS,DXS,DX,DHD,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTUCI,FLDS,DCC,DIPT,X

 W:'$D(ZTQUEUED) "REQUEST QUEUED!",!,"Task number: "_$G(ZTSK),! X $G(^%ZIS("C")) G Q^DIP

 ;

ZTSK ;

 K DISYS D CLEAN^DIEFU

 I $G(DPP(1))]"",'$D(DPP(1,"GET")) Q:$G(DK)=""  D

 . S DIPCRIT=+$G(DIPCRIT),DISUPNO=$S($D(DISUPNO)#2:DISUPNO,1:1)

 . N S,Q S DIFM=+$G(L),S=+$P($G(@(DK_"0)")),U,2),Q="""" N DIBTRPT,DICNVDPP,DITYP,DJ,DU,DV

 . S DICNVDPP=1 D CNVCM^DIP11,T1^DIP11

 . Q

 D 0^DICRW G DQ^DITC1:$D(DIT),^DIP5

DIP4      ;SFISC/XAK-QUEUE & DEQUEUE ;12:34 PM  13 Apr 2000 [ 04/02/2003   8:25 AM ]

 +1       ;;22.0;VA FileMan;**1001**;APR 1, 2003

 +2       ;;22.0;VA FileMan;**34**;Mar 30, 1999

 +3       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +4        IF ('$DATA(DQTIME)#2)&($DATA(ZTQUEUED))

               SET DQTIME="NOW"

 +5        IF ($GET(DDXP)=4)&($DATA(IO("Q")))

               SET DDXPQ=1

           KILL IO("Q")

           SET %DT="TEX"

           SET X=""

           IF $DATA(DQTIME)#2

               SET X=DQTIME

               SET %DT="XT"

W          IF '$DATA(DQTIME)

               SET %DT("A")="Requested Time To Print: "

               SET %DT("B")="NOW"

 +1        IF $DATA(DQTIME)

               SET X=DQTIME

 +2        SET %DT="FRX"

           IF '$DATA(DQTIME)

               SET %DT=%DT_"AE"

           SET %DT(0)="NOW"

           DO ^%DT

           KILL %DT

           IF Y<1

               IF $DATA(DQTIME)

                   GOTO X^DIP3

               IF X[U

                   GOTO X^DIP3

               IF $DATA(DTOUT)

                   GOTO X^DIP3

               GOTO W

           SET X=+Y

           DO H^%DTC

           SET Y=%H_","_%T

 +3        IF '$DATA(ZTQUEUED)

               WRITE !

           SET ZTDTH=Y

           XECUTE ^%ZOSF("UCI")

           SET ZTUCI=Y

           SET ZTRTN="ZTSK^DIP4"

           SET ZTDESC=DHD

 +4        SET ZTSAVE("^UTILITY(""DIP2"",$J,")=""

 +5        IF $PIECE($GET(DPP(0,"IX")),U,2)["$J"

               SET ZTSAVE("^"_$PIECE(DPP(0,"IX"),U,2))=""

 +6        IF $GET(DPP(1,"IX"))["^UTILITY("

               SET ZTSAVE("^UTILITY(U,$J,")=""

 +7        SET ZTIO=$SELECT($DATA(ION)#2:ION,1:IO)

           IF $GET(IOST)]""

               SET ZTIO=ZTIO_";"_IOST

 +8        IF $GET(IO("DOC"))]""

               SET ZTIO=ZTIO_";"_IO("DOC")

               GOTO ZTM

 +9        IF $GET(IOM)

               SET ZTIO=ZTIO_";"_IOM

               IF $GET(IOSL)

                   SET ZTIO=ZTIO_";"_IOSL

ZTM        SET ZTSAVE("*")=""

           DO ^%ZTLOAD

 +1        KILL ^UTILITY("DIP2",$JOB),^UTILITY(U,$JOB),DIS,DXS,DX,DHD,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTUCI,FLDS,DCC,DIPT,X

 +2        IF '$DATA(ZTQUEUED)

               WRITE "REQUEST QUEUED!",!,"Task number: "_$GET(ZTSK),!

           XECUTE $GET(^%ZIS("C"))

           GOTO Q^DIP

 +3       ;

ZTSK      ;

 +1        KILL DISYS

           DO CLEAN^DIEFU

 +2        IF $GET(DPP(1))]""

               IF '$DATA(DPP(1,"GET"))

                   IF $GET(DK)=""

                       QUIT 

                   Begin DoDot:1

 +3                    SET DIPCRIT=+$GET(DIPCRIT)

                       SET DISUPNO=$SELECT($DATA(DISUPNO)#2:DISUPNO,1:1)

 +4                    NEW S,Q

                       SET DIFM=+$GET(L)

                       SET S=+$PIECE($GET(@(DK_"0)")),U,2)

                       SET Q=""""

                       NEW DIBTRPT,DICNVDPP,DITYP,DJ,DU,DV

 +5                    SET DICNVDPP=1

                       DO CNVCM^DIP11

                       DO T1^DIP11

 +6                    QUIT 

                   End DoDot:1

 +7        DO 0^DICRW

           IF $DATA(DIT)

               GOTO DQ^DITC1

           GOTO ^DIP5