DIS3 ;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93 13:16
;;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.
;
EN ;
N DIQUIET,DIFM S L=$G(L),DIFM=+L D CLEAN^DIEFU,INIT^DIP
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
N DISV,Y D S DISV=+Y I Y<0 S DIC="DISTEMP" G QER
.N DIC,X,DIS S Y=-1,DIS=$G(DISTEMP) Q:DIS=""
.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""))"
.D ^DIC Q
N DISTXT S %X="^DIBT(DISV,""DIS"",",%Y="DIS(" D %XY^%RCR
S %X="^DIBT(DISV,""O"",",%Y="DISTXT(" D %XY^%RCR
K ^DIBT(DISV,1)
D EN1^DIP G EXIT
;
QER1 S DIC="DIC"
QER D BLD^DIALOG(201,DIC) D:'$G(DIQUIET) MSG^DIALOG()
D Q^DIP
EXIT K DIC,DISTEMP Q
;DIALOG #201 'The input variable...is missing or invalid.'
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIS3 1129 printed Oct 16, 2024@18:54:34 Page 2
DIS3 ;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93 13:16
+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 ;
EN ;
+1 NEW DIQUIET,DIFM
SET L=$GET(L)
SET DIFM=+L
DO CLEAN^DIEFU
DO INIT^DIP
+2 if $GET(DIC)
SET DIC=$GET(^DIC(DIC,0,"GL"))
if $GET(DIC)=""
GOTO QER1
NEW DK
SET DK=+$PIECE($GET(@(DIC_"0)")),U,2)
if 'DK
GOTO QER1
+3 NEW DISV,Y
Begin DoDot:1
+4 NEW DIC,X,DIS
SET Y=-1
SET DIS=$GET(DISTEMP)
if DIS=""
QUIT
+5 SET X=$SELECT($EXTRACT(DIS)="[":$PIECE($EXTRACT(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""))"
+6 DO ^DIC
QUIT
End DoDot:1
SET DISV=+Y
IF Y<0
SET DIC="DISTEMP"
GOTO QER
+7 NEW DISTXT
SET %X="^DIBT(DISV,""DIS"","
SET %Y="DIS("
DO %XY^%RCR
+8 SET %X="^DIBT(DISV,""O"","
SET %Y="DISTXT("
DO %XY^%RCR
+9 KILL ^DIBT(DISV,1)
+10 DO EN1^DIP
GOTO EXIT
+11 ;
QER1 SET DIC="DIC"
QER DO BLD^DIALOG(201,DIC)
if '$GET(DIQUIET)
DO MSG^DIALOG()
+1 DO Q^DIP
EXIT KILL DIC,DISTEMP
QUIT
+1 ;DIALOG #201 'The input variable...is missing or invalid.'
