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

DIS3.m

Go to the documentation of this file.
  1. DIS3 ;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93 13:16
  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. EN ;
  1. N DIQUIET,DIFM S L=$G(L),DIFM=+L D CLEAN^DIEFU,INIT^DIP
  1. S:$G(DIC) DIC=$G(^DIC(DIC,0,"GL")) G QER1:$G(DIC)="" N DK S DK=+$P($G(@(DIC_"0)")),U,2) G QER1:'DK
  1. N DISV,Y D S DISV=+Y I Y<0 S DIC="DISTEMP" G QER
  1. .N DIC,X,DIS S Y=-1,DIS=$G(DISTEMP) Q:DIS=""
  1. .S X=$S($E(DIS)="[":$P($E(DIS,2,99),"]"),1:DIS),DIC="^DIBT(",DIC(0)="Q",DIC("S")="I '$P(^(0),U,8),$P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$D(^(""DIS""))"
  1. .D ^DIC Q
  1. N DISTXT S %X="^DIBT(DISV,""DIS"",",%Y="DIS(" D %XY^%RCR
  1. S %X="^DIBT(DISV,""O"",",%Y="DISTXT(" D %XY^%RCR
  1. K ^DIBT(DISV,1)
  1. D EN1^DIP G EXIT
  1. ;
  1. QER1 S DIC="DIC"
  1. QER D BLD^DIALOG(201,DIC) D:'$G(DIQUIET) MSG^DIALOG()
  1. D Q^DIP
  1. EXIT K DIC,DISTEMP Q
  1. ;DIALOG #201 'The input variable...is missing or invalid.'