TMGDIS3 ;TMG/kst/Custom version of DIS3 ;03/25/06 ; 5/15/10 6:04pm
         ;;1.0;TMG-LIB;**1**;01/01/06
        ;"---- Prior header below --------
DIS3    ;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93  13:16
        ;;22.0;VA FileMan;;Mar 30, 1999
        ;Per VHA Directive 10-93-142, this routine should not be modified.
EN      ;
        new DIQUIET,DIFM
        set L=$G(L)
        set DIFM=+L
        do CLEAN^DIEFU,INIT^DIP
        set:$G(DIC) DIC=$G(^DIC(DIC,0,"GL"))
        goto QER1:$G(DIC)=""
        new DK
        set DK=+$P($G(@(DIC_"0)")),U,2)
        goto QER1:'DK
        new DISV,Y
        do
        . new DIC,X,DIS
        . set Y=-1,DIS=$G(DISTEMP)
        . quit:DIS=""
        . set X=$S($E(DIS)="[":$P($E(DIS,2,99),"]"),1:DIS)
        . set DIC="^DIBT("
        . set DIC(0)="Q"
        . set DIC("S")="I '$P(^(0),U,8),$P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$D(^(""DIS""))"
        . do ^DIC
        . Q
        set DISV=+Y
        if Y<0 set DIC="DISTEMP" goto QER
        new DISTXT
        set %X="^DIBT(DISV,""DIS"",",%Y="DIS("
        do %XY^%RCR
        set %X="^DIBT(DISV,""O"",",%Y="DISTXT("
        do %XY^%RCR
        kill ^DIBT(DISV,1)
        do EN1^DIP
        goto EXIT
        ;"==========================================
QER1    set DIC="DIC"
QER     do BLD^DIALOG(201,DIC)
        do:'$G(DIQUIET) MSG^DIALOG()
        do Q^DIP
EXIT    kill DIC,DISTEMP
        Q
        ;"DIALOG #201  'The input variable...is missing or invalid.'