| 1 | TMGRPC6A ;TMG/kst/Support Functions for tmg-messenger ;09/17/09
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;09/17/09
|
|---|
| 3 | ;
|
|---|
| 4 | ;"TMG RPC FUNCTIONS for TMG-Messenger program
|
|---|
| 5 | ;
|
|---|
| 6 | ;"Kevin Toppenberg MD
|
|---|
| 7 | ;"GNU Lessor General Public License (LGPL) applies
|
|---|
| 8 | ;"9/17/09
|
|---|
| 9 | ;
|
|---|
| 10 | ;"=======================================================================
|
|---|
| 11 | ;" RPC -- Public Functions.
|
|---|
| 12 | ;"=======================================================================
|
|---|
| 13 | ;"GETEMULT(TMGOUT,TMGPARAMS) ;"GET USERS OF EMAIL ADDRESS
|
|---|
| 14 | ;"GETUEMA(TMGOUT,TMGPARAMS) ;"GET MULT USERS EMAIL ADDRESSES
|
|---|
| 15 | ;"SETUEMA(TMGOUT,TMGPARAMS) ;"SET ONE USER'S EMAIL ADDRESS
|
|---|
| 16 | ;"KILLUEMA(TMGOUT,TMGPARAMS) ;"REMOVE ONE EMAIL ADDRESS FROM A USER
|
|---|
| 17 | ;"SETUSEM(TMGOUT,TMGPARAMS) ;"SET MULTIPLE USERS EMAIL ADDRESSES
|
|---|
| 18 | ;"GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
|
|---|
| 19 | ;"GETIEN8925(TMGOUT,TMGUID) ;"GET IEN 8925 FOR IMAP UID
|
|---|
| 20 | ;"SETUID(TMGOUT,TMGPARAMS) ;"SET IMAP UID FOR IEN 8925
|
|---|
| 21 | ;"GETEMDOC(TMGOUT,TMGPARAMS) ;"GET IEN OF 'EMAIL' DOC IN 8925.1
|
|---|
| 22 | ;"
|
|---|
| 23 | ;"=======================================================================
|
|---|
| 24 | ;"PRIVATE API FUNCTIONS
|
|---|
| 25 | ;"=======================================================================
|
|---|
| 26 | ;
|
|---|
| 27 | ;"=======================================================================
|
|---|
| 28 | ;"=======================================================================
|
|---|
| 29 | ;"Dependencies:
|
|---|
| 30 | ;" TMGDEBUG
|
|---|
| 31 | ;"=======================================================================
|
|---|
| 32 | ;"=======================================================================
|
|---|
| 33 | ;
|
|---|
| 34 | ;"=======================================================================
|
|---|
| 35 | ;
|
|---|
| 36 | GETEMULT(TMGOUT,TMGPARAMS) ;"GET USERS OF EMAIL ADDRESS
|
|---|
| 37 | ;"Purpose: to fill list with users with matching email address
|
|---|
| 38 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 39 | ;" TMGPARAMS -- email address, e.g. 'Someuser@gmail.com'
|
|---|
| 40 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 41 | ;" TMGOUT(0)="#Found^Success" or "-1^Message"
|
|---|
| 42 | ;" e.g. 1^Success --> 1 match found
|
|---|
| 43 | ;" 2^Success --> 2 matches found
|
|---|
| 44 | ;" 0^Success --> no errors, but no matches found.
|
|---|
| 45 | ;" TMGOUT(1)=Name^DOB^IEN2
|
|---|
| 46 | ;" TMGOUT(2)=Name^DOB^IEN2
|
|---|
| 47 | ;"
|
|---|
| 48 | ;"Results: none
|
|---|
| 49 | ;
|
|---|
| 50 | MERGE ^TMG("TMP","RPC","GETEMULT","TMGPARAMS")=TMGPARAMS
|
|---|
| 51 | NEW TMGINDEX SET TMGINDEX=1
|
|---|
| 52 | NEW TMGEMAIL SET TMGEMAIL=$$LOW^XLFSTR($EXTRACT($GET(TMGPARAMS),1,128))
|
|---|
| 53 | IF TMGEMAIL="" DO QUIT
|
|---|
| 54 | . SET TMGOUT(0)="-1^No email address passed for lookup"
|
|---|
| 55 | NEW TMGIEN SET TMGIEN=""
|
|---|
| 56 | KILL TMGOUT
|
|---|
| 57 | FOR SET TMGIEN=$ORDER(^DPT("ATMGEMAIL",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
|
|---|
| 58 | . NEW TMGNAME SET TMGNAME=$PIECE($GET(^DPT(TMGIEN,0)),"^",1)
|
|---|
| 59 | . NEW TMGDOB SET TMGDOB=$PIECE($GET(^DPT(TMGIEN,0)),"^",3)
|
|---|
| 60 | . SET TMGDOB=$$FMTE^XLFDT(TMGDOB,"5D") ;"MM/DD/YYY format
|
|---|
| 61 | . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGDOB_"^"_TMGIEN
|
|---|
| 62 | . SET TMGINDEX=TMGINDEX+1
|
|---|
| 63 | FOR SET TMGIEN=$ORDER(^DPT("ATMGALTEMAIL",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
|
|---|
| 64 | . NEW TMGNAME SET TMGNAME=$PIECE($GET(^DPT(TMGIEN,0)),"^",1)
|
|---|
| 65 | . NEW TMGDOB SET TMGDOB=$PIECE($GET(^DPT(TMGIEN,0)),"^",3)
|
|---|
| 66 | . SET TMGDOB=$$FMTE^XLFDT(TMGDOB,"5D") ;"MM/DD/YYY format
|
|---|
| 67 | . SET TMGOUT(TMGINDEX)=TMGNAME_"^"_TMGDOB_"^"_TMGIEN
|
|---|
| 68 | . SET TMGINDEX=TMGINDEX+1
|
|---|
| 69 | ;
|
|---|
| 70 | SET TMGOUT(0)=(TMGINDEX-1)_"^Success"
|
|---|
| 71 | ;
|
|---|
| 72 | QUIT
|
|---|
| 73 | ;
|
|---|
| 74 | GETUEMA(TMGOUT,TMGPARAMS) ;"GET MULT USERS EMAIL ADDRESSES
|
|---|
| 75 | ;"Purpose: to fill list of email address for requested users.
|
|---|
| 76 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 77 | ;" TMGPARAMS -- list of DFN's e.g. 1234;2345;234
|
|---|
| 78 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 79 | ;" TMGOUT(0)="#Found^Success" or "-1^Message"
|
|---|
| 80 | ;" e.g. 1^Success --> 1 match found
|
|---|
| 81 | ;" 2^Success --> 2 matches found
|
|---|
| 82 | ;" 0^Success --> no errors, but no matches found.
|
|---|
| 83 | ;" TMGOUT(1)=DFN1^EmailAddress
|
|---|
| 84 | ;" TMGOUT(2)=DFN1^;ALT;AltEmail1
|
|---|
| 85 | ;" TMGOUT(3)=DFN1^;ALT;AltEmail2
|
|---|
| 86 | ;" TMGOUT(4)=DFN2^EmailAddress
|
|---|
| 87 | ;" NOTE: So if a user has 1 primary and 2 secondary
|
|---|
| 88 | ;" email addresses, then there will be 3 entries
|
|---|
| 89 | ;" starting with the same DFN
|
|---|
| 90 | ;"
|
|---|
| 91 | ;"Results: none
|
|---|
| 92 | ;
|
|---|
| 93 | MERGE ^TMG("TMP","RPC","GETUEMA","TMGPARAMS")=TMGPARAMS
|
|---|
| 94 | NEW TMGINDEX SET TMGINDEX=1
|
|---|
| 95 | NEW TMGI
|
|---|
| 96 | NEW TMGEMAIL
|
|---|
| 97 | NEW TMGIEN SET TMGIEN=""
|
|---|
| 98 | SET TMGPARAMS=$GET(TMGPARAMS)
|
|---|
| 99 | KILL TMGOUT
|
|---|
| 100 | FOR TMGI=1:1:$LENGTH(TMGPARAMS,";") DO
|
|---|
| 101 | . SET TMGIEN=+$PIECE(TMGPARAMS,";",TMGI)
|
|---|
| 102 | . QUIT:(TMGIEN'>0)
|
|---|
| 103 | . SET TMGEMAIL=$PIECE($GET(^DPT(TMGIEN,.13)),"^",3)
|
|---|
| 104 | . SET TMGOUT(TMGINDEX)=TMGIEN_"^"_TMGEMAIL
|
|---|
| 105 | . SET TMGINDEX=TMGINDEX+1
|
|---|
| 106 | . NEW TMGIEN2 SET TMGIEN2=0
|
|---|
| 107 | . FOR SET TMGIEN2=$ORDER(^DPT(TMGIEN,"TMGALTEMAIL",TMGIEN2)) QUIT:(+TMGIEN2'>0) DO
|
|---|
| 108 | . . NEW TMGALTEMAIL SET TMGALTEMAIL=""
|
|---|
| 109 | . . SET TMGALTEMAIL=$PIECE($GET(^DPT(TMGIEN,"TMGALTEMAIL",TMGIEN2,0)),"^",1)
|
|---|
| 110 | . . SET TMGOUT(TMGINDEX)=TMGIEN_"^;ALT;"_TMGALTEMAIL
|
|---|
| 111 | . . SET TMGINDEX=TMGINDEX+1
|
|---|
| 112 | ;
|
|---|
| 113 | SET TMGOUT(0)=(TMGINDEX-1)_"^Success"
|
|---|
| 114 | ;
|
|---|
| 115 | QUIT
|
|---|
| 116 | ;
|
|---|
| 117 | SETUEMA(TMGOUT,TMGPARAMS) ;"SET ONE USER EMAIL ADDRESS
|
|---|
| 118 | ;"Purpose: to store a new email address for 1 user.
|
|---|
| 119 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 120 | ;" TMGPARAMS -- DFN^NewEMailAddress^AltEMail1^AltEMail2^...
|
|---|
| 121 | ;" e.g. 1234^MyEMail@server.com
|
|---|
| 122 | ;" NOTE: NewEMailAddress is optional
|
|---|
| 123 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 124 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 125 | ;"
|
|---|
| 126 | ;"Results: none
|
|---|
| 127 | ;
|
|---|
| 128 | MERGE ^TMG("TMP","RPC","SETUEMA","TMGPARAMS")=TMGPARAMS
|
|---|
| 129 | KILL TMGOUT
|
|---|
| 130 | SET TMGOUT(0)="1^Success"
|
|---|
| 131 | SET TMGPARAMS=$GET(TMGPARAMS)
|
|---|
| 132 | NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 133 | IF +TMGDFN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGDFN_"')" QUIT
|
|---|
| 134 | NEW TMGEMAIL SET TMGEMAIL=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 135 | NEW TMGFDA,TMGMSG
|
|---|
| 136 | IF TMGEMAIL'="" do
|
|---|
| 137 | . SET TMGFDA(2,TMGDFN_",",".133")=TMGEMAIL
|
|---|
| 138 | . DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 139 | . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 140 | . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 141 | NEW TMGI,TMGALTEMAIL
|
|---|
| 142 | FOR TMGI=3:1:$LENGTH(TMGPARAMS,"^") DO QUIT:(TMGALTEMAIL="")
|
|---|
| 143 | . SET TMGALTEMAIL=$PIECE(TMGPARAMS,"^",TMGI)
|
|---|
| 144 | . IF TMGALTEMAIL="" QUIT
|
|---|
| 145 | . IF +$ORDER(^DPT(TMGDFN,"ATMGALTEMAIL",$$LOW^XLFSTR(TMGALTEMAIL),""))>0 QUIT
|
|---|
| 146 | . KILL TMGFDA NEW TMGIEN
|
|---|
| 147 | . SET TMGFDA(2.022703,"+1,"_TMGDFN_",",.01)=TMGALTEMAIL
|
|---|
| 148 | . DO UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 149 | . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 150 | . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) ;"Only will store LAST error.
|
|---|
| 151 | ;
|
|---|
| 152 | QUIT
|
|---|
| 153 | ;
|
|---|
| 154 | KILLUEMA(TMGOUT,TMGPARAMS) ;"REMOVE ONE EMAIL ADDRESS FROM A USER
|
|---|
| 155 | ;"Purpose: Remove an email address, either primary or alternative
|
|---|
| 156 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 157 | ;" TMGPARAMS -- DFN^BAD-EMailAddress^Bademail2^bademail3^...
|
|---|
| 158 | ;" e.g. 1234^MyBadEMail@server.com
|
|---|
| 159 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 160 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 161 | ;"
|
|---|
| 162 | ;"Results: none
|
|---|
| 163 | ;
|
|---|
| 164 | MERGE ^TMG("TMP","RPC","KILLUEMA","TMGPARAMS")=TMGPARAMS
|
|---|
| 165 | SET TMGOUT(0)="1^Success"
|
|---|
| 166 | SET TMGPARAMS=$GET(TMGPARAMS)
|
|---|
| 167 | NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 168 | IF +TMGDFN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGDFN_"')" QUIT
|
|---|
| 169 | NEW TMGI,TMGEMAIL
|
|---|
| 170 | FOR TMGI=2:1:$LENGTH(TMGPARAMS,"^") DO QUIT:(TMGEMAIL="")!(+TMGOUT(0)=-1)
|
|---|
| 171 | . NEW TMGFOUND SET TMGFOUND=0
|
|---|
| 172 | . SET TMGEMAIL=$$LOW^XLFSTR($PIECE(TMGPARAMS,"^",TMGI))
|
|---|
| 173 | . IF TMGEMAIL="" QUIT
|
|---|
| 174 | . NEW TMGIEN SET TMGIEN=""
|
|---|
| 175 | . FOR SET TMGIEN=$ORDER(^DPT("ATMGEMAIL",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0)!(+TMGOUT(0)=-1) DO
|
|---|
| 176 | . . IF TMGIEN'=TMGDFN QUIT
|
|---|
| 177 | . . SET TMGFOUND=1
|
|---|
| 178 | . . NEW TMGFDA,TMGMSG
|
|---|
| 179 | . . SET TMGFDA(2,TMGDFN_",",".133")="@"
|
|---|
| 180 | . . DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 181 | . . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 182 | . . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 183 | . SET TMGIEN=""
|
|---|
| 184 | . FOR SET TMGIEN=$ORDER(^DPT(TMGDFN,"TMGALTEMAIL","B",TMGEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0)!(+TMGOUT(0)=-1) DO
|
|---|
| 185 | . . SET TMGFOUND=1
|
|---|
| 186 | . . NEW TMGFDA,TMGMSG
|
|---|
| 187 | . . SET TMGFDA(2.022703,TMGIEN_","_TMGDFN_",",".01")="@"
|
|---|
| 188 | . . DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 189 | . . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 190 | . . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 191 | . IF TMGFOUND=0 DO ;"only will retain LAST message...
|
|---|
| 192 | . . SET TMGOUT(0)="-1^Couldn't locate email to delete: "+TMGEMAIL
|
|---|
| 193 | ;
|
|---|
| 194 | QUIT
|
|---|
| 195 | ;
|
|---|
| 196 | ALTEREMA(TMGOUT,TMGPARAMS) ;"ALTER USER EMAIL ADDRESS
|
|---|
| 197 | ;"Purpose: Change the value for an email address
|
|---|
| 198 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 199 | ;" TMGPARAMS -- DFN^OldEMailAddress^NewEmailAddress
|
|---|
| 200 | ;" e.g. 1234^OldEMail@server.com^NewEmail@server2.com
|
|---|
| 201 | ;" NOTE: If old value is the value for primary email address, then that will be changed
|
|---|
| 202 | ;" Otherwise, alternative emails will be searched. Search is case insensitive
|
|---|
| 203 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 204 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 205 | ;"
|
|---|
| 206 | ;"Results: none
|
|---|
| 207 | ;
|
|---|
| 208 | MERGE ^TMG("TMP","RPC","ALTEREMA","TMGPARAMS")=TMGPARAMS
|
|---|
| 209 | SET TMGOUT(0)="1^Success"
|
|---|
| 210 | NEW TMGFOUND SET TMGFOUND=0
|
|---|
| 211 | SET TMGPARAMS=$GET(TMGPARAMS)
|
|---|
| 212 | NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 213 | IF +TMGDFN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGDFN_"')" QUIT
|
|---|
| 214 | NEW TMGI,TMGOLDEMAIL,TMGNEWEMAIL
|
|---|
| 215 | SET TMGOLDEMAIL=$$LOW^XLFSTR($PIECE(TMGPARAMS,"^",2))
|
|---|
| 216 | IF TMGOLDEMAIL="" DO QUIT
|
|---|
| 217 | . SET TMGOUT(0)="-1^Old email value not provided."
|
|---|
| 218 | SET TMGNEWEMAIL=$PIECE(TMGPARAMS,"^",3)
|
|---|
| 219 | IF TMGNEWEMAIL="" DO QUIT
|
|---|
| 220 | . SET TMGOUT(0)="-1^New email value not provided."
|
|---|
| 221 | NEW TMGIEN SET TMGIEN=""
|
|---|
| 222 | FOR SET TMGIEN=$ORDER(^DPT("ATMGEMAIL",TMGOLDEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
|
|---|
| 223 | . IF TMGIEN'=TMGDFN QUIT
|
|---|
| 224 | . SET TMGFOUND=1
|
|---|
| 225 | . NEW TMGFDA,TMGMSG
|
|---|
| 226 | . SET TMGFDA(2,TMGDFN_",",".133")=TMGNEWEMAIL
|
|---|
| 227 | . DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 228 | . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 229 | . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 230 | IF TMGFOUND=1 QUIT
|
|---|
| 231 | SET TMGIEN=""
|
|---|
| 232 | FOR SET TMGIEN=$ORDER(^DPT(TMGDFN,"TMGALTEMAIL","B",TMGOLDEMAIL,TMGIEN)) QUIT:(+TMGIEN'>0) DO
|
|---|
| 233 | . NEW TMGFDA,TMGMSG
|
|---|
| 234 | . SET TMGFDA(2.022703,TMGIEN_","_TMGDFN_",",".01")=TMGNEWEMAIL
|
|---|
| 235 | . DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 236 | . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 237 | . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 238 | ;
|
|---|
| 239 | QUIT
|
|---|
| 240 | ;
|
|---|
| 241 | SETUSEM(TMGOUT,TMGPARAMS) ;"SET MULTIPLE USERS EMAIL ADDRESSES
|
|---|
| 242 | ;"Purpose: to store a new email address for more than 1 user.
|
|---|
| 243 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 244 | ;" TMGPARAMS -- DFN=NewEMailAddress;DFN=NewEMailAddress;DFN=NewEMailAddress....
|
|---|
| 245 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 246 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 247 | ;"
|
|---|
| 248 | ;"Results: none
|
|---|
| 249 | ;"Note: If error encountered, then no further attempts to file others in list tried.
|
|---|
| 250 | ;
|
|---|
| 251 | MERGE ^TMG("TMP","RPC","SETUSEM","TMGPARAMS")=TMGPARAMS
|
|---|
| 252 | KILL TMGOUT
|
|---|
| 253 | SET TMGOUT(0)="1^Success"
|
|---|
| 254 | SET TMGPARAMS=$GET(TMGPARAMS)
|
|---|
| 255 | NEW TMGFDA,TMGMSG,TMGI,TMGERR
|
|---|
| 256 | SET TMGERR=0
|
|---|
| 257 | FOR TMGI=1:1:$LENGTH(TMGPARAMS,";") DO QUIT:TMGERR
|
|---|
| 258 | . KILL TMGFDA,TMGMSG
|
|---|
| 259 | . NEW TMG1PARAM SET TMG1PARAM=$PIECE(TMGPARAMS,";",TMGI)
|
|---|
| 260 | . NEW TMGIEN SET TMGIEN=$PIECE(TMG1PARAM,"=",1)
|
|---|
| 261 | . IF +TMGIEN'>0 SET TMGOUT(0)="-1^Patient IEN not provided (Got '"_TMGIEN_"')" SET TMGERR=1 QUIT
|
|---|
| 262 | . NEW TMGEMAIL SET TMGEMAIL=$PIECE(TMG1PARAM,"=",2)
|
|---|
| 263 | . IF TMGEMAIL="" SET TMGOUT(0)="-1^Email address not provided" SET TMGERR=1 QUIT
|
|---|
| 264 | . SET TMGFDA(2,TMGIEN_",",".133")=TMGEMAIL
|
|---|
| 265 | . DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 266 | . IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 267 | . . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 268 | . . SET TMGERR=1
|
|---|
| 269 | ;
|
|---|
| 270 | QUIT
|
|---|
| 271 | ;
|
|---|
| 272 | GFLSUBST(TMGOUT,TMGPARAMS) ;"GET FILE SUBSET
|
|---|
| 273 | ;"Purpose: to return a subset of entries a file's .01 names
|
|---|
| 274 | ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
|
|---|
| 275 | ;" TMGPARAMS -- FileNum^StartFrom^Direction^maxCount
|
|---|
| 276 | ;" TMGFNUM - filename file to traverse
|
|---|
| 277 | ;" StartFrom -- text to $ORDER() from -- OPTIONAL
|
|---|
| 278 | ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL
|
|---|
| 279 | ;" maxCt -- OPTIONAL -- the max number of entries to return.
|
|---|
| 280 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 281 | ;" TMGOUT(0)="1^Success" or "-1^Message"
|
|---|
| 282 | ;" TMGOUT(1)=IEN^Value
|
|---|
| 283 | ;" TMGOUT(2)=IEN^Value
|
|---|
| 284 | ;" ...
|
|---|
| 285 | ;"Results: none
|
|---|
| 286 | ;"NOTE: does NOT work with sub files.
|
|---|
| 287 | ;" Also, originally copied from TMGRPC3B to remove dependancies to that file
|
|---|
| 288 | ;
|
|---|
| 289 | NEW TMGFILE SET TMGFILE=+$PIECE(TMGPARAMS,"^",1)
|
|---|
| 290 | IF TMGFILE'>0 DO GOTO GFSDONE
|
|---|
| 291 | . SET TMGOUT(0)="-1^No file number supplied"
|
|---|
| 292 | NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 293 | NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",3)
|
|---|
| 294 | IF TMGDIR'=-1 SET TMGDIR=1
|
|---|
| 295 | NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",4)
|
|---|
| 296 | IF TMGMAXCT=0 SET TMGMAXCT=44
|
|---|
| 297 | ;
|
|---|
| 298 | NEW TMGI SET TMGI=0
|
|---|
| 299 | ;"NEW TMGLAST SET TMGLAST=""
|
|---|
| 300 | ;"NEW prev SET prev=""
|
|---|
| 301 | NEW TMGREF SET TMGREF=$GET(^DIC(TMGFILE,0,"GL"))
|
|---|
| 302 | SET TMGREF=$$CREF^DILF(TMGREF) ;"convert open --> closed reference
|
|---|
| 303 | IF TMGREF="" DO GOTO GFSDONE
|
|---|
| 304 | . SET TMGOUT(0)="-1^Unable to obtain global ref for file #"_TMGFILE
|
|---|
| 305 | ;
|
|---|
| 306 | FOR SET TMGFROM=$ORDER(@TMGREF@("B",TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI=TMGMAXCT) DO
|
|---|
| 307 | . NEW TMGIEN SET TMGIEN=""
|
|---|
| 308 | . FOR SET TMGIEN=$ORDER(@TMGREF@("B",TMGFROM,TMGIEN),TMGDIR) QUIT:(+TMGIEN'>0) DO
|
|---|
| 309 | . . SET TMGI=TMGI+1
|
|---|
| 310 | . . SET TMGOUT(TMGI)=TMGIEN_"^"_$$GET1^DIQ(TMGFILE,TMGIEN_",",.01)
|
|---|
| 311 | . . ;"SET TMGOUT(TMGI)=$$GET1^DIQ(TMGFILE,IEN_",",.01)
|
|---|
| 312 | ;
|
|---|
| 313 | SET TMGOUT(0)="1^Success"
|
|---|
| 314 | GFSDONE ;
|
|---|
| 315 | QUIT
|
|---|
| 316 | ;
|
|---|
| 317 | GETIEN8925(TMGOUT,TMGUID) ;"GET IEN 8925 FOR IMAP UID
|
|---|
| 318 | ;"Purpose: To retrieve the IEN from file 8925 that is linked to UID (if any)
|
|---|
| 319 | ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
|
|---|
| 320 | ;" TMGPARAMS -- UID
|
|---|
| 321 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 322 | ;" TMGOUT(0)="-1^Message" or TMG(0)=IEN or TMG(0)=0 if not found.
|
|---|
| 323 | ;"Results: none
|
|---|
| 324 | NEW TMGIEN
|
|---|
| 325 | IF $GET(TMGUID)="" DO QUIT
|
|---|
| 326 | . SET TMGOUT(0)="-1^No UID passed"
|
|---|
| 327 | SET TMGIEN=+$ORDER(^TIU(8925,"TMGUID",TMGUID,""))
|
|---|
| 328 | SET TMGOUT(0)=TMGIEN
|
|---|
| 329 | ;
|
|---|
| 330 | QUIT
|
|---|
| 331 | ;
|
|---|
| 332 | SETUID(TMGOUT,TMGPARAMS) ;"SET IMAP UID FOR IEN 8925
|
|---|
| 333 | ;"Purpose: To store an IMAP UID (identifier) for a given TIU Document
|
|---|
| 334 | ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
|
|---|
| 335 | ;" TMGPARAMS -- IEN8925^UID
|
|---|
| 336 | ;" IEN8925 -- The IEN in file 8925 to be altered.
|
|---|
| 337 | ;" UID -- The UID to be stored in the above document.
|
|---|
| 338 | ;"Output: TMGOUT(0) = 1^Success, or -1^Error Message
|
|---|
| 339 | ;"Results: none
|
|---|
| 340 | SET TMGOUT(0)="1^Success" ;"Default to success
|
|---|
| 341 | NEW TMGIEN,TMGUID,TMGFDA,TMGMSG
|
|---|
| 342 | SET TMGIEN=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 343 | IF +TMGIEN'>0 DO QUIT
|
|---|
| 344 | . SET TMGOUT(0)="-1^Bad IEN passed: "_TMGIEN
|
|---|
| 345 | SET TMGUID=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 346 | IF TMGUID="" DO QUIT
|
|---|
| 347 | . SET TMGOUT(0)="-1^No UID passed."
|
|---|
| 348 | SET TMGFDA(8925,TMGIEN_",",22710)=TMGUID
|
|---|
| 349 | DO FILE^DIE("EK","TMGFDA","TMGMSG")
|
|---|
| 350 | IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 351 | . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 352 | ;
|
|---|
| 353 | QUIT
|
|---|
| 354 | ;
|
|---|
| 355 | GETEMDOC(TMGOUT,TMGPARAMS) ;"
|
|---|
| 356 | ;"Purpose: GET IEN OF 'EMAIL' DOC IN 8925.1
|
|---|
| 357 | ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
|
|---|
| 358 | ;" TMGPARAMS -- Not used, so data ignored.
|
|---|
| 359 | ;"Output: TMGOUT is filled as follows:
|
|---|
| 360 | ;" TMGOUT(0)="-1^Message" or TMG(0)=IEN^Name
|
|---|
| 361 | ;"Results: none
|
|---|
| 362 | ;"
|
|---|
| 363 | NEW X,Y,DIC
|
|---|
| 364 | SET DIC=8925.1
|
|---|
| 365 | SET DIC(0)="M"
|
|---|
| 366 | SET X="EMAIL"
|
|---|
| 367 | DO ^DIC
|
|---|
| 368 | IF +Y>0 DO
|
|---|
| 369 | . SET TMGOUT(0)=Y
|
|---|
| 370 | ELSE DO
|
|---|
| 371 | . SET TMGOUT(0)="-1^Unique title EMAIL not found"
|
|---|
| 372 | ;
|
|---|
| 373 | QUIT
|
|---|
| 374 | ;
|
|---|
| 375 | GETCONSNT(TMGOUT,TMGPARAMS) ;
|
|---|
| 376 | ;"Purpose: Get status of HIPPA consent documented in patient chart
|
|---|
| 377 | ;"Input: TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
|
|---|
| 378 | ;" TMGPARAMS -- PatientIEN^
|
|---|
| 379 | ;"Results: TMGOUT(0) = 1^Codes, or -1^Error Message
|
|---|
| 380 | ;" Codes are E - Email consented;
|
|---|
| 381 | ;" EC - email & cell msg consented;
|
|---|
| 382 | ;" C - just cell msg consented.
|
|---|
| 383 | ;" N - NOT CONSENTED, or no code found
|
|---|
| 384 | ;"Results : none
|
|---|
| 385 | ;"Note: This field is a multiple, and allows status to change over time
|
|---|
| 386 | ;" This routine will return the status for NOW.
|
|---|
| 387 | NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 388 | IF +TMGDFN'>0 DO QUIT
|
|---|
| 389 | . SET TMGOUT(0)="-1^Valid Patient IEN Not Found. Got: "_TMGDFN
|
|---|
| 390 | SET TMGDFN=+TMGDFN
|
|---|
| 391 | NEW TMGDT,%,X
|
|---|
| 392 | DO NOW^%DTC SET TMGDT=% ;"Get NOW into TMGDT
|
|---|
| 393 | NEW TMGLASTDT
|
|---|
| 394 | SET TMGLASTDT=$ORDER(^DPT(TMGDFN,"TMGHIPPA","TMGDATE",TMGDT),-1)
|
|---|
| 395 | IF TMGLASTDT="" DO QUIT
|
|---|
| 396 | . SET TMGOUT(0)="-1^NO Current Status for Current Date-Time"
|
|---|
| 397 | NEW TMGIEN
|
|---|
| 398 | SET TMGIEN=$ORDER(^DPT(TMGDFN,"TMGHIPPA","TMGDATE",TMGLASTDT,""))
|
|---|
| 399 | NEW TMGSTATUS
|
|---|
| 400 | SET TMGSTATUS=$PIECE($GET(^DPT(TMGDFN,"TMGHIPPA",TMGIEN,0)),"^",1)
|
|---|
| 401 | IF TMGSTATUS="" SET TMGSTATUS="N"
|
|---|
| 402 | SET TMGOUT(0)="1^"_TMGSTATUS
|
|---|
| 403 | QUIT
|
|---|
| 404 | ;
|
|---|
| 405 | SETCONSNT(TMGOUT,TMGPARAMS) ;
|
|---|
| 406 | ;"PURPOSE: Set status of HIPPA consent documented in patient chart
|
|---|
| 407 | ;"Input TMGOUT -- An OUT PARAMETER. PASS BY REFERENCE.
|
|---|
| 408 | ;" TMGPARAMS -- PatientIEN^StatusCodes
|
|---|
| 409 | ;" Codes should be E - Email consented;
|
|---|
| 410 | ;" EC - email & cell msg consented;
|
|---|
| 411 | ;" C - just cell msg consented.
|
|---|
| 412 | ;" N - NOT CONSENTED
|
|---|
| 413 | ;" (Note, codes ARE case sensitive)
|
|---|
| 414 | ;"Results: TMGOUT(0) = 1^Success, or -1^Error Message
|
|---|
| 415 | NEW TMGDFN SET TMGDFN=$PIECE(TMGPARAMS,"^",1)
|
|---|
| 416 | IF +TMGDFN'>0 DO QUIT
|
|---|
| 417 | . SET TMGOUT(0)="-1^Valid Patient IEN Not Found. Got: "_TMGDFN
|
|---|
| 418 | SET TMGDFN=+TMGDFN
|
|---|
| 419 | NEW TMGCODE SET TMGCODE=$PIECE(TMGPARAMS,"^",2)
|
|---|
| 420 | NEW TMGVCODES SET TMGVCODES=$PIECE($GET(^DD(2.22704,.01,0)),"^",3)
|
|---|
| 421 | NEW TMGOK,TMGI SET TMGOK=0
|
|---|
| 422 | FOR TMGI=1:1:$LENGTH(TMGVCODES,";") DO QUIT:(TMGOK=1)
|
|---|
| 423 | . NEW ONECODE SET ONECODE=$PIECE(TMGVCODES,";",TMGI)
|
|---|
| 424 | . IF $PIECE(ONECODE,":",1)=TMGCODE SET TMGOK=1 QUIT
|
|---|
| 425 | . ;"IF $PIECE(ONECODE,":",2)=TMGCODE SET TMGOK=1 QUIT
|
|---|
| 426 | IF TMGOK'=1 DO QUIT
|
|---|
| 427 | . SET TMGOUT(0)="-1^Invalid code. Got: "_TMGCODE
|
|---|
| 428 | NEW TMGDT,%,X
|
|---|
| 429 | DO NOW^%DTC SET TMGDT=% ;"Get NOW into TMGDT
|
|---|
| 430 | NEW TMGFDA,TMGMSG,TMGIEN,TMGIENS
|
|---|
| 431 | SET TMGIENS="+1,"_TMGDFN_","
|
|---|
| 432 | SET TMGFDA(2.22704,TMGIENS,.01)=TMGCODE
|
|---|
| 433 | SET TMGFDA(2.22704,TMGIENS,.02)=TMGDT
|
|---|
| 434 | SET TMGFDA(2.22704,TMGIENS,.03)=DUZ
|
|---|
| 435 | DO UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG")
|
|---|
| 436 | IF $DATA(TMGMSG("DIERR")) DO
|
|---|
| 437 | . SET TMGOUT(0)="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
|
|---|
| 438 | ELSE DO
|
|---|
| 439 | . SET TMGOUT(0)="1^Success"
|
|---|
| 440 | ;
|
|---|
| 441 | QUIT
|
|---|
| 442 | ;
|
|---|
