DIEZ3 ;SFISC/MKO-COMPILE INPUT TEMPLATE, BUILD CODE TO CHECK KEYS ;2:54 PM 15 Jul 1999
;;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.
;
;In:
; DIEZKEY(uniqxref#) = count
; DQ = item # in DR string
;
GETKEY(DIEZFIL,DIEZFLD,DIEZKEY,DQ) ;Build routine to check keys
Q:'$D(DIEZKEY)
N DIEZUI
;
;Build code to check field-level keys
D L("K"_DQ_"() N DIMAXL,DIUIR,DIXR")
S DIEZUI=0
F S DIEZUI=$O(DIEZKEY(DIEZUI)) Q:'DIEZUI D
. D BLD(DIEZFIL,DIEZFLD,DIEZUI,DQ,DIEZKEY(DIEZUI))
Q
;
BLD(DIEZFIL,DIEZFLD,DIEZUI,DQ,DIEZCNT) ;Get code for one index DIEZXR
N DIEZMAXL,DIEZSLIS,DIEZUIR
D XRINFO^DIKCU2(DIEZUI,.DIEZUIR,"",.DIEZMAXL)
;
D L(" S DIXR="_DIEZUI)
D L(" S @DIEZTMP@(""V"","_DIEZFIL_",DIIENS,"_DIEZFLD_",""N"")=X")
D L(" N X D C"_DQ_"X"_DIEZCNT_"(""N"")")
D L(" K @DIEZTMP@(""V"","_DIEZFIL_",DIIENS,"_DIEZFLD_",""N"")")
D L(" S DIUIR=$NA("_DIEZUIR_") Q:'$D(@DIUIR) 1")
;
I $D(DIEZMAXL) D
. N ORD,X
. S X="S ",ORD=0
. F S ORD=$O(DIEZMAXL(ORD)) Q:'ORD D
.. S X=X_"DIMAXL("_ORD_")="_DIEZMAXL(ORD)_","
. I X?.E1"," D L(" "_$E(X,1,$L(X)-1))
;
D L(" Q $$UNIQUE^DIE17(.X,.DA,DIUIR,""C"_DQ_"X"_DIEZCNT_U_DNM_DRN_""""_$S($D(DIEZMAXL):",.DIMAXL",1:"")_")")
Q
;
L(X) ;Add CODE to ^UTILITY
S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X)+2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEZ3 1554 printed Dec 13, 2024@02:47:30 Page 2
DIEZ3 ;SFISC/MKO-COMPILE INPUT TEMPLATE, BUILD CODE TO CHECK KEYS ;2:54 PM 15 Jul 1999
+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 ;
+7 ;In:
+8 ; DIEZKEY(uniqxref#) = count
+9 ; DQ = item # in DR string
+10 ;
GETKEY(DIEZFIL,DIEZFLD,DIEZKEY,DQ) ;Build routine to check keys
+1 if '$DATA(DIEZKEY)
QUIT
+2 NEW DIEZUI
+3 ;
+4 ;Build code to check field-level keys
+5 DO L("K"_DQ_"() N DIMAXL,DIUIR,DIXR")
+6 SET DIEZUI=0
+7 FOR
SET DIEZUI=$ORDER(DIEZKEY(DIEZUI))
if 'DIEZUI
QUIT
Begin DoDot:1
+8 DO BLD(DIEZFIL,DIEZFLD,DIEZUI,DQ,DIEZKEY(DIEZUI))
End DoDot:1
+9 QUIT
+10 ;
BLD(DIEZFIL,DIEZFLD,DIEZUI,DQ,DIEZCNT) ;Get code for one index DIEZXR
+1 NEW DIEZMAXL,DIEZSLIS,DIEZUIR
+2 DO XRINFO^DIKCU2(DIEZUI,.DIEZUIR,"",.DIEZMAXL)
+3 ;
+4 DO L(" S DIXR="_DIEZUI)
+5 DO L(" S @DIEZTMP@(""V"","_DIEZFIL_",DIIENS,"_DIEZFLD_",""N"")=X")
+6 DO L(" N X D C"_DQ_"X"_DIEZCNT_"(""N"")")
+7 DO L(" K @DIEZTMP@(""V"","_DIEZFIL_",DIIENS,"_DIEZFLD_",""N"")")
+8 DO L(" S DIUIR=$NA("_DIEZUIR_") Q:'$D(@DIUIR) 1")
+9 ;
+10 IF $DATA(DIEZMAXL)
Begin DoDot:1
+11 NEW ORD,X
+12 SET X="S "
SET ORD=0
+13 FOR
SET ORD=$ORDER(DIEZMAXL(ORD))
if 'ORD
QUIT
Begin DoDot:2
+14 SET X=X_"DIMAXL("_ORD_")="_DIEZMAXL(ORD)_","
End DoDot:2
+15 IF X?.E1","
DO L(" "_$EXTRACT(X,1,$LENGTH(X)-1))
End DoDot:1
+16 ;
+17 DO L(" Q $$UNIQUE^DIE17(.X,.DA,DIUIR,""C"_DQ_"X"_DIEZCNT_U_DNM_DRN_""""_$SELECT($DATA(DIEZMAXL):",.DIMAXL",1:"")_")")
+18 QUIT
+19 ;
L(X) ;Add CODE to ^UTILITY
+1 SET L=L+1
SET ^UTILITY($JOB,0,L)=X
SET T=T+$LENGTH(X)+2
+2 QUIT
