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

DIETLIB.m

Go to the documentation of this file.
  1. DIETLIB ;SFISC/MKO,O-OIFO/GFT - LIBRARY OF APIs FOR USER DEFINED DATA TYPES ;04MAR2016
  1. ;;22.2;VA FileMan;**2,5**;Jan 05, 2016;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;*************************************************************
  1. ;
  1. ;THESE CALLS DEAL WITH NODE 41 IN FILE .81, 'FIELD DEFINED BY THIS TYPE'
  1. ;
  1. AFDEF(FILE,FIELD) ; --'SET' CROSS-REFERENCE ON SPECIFIER
  1. N T,FF,I
  1. S T=+$P($P($G(^DD(FILE,FIELD,0)),U,2),"t",2) Q:'T!'$D(^DI(.81,T,0)) ;GET THE EXTENDED TYPE
  1. S I=$O(^DI(.81,T,41,"A"),-1)+1,FF=FILE_","_FIELD
  1. I '$D(^DI(.81,"AFDEF",T,FF)) S ^(FF,I)="",^DI(.81,T,41,0)="^.81215^"_I_U_I,^(I,0)=FF ;ADD FIELD TO LIST OF DATATYPES FOR IT
  1. S $P(^DD(FILE,FIELD,0),U,5,99)="",$P(^(0),U,3)="" K ^(12) ;DELETE INPUT TRANSFORM, POINTER,SCREEN EXPLANATION FOR A FIELD THAT IS NOW 'EXTENDED'
  1. Q
  1. ;
  1. AFDEFDEL(FILE,FIELD) ;'KILL' CROSS-REFERENCE ON SPECIFIER
  1. N T,FF,I,Z
  1. S T=+$P($P($G(^DD(FILE,FIELD,0)),U,2),"t",2) Q:'T!'$D(^DI(.81,T,0))
  1. S FF=FILE_","_FIELD
  1. F I=0:0 S I=$O(^DI(.81,"AFDEF",T,FF,I)) Q:'I I $G(^DI(.81,T,41,I,0))=FF K ^(0) S Z=$G(^DI(.81,T,41,0)),^(0)="^.81215^"_$O(^("A"),-1)_"^"_($P(Z,U,4)-1)
  1. K ^DI(.81,"AFDEF",T,FF)
  1. Q
  1. ;
  1. ;
  1. DELETEQ ;CANNOT DELETE A DATA TYPE IN USE
  1. IF DA<100 Q
  1. IF $D(^DI(.81,"AFDEF",DA))
  1. IF W !?3,"SORRY! DATA TYPES IN USE CANNOT BE DELETED!!",!
  1. QUIT
  1. ;
  1. ;
  1. CLEANDEF ; POST-INSTALL CAN CALL THIS TO MAKE SURE THAT 'FIELD DEFINED BY THIS TYPE' DOES NOT HAVE EXTRA MULTIPLES
  1. N TY,I,FI,FL
  1. F TY=0:0 S TY=$O(^DI(.81,TY)) Q:'TY F I=0:0 S I=$O(^DI(.81,TY,41,I)) Q:'I I $D(^(I,0)) S Z=^(0) D
  1. .S FI=+Z,FL=+$P(Z,",",2) I $D(^DD(FI,FL,0)),$P($P(^(0),"^",2),"t",2)=TY Q
  1. .K ^DI(.81,"AFDEF",TY,Z,I),^DI(.81,TY,41,I)
  1. Q
  1. ;
  1. ;
  1. ;
  1. ;
  1. ;****************************************************************
  1. ;called from DICATTUD & DIRUD
  1. PARSE(DDTSTR,DDTVALS) ;Parse DDTSTR, replacing |abbr| with DDTVALS(abbr)
  1. ;Two consecutive |s are replaced with a single |
  1. ;|#FILE#| is replaced with DDTVALS("#FILE#")
  1. ;|#FIELD#| is replaced with DDTVALS("#FIELD#")
  1. Q:$G(DDTSTR)="" ""
  1. Q:DDTSTR'["|" DDTSTR
  1. ;
  1. N I,J,DDTABBR,DDTVAL,L,DDTWIND
  1. ;
  1. S I=1 F D Q:'I
  1. . ;Find the next |
  1. . S I=$F(DDTSTR,"|",I) Q:'I
  1. . ;
  1. . ;Replace || with |
  1. . I $E(DDTSTR,I)="|" S $E(DDTSTR,I-1,I)="|" Q
  1. . ;
  1. . ;Find the next |, get the abbreviation and the property value
  1. . S J=$F(DDTSTR,"|",I) I 'J S I=0 Q
  1. . S DDTWIND=$E(DDTSTR,I,J-2)
  1. . S L=+$P(DDTWIND,",",2),DDTABBR=$P(DDTWIND,",")
  1. . S DDTVAL=$G(DDTVALS(DDTABBR))
  1. . S:L DDTVAL=$$QT(DDTVAL,L)
  1. . ;
  1. . ;Replace |abbr| with the value, update I
  1. . S $E(DDTSTR,I-1,J-1)=DDTVAL
  1. . S I=J+$L(DDTVAL)-$L(DDTWIND)-2
  1. Q DDTSTR
  1. ;
  1. QT(X,L) ;Return X with one quote replaced with 2 quotes.Repeat the process L times}
  1. N I,J,K
  1. Q:$G(L)=0 X
  1. S:'$G(L) L=1
  1. ;
  1. F I=1:1:L D
  1. . S Y=""
  1. . S J=1,K=1 F S K=$F(X,"""",J) Q:'K D
  1. .. S Y=Y_$E(X,J,K-1)_""""
  1. .. S J=K
  1. . S X=Y_$E(X,J,999)
  1. Q X
  1. ;
  1. ;
  1. ;
  1. XCODE(DDTCODE,DDTVALS) ;Execute DDTCODE, return value of X Called by DICATTUD,DIRUD
  1. N X
  1. Q:$G(DDTCODE)="" ""
  1. ;
  1. S DDTCODE=$$PARSE(DDTCODE,.DDTVALS)
  1. X DDTCODE
  1. Q $G(X)
  1. ;
  1. XCODEM(DDTCODE,DDTVALS,DDTOUT) ;Execute DDTCODE,
  1. ; Return values in DDTOUT array
  1. ;In:
  1. ; DDTCODE = code to execute (may contain |s); sets X or X array
  1. ; DDTVALS(abbrev) = array of property values
  1. ;Out:
  1. ; .DDTOUT = X array set by DDTCODE
  1. ;
  1. N X K DDTOUT
  1. Q:$G(DDTCODE)="" ""
  1. ;
  1. S DDTCODE=$$PARSE(DDTCODE,.DDTVALS)
  1. X DDTCODE
  1. K DDTOUT M DDTOUT=X
  1. Q
  1. ;
  1. ;*************************************************************
  1. ;