DIP4 ;SFISC/XAK-QUEUE & DEQUEUE ;19AUG2003
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
S:$D(DQTIME)[0&$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")=$$EZBLD^DIALOG(8160)_": ",%DT("B")="NOW" ;**CCO/NI 'REQUESTED TIME TO PRINT:'
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) $$EZBLD^DIALOG(8161,$G(ZTSK)),! X $G(^%ZIS("C")) G Q^DIP ;**CCO/NI 'REQUEST QUEUED'
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIP4 1778 printed Nov 22, 2024@18:02:44 Page 2
DIP4 ;SFISC/XAK-QUEUE & DEQUEUE ;19AUG2003
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 if $DATA(DQTIME)[0&$DATA(ZTQUEUED)
SET DQTIME="NOW"
+8 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 ;**CCO/NI 'REQUESTED TIME TO PRINT:'
IF '$DATA(DQTIME)
SET %DT("A")=$$EZBLD^DIALOG(8160)_": "
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 ;**CCO/NI 'REQUEST QUEUED'
if '$DATA(ZTQUEUED)
WRITE $$EZBLD^DIALOG(8161,$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
