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

DMSQD.m

Go to the documentation of this file.
  1. DMSQD ;SFISC/JHM-SETUP FOR DATATYPE AND DOMAIN ;5/7/98 14:53
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. Q
  1. LCKF ;BUILD KEY FORMAT FOR LONG CHARACTER FIELDS
  1. N KFI,DTI,KIE,KIX
  1. S KFI=$O(^DMSQ("KF","B","LONG_CHARACTER",""))
  1. S DTI=$O(^DMSQ("DT","B","CHARACTER",""))
  1. I 'DTI D F(2) S DTI=$O(^DMSQ("DT","B","CHARACTER","")) I 'DTI Q
  1. S KIE="$E({I},1,30)",KIX="S {K}="_KIE
  1. S IEN=$S(KFI:KFI,1:"+1")_",",TT=1.5213
  1. S FDA(TT,IEN,.01)="LONG_CHARACTER" ;NAME
  1. S FDA(TT,IEN,1)=DTI ;DATA TYPE
  1. S FDA(TT,IEN,2)="Truncate long free text fields to 30 characters" ;COMM
  1. S FDA(TT,IEN,3)=KIE ;EXPRESSION FORMAT
  1. S FDA(TT,IEN,4)=KIX ;EXECUTE FORMAT
  1. S KFI=$$PUT^DMSQU(IEN,"FDA","ERR")
  1. I $D(ERR)!'KFI D ERR^DMSQU(TT,"","KEY FORMAT: LONG_CHARACTER INSERT FAILED")
  1. Q
  1. VPTOF(F,FI) ;BUILD OUTPUT FORMAT FOR VARIABLE POINTER FILE F, FIELD FI
  1. N TI,ON,OI,TT,IEN,BE,FDA,ERR S TI=$O(^DMSQ("T","C",F,"")) Q:'TI ""
  1. S T=^DMSQ("T",TI,0),ON=$$SQLK^DMSQU($P(T,U)_"_VPOF",30)
  1. S OI=$O(^DMSQ("OF","B",ON,"")),TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
  1. S BE="$$EXT^DMSQU("_F_","_FI_","""",{B})"
  1. S FDA(TT,IEN,.01)=ON ;OF NAME
  1. S FDA(TT,IEN,1)=2 ; BASE DATA TYPE IS CHARACTER
  1. S FDA(TT,IEN,2)="Variable pointer output format" ; COMMENT
  1. S FDA(TT,IEN,3)=BE ; OUTPUT TRANSFORM
  1. S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
  1. I $D(ERR)!'OI D ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF VARIABLE POINTER OUTPUT FORMAT FAILED")
  1. Q OI
  1. PTROF(F) ;BUILD OUTPUT FORMAT FOR POINTER TO TABLE FI
  1. N TI,ON,OI,TT,IEN,BE,FDA,ERR S TI=$O(^DMSQ("T","C",F,"")) Q:'TI ""
  1. S T=^DMSQ("T",TI,0),ON=$$SQLK^DMSQU($P(T,U)_"_PTOF",30)
  1. S OI=$O(^DMSQ("OF","B",ON,"")),TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
  1. S BE="$S('{B}:"""",1:$$GET^DMSQU("_F_",{B}_"","",.01))"
  1. S FDA(TT,IEN,.01)=ON ;OF NAME
  1. S FDA(TT,IEN,1)=3 ; BASE DATA TYPE IS INTEGER
  1. S FDA(TT,IEN,2)="Output format for pointer to "_$P(T,U) ; COMMENT
  1. S FDA(TT,IEN,3)=BE ; OUTPUT TRANSFORM
  1. S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
  1. I $D(ERR)!'OI D ERR^DMSQU(TI,FI,"OUTPUT FORMAT: INSERT OF POINTER OUTPUT FORMAT FAILED")
  1. Q OI
  1. BE ;;$P($P("{S}",";"_{B}_":",2),";")
  1. SETOF(SD) ;BUILD PUTPUT FORMAT FOR SET DEFINITION SD
  1. N ON,OI,FDA,ERR,BE,TT,IEN,SL
  1. I SD?1P.E S $E(SD,1)="Z" ;" " IS USED FOR DEFAULT CODE
  1. S ON=$$SQLK^DMSQU(SD,30),OI=$O(^DMSQ("OF","B",ON,""))
  1. S:$E(SD)'=";" SD=";"_SD S:$E(SD,$L(SD))'=";" SD=SD_";"
  1. S BE=$P($T(BE),";;",2,99),BE=$P(BE,"{S}")_SD_$P(BE,"{S}",2)
  1. ;BUILD OUTPUT FORMAT
  1. S TT=1.5214,IEN=$S(OI:OI,1:"+1")_","
  1. S FDA(TT,IEN,.01)=ON ;OUTPUT FORMAT NAME
  1. S FDA(TT,IEN,1)=2 ;CHARACTER DATA TYPE
  1. S FDA(TT,IEN,2)="Set output format" ;COMMENT
  1. S FDA(TT,IEN,3)=BE ;OUTPUT TRANSFORM EXPRESSION
  1. S OI=$$PUT^DMSQU(IEN,"FDA","ERR")
  1. I $D(ERR)!'OI D ERR^DMSQU($G(F),$G(FI),"OUTPUT FORMAT: INSERT OF SET-OF-CODES OUTPUT FORMAT FAILED")
  1. Q OI
  1. ;KW SOURCE ARRAY MUST HAVE THE FORM:
  1. ; SRC(I)=KW : FOR EVERY I THERE MUST BE A KEYWORD
  1. ;SRC MAY BE LOCAL OR GLOBAL, BUT MUST WORK IN THE SYNTAX @SRC@(I)
  1. ;CALL: D KW("^SRC",.ERR)
  1. KW(SRC,ERR) ;LOAD KEYWORD GLOBAL FROM ARRAY SRC
  1. ;RETURN ERRORS IN ERR: D KW^DMSQD("^SRC(,1,",.ERROR)
  1. Q:$G(SRC)="" I $G(DUZ(0))'["@" S ERR="ACCESS DENIED" Q
  1. N E,DIERR,I,TT,KW,IEN,FDA,@$$NEW^DMSQU K ERR D ENV^DMSQU
  1. S TT=1.52101,I=""
  1. I $O(@SRC@(""))="" S ERR="INVALID OR MISSING KEYWORD ARRAY" Q
  1. F S I=$O(@SRC@(I)) Q:I=""!$D(ERR) D
  1. . S KW=$G(@SRC@(I)) Q:KW=""
  1. . S IEN=$O(^DMSQ("K","B",KW,""))
  1. . S IEN=$S(IEN:IEN,1:"+1")_","
  1. . D VAL^DIE(TT,IEN,.01,"F",.KW,"","FDA","E")
  1. . I $D(DIERR) S ERR=E("DIERR",1,"TEXT",1) Q
  1. . S IEN=$$PUT^DMSQU(IEN,"FDA","ERR")
  1. . I $D(ERR)!'IEN S ERR="KEYWORD-$$PUT FAILED"
  1. Q
  1. DMDT F I=1:1 Q:$T(@I)="" D F(I)
  1. S $P(^DMSQ("DM",0),U,3)=99
  1. Q
  1. F(DI) N I,FDA,FDB,ERR,IEN,TT,EO
  1. S TT=1.5212,IEN=$S($D(^DMSQ("DM",DI)):DI,1:"+1")_","
  1. F I=0:1 S T=$T(@DI+I) Q:T>DI D
  1. . S FDA(TT,IEN,$P(T,";",3))=$P(T,";",4,99)
  1. I FDA(TT,IEN,1)=DI D Q:$D(ERR)
  1. . N DIEN S DIEN=$S($D(^DMSQ("DT",DI)):DI,1:"+1")_","
  1. . S FDB(1.5211,DIEN,.01)=FDA(TT,IEN,.01)
  1. . S FDB(1.5211,DIEN,1)=FDA(TT,IEN,2)
  1. . S EO=$$PUT^DMSQU(DIEN,"FDB","ERR")
  1. . I $D(ERR) D ERR^DMSQU(1.5211,"","DATA TYPE: INSERT OF DATA TYPE RECORD FAILED")
  1. S EO=$$PUT^DMSQU(IEN,"FDA","ERR")
  1. I $D(ERR) D ERR^DMSQU(1.5212,"","DOMAIN: INSERT OF DOMAIN RECORD FAILED")
  1. Q
  1. 1 ;;.01;PRIMARY_KEY
  1. ;;1;1
  1. ;;2;Table domain, used for primary and foreign keys
  1. 2 ;;.01;CHARACTER
  1. ;;1;2
  1. ;;2;Free Text less than 256 characters
  1. ;;4;30
  1. 3 ;;.01;INTEGER
  1. ;;1;3
  1. ;;2;Up to 15 numeric characters without leading zeroes
  1. ;;4;10
  1. 4 ;;.01;NUMERIC
  1. ;;1;4
  1. ;;2;Up to 15 numeric characters with at most one decimal point
  1. ;;4;10
  1. ;;5;2
  1. 5 ;;.01;DATE
  1. ;;1;5
  1. ;;2;Base date is M $H format, ODBC = YYYY-MM-DD
  1. ;;4;8
  1. 6 ;;.01;TIME
  1. ;;1;6
  1. ;;2;Base is M $H format, ODBC = HH:MM:SS[.S...]
  1. ;;4;8
  1. 7 ;;.01;MOMENT
  1. ;;1;7
  1. ;;2;Base is M $H format
  1. ;;4;17
  1. 8 ;;.01;BOOLEAN
  1. ;;1;8
  1. ;;2;YES or NO, internally 1 or 0
  1. ;;4;3
  1. 9 ;;.01;MEMO
  1. ;;1;9
  1. ;;2;Huge character string up to 32KB long
  1. ;;4;70
  1. 10 ;;.01;FM_DATE
  1. ;;1;5
  1. ;;2;Handle base-internal translation of FileMan internal date w/o time
  1. ;;4;8
  1. ;;8;S %H={B} D YMD^%DTC S {I}=X
  1. ;;10;S X={I} D H^%DTC S {B}=%H
  1. ;;11;D
  1. 11 ;;.01;FM_MOMENT
  1. ;;1;7
  1. ;;2;Base-internal of FileMan internal date with optional time
  1. ;;4;17
  1. ;;8;S %H={B} D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
  1. ;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_$S($G(%T)]"":","_%T,1:"")
  1. ;;11;DT
  1. 12 ;;.01;FM_BOOLEAN
  1. ;;1;2
  1. ;;2;Translate FileMan logical to ODBC
  1. ;;7;$S({B}="":0,1:{B})
  1. ;;9;$S({I}:{I},1:"")
  1. ;;11;B
  1. 13 ;;.01;POINTER
  1. ;;1;3
  1. ;;2;Pointer to FileMan files in FILE - no subfiles
  1. ;;4;10
  1. ;;11;P
  1. 14 ;;.01;WORD_PROCESSING
  1. ;;1;9
  1. ;;2;FileMan WORD-PROCESSING data type
  1. ;;4;70
  1. ;;11;W
  1. 15 ;;.01;SET_OF_CODES
  1. ;;1;2
  1. ;;2;FileMan SET-OF-CODES data type
  1. ;;4;13
  1. ;;11;S
  1. 16 ;;.01;VARIABLE_POINTER
  1. ;;1;2
  1. ;;2;FileMan VARIABLE POINTER data type
  1. ;;4;13
  1. ;;11;V
  1. 17 ;;.01;FM_MUMPS
  1. ;;1;2
  1. ;;2;FileMan MUMPS data type
  1. ;;4;245
  1. ;;11;K
  1. 18 ;;.01;FM_DATE_TIME
  1. ;;1;7
  1. ;;2;Base-internal of FileMan internal date with required time
  1. ;;4;17
  1. ;;8;S %H={B} S:'$P(%H,",",2) %H=%H-1_",86400" D YMD^%DTC S {I}=X_$S($G(%):%,1:"")
  1. ;;10;S X={I} D H^%DTC S:$G(%T)=86400 %T=0,%H=%H+1 S {B}=%H_","_(+$G(%T))
  1. ;;11;DTR
  1. 99 ;;END FLAG