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.
Q
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)
Q
ERR1700(DIQGERR) ;Error processing
N P S P(1)=DIQGERR
D BLD^DIALOG(1700,.P)
Q
;
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:"")
