| 1 | TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08, 7/7/10
 | 
|---|
| 2 |          ;;1.0;TMG-LIB;**1**;08/31/08
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;"TMG RPC FUNCTIONS for a GUI config program
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ;"Kevin Toppenberg MD
 | 
|---|
| 7 |  ;"GNU Lessor General Public License (LGPL) applies
 | 
|---|
| 8 |  ;"7/20/08
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ;"=======================================================================
 | 
|---|
| 11 |  ;" RPC -- Public Functions.
 | 
|---|
| 12 |  ;"=======================================================================
 | 
|---|
| 13 |  ;" <none>
 | 
|---|
| 14 |  ;"=======================================================================
 | 
|---|
| 15 |  ;"PRIVATE API FUNCTIONS
 | 
|---|
| 16 |  ;"=======================================================================
 | 
|---|
| 17 |  ;"GETEMPTY(TMGOUT,TMGPARAMS) -- get stub entries for a file (typically a subfile)
 | 
|---|
| 18 |  ;"GETHELPM(TMGOUT,TMGPARAMS)  -- retrieve the help message for a given field.
 | 
|---|
| 19 |  ;"STUBNEWR(TMGFILE,NewValue,TMGOUT) -- create a stub entry in the file (200), to be filled in elsewhere
 | 
|---|
| 20 |  ;"GETIFWP(TMGOUT,TMGPARAMS) -- return if filenumber is a WP subfile
 | 
|---|
| 21 |  ;"GETWPFLD(TMGOUT,TMGPARAMS) -- retrieve on word processing (WP) field entry
 | 
|---|
| 22 |  ;"PSTWPFLD(TMGOUT,TMGPARAMS,INPUT) -- store a word processing (WP) field entry
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 |  ;"=======================================================================
 | 
|---|
| 25 |  ;"=======================================================================
 | 
|---|
| 26 |  ;"Dependencies:
 | 
|---|
| 27 |  ;"  TMGRPC3* only
 | 
|---|
| 28 |  ;
 | 
|---|
| 29 |  ;"=======================================================================
 | 
|---|
| 30 |  ;"=======================================================================
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 | GETEMPTY(TMGOUT,TMGPARAMS) ;"GET EMPTY ENTRY
 | 
|---|
| 33 |         ;"Purpose: to get stub entries for a file (typically a subfile)
 | 
|---|
| 34 |         ;"              "GET EMPTY ENTRY"  -- getting stub entries for subfiles typically
 | 
|---|
| 35 |         ;"                   TMGPARAMS: file entry (file or subfile number)
 | 
|---|
| 36 |         ;"Input: TMGOUT --an OUT ARRAY, filled as follows:
 | 
|---|
| 37 |         ;"          TMGOUT(0)="1^Success" or "-1^Message"
 | 
|---|
| 38 |         ;"          TMGOUT(1)=File^^FieldNum^^DDInfo...
 | 
|---|
| 39 |         ;"          TMGOUT(2)=File^^FieldNum^^DDInfo...
 | 
|---|
| 40 |         ;"          Etc ...
 | 
|---|
| 41 |         ;"       Params: filenumber (typically a subfilenumber)
 | 
|---|
| 42 |         ;"Result: None
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 |         SET TMGOUT(0)="1^Success"
 | 
|---|
| 45 |         NEW TMGCOUNT SET TMGCOUNT=1
 | 
|---|
| 46 |         NEW TMGFNUM SET TMGFNUM=+$GET(TMGPARAMS)
 | 
|---|
| 47 |         NEW TMGFLDNUM SET TMGFLDNUM=0
 | 
|---|
| 48 |         FOR  SET TMGFLDNUM=$ORDER(^DD(TMGFNUM,TMGFLDNUM)) QUIT:(+TMGFLDNUM'>0)  DO
 | 
|---|
| 49 |         . NEW TMGDDINFO SET TMGDDINFO=$PIECE($GET(^DD(TMGFNUM,TMGFLDNUM,0)),"^",1,4)
 | 
|---|
| 50 |         . SET TMGOUT(TMGCOUNT)=TMGFNUM_"^^"_TMGFLDNUM_"^^"_TMGDDINFO
 | 
|---|
| 51 |         . SET TMGCOUNT=TMGCOUNT+1
 | 
|---|
| 52 |  ;
 | 
|---|
| 53 |         QUIT
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 |  ;
 | 
|---|
| 56 | GETHELPM(TMGOUT,TMGPARAMS) ;
 | 
|---|
| 57 |         ;"Purpose: to retrieve the help message for a given field.
 | 
|---|
| 58 |         ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
 | 
|---|
| 59 |         ;"       TMGPARAMS -- file^field^HelpType^IENS
 | 
|---|
| 60 |         ;"Output: TMGOUT is filled as follows:
 | 
|---|
| 61 |         ;"          TMGOUT(0)="1^Success" or "-1^Message"
 | 
|---|
| 62 |         ;"          TMGOUT(1...?)=Help Message
 | 
|---|
| 63 |  ;
 | 
|---|
| 64 |         NEW TMGMSG
 | 
|---|
| 65 |         NEW TMGINDEX SET TMGINDEX=1
 | 
|---|
| 66 |         NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
 | 
|---|
| 67 |         NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
 | 
|---|
| 68 |         NEW TMGHELPTYPE SET TMGHELPTYPE=$PIECE(TMGPARAMS,"^",3)
 | 
|---|
| 69 |         NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",4)
 | 
|---|
| 70 |         IF TMGFILE'>0 DO  GOTO GHMDONE
 | 
|---|
| 71 |         . SET TMGOUT(0)="-1^No file number supplied"
 | 
|---|
| 72 |         IF TMGFIELD'>0 DO  GOTO GHMDONE
 | 
|---|
| 73 |         . SET TMGOUT(0)="-1^No Field Number supplied"
 | 
|---|
| 74 |         DO HELP^DIE(TMGFILE,TMGIENS,TMGFIELD,TMGHELPTYPE,"TMGMSG")
 | 
|---|
| 75 |         NEW TMGI SET TMGI=""
 | 
|---|
| 76 |         FOR  SET TMGI=$ORDER(TMGMSG("DIHELP",TMGI)) QUIT:(TMGI="")  DO
 | 
|---|
| 77 |         . SET TMGOUT(TMGINDEX)=TMGMSG("DIHELP",TMGI)
 | 
|---|
| 78 |         . SET TMGINDEX=TMGINDEX+1
 | 
|---|
| 79 |  ;
 | 
|---|
| 80 |         SET TMGOUT(0)="1^Success"
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 | GHMDONE ;
 | 
|---|
| 83 |         QUIT
 | 
|---|
| 84 |  ;
 | 
|---|
| 85 |  ;
 | 
|---|
| 86 | STUBNEWR(TMGFILE,TMGNEWVALUE,TMGOUT) ;"STUB NEW RECORD
 | 
|---|
| 87 |         ;"Purpose: to create a stub entry in the file (200), to be filled in elsewhere
 | 
|---|
| 88 |         ;"Input: TMGNEWVALUE -- a value for the .01 field
 | 
|---|
| 89 |         ;"       TMGOUT -- PASS BY REFERENCE, an OUT PARAMETER.
 | 
|---|
| 90 |         ;"Output: A new record will be added to file, if no errors
 | 
|---|
| 91 |         ;"       TMGOUT(0): 1^Success^NewIEN   or -1^See Fileman message
 | 
|---|
| 92 |         ;"       TMGOUT(1) will contain Fileman error, if any
 | 
|---|
| 93 |         ;"Results: none
 | 
|---|
| 94 |         ;"NOTICE: This function makes no promise that the creation of the
 | 
|---|
| 95 |         ;"      new record will succeed.  For example, if there are required
 | 
|---|
| 96 |         ;"      fields, the creation will fail.  So users should check for success
 | 
|---|
| 97 |         ;"      result and error feedback.
 | 
|---|
| 98 |         ;"Results: none
 | 
|---|
| 99 |  ;
 | 
|---|
| 100 |         NEW TMGFDA,TMGIEN,TMGMSG,DIC
 | 
|---|
| 101 |         SET DIC(0)=""  ;"I get a crash without this, for some reason...
 | 
|---|
| 102 |         SET TMGFDA(TMGFILE,"+1,",.01)=TMGNEWVALUE
 | 
|---|
| 103 |         DO UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
 | 
|---|
| 104 |  ;
 | 
|---|
| 105 |         IF $DATA(TMGMSG("DIERR")) DO  GOTO SNPDONE
 | 
|---|
| 106 |         . SET TMGOUT(0)="-1^See Fileman message"
 | 
|---|
| 107 |         . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 108 |  ;
 | 
|---|
| 109 |         SET TMGOUT(0)="1^Success^"_$GET(TMGIEN(1))
 | 
|---|
| 110 |  ;
 | 
|---|
| 111 | SNPDONE ;
 | 
|---|
| 112 |         QUIT
 | 
|---|
| 113 |  ;
 | 
|---|
| 114 |  ;
 | 
|---|
| 115 | GETIFWP(TMGOUT,TMGPARAMS) ;"GET IF WP FIELD
 | 
|---|
| 116 |         ;"Purpose: to return if filenumber is a WP subfile
 | 
|---|
| 117 |         ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
 | 
|---|
| 118 |         ;"       TMGPARAMS -- file^field
 | 
|---|
| 119 |         ;"Output:
 | 
|---|
| 120 |         ;"       TMGOUT(0): "1^Success^YES/NO" or "-1^Message"
 | 
|---|
| 121 |         ;"            "YES" if is a WP subfile, otherwise "NO"
 | 
|---|
| 122 |         ;"       TMGOUT(1) will contain Fileman error, if any
 | 
|---|
| 123 |         ;"Results: none
 | 
|---|
| 124 |  ;
 | 
|---|
| 125 |         NEW TMGRESULT
 | 
|---|
| 126 |         NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
 | 
|---|
| 127 |         NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
 | 
|---|
| 128 |         IF TMGFILE'>0 DO  GOTO GWPSDONE
 | 
|---|
| 129 |         . SET TMGOUT(0)="-1^No file number supplied"
 | 
|---|
| 130 |         IF TMGFIELD'>0 DO  GOTO GWPSDONE
 | 
|---|
| 131 |         . SET TMGOUT(0)="-1^No Field Number supplied"
 | 
|---|
| 132 |  ;
 | 
|---|
| 133 |         DO FIELD^DID(TMGFILE,TMGFIELD,"","TYPE","TMGARRAY","TMGMSG")
 | 
|---|
| 134 |  ;
 | 
|---|
| 135 |         IF $DATA(TMGMSG("DIERR")) DO  GOTO GWPSDONE
 | 
|---|
| 136 |         . SET TMGOUT(0)="-1^See Fileman message"
 | 
|---|
| 137 |         . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 138 |  ;
 | 
|---|
| 139 |         IF $GET(TMGARRAY("TYPE"))="WORD-PROCESSING" DO
 | 
|---|
| 140 |         . SET TMGRESULT="YES"
 | 
|---|
| 141 |         ELSE  DO
 | 
|---|
| 142 |         . SET TMGRESULT="NO"
 | 
|---|
| 143 |  ;
 | 
|---|
| 144 |         SET TMGOUT(0)="1^Success^"_TMGRESULT
 | 
|---|
| 145 |  ;
 | 
|---|
| 146 | GWPSDONE ;
 | 
|---|
| 147 |         QUIT
 | 
|---|
| 148 |  ;
 | 
|---|
| 149 |  ;
 | 
|---|
| 150 | GETWPFLD(TMGOUT,TMGPARAMS) ;"GET WP FIELD
 | 
|---|
| 151 |         ;"Purpose: To retrieve on word processing (WP) field entry
 | 
|---|
| 152 |         ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
 | 
|---|
| 153 |         ;"       TMGPARAMS -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^73,')
 | 
|---|
| 154 |         ;"Output:
 | 
|---|
| 155 |         ;"       TMGOUT(0): "1^Success" or "-1^Message"
 | 
|---|
| 156 |         ;"       TMGOUT(1) will contain Fileman error, if any
 | 
|---|
| 157 |         ;"       - or to return WP array -
 | 
|---|
| 158 |         ;"       TMGOUT(1)=1st line of text
 | 
|---|
| 159 |         ;"       TMGOUT(2)=2nd line of text
 | 
|---|
| 160 |         ;"       etc..
 | 
|---|
| 161 |         ;"Results: None
 | 
|---|
| 162 |  ;
 | 
|---|
| 163 |         NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
 | 
|---|
| 164 |         NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
 | 
|---|
| 165 |         NEW TMGIENS SET TMGIENS=+$PIECE(TMGPARAMS,"^",3)
 | 
|---|
| 166 |         IF TMGFILE'>0 DO  GOTO GWPDONE
 | 
|---|
| 167 |         . SET TMGOUT(0)="-1^No file number supplied"
 | 
|---|
| 168 |         IF TMGFIELD'>0 DO  GOTO GWPDONE
 | 
|---|
| 169 |         . SET TMGOUT(0)="-1^No Field Number supplied"
 | 
|---|
| 170 |         IF TMGIENS="" DO  GOTO GWPDONE
 | 
|---|
| 171 |         . SET TMGOUT(0)="-1^No IENS supplied"
 | 
|---|
| 172 |  ;
 | 
|---|
| 173 |         NEW TMGTEMP
 | 
|---|
| 174 |         SET TMGTEMP=$$GET1^DIQ(TMGFILE,TMGIENS,TMGFIELD,"","TMGARRAY","TMGMSG")
 | 
|---|
| 175 |         IF $DATA(TMGMSG("DIERR")) DO  GOTO GWPDONE
 | 
|---|
| 176 |         . SET TMGOUT(0)="-1^See Fileman message"
 | 
|---|
| 177 |         . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 178 |  ;
 | 
|---|
| 179 |         SET TMGOUT(0)="1^Success"
 | 
|---|
| 180 |         NEW TMGINDEX SET TMGINDEX=1
 | 
|---|
| 181 |         NEW TMGI SET TMGI=0
 | 
|---|
| 182 |         FOR  SET TMGI=$ORDER(TMGARRAY(TMGI)) QUIT:(TMGI="")  DO
 | 
|---|
| 183 |         . SET TMGOUT(TMGINDEX)=TMGARRAY(TMGI)
 | 
|---|
| 184 |         . SET TMGINDEX=TMGINDEX+1
 | 
|---|
| 185 |  ;
 | 
|---|
| 186 | GWPDONE ;
 | 
|---|
| 187 |         QUIT
 | 
|---|
| 188 |  ;
 | 
|---|
| 189 |  ;
 | 
|---|
| 190 | PSTWPFLD(TMGOUT,TMGPARAMS,INPUT) ;"POST WP FIELD
 | 
|---|
| 191 |         ;"Purpose: To store a word processing (WP) field entry
 | 
|---|
| 192 |         ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
 | 
|---|
| 193 |         ;"       TMGPARAMS -- FileNum^FieldNum^IENS (e.g. 'GET ONE WP FIELD^200^73,')
 | 
|---|
| 194 |         ;"       INPUT -- holds the WP itself to be stored:
 | 
|---|
| 195 |         ;"                   INPUT(0)=0TH line
 | 
|---|
| 196 |         ;"                   INPUT(1)=1st line
 | 
|---|
| 197 |         ;"                   INPUT(2)=2nd line
 | 
|---|
| 198 |         ;"                   ...
 | 
|---|
| 199 |         ;"Output:
 | 
|---|
| 200 |         ;"       TMGOUT(0): "1^Success" or "-1^Message"
 | 
|---|
| 201 |         ;"       TMGOUT(1) will contain Fileman error, if any
 | 
|---|
| 202 |         ;"Results: None
 | 
|---|
| 203 |  ;
 | 
|---|
| 204 |         NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
 | 
|---|
| 205 |         NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
 | 
|---|
| 206 |         NEW TMGIENS SET TMGIENS=+$PIECE(TMGPARAMS,"^",3)
 | 
|---|
| 207 |         IF TMGFILE'>0 DO  GOTO PWPDONE
 | 
|---|
| 208 |         . SET TMGOUT(0)="-1^No file number supplied"
 | 
|---|
| 209 |         IF TMGFIELD'>0 DO  GOTO PWPDONE
 | 
|---|
| 210 |         . SET TMGOUT(0)="-1^No Field Number supplied"
 | 
|---|
| 211 |         IF TMGIENS="" DO  GOTO PWPDONE
 | 
|---|
| 212 |         . SET TMGOUT(0)="-1^No IENS supplied"
 | 
|---|
| 213 |         IF $LENGTH(TMGIENS,",")=1 SET TMGIENS=TMGIENS_","
 | 
|---|
| 214 |  ;
 | 
|---|
| 215 |         DO WP^DIE(TMGFILE,TMGIENS,TMGFIELD,"K","INPUT","TMGMSG")
 | 
|---|
| 216 |  ;
 | 
|---|
| 217 |         IF $DATA(TMGMSG("DIERR")) DO  GOTO GWPDONE
 | 
|---|
| 218 |         . SET TMGOUT(0)="-1^See Fileman message"
 | 
|---|
| 219 |         . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 220 |  ;
 | 
|---|
| 221 |         SET TMGOUT(0)="1^Success"
 | 
|---|
| 222 |  ;
 | 
|---|
| 223 | PWPDONE ;
 | 
|---|
| 224 |         QUIT
 | 
|---|
| 225 |  ;
 | 
|---|
| 226 |  ;
 | 
|---|