Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIP4

DIP4.m

Go to the documentation of this file.
  1. DIP4 ;SFISC/XAK-QUEUE & DEQUEUE ;19AUG2003
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. S:$D(DQTIME)[0&$D(ZTQUEUED) DQTIME="NOW"
  1. 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"
  1. W I '$D(DQTIME) S %DT("A")=$$EZBLD^DIALOG(8160)_": ",%DT("B")="NOW" ;**CCO/NI 'REQUESTED TIME TO PRINT:'
  1. S:$D(DQTIME) X=DQTIME
  1. 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
  1. W:'$D(ZTQUEUED) ! S ZTDTH=Y X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="ZTSK^DIP4",ZTDESC=DHD
  1. S ZTSAVE("^UTILITY(""DIP2"",$J,")=""
  1. I $P($G(DPP(0,"IX")),U,2)["$J" S ZTSAVE("^"_$P(DPP(0,"IX"),U,2))=""
  1. I $G(DPP(1,"IX"))["^UTILITY(" S ZTSAVE("^UTILITY(U,$J,")=""
  1. S ZTIO=$S($D(ION)#2:ION,1:IO) I $G(IOST)]"" S ZTIO=ZTIO_";"_IOST
  1. I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_IO("DOC") G ZTM
  1. I $G(IOM) S ZTIO=ZTIO_";"_IOM I $G(IOSL) S ZTIO=ZTIO_";"_IOSL
  1. ZTM S ZTSAVE("*")="" D ^%ZTLOAD
  1. K ^UTILITY("DIP2",$J),^UTILITY(U,$J),DIS,DXS,DX,DHD,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTUCI,FLDS,DCC,DIPT,X
  1. W:'$D(ZTQUEUED) $$EZBLD^DIALOG(8161,$G(ZTSK)),! X $G(^%ZIS("C")) G Q^DIP ;**CCO/NI 'REQUEST QUEUED'
  1. ;
  1. ZTSK ;
  1. K DISYS D CLEAN^DIEFU
  1. I $G(DPP(1))]"",'$D(DPP(1,"GET")) Q:$G(DK)="" D
  1. . S DIPCRIT=+$G(DIPCRIT),DISUPNO=$S($D(DISUPNO)#2:DISUPNO,1:1)
  1. . N S,Q S DIFM=+$G(L),S=+$P($G(@(DK_"0)")),U,2),Q="""" N DIBTRPT,DICNVDPP,DITYP,DJ,DU,DV
  1. . S DICNVDPP=1 D CNVCM^DIP11,T1^DIP11
  1. . Q
  1. D 0^DICRW G DQ^DITC1:$D(DIT),^DIP5