Annotation of freem_fileman/USER/DIP4.m, revision 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>