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

DIETLIBF.m

Go to the documentation of this file.
  1. DIETLIBF ;SFISC/MKO,GFT - LIBRARY FOR FIELD ATTRIBUTES ;23JUN2017
  1. ;;22.2;VA FileMan;**2,5,13**;Jan 05, 2016;Build 4
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;The following functions return, for a given file and field,
  1. ;code to do something, such as validate user input, or validate
  1. ;the internal form of data. The actual code to perform these
  1. ;functions may reside under one of several methods, so a list of
  1. ;methods need to be searched.
  1. ;
  1. ;Input to these methods are:
  1. ; DDTFILE = File #
  1. ; DDTFIELD = Field #
  1. ;
  1. ;Returned is:
  1. ; Code for method or null
  1. ;
  1. VALEXT(DDTFILE,DDTFIELD) ;Return code to validate and transform user input --PERHAPS INTERACTIVELY
  1. Q $$GETMETH(.DDTFILE,.DDTFIELD,$$VALEXTL)
  1. ;
  1. VALEXTS(DDTFILE,DDTFIELD) ;Return code to SILENTLY validate and transform user input
  1. ;Non-interactive
  1. N D,%
  1. S %=$$GETMETH(.DDTFILE,.DDTFIELD,$$VALEXTSL) I %["+X" S %="K:X?16.N.E X I $D(X) "_% ;DON'T TRY TO "+" A HUGE NUMBER
  1. S D=$F(%,"%DT=""E") I D>0 S %=$E(%,1,D-2)_$E(%,D,9999)
  1. Q "N %T,%DT,C,DIG,DIH,DIU,DIV,DICR,DIQUIET S DIQUIET=1 "_% ;PRESERVE VARIABLES
  1. ;
  1. VALINT(DDTFILE,DDTFIELD) ;Return code to validate internal form
  1. Q $$GETMETH(.DDTFILE,.DDTFIELD,$$VALINTL)
  1. ;
  1. XHELP(DDTFILE,DDTFIELD) ;Return the executable help of a field
  1. D DIPA(DDTFILE,DDTFIELD) ;I $D(^DI(.81,+$P($P(^DD(DDTFILE,DDTFIELD,0),U,2),"t",2),101,4,0)) S DIPA("POINTER")=$$GETPROP(DDTFILE,DDTFIELD,"POINTER")
  1. Q $$GETMETH(.DDTFILE,.DDTFIELD,$$XHELPL)
  1. ;
  1. OUTPUT(DDTFILE,DDTFIELD) ;Return the executable code to output a field's value. No arguments means ^DD(DDTFILE,DDTFIELD,0) is already in naked ref
  1. Q $$GETMETH(.DDTFILE,.DDTFIELD,$$OUTPUTL)
  1. ;
  1. ;
  1. ;
  1. DIPA(DDTFILE,DDTFIELD) ;CREATE DIPA NODES FROM PROPERTIES IN THE FIELD
  1. N T,P,V,N
  1. S T=+$P($P(^DD(DDTFILE,DDTFIELD,0),U,2),"t",2) Q:'T ;ONLY HAPPENS FOR EXTENDED DATA TYPES
  1. F P=0:0 S P=$O(^DD(DDTFILE,DDTFIELD,101,P)) Q:'P S V=$G(^(P,31)) I V]"" S N=$P($G(^DI(.86,P,0)),U) I N]"" S DIPA(N)=V ;E.G., DIPA("POINTER")="DIC(5,"
  1. F P=0:0 S P=$O(^DD(DDTFILE,DDTFIELD,201,P)) Q:'P S V=$G(^(P,31)) I V]"" S N=$P($G(^DI(.87,P,0)),U) I N]"" S DIPA(N)=V ;E.G., DIPA("CODE TO SET POINTER SCREEN")="I 1"
  1. Q
  1. ;
  1. ;****************************************************************
  1. ;The following functions return a string of methods to search
  1. ;
  1. VALEXTL() Q "INTERACTIVE VALIDATE AND INPUT TRANSFORM;VALIDATE AND TRANSFORM INPUT;INPUT TRANSFORM"
  1. VALEXTSL() Q "VALIDATE AND TRANSFORM INPUT;INPUT TRANSFORM"
  1. VALINTL() Q "VALIDATE INTERNAL FORM;INPUT TRANSFORM"
  1. XHELPL() Q "INTERACTIVE EXECUTABLE HELP;XECUTABLE HELP"
  1. OUTPUTL() Q "OUTPUT TRANSFORM"
  1. ;
  1. ;****************************************************************
  1. ;
  1. GETMETH(DDTFILE,DDTFIELD,DDTMETL) ;Look for methods in the ;-delimited string
  1. ;of method numbers.
  1. ;Return the code for the first non-null method found.
  1. ;In:
  1. ; DDTFILE = file #
  1. ; DDTFIELD = field #
  1. ; DDTMETL = ;-delimited list of methods to search for
  1. ;
  1. N REF,DDTCOD,DDTMET,DDTP,DDTPC,I
  1. Q:" "[$G(DDTMETL) ""
  1. ; The use of the naked reference is needed here, regardless of its obscurity. MSC/DKA 2016-03-04
  1. I '$G(DDTFILE)!'$G(DDTFIELD) S REF=$NA(^(0)) ;^DD(DDTFILE,DDTFIELD,0) is already in naked ref -- MAYBE! LET'S NOT USE THIS 'NAKED' TRICK
  1. E S REF=$NA(^DD(DDTFILE,DDTFIELD,0))
  1. Q:REF'?1"^DD(".E ""
  1. F DDTPC=1:1:$L(DDTMETL,";") S DDTMET=$P(DDTMETL,";",DDTPC) D:DDTMET]"" Q:$G(DDTCOD)]""
  1. . S I=+$P($P($G(@REF),U,2),"t",2)
  1. . S DDTP=$O(^DI(.87,"B",DDTMET,""),-1) I DDTP,$P($G(^DI(.81,I,201,DDTP,31)),";")'?."^" S DDTCOD=^(31) ;Q ;FIRST TRY TO GET IT FROM THE DEFINITION IN .81
  1. . I DDTMET="INPUT TRANSFORM" D Q:$D(DDTCOD)
  1. ..D DIPA(DDTFILE,DDTFIELD) ;SET UP THE PARAMETERS
  1. ..S DDTP=$$PROP4TYP("SET OF CODES",I) I DDTP]"" S DDTCOD="D READSET^DIED(.X,"""_DDTP_""")" Q ;M CODE: D READSET^DIED(.X,$$PROP4TYP^DIETLIBF("SET OF CODES",11)
  1. ..I "Q"'[$P($G(@REF),U,5,999) S DDTCOD=$P(^(0),U,5,999) ;from regular field, get the old input transform
  1. . I DDTMET="OUTPUT TRANSFORM",$G(@REF)]"",$G(^(2))'?."^" S DDTCOD=^(2) Q
  1. . I DDTMET="XECUTABLE HELP",$G(@REF)]"",$G(^(4))'?."^" S DDTCOD=^(4) Q
  1. Q $G(DDTCOD)
  1. ;
  1. ;
  1. %DT(PARAM) ;CREATE CODE TO SET THE %DT VARIABLE FROM PARAMETERS, INCLUDING 'PARAM', WHICH MAY BE "E"
  1. N EARLY
  1. S EARLY="",PARAM=$TR(PARAM,"""")
  1. I $G(DIPA("EARLIEST DATE")) S EARLY=",%DT(0)="_DIPA("EARLIEST DATE")
  1. I $G(DIPA("TIME REQUIRED")) S PARAM=PARAM_"R"
  1. I $G(DIPA("SECONDS ALLOWED")) S PARAM=PARAM_"S"
  1. I $G(DIPA("TIME OF DAY")) S PARAM=PARAM_"T"
  1. I '$G(DIPA("IMPRECISE DATE")) S PARAM=PARAM_"X"
  1. Q "SET %DT="""_PARAM_""""_EARLY
  1. ;
  1. DIC ;SET THE DIC VARIABLE FROM PARAMETERS
  1. I $G(DIPA("POINTER"))'["(" S Y=-1 Q
  1. N DIS,DIC,DIFILE,DIBTDH ;DIFILE SHOULD REALLY BE NEWED BY ^DIC ITSELF
  1. X $G(DIPA("CODE TO SET POINTER SCREEN")) ;S DIC("S")
  1. S DIC="^"_DIPA("POINTER"),DIC(0)="M"_$E("L",$G(DIPA("LAYGO"))) I '$D(DIQUIET) S DIC(0)=DIC(0)_"EQ"
  1. D ^DIC
  1. Q
  1. ;
  1. ;
  1. GETPROP(DDTFILE,DDTFIELD,DDTPROL) ;Look for PROPERTIES in the ;-delimited string
  1. ;Return the string for the first non-null property found.
  1. ;In:
  1. ; DDTFILE = file #
  1. ; DDTFIELD = field #
  1. ; DDTPROL = ;-delimited list of properties to search for
  1. ;
  1. N REF
  1. Q:" "[$G(DDTPROL) ""
  1. I '$G(DDTFILE)!'$G(DDTFIELD) S REF=$NA(^(0)) ;^DD(DDTFILE,DDTFIELD,0) is already in naked ref
  1. E S REF=$NA(^DD(DDTFILE,DDTFIELD,0))
  1. Q:REF'?1"^DD(".E ""
  1. N DDTCOD,DDTP,DDTPC,I,DIP
  1. S I=+$P($P($G(@REF),U,2),"t",2)
  1. F DDTPC=1:1:$L(DDTPROL,";") S DDTP=$P(DDTPROL,";",DDTPC) I DDTP]"" D Q:$G(DDTCOD)]""
  1. .I $D(@REF),$O(^(101,0)) S DIP=$O(^DI(.86,"B",DDTP,""),-1) I DIP,$D(@REF),$G(^(101,DIP,31))]"" S DDTCOD=^(31) Q ;GET PROPERTY FROM THE FIELD ITSELF
  1. .S DDTCOD=$$PROP4TYP(DDTP,I)
  1. Q $G(DDTCOD)
  1. ;
  1. PROP4TYP(T,I) ;FOR PROPERTY 'T' IN DATA TYPE 'I', RETURN THE VALUE
  1. S T=$O(^DI(.86,"B",T,""),-1) I T,$G(^DI(.81,I,101,T,31))'?."^" Q ^(31) ;GET IT FROM THE DEFINITION IN .81
  1. Q ""
  1. ;
  1. ;
  1. METH4TYP(T,I) ;FOR METHOD 'T' IN DATA TYPE 'I', RETURN THE VALUE
  1. S T=$O(^DI(.87,"B",T,""),-1) I T,$G(^DI(.81,I,201,T,31))'?."^" Q ^(31) ;GET IT FROM THE DEFINITION IN .81
  1. Q ""