Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIEZ4

DIEZ4.m

Go to the documentation of this file. 
  1. DIEZ4 ;SFISC/MKO-COMPILE INPUT TEMPLATE, RECORD-LEVEL INDEXES ;2:15 PM  14 Jul 1999 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**11**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ;Variables passed in through symbol table:
  1.  ;  DNM  = Name of routine
  1.  ;  DRN(routine#) = "" : array of routine numbers
  1.  ;  DMAX = Maximum routine size
  1.  ;  DIEZTMP = Root of global that contains record-level index info
  1.  ;
  1.  ;Routine-wide variables
  1.  ;  T   = Total byte count of current routine
  1.  ;  L   = Last line number in current routine
  1.  ;  DP  = file #
  1.  ;  DRN = routine #
  1.  ;  DIEZCNT = Count of xrefs processed in current routine (used as
  1.  ;            a line tag)
  1.  ;  DIEZAR(file#,xref#) = linetag^routine (returned)
  1.  ;  DIEZKEYR(file#,key#,uniqxref#) = Xn^routine
  1.  ;
  1. RECXR(DIEZAR) ;Build routines for record-level indexes
  1.  Q:'$D(@DIEZTMP@("R"))
  1.  N DIEZCNT,DIEZXR,DP
  1.  ;
  1.  S DRN=$O(DRN(""),-1)+1
  1.  D NEWROU
  1.  ;
  1.  S DP=0 F  S DP=$O(@DIEZTMP@("R",DP)) Q:'DP  D  Q:$G(DIEZQ)
  1.  . S DIEZXR=0
  1.  . F  S DIEZXR=$O(@DIEZTMP@("R",DP,DIEZXR)) Q:'DIEZXR  D  Q:$G(DIEZQ)
  1.  .. D GETXR(DIEZXR) Q:$G(DIEZQ)
  1.  Q:$G(DIEZQ)
  1.  D SAVE
  1.  Q
  1.  ;
  1. GETXR(DIEZXR) ;Get code for one index DIEZXR
  1.  N DIEZCOD,DIEZF,DIEZKLOG,DIEZNSS,DIEZO,DIEZSLOG
  1.  I T>DMAX D SAVE Q:$G(DIEZQ)  D NEWROU
  1.  ;
  1.  S DIEZCNT=$G(DIEZCNT)+1
  1.  S DIEZAR(DP,DIEZXR)=DIEZCNT_U_DNM_DRN
  1.  ;
  1.  ;Build code to call subroutine to set X array
  1.  D L(DIEZCNT_" N X,X1,X2 S DIXR="_DIEZXR_" D X"_DIEZCNT_"(U) K X2 M X2=X D X"_DIEZCNT_"(""F"") K X1 M X1=X")
  1.  ;
  1.  ;Build code to check for null subscripts
  1.  S DIEZNSS="",DIEZO=0
  1.  F  S DIEZO=$O(@DIEZTMP@("R",DP,DIEZXR,DIEZO)) Q:'DIEZO  D
  1.  . Q:'$G(@DIEZTMP@("R",DP,DIEZXR,DIEZO,"SS"))
  1.  . I DIEZNSS="" S DIEZNSS="$G(X("_DIEZO_"))]"""""
  1.  . E  S DIEZNSS=DIEZNSS_",$G(X("_DIEZO_"))]"""""
  1.  I DIEZNSS]"" S DIEZNSS=" I "_DIEZNSS_" D"
  1.  E  S DIEZNSS=" D"
  1.  ;
  1.  ;Store kill logic and condition
  1.  S DIEZKLOG=$G(@DIEZTMP@("R",DP,DIEZXR,"K"))
  1.  I DIEZKLOG'?."^" D
  1.  . D L(DIEZNSS)
  1.  . ;Build kill condition code
  1.  . S DIEZCOD=$G(@DIEZTMP@("R",DP,DIEZXR,"KC"))
  1.  . I DIEZCOD'?."^" D
  1.  .. D L(" . N DIEZCOND,DIEXARR M DIEXARR=X S DIEZCOND=1")
  1.  .. D L(" . "_DIEZCOD)
  1.  .. D L(" . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND")
  1.  . ;Store kill logic
  1.  . D L(" . "_DIEZKLOG)
  1.  ;
  1.  ;Store set logic and condition
  1.  S DIEZSLOG=$G(@DIEZTMP@("R",DP,DIEZXR,"S"))
  1.  I DIEZSLOG'?."^" D
  1.  . D L(" K X M X=X2"_DIEZNSS)
  1.  . ;Build set condition code
  1.  . S DIEZCOD=$G(@DIEZTMP@("R",DP,DIEZXR,"SC"))
  1.  . I DIEZCOD'?."^" D
  1.  .. D L(" . N DIEZCOND,DIEXARR M DIEXARR=X S DIEZCOND=1")
  1.  .. D L(" . "_DIEZCOD)
  1.  .. D L(" . S DIEZCOND=$G(X) K X M X=DIEXARR Q:'DIEZCOND")
  1.  . ;Store set logic
  1.  . D L(" . "_DIEZSLOG)
  1.  ;
  1.  ;Build code to check record level keys
  1.  D:$D(^DD("KEY","AU",DIEZXR)) BLDKCHK(DIEZXR)
  1.  D L(" Q")
  1.  ;
  1.  ;Build code to set X array
  1.  S DIEZF=$O(@DIEZTMP@("R",DP,DIEZXR,0))
  1.  D L("X"_DIEZCNT_"(DION) K X")
  1.  ;
  1.  S DIEZO=0
  1.  F  S DIEZO=$O(@DIEZTMP@("R",DP,DIEZXR,DIEZO)) Q:'DIEZO  D BLDDEC(DIEZXR,DIEZO)
  1.  D L(" S X=$G(X("_DIEZF_"))")
  1.  D L(" Q")
  1.  Q
  1.  ;
  1. BLDDEC(DIEZXR,DIEZO) ;Build data extraction code
  1.  N CODE,NODE,TRANS
  1.  ;
  1.  S CODE=$G(@DIEZTMP@("R",DP,DIEZXR,DIEZO)) Q:CODE?."^"
  1.  S TRANS=$G(@DIEZTMP@("R",DP,DIEZXR,DIEZO,"T"))
  1.  I TRANS'?."^" D
  1.  . D L(" "_CODE)
  1.  . D DOTLINE(" I $D(X)#2 "_TRANS)
  1.  . D L(" S:$D(X)#2 X("_DIEZO_")=X")
  1.  E  I $D(@DIEZTMP@("R",DP,DIEZXR,DIEZO,"F"))#2,CODE?1"S X=".E D
  1.  . D L(" S X("_DIEZO_")"_$E(CODE,4,999))
  1.  E  D
  1.  . D L(" "_CODE)
  1.  . D L(" S:$D(X)#2 X("_DIEZO_")=X")
  1.  Q
  1.  ;
  1. BLDKCHK(DIEZUI) ;Build code to check key for xref
  1.  N DIEZKLST,DIEZMAXL,DIEZUIR,I
  1.  ;
  1.  D XRINFO^DIKCU2(DIEZUI,.DIEZUIR,"",.DIEZMAXL)
  1.  ;
  1.  ;Get list of keys with this uniqueness index
  1.  S DIEZKLST="",I=0
  1.  S I=0 F  S I=$O(^DD("KEY","AU",DIEZUI,I)) Q:'I  S DIEZKLST=I_","
  1.  Q:DIEZKLST=""
  1.  S DIEZKLST=$E(DIEZKLST,1,$L(DIEZKLST)-1)
  1.  ;
  1.  D L(" . I $G(DIEXEC)[""K"" D")
  1.  D L(" .. N DIMAXL,DIUIR")
  1.  D L(" .. S DIUIR=$NA("_DIEZUIR_") Q:'$D(@DIUIR)")
  1.  ;
  1.  ;Build code to set DIMAXL(order#)=maxLength
  1.  I $D(DIEZMAXL) D
  1.  . N ORD,X
  1.  . S X="S ",ORD=0
  1.  . F  S ORD=$O(DIEZMAXL(ORD)) Q:'ORD  D
  1.  .. S X=X_"DIMAXL("_ORD_")="_DIEZMAXL(ORD)_","
  1.  . I X?.E1"," D L(" .. "_$E(X,1,$L(X)-1))
  1.  ;
  1.  D L(" .. I '$$UNIQUE^DIE17(.X,.DA,DIUIR,""X"_DIEZCNT_U_DNM_DRN_""""_$S($D(DIEZMAXL):",.DIMAXL",1:"")_") N I F I="_DIEZKLST_" S DIKEY("_DP_",I,DIIENS)=""""")
  1.  Q
  1.  ;
  1. L(X) ;Add CODE to ^UTILITY
  1.  S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X)+2
  1.  Q
  1.  ;
  1. DOTLINE(X) ;
  1.  I X[" Q"!(X[" Q:") D
  1.  . D L(" D"),L(" ."_X)
  1.  E  D L(X)
  1.  Q
  1.  ;
  1. NEWROU ;Start a new routine
  1.  K ^UTILITY($J,0)
  1.  S ^UTILITY($J,0,1)=DNM_DRN_" ; ;"_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),T=$L(^(1))
  1.  S ^UTILITY($J,0,2)=" ;;",T=T+$L(^(2))
  1.  S L=2,DIEZCNT=0
  1.  Q
  1.  ;
  1. SAVE ;Get the next available routine number
  1.  N DQ
  1.  F DQ=DRN+1:1 Q:'$D(DRN(DQ))
  1.  ;
  1.  ;Save current routine
  1.  D SAVE^DIEZ1 Q:$G(DIEZQ)
  1.  K ^UTILITY($J,0)
  1.  Q