DIS3.m

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 ;

 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.'

DIS3      ;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93  13:16

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

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.'