DIEZ3.m

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 ---DIEZ3   1554     printed  Apr 09, 2024@21:45:37                                                                                                                                                                                                       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