File:  [Coherent Logic Development] / freem_fileman / USER / DIS3.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIS3	;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93  13:16
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN	;
    5: 	N DIQUIET,DIFM S L=$G(L),DIFM=+L D CLEAN^DIEFU,INIT^DIP
    6: 	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
    7: 	N DISV,Y D  S DISV=+Y I Y<0 S DIC="DISTEMP" G QER
    8: 	.N DIC,X,DIS S Y=-1,DIS=$G(DISTEMP) Q:DIS=""
    9: 	.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""))"
   10: 	.D ^DIC Q
   11: 	N DISTXT S %X="^DIBT(DISV,""DIS"",",%Y="DIS(" D %XY^%RCR
   12: 	S %X="^DIBT(DISV,""O"",",%Y="DISTXT(" D %XY^%RCR
   13: 	K ^DIBT(DISV,1)
   14: 	D EN1^DIP G EXIT
   15: 	;
   16: QER1	S DIC="DIC"
   17: QER	D BLD^DIALOG(201,DIC) D:'$G(DIQUIET) MSG^DIALOG()
   18: 	D Q^DIP
   19: EXIT	K DIC,DISTEMP Q
   20: 	;DIALOG #201  'The input variable...is missing or invalid.'

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>