Routine: DIQGDDU

DIQGDDU ;SFISC/DCL-DATA DICTIONARY UTILITIES ;1:16 PM  26 Sep 1996

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

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

FL(DIQGFILE,DIQGFLD) ;Return field length

 ;Short version of DIOS1

 ;In:

 ;  DIQGFILE = file#

 ;  DIQGFLD  = field#

 I $G(DIQGFILE)'>0 D ERR202("FILE NUMBER") Q ""

 I $G(DIQGFLD)'>0 D ERR202("FIELD NUMBER") Q ""

 N DD,DIIT,DN,W

 S DD=$G(^DD(DIQGFILE,DIQGFLD,0))

 I DD?."^" D ERR1700("DD FOR FILE#"_DIQGFILE_", FIELD#"_DIQGFLD_" DOES NOT EXIST") Q ""

 S W=0,DN=$P(DD,"^",2),DIIT=$P(DD,"^",5,999)

 I DN S W=$$FL(+DN,.01)

 E  I DN["W" S W=""

 E  I DN["P" S W=$$FL(+$P(DN,"P",2),.01)

 E  I DN["J" S W=+$P(DN,"J",2)

 E  I DN["S" D

 . N C,C1,P

 . S C=$P(DD,U,3)

 . F P=1:1 S C1=$P(C,";",P) Q:C1=""  S W=$$MAX(W,$L($P(C1,":",2)))

 E  I DN["D" D

 . N D

 . S D=$P($P(DIIT,"S %DT=""",2,999),"""")

 . S W=$S(D["S"&(D["T"):21,D["T":18,1:12)

 E  I DN["V" D

 . N N

 . S N=0

 . F  S N=$O(^DD(DIQGFILE,DIQGFLD,"V",N)) Q:'N  S:$G(^(N,0)) W=$$MAX(W,$$FL(+^(0),.01))

 E  I DIIT["$L(X)>" S W=+$P(DIIT,"$L(X)>",2)

 E  S W=+$P($P($P($P(DD,"^",4),";",2),"E",2),",")

 S:W=0 W=30

Q W

MAX(X,Y,Z) ;Return maximum of 2 or 3 numbers

N M

 S M=$S(X>Y:+X,1:+Y),M=$S(M>$G(Z):M,1:+$G(Z))

Q M

ERR202(DIQGERR) ;Error processing

 N P S P(1)=DIQGERR

 D BLD^DIALOG(202,.P)

ERR1700(DIQGERR) ;Error processing

 N P S P(1)=DIQGERR

 D BLD^DIALOG(1700,.P)

RIF(DA,DR,DIQGETA) ;FUNCTION CALL FOR RI

RI ;REQUIRED IDENTIFIERS - CALLED BY EN3^DIQGDD

 ;DA=FILENR,DR="REQUIRED IDENTIFIERS",DIQGETA=TARGET_ARRAY

 N DIQGRIA,DIQGRI,DIQGR

 D REQIDS^DICU(DA,"DIQGRIA")

 S DIQGRIA="",DIQGRI=0

 F  S DIQGRIA=$O(DIQGRIA(DR,DIQGRIA)) Q:DIQGRIA=""  D

 .S DIQGRI=DIQGRI+1,@DIQGETA@(DR,DIQGRI,"FIELD")=DIQGRIA

.Q

 Q $S(DIQGRI:$NA(@DIQGETA@(DR)),1:"")

DIQGDDU   ;SFISC/DCL-DATA DICTIONARY UTILITIES ;1:16 PM  26 Sep 1996

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

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

 +3        QUIT

FL(DIQGFILE,DIQGFLD) ;Return field length

 +1       ;Short version of DIOS1

 +2       ;In:

 +3       ;  DIQGFILE = file#

 +4       ;  DIQGFLD  = field#

 +5       ;

 +6        IF $GET(DIQGFILE)'>0

               DO ERR202("FILE NUMBER")

               QUIT ""

 +7        IF $GET(DIQGFLD)'>0

               DO ERR202("FIELD NUMBER")

               QUIT ""

 +8       ;

 +9        NEW DD,DIIT,DN,W

 +10       SET DD=$GET(^DD(DIQGFILE,DIQGFLD,0))

 +11       IF DD?."^"

               DO ERR1700("DD FOR FILE#"_DIQGFILE_", FIELD#"_DIQGFLD_" DOES NOT EXIST")

               QUIT ""

 +12      ;

 +13       SET W=0

           SET DN=$PIECE(DD,"^",2)

           SET DIIT=$PIECE(DD,"^",5,999)

 +14      ;

 +15       IF DN

               SET W=$$FL(+DN,.01)

 +16      IF '$TEST

               IF DN["W"

                   SET W=""

 +17      IF '$TEST

               IF DN["P"

                   SET W=$$FL(+$PIECE(DN,"P",2),.01)

 +18      IF '$TEST

               IF DN["J"

                   SET W=+$PIECE(DN,"J",2)

 +19      ;

 +20      IF '$TEST

               IF DN["S"

                   Begin DoDot:1

 +21                   NEW C,C1,P

 +22                   SET C=$PIECE(DD,U,3)

 +23                   FOR P=1:1

                           SET C1=$PIECE(C,";",P)

                           IF C1=""

                               QUIT

                           SET W=$$MAX(W,$LENGTH($PIECE(C1,":",2)))

                   End DoDot:1

 +24      ;

 +25      IF '$TEST

               IF DN["D"

                   Begin DoDot:1

 +26                   NEW D

 +27                   SET D=$PIECE($PIECE(DIIT,"S %DT=""",2,999),"""")

 +28                   SET W=$SELECT(D["S"&(D["T"):21,D["T":18,1:12)

                   End DoDot:1

 +29      ;

 +30      IF '$TEST

               IF DN["V"

                   Begin DoDot:1

 +31                   NEW N

 +32                   SET N=0

 +33                   FOR

                           SET N=$ORDER(^DD(DIQGFILE,DIQGFLD,"V",N))

                           IF 'N

                               QUIT

                           IF $GET(^(N,0))

                               SET W=$$MAX(W,$$FL(+^(0),.01))

                   End DoDot:1

 +34      ;

 +35      IF '$TEST

               IF DIIT["$L(X)>"

                   SET W=+$PIECE(DIIT,"$L(X)>",2)

 +36      IF '$TEST

               SET W=+$PIECE($PIECE($PIECE($PIECE(DD,"^",4),";",2),"E",2),",")

 +37      ;

 +38       IF W=0

               SET W=30

 +39       QUIT W

 +40      ;

MAX(X,Y,Z) ;Return maximum of 2 or 3 numbers

 +1        NEW M

 +2        SET M=$SELECT(X>Y:+X,1:+Y)

           SET M=$SELECT(M>$GET(Z):M,1:+$GET(Z))

 +3        QUIT M

 +4       ;

ERR202(DIQGERR) ;Error processing

 +1        NEW P

           SET P(1)=DIQGERR

 +2        DO BLD^DIALOG(202,.P)

 +3        QUIT

ERR1700(DIQGERR) ;Error processing

 +1        NEW P

           SET P(1)=DIQGERR

 +2        DO BLD^DIALOG(1700,.P)

 +3        QUIT

 +4       ;

RIF(DA,DR,DIQGETA) ;FUNCTION CALL FOR RI

RI        ;REQUIRED IDENTIFIERS - CALLED BY EN3^DIQGDD

 +1       ;DA=FILENR,DR="REQUIRED IDENTIFIERS",DIQGETA=TARGET_ARRAY

 +2        NEW DIQGRIA,DIQGRI,DIQGR

 +3        DO REQIDS^DICU(DA,"DIQGRIA")

 +4        SET DIQGRIA=""

           SET DIQGRI=0

 +5        FOR

               SET DIQGRIA=$ORDER(DIQGRIA(DR,DIQGRIA))

               IF DIQGRIA=""

                   QUIT

               Begin DoDot:1

 +6                SET DIQGRI=DIQGRI+1

                   SET @DIQGETA@(DR,DIQGRI,"FIELD")=DIQGRIA

 +7                QUIT

               End DoDot:1

 +8        QUIT $SELECT(DIQGRI:$NAME(@DIQGETA@(DR)),1:"")

DIQGDDU.m