TMGRPC1 ;TMG/kst-RPC Functions ;03/25/06 ;;1.0;TMG-LIB;**1**;08/18/09 ;"TMG RPC FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"3/24/07 ;"======================================================================= ;" RPC -- Public Functions. ;"======================================================================= ;"DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) ; Depreciated MOVED to TMGRPC1C ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) ; Depreciated MOVED to TMGRPC1C ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ; Depreciated MOVED to TMGRPC1C ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ; Depreciated MOVED to TMGRPC1C ;"GETLONG(GREF,IMAGEIEN) ;"GETDFN(RESULT,RECNUM,RECFIELD,LNAME,FNAME,MNAME,DOB,SEX,SSNUM) ;"BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) ;"AUTOSIGN(RESULT,DOCIEN) ;"FNINFO(RESULT,DFN) -- GET PATIENT DEMOGRAPHICS ;"PTADD(RESULT,INFO) -- ADD PATIENT ;"STPTINFO(RESULT,DFN,INFO) -- SET PATIENT DEMOGRAPHICS ;"GETURLS(RESULT) -- TMG CPRS GET URL LIST ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"ENCODE(GRef,incSubscr,encodeFn) ; Depreciated MOVED to TMGRPC1C ;"DECODE(GRef,incSubscr,decodeFn) ; Depreciated MOVED to TMGRPC1C ;"$$HEXCODER(INPUT) ;encode the input string. Currently using simple hex encoding/ ;"$$B64CODER(INPUT) ;encode the input string via UUENCODE (actually Base64) ;"$$B64DECODER(INPUT) ;encode the input string via UUDECODE (actually Base64) ;"======================================================================= ;"======================================================================= ;"Dependencies: ;"TMGBINF ;"TMGSTUTL ;"RGUTUU ;"======================================================================= ;"======================================================================= DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) GOTO DOWNLOAD+1^TMGRPC1C ; UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) GOTO UPLOAD+1^TMGRPC1C ; DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file GOTO DOWNDROP+1^TMGRPC1C ; UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File GOTO UPLDDROP+1^TMGRPC1C ; ENCODE(GRef,incSubscr,encodeFn) ;"Purpose: ENCODE a BINARY GLOBAL. GOTO ENCODE+1^TMGRPC1C ; DECODE(GRef,incSubscr,decodeFn) ;"Purpose: ENCODE a BINARY GLOBAL. GOTO DECODE+1^TMGRPC1C ; GETLONG(GREF,IMAGEIEN) ;"SCOPE: Public ;"Purpose: To provide an entry point for a RPC call from a client. ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE) ;"Output: results are passed out in @GREF ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format) ;" @GREF@(1) = WP line 1 ;" @GREF@(2) = WP line 2 ;" @GREF@(3) = WP line 3 ;" @GREF@(4) = WP line 4 ... etc. set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")" kill @GREF new i,s,MaxLines,header set header="" if +$get(IMAGEIEN)>0 do . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0 set @GREF@(0)=header set MaxLines=+$piece(header,"^",3) for i=1:1:MaxLines do . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0)) quit GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD) ;"Purpose: This is a RPC entry point for looking up a patient. ;"Input: ;" RESULT -- an OUT PARAMETER ;" RECNUM -- Record number from a PMS ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm) ;" FNAME -- First Name ;" LNAME -- Last name ;" MNAME -- Middle Name or initial ;" DOB -- Date of birth in EXTERNAL format ;" SEX -- Patient sex: M or F ;" SSNUM -- Social security number (digits only) ;" AUTOADD -- Automatically register patient if needed (if value=1) ;"Output: Patient may be added to database if AUTOADD=1 ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error new Patient,TMGFREG set RESULT=-1 ;"default to not found if $get(LNAME)'="" do . set Patient("NAME")=$get(LNAME) . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME set Patient("DOB")=$get(DOB) set Patient("SEX")=$get(SEX) set Patient("SSNUM")=$get(SSNUM) test if $get(AUTOADD)=1 set TMGFREG=1 if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number ;"temp ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME set RESULT=$$GetDFN^TMGGDFN(.Patient) quit BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) ;"Purpose: To create a new, blank TIU note and return it's IEN ;"Input: DFN -- IEN in PATIENT file of patient ;" PERSON -- Provider NAME ;" LOC -- Location for new document ;" DOS -- Date of Service ;" TITLE -- Title of new document ;"Results: IEN in file 8925 is returned in RESULT, ;" or -1^ErrMsg1;ErrMsg2... if failure ;"Note: This functionality probably duplicates that of RPC call: ;" TIU CREATE NOTE -- found after writing this... new Document,Flag kill ^TMG("TMP","BLANKTIU") set ^TMG("TMP","BLANKTIU","DFN")=$G(DFN) set ^TMG("TMP","BLANKTIU","PERSON")=$G(PERSON) set ^TMG("TMP","BLANKTIU","LOC")=$G(LOC) set ^TMG("TMP","BLANKTIU","DOS")=$G(DOS) set ^TMG("TMP","BLANKTIU","TITLE")=$G(TITLE) set Document("DFN")=DFN set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON) if +LOC=LOC s LOC="`"_LOC set Document("LOCATION")=$get(LOC) set Document("DATE")=$get(DOS) set Document("TITLE")=$get(TITLE) set Document("TRANSCRIPTIONIST")="" set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0 set RESULT=$$PrepDoc^TMGPUTN0(.Document) if +RESULT>0 do ;"change capture method from Upload (default) to RPC . new TMGFDA,TMGMSG . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC . merge ^TMG("TMP","BLANKTIU","TMGFDA")=TMGFDA . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors. else do . new i,ErrMsg set ErrMsg="" . for i=1:1:+$get(Document("ERROR","NUM")) do . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||" . if $data(Document("ERROR","FM INFO"))>0 do . . new ref set ref="Document(""ERROR"",""FM INFO"")" . . set ErrMsg=ErrMsg_"FILEMAN SAYS:" . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||" . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref) . if ErrMsg="" set ErrMsg="Unknown error" . set ErrMsg=$translate(ErrMsg,"^","@") . set $piece(RESULT,"^",2)=ErrMsg ;"temp merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT merge ^TMG("TMP","BLANKTIU","Document")=Document quit AUTOSIGN(RESULT,DOCIEN) ;"Purpose: To automatically sign TIU note (8925). ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed. ;"Note: This function will not succeed unless field 1303 holds "R" ;" and an Author found for note ;"Results: Results passed back in RESULT(0) ARRAY ;" -1 = failure. 1= success ;" Any error message is passed back in RESULT("DIERR") ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture ;" code is NOT required new TMGFDA,TMGMSG new AuthorIEN,AuthorName new CaptureMethod set DOCIEN=+$get(DOCIEN) set RESULT=-1 ;"default to failure set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3) if CaptureMethod'="R" do goto ASDone . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'." set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2) if AuthorIEN'>0 do goto ASDone . set RESULT("DIERR")="Unable to find author of document." set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1) set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode do FILE^DIE("E","TMGFDA","TMGMSG") if $data(TMGMSG("DIERR")) do goto ASDone . merge RESULT("DIERR")=TMGMSG("DIERR") set RESULT(0)=1 ;"set success if we got this far. ASDone quit DFNINFO(RESULT,DFN) ;"Purpose: To return array with demographcs details about patient ;"Input: RESULT (this is the output array) ;" DFN : The record number in file #2 of the patient to inquire about. ;"Results: Results passed back in RESULT array. Format as follows: ;" The results are in format: KeyName=Value, ;" There is no set order these will appear. ;" Here are the KeyName names that will be provided. ;" If the record has no value, then value will be empty ;" IEN=record# ;" COMBINED_NAME= ;" LNAME= ;" FNAME= ;" MNAME= ;" PREFIX= ;" SUFFIX= ;" DEGREE ;" DOB= ;" SEX= ;" SS_NUM= ;" ADDRESS_LINE_1= ;" ADDRESS_LINE_2= ;" ADDRESS_LINE_3= ;" CITY= ;" STATE= ;" ZIP4= ;" BAD_ADDRESS= ;" TEMP_ADDRESS_LINE_1= ;" TEMP_ADDRESS_LINE_2= ;" TEMP_ADDRESS_LINE_3= ;" TEMP_CITY= ;" TEMP_STATE= ;" TEMP_ZIP4= ;" TEMP_STARTING_DATE= ;" TEMP_ENDING_DATE= ;" TEMP_ADDRESS_ACTIVE= ;" CONF_ADDRESS_LINE_1= ;" CONF_ADDRESS_LINE_2= ;" CONF_ADDRESS_LINE_3= ;" CONF_CITY= ;" CONF_STATE= ;" CONF_ZIP4= ;" CONF_STARTING_DATE= ;" CONF_ENDING_DATE= ;" CONF_ADDRESS_ACTIVE= ;" PHONE_RESIDENCE= ;" PHONE_WORK= ;" PHONE_CELL= ;" PHONE_TEMP= ;"Note, for the following, there may be multiple entries. # is record number ;" ALIAS # NAME ;" ALIAS # SSN new TMGFDA,TMGMSG,IENS set IENS="" new ptrParts set ptrParts=0 set DFN=+$get(DFN) if DFN>0 do . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS . set IENS=DFN_"," . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG") new line set line=0 set RESULT(line)="IEN="_DFN set line=line+1 set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1 new s set s="" if ptrParts>0 set s=$get(^VA(20,ptrParts,1)) set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1 set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1 set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1 set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1 set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1 set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1 set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1 set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1 set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1 set RESULT(line)="EMAIL="_$get(TMGFDA(2,IENS,.133)) set line=line+1 set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1 set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1 set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1 set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1 set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1 if $get(TMGFDA(2,IENS,.1122))'="" do . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1122)) set line=line+1 else if $get(TMGFDA(2,IENS,.1116))'="" do . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1 set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1 set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1 set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1 set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1 set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1 set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1 set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1 set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1 set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1 set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1 set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1 set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1 set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1 set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1 set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1 set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1 set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1 set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1 set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1 set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.134)) set line=line+1 set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1 ;"the GETS doesn't return ALIAS entries, so will do manually: new Itr,IEN set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",") if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0) . new s set s=$get(^DPT(DFN,.01,IEN,0)) . if s="" quit . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1 . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1 . ;"maybe later do something with NAME COMPONENTS in Alias. quit STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO ;"Purpose: To set demographcs details about patient ;"Input: RESULT (this is the output array) ;" DFN : The record number in file #2 of the patient to inquire about. ;" INFO: Format as follows: ;" The results are in format: INFO("KeyName")=Value, ;" There is no set order these will appear. ;" Here are the KeyName names that will be provided. ;" If the record has no value, then value will be empty ;" If a record should be deleted, its value will be @ ;" INFO("COMBINED_NAME")= ;" INFO("PREFIX")= ;" INFO("SUFFIX")= ;" INFO("DEGREE")= ;" INFO("DOB")= ;" INFO("SEX")= ;" INFO("SS_NUM")= ;" INFO("ADDRESS_LINE_1")= ;" INFO("ADDRESS_LINE_2")= ;" INFO("ADDRESS_LINE_3")= ;" INFO("CITY")= ;" INFO("STATE")= ;" INFO("ZIP4")= ;" INFO("BAD_ADDRESS")= ;" INFO("TEMP_ADDRESS_LINE_1")= ;" INFO("TEMP_ADDRESS_LINE_2")= ;" INFO("TEMP_ADDRESS_LINE_3")= ;" INFO("TEMP_CITY")= ;" INFO("TEMP_STATE")= ;" INFO("TEMP_ZIP4")= ;" INFO("TEMP_STARTING_DATE")= ;" INFO("TEMP_ENDING_DATE")= ;" INFO("TEMP_ADDRESS_ACTIVE")= ;" INFO("CONF_ADDRESS_LINE_1")= ;" INFO("CONF_ADDRESS_LINE_2")= ;" INFO("CONF_ADDRESS_LINE_3")= ;" INFO("CONF_CITY")= ;" INFO("CONF_STATE")= ;" INFO("CONF_ZIP4")= ;" INFO("CONF_STARTING_DATE")= ;" INFO("CONF_ENDING_DATE")= ;" INFO("CONF_ADDRESS_ACTIVE")= ;" INFO("PHONE_RESIDENCE")= ;" INFO("PHONE_WORK")= ;" INFO("PHONE_CELL")= ;" INFO("PHONE_TEMP")= ;"Note, for the following, there may be multiple entries. # is record number ;" If a record should be added, it will be marked +1, +2 etc. ;" INFO("ALIAS # NAME")= ;" INFO("ALIAS # SSN")= ;" ;"Results: Results passed back in RESULT string: ;" 1 = success ;" -1^Message = failure set RESULT=1 ;"default to success ;"kill ^TMG("TMP","RPC") ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later new TMGFDA,TMGMSG,IENS set IENS=DFN_"," new key set key="" for set key=$order(INFO(key)) quit:(key="") do . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME") . else if +key=key set TMGFDA(2,IENS,key)=INFO(key) . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB") . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX") . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM") . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1") . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2") . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3") . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY") . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE") . else if key="ZIP4" set TMGFDA(2,IENS,.1112)=INFO("ZIP4") . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS") . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1") . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2") . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3") . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY") . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE") . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.12112)=INFO("TEMP_ZIP4") . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE") . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE") . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE") . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1") . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2") . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3") . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY") . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE") . else if key="CONF_ZIP" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP") . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE") . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE") . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE") . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE") . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK") . else if key="PHONE_CELL" set TMGFDA(2,IENS,.134)=INFO("PHONE_CELL") . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP") . else if key="EMAIL" set TMGFDA(2,IENS,.133)=INFO("EMAIL") if $data(TMGFDA) do . do FILE^DIE("EKST","TMGFDA","TMGMSG") . if $data(TMGMSG("DIERR")) do . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA ;"now file Alias info separately if RESULT=1 do . new tempArray,index,key2 . new key set key="" . for set key=$order(INFO(key)) quit:(key="") do . . if key["ALIAS" do . . . set index=$piece(key," ",2) quit:(index="") . . . set key2=$piece(key," ",3) . . . set tempArray(index,key2)=INFO(key) . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do . . new TMGFDA,TMGMSG,TMGIEN,newRec . . set newRec=0 . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME")) . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN")) . . . if index["+" set newRec=1 . . if $data(TMGFDA) do . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG") . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG") . . if $data(TMGMSG("DIERR")) do . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA quit PTADD(RESULT,INFO) ;" ADD PATIENT ;"Purpose: To add a patient ;"Input: RESULT (this is the output array) ;" ;" INFO: Format as follows: ;" The results are in format: INFO("KeyName")=Value, ;" There is no set order these will appear. ;" Here are the KeyName names that will be provided. ;" If the record has no value, then value will be empty ;" If a record should be deleted, its value will be @ ;" INFO("COMBINED_NAME")= ;" INFO("DOB")= ;" INFO("SEX")= ;" INFO("SS_NUM")= ;" INFO("Veteran")= ;" INFO("PtType")= ;"Results: Results passed back in RESULT string: ;" DFN = success ;" -1^Message = failure ;" 0^DFN = already exists set RESULT=1 ;"default to success kill ^TMG("TMP","RPC") merge ^TMG("TMP","RPC")=INFO ;"temp... remove later new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG ;" set IENS=DFN_"," new key set key="" for set key=$order(INFO(key)) quit:(key="") do . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME") . else if key="DOB" set PATIENT("DOB")=INFO("DOB") . else if key="SEX" set PATIENT("SEX")=INFO("SEX") . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM") . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran") . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType") set DFN=$$GetDFN^TMGGDFN(.PATIENT) if DFN=-1 do . new Entry,result,ErrMsg . do Pat2Entry^TMGGDFN(.PATIENT,.Entry) . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg) . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT) . if DFN'>0 do . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg) . else do .. set RESULT=DFN else do . set RESULT="0^"_DFN quit GETBARCD(GREF,MESSAGE,OPTION) ;"SCOPE: Public ;"RPC that calls this: TMG BARCODE ENCODE ;"Purpose: To provide an entry point for a RPC call from a client. ;" A 2D DataMatrix Bar Code will be create and passed to client. ;" It will not be stored on server ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) ;" MESSAGE-- The text to use to create the barcode ;" OPTION -- Array that may hold optional settings, as follows: ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png" ;"Output: results are passed out in @GREF ;" @GREF@(0)=success; 1=success, 0=failure ;" @GREF@(1..xxx) = actual data ;"NOTE: dmtxread must be installed on linux host. ;" I found source code here: ;" http://sourceforge.net/projects/libdmtx/ ;" After installing (./configure --> make --> make install), I ;" copied dmtxread and dmtxwrite, which were found in the ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs ;" folders, into a folder on the system path. I chose /usr/bin/ ;" Also, to achieve compile of above, I had to install required libs. ;" See notes included with dmtx source code. new FileSpec new file new FName,FPath set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")" kill @GREF set @GREF@(0)="" ;"default to failure set MESSAGE=$get(MESSAGE) if MESSAGE="" goto GBCDone ;"Create the barcode and get file name and path set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION) do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") ;"Load binary image into global array set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3) ;"convert binary data to ascii encoded data do ENCODE($name(@GREF@(1)),3) ;"delete temp image file do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") set FileSpec(FName)="" new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") GBCDone quit DECODEBC(RESULT,ARRAY,IMGTYPE) ;"SCOPE: Public ;"RPC that calls this: TMG BARCODE DECODE ;"Purpose: To provide an entry point for a RPC call from a client. The client ;" will upload an image file (.png format only) of a barcode (Datamatrix ;" format) for decoding. Decoded message is passed back. ;"Input: RESULT -- an OUT PARAMETER. See output below. ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.') ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage ;"NOTE: dmtxread must be installed on linux host. ;" I found source code here: ;" http://sourceforge.net/projects/libdmtx/ ;" After installing (./configure --> make --> make install), I ;" copied dmtxread and dmtxwrite, which were found in the ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs ;" folders, into a folder on the system path. I chose /usr/bin/ ;" Also, to achieve compile of above, I had to install required libs. ;" See notes included with dmtx source code. ;"NOTE: if image types other than .png will be uploaded, then the linux host ;" must have ImageMagick utility 'convert' installed for conversion ;" between image types. kill ^TMG("TMP","BARCODE") ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp ;"new Stack do GetStackInfo^TMGIDE2(.Stack) ;"merge ^TMG("TMP","BARCODE","STACK")=Stack new resultMsg if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE)) if imageType="" set resultMsg="0^Image type not specified" goto DBCDone new imageFName set imageFName="/tmp/barcode."_imageType set imageFName=$$UNIQUE^%ZISUTL(imageFName) new FName,FPath,FileSpec do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") set FileSpec(FName)="" ;"temp... ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp ;"Remove BASE64 ascii encoding do DECODE("ARRAY(0)",1) ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)="" ;"Save to host file system if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone . set resultMsg="0^Error while saving file to HFS" ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp ;"convert image file to .png format, if needed if imageType'="png" do . set imageFName=$$Convert^TMGKERNL(imageFName,"png") . if imageFName="" do quit . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format." . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") . set FileSpec(FName)="" if imageFName="" goto DBCDone ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp ;"Decode the barcode.png image new result set result=$$READBC^TMGBARC(imageFName) if result'="" set resultMsg="1^"_result else set resultMsg="0^Unable to Decode Image" ;"delete temp image file ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!! ;"set result=$$DEL^%ZISH(FPath,"FileSpec") DBCDone ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp set RESULT=resultMsg quit ;"-------------------- GETURLS(RESULT) ;"SCOPE: Public ;"RPC that calls this: TMG CPRS GET URL LIST ;"Purpose: To provide an entry point for a RPC call from a client. The client ;" will request URLs to display in custom tabs inside CPRS, in an ;" imbedded web browser ;"Input: RESULT -- an OUT PARAMETER. See output below. ;"Output: results are passed out in RESULT: ;" RESULT(0)="1^Success" or "0^SomeFailureMessage" ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1' ;" RESULT(2)="Name2^URL#2" ; etc. ;" RESULT(3)="Name3^URL#3" ;" ;" E.g. RESULT(1)="cnn^www.cnn.com" ;" RESULT(2)="INFO^192.168.0.1/home.html" ;" ;" The number of allowed tabs is determined by code in CPRS ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS ;" If a web tab is NOT specified, then the page previously ;" displayed will be left in place. It will not be cleared. ;" To clear a given page, a url of "about:blank" will cause a ;" blank page to be displayed. e.g. ;" RESULT(3)="^about:blank" ;" To HIDE a tab on CPRS use this: ;" RESULT(3)="^" ;triggers tab #3 to be hidden ;" To have the browser remain UNCHANGED use this: ;" RESULT(3)="^" ;triggers tab #3 to remain unchanged. ;" Note: the rationale for this is that the web tab may have info ;" that should not be refreshed when the patient info is refreshed ;" i.e. the user may have navigated somewhere, and doesn't want ;" to loose their location. ;" --to be implemented. ;" Note: The other way to do this, acs above, is to simply have NO ;" entry for a given tab. I.e. don't have any value for RESULT(3) ;" --already implemented. ;"Notice to others: Below is where code should be added to return ;" proper URL's to CPRS. This will be called whenever a new patient ;" is opened, or a Refresh Information is requested. ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used ;" to pass back URLS specific for a given patient. set RESULT(0)="1^Success" set RESULT(1)="MerkMedicus^http://www.merckmedicus.com/pp/us/hcp/hcp_home.jsp" set RESULT(2)="Pathgroup^http://pathgroup.com/" set RESULT(3)="AAFP^http://search.aafp.org/search?access=p&output=xml_no_dtd&site=a&filter=0&ie=UTF-8&oe=UTF-8&client=aafp&proxystylesheet=aafp&proxycustom=%3CADVANCED/%3E" set RESULT(4)="EMedicine^http://emedicine.medscape.com/" ;"kill RESULT ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!! quit ;