Return to DIP4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIP4	;SFISC/XAK-QUEUE & DEQUEUE ;9/21/94  11:05
	;;21.0;VA FileMan;;Dec 28, 1994
	;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	R:'$D(DQTIME) !,"REQUESTED TIME TO PRINT: NOW// ",X:DTIME
	G X^DIP3:X[U!'$T S Y=$H
	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
	W:'$D(ZTQUEUED) ! S ZTDTH=Y X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="ZTSK^DIP4",ZTDESC=DHD
	S ZTSAVE("^UTILITY(""DIP2"",$J,")=""
	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