Annotation of freem_fileman/DIP4.m, revision 1.1.1.1

1.1       snw         1: DIP4   ;SFISC/XAK-QUEUE & DEQUEUE ;9/21/94  11:05
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        S:('$D(DQTIME)#2)&($D(ZTQUEUED)) DQTIME="NOW"
                      5:        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"
                      6: W      R:'$D(DQTIME) !,"REQUESTED TIME TO PRINT: NOW// ",X:DTIME
                      7:        G X^DIP3:X[U!'$T S Y=$H
                      8:        I $P("NOW",X)]"" S:X'["@" X="T@"_X S %DT(0)="NOW" D ^%DT K %DT(0) G:Y<1 X^DIP3:$D(DQTIME),W S X=+Y D H^%DTC S Y=%H_","_%T
                      9:        W:'$D(ZTQUEUED) ! S ZTDTH=Y X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="ZTSK^DIP4",ZTDESC=DHD
                     10:        S ZTSAVE("^UTILITY(""DIP2"",$J,")=""
                     11:        I $G(DPP(1,"IX"))["^UTILITY(" S ZTSAVE("^UTILITY(U,$J,")=""
                     12:        S ZTIO=$S($D(ION)#2:ION,1:IO) I $G(IOST)]"" S ZTIO=ZTIO_";"_IOST
                     13:        I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_IO("DOC") G ZTM
                     14:        I $G(IOM) S ZTIO=ZTIO_";"_IOM I $G(IOSL) S ZTIO=ZTIO_";"_IOSL
                     15: ZTM    S ZTSAVE("*")="" D ^%ZTLOAD
                     16:        K ^UTILITY("DIP2",$J),^UTILITY(U,$J),DIS,DXS,DX,DHD,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTUCI,FLDS,DCC,DIPT,X
                     17:        W:'$D(ZTQUEUED) "REQUEST QUEUED!",!,"Task number: "_$G(ZTSK),! X $G(^%ZIS("C")) G Q^DIP
                     18:        ;
                     19: ZTSK   ;
                     20:        K DISYS D CLEAN^DIEFU
                     21:        I $G(DPP(1))]"",'$D(DPP(1,"GET")) Q:$G(DK)=""  D 
                     22:        . S DIPCRIT=+$G(DIPCRIT),DISUPNO=$S($D(DISUPNO)#2:DISUPNO,1:1)
                     23:        . N S,Q S DIFM=+$G(L),S=+$P($G(@(DK_"0)")),U,2),Q="""" N DIBTRPT,DICNVDPP,DITYP,DJ,DU,DV
                     24:        . S DICNVDPP=1 D CNVCM^DIP11,T1^DIP11
                     25:        . Q
                     26:        D 0^DICRW G DQ^DITC1:$D(DIT),^DIP5

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>