source: cprs/branches/tmg-cprs/m_files/TMGTIUO2.m@ 1099

Last change on this file since 1099 was 796, checked in by Kevin Toppenberg, 15 years ago

Initial upload
File size: 8.2 KB
RevLine 
[796]1TMGTIU02 ;TMG/TIU Text Object Expansion Fns;04/15/10
2 ;;1.0;TMG-LIB;**1**;04/15/10
3 ;
4 ;"Kevin Toppenberg MD
5 ;"GNU General Public License (GPL) applies
6 ;"04/15/10
7 ;
8 ;"=======================================================================
9 ;"PUBLIC FUNCTIONS
10 ;"=======================================================================
11 ;
12 ;"=======================================================================
13 ;"PRIVATE FUNCTIONS
14 ;"=======================================================================
15 ;
16 ;"=======================================================================
17 ;
18GETPTFLD(DFN,PARAM) ;
19 ;"Purpose: This is the server-side code for the TIU TEXT OBJECT, which
20 ;" will allow the user to retrieve a field from the PATIENT file.
21 ;"NOTE: This requires that patch TMG-CPRS-TEXTOBJ-PARAM*1.0*1 or later
22 ;" be installed, to allow passing in of parameters from the CPRS client.
23 ;"Input: DFN -- This should be the IEN of the currently open patient
24 ;" Param -- Field(s)^Flags^FormatString. Details below
25 ;" Field(s) -- required. Options for input:
26 ;" - A single field number or name
27 ;" - A list of field numbers (or names), separated by semicolons
28 ;" - A range of field numbers (or names), in the form M:N,
29 ;" where M and N are the end points of the inclusive range.
30 ;" All field numbers within this range are retrieved.
31 ;" - A '*' for all fields at the top level (no sub-multiple record).
32 ;" - A '**' for all fields including all fields and data in sub-multiple fields.
33 ;" - Field number (or name) of a multiple followed by an * to indicate all
34 ;" fields and records in the sub-multiple for that field.
35 ;" Invalid field names will be ignored
36 ;" Flags -- Optional.
37 ;" - 'F' -- include field name in results with value. e.g. "AGE: 43" instead of just "43"
38 ;" - This flag is ignored if a FormatString is provided (see below)
39 ;" - 'S' -- Keep all data values on a single line, separated by ';'.
40 ;" - If flag not provided, and multiple data fields are requested,
41 ;" - then the default is that each data value will be separated by a
42 ;" - CRLF [$C(13)_$C(10)]
43 ;" - This flag is ignored if a FormatString is provided (see below)
44 ;" - 'R' -- Resolve fields to NAMES, even if a field NUMBER was used for input request
45 ;" - Note: this will affect the sorting order of the output (see FormatString
46 ;" - info below). I.e. if R not specified, and field NUMBERS are used for input,
47 ;" - then results will be returned in numerical field number order by default.
48 ;" - If R is specified, then field numbers are converted to field NAMES, and that
49 ;" - is used to determine the order of output.
50 ;" - 'N' -- Don't return values for empty fields. This is helpful if ALL fields
51 ;" - were requested via '*'
52 ;" FormatString -- A string to determine how results are passed back....
53 ;" NOTE: without a format string, results will be passed back in the order returned
54 ;" by fileman. I.e. if user requested fields "SEX;.01;AGE", then Fileman will
55 ;" place results into an array, which MUMPS will sort alphabetically, e.g.
56 ;" .01, then AGE, then SEX. If "*" fields are requested, it would be even
57 ;" more complex. A format string will allow the user to specify ORDER.
58 ;" Format: e.g. "Any arbitrary text %FieldNameOrNum% more text %FieldNameOrNum% ..."
59 ;" (The goal was to follow the method used by printf in the c language.)
60 ;" - Any arbitrary text can be included.
61 ;" - Field numbers or names should be enclosed by the '%' character
62 ;" These will be replaced with actual data values.
63 ;" - '\n' can be included to specify line breaks
64 ;" - '%%' will be used to show a '%' in the output text
65 ;" - Invalid, or non-matching, field names/numbers will be ignored.
66 ;"
67 ;"Results: returns a string that will be sent back to CPRS, to be included in a text note
68 ;"NOTE: I have chosen to make this function work with only file 2 (PATIENT FILE). I think
69 ;" it could be a security violation if any CPRS user was able to look at any arbitrary file.
70 ;"
71 ;"Examples of PARAM inputs:
72 ;" '.01' -- returns .01 field, which is the patients NAME, e.g. "SMITH,JOHN A"
73 ;" 'NAME' -- returns same value as above, e.g. "SMITH,JOHN A"
74 ;" 'NAME^F' -- e.g result "NAME: SMITH,JOHN A"
75 ;" 'NAME;SEX;AGE^F' --> "AGE: 34"_$C(13)_$C(10)_"NAME: SMITH,JOHN A"_$C(13)_$C(10)_"SEX: MALE"
76 ;" 'NAME;SEX;AGE^S' --> "34; SMITH,JOHN A; MALE"
77 ;" 'NAME;SEX;AGE^^"NAME: %NAME%, %AGE% yrs., %SEX%"' --> "NAME: SMITH,JOHN A, 34 YRS., MALE"
78 ;"
79 NEW TMGFLDS,TMGFLAGS
80 NEW TMGFILE SET TMGFILE=2
81 NEW RESULT SET RESULT=""
82 SET PARAM=$GET(PARAM)
83 SET TMGFLDS=$PIECE(PARAM,"^",1)
84 IF TMGFLDS="" DO GOTO GPDN
85 . SET RESULT="ERROR: No input parameter. Example of use: |TMG PATIENT FLD{AGE}|"
86 SET DFN=$GET(DFN)
87 IF +DFN'>0 DO GOTO GPDN
88 . SET RESULT="ERROR: Internal patient value DFN not defined. Contact IRM"
89 NEW TMGIENS SET TMGIENS=DFN_","
90 SET TMGFLAGS=""
91 NEW TMGTEMP SET TMGTEMP=$$UP^XLFSTR($PIECE(PARAM,"^",2))
92 IF TMGTEMP["N" SET TMGFLAGS=TMGFLAGS_"N"
93 IF TMGTEMP["F" SET TMGFLAGS=TMGFLAGS_"R"
94 NEW TMGFORMAT SET TMGFORMAT=$PIECE(PARAM,"^",3)
95 NEW TMGOUT,TMGMSG
96 DO GETS^DIQ(TMGFILE,TMGIENS,TMGFLDS,TMGFLAGS,"TMGOUT","TMGMSG")
97 IF $DATA(TMGMSG("DIERR")) DO GOTO GPDN
98 . SET RESULT=$$GetErrStr^TMGDEBUG(.TMGMSG)
99 NEW FLD,FLDNAME
100 SET FLD=""
101 IF TMGFORMAT="" DO
102 . FOR SET FLD=$ORDER(TMGOUT(TMGFILE,TMGIENS,FLD)) QUIT:(FLD="") DO
103 . . IF $DATA(TMGOUT(TMGFILE,TMGIENS,FLD,0)) QUIT ;"For now, WP fields are not supported. Could add later if needed.
104 . . NEW VALUE SET VALUE=$GET(TMGOUT(TMGFILE,TMGIENS,FLD))
105 . . IF VALUE="",TMGTEMP["N" QUIT
106 . . IF RESULT'="" DO
107 . . . IF TMGTEMP["S" SET RESULT=RESULT_"; "
108 . . . ELSE SET RESULT=RESULT_$CHAR(13)_$CHAR(10)
109 . . IF TMGTEMP["F" DO
110 . . . IF FLD'=+FLD SET FLDNAME=FLD
111 . . . ELSE SET FLDNAME=$PIECE($GET(^DD(TMGFILE,FLD,0)),"^",1)
112 . . . SET RESULT=RESULT_FLDNAME_": "
113 . . SET RESULT=RESULT_VALUE
114 ELSE DO ;"Handle format strings.
115 . SET RESULT=TMGFORMAT
116 . FOR QUIT:(RESULT'["%") DO
117 . . NEW SUBA,SUBB
118 . . SET SUBA=$PIECE(RESULT,"%",1)
119 . . SET FLD=$PIECE(RESULT,"%",2)
120 . . SET SUBB=$PIECE(RESULT,"%",3,999)
121 . . NEW VALUE
122 . . IF FLD="" SET VALUE="<@!@>" ;"protect %%, later convert back to '%'
123 . . ELSE SET VALUE=$GET(TMGOUT(TMGFILE,TMGIENS,FLD))
124 . . IF VALUE="" DO
125 . . . IF FLD=+FLD DO
126 . . . . SET FLD=$PIECE($GET(^DD(TMGFILE,FLD,0)),"^",1) ;"Convert # to name
127 . . . ELSE DO
128 . . . . SET FLD=$ORDER(^DD(TMGFILE,"B",FLD,"")) ;"Convert name to #
129 . . . IF FLD'="" SET VALUE=$GET(TMGOUT(TMGFILE,TMGIENS,FLD))
130 . . . IF VALUE="" SET VALUE="??"
131 . . SET RESULT=SUBA_VALUE_SUBB
132 . NEW TMGALT
133 . SET TMGALT("<@!@>")="%"
134 . SET TMGALT("\n")=$CHAR(13)_$CHAR(10)
135 . SET RESULT=$$REPLACE^XLFSTR(RESULT,.TMGALT)
136 ;
137GPDN QUIT RESULT
Note: See TracBrowser for help on using the repository browser.