DIQGDDU ;SFISC/DCL - DATA DICTIONARY UTILITIES ;13AUG2015
;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
;;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.
;
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["t",$$GETPROP^DIETLIBF(DIQGFILE,DIQGFLD,"FIELD LENGTH")]"" S W=$$GETPROP^DIETLIBF(DIQGFILE,DIQGFLD,"FIELD LENGTH")
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:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIQGDDU 2203 printed Oct 16, 2024@18:54:11 Page 2
DIQGDDU ;SFISC/DCL - DATA DICTIONARY UTILITIES ;13AUG2015
+1 ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
+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 ;
+7 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["t"
IF $$GETPROP^DIETLIBF(DIQGFILE,DIQGFLD,"FIELD LENGTH")]""
SET W=$$GETPROP^DIETLIBF(DIQGFILE,DIQGFLD,"FIELD LENGTH")
+17 IF '$TEST
IF DN["W"
SET W=""
+18 IF '$TEST
IF DN["P"
SET W=$$FL(+$PIECE(DN,"P",2),.01)
+19 IF '$TEST
IF DN["J"
SET W=+$PIECE(DN,"J",2)
+20 ;
+21 IF '$TEST
IF DN["S"
Begin DoDot:1
+22 NEW C,C1,P
+23 SET C=$PIECE(DD,U,3)
+24 FOR P=1:1
SET C1=$PIECE(C,";",P)
if C1=""
QUIT
SET W=$$MAX(W,$LENGTH($PIECE(C1,":",2)))
End DoDot:1
+25 ;
+26 IF '$TEST
IF DN["D"
Begin DoDot:1
+27 NEW D
+28 SET D=$PIECE($PIECE(DIIT,"S %DT=""",2,999),"""")
+29 SET W=$SELECT(D["S"&(D["T"):21,D["T":18,1:12)
End DoDot:1
+30 ;
+31 IF '$TEST
IF DN["V"
Begin DoDot:1
+32 NEW N
+33 SET N=0
+34 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
+35 ;
+36 IF '$TEST
IF DIIT["$L(X)>"
SET W=+$PIECE(DIIT,"$L(X)>",2)
+37 IF '$TEST
SET W=+$PIECE($PIECE($PIECE($PIECE(DD,"^",4),";",2),"E",2),",")
+38 ;
+39 if W=0
SET W=30
+40 QUIT W
+41 ;
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:"")
