- 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 Jan 18, 2025@03:53:46 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