KIDS Distribution saved on Feb 18, 2009@16:07:34 Patch KIDS for TMG1-1.0-2d **KIDS**:TMG1*1.0*3^ **INSTALL NAME** TMG1*1.0*3 "BLD",6135,0) TMG1*1.0*3^^0^3090218^n "BLD",6135,1,0) ^^2^2^3090218^^ "BLD",6135,1,1,0) This is a patch for a bug fix in TMGRPC1 "BLD",6135,1,2,0) It is not a complete set of server code. "BLD",6135,4,0) ^9.64PA^^ "BLD",6135,6.3) 1 "BLD",6135,"KRN",0) ^9.67PA^8989.52^19 "BLD",6135,"KRN",.4,0) .4 "BLD",6135,"KRN",.401,0) .401 "BLD",6135,"KRN",.402,0) .402 "BLD",6135,"KRN",.403,0) .403 "BLD",6135,"KRN",.5,0) .5 "BLD",6135,"KRN",.84,0) .84 "BLD",6135,"KRN",3.6,0) 3.6 "BLD",6135,"KRN",3.8,0) 3.8 "BLD",6135,"KRN",9.2,0) 9.2 "BLD",6135,"KRN",9.8,0) 9.8 "BLD",6135,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",6135,"KRN",9.8,"NM",1,0) TMGRPC1^^0^B6434 "BLD",6135,"KRN",9.8,"NM","B","TMGRPC1",1) "BLD",6135,"KRN",19,0) 19 "BLD",6135,"KRN",19.1,0) 19.1 "BLD",6135,"KRN",101,0) 101 "BLD",6135,"KRN",409.61,0) 409.61 "BLD",6135,"KRN",771,0) 771 "BLD",6135,"KRN",870,0) 870 "BLD",6135,"KRN",8989.51,0) 8989.51 "BLD",6135,"KRN",8989.52,0) 8989.52 "BLD",6135,"KRN",8994,0) 8994 "BLD",6135,"KRN","B",.4,.4) "BLD",6135,"KRN","B",.401,.401) "BLD",6135,"KRN","B",.402,.402) "BLD",6135,"KRN","B",.403,.403) "BLD",6135,"KRN","B",.5,.5) "BLD",6135,"KRN","B",.84,.84) "BLD",6135,"KRN","B",3.6,3.6) "BLD",6135,"KRN","B",3.8,3.8) "BLD",6135,"KRN","B",9.2,9.2) "BLD",6135,"KRN","B",9.8,9.8) "BLD",6135,"KRN","B",19,19) "BLD",6135,"KRN","B",19.1,19.1) "BLD",6135,"KRN","B",101,101) "BLD",6135,"KRN","B",409.61,409.61) "BLD",6135,"KRN","B",771,771) "BLD",6135,"KRN","B",870,870) "BLD",6135,"KRN","B",8989.51,8989.51) "BLD",6135,"KRN","B",8989.52,8989.52) "BLD",6135,"KRN","B",8994,8994) "BLD",6135,"QUES",0) ^9.62^^ "MBREQ") 0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","TMGRPC1") 0^1^B6434 "RTN","TMGRPC1",1,0) TMGRPC1 ;TMG/kst-RPC Functions ;03/25/06 "RTN","TMGRPC1",2,0) ;;1.0;TMG-LIB;**1**;06/04/08;Build 1 "RTN","TMGRPC1",3,0) "RTN","TMGRPC1",4,0) ;"TMG RPC FUNCTIONS "RTN","TMGRPC1",5,0) "RTN","TMGRPC1",6,0) ;"Kevin Toppenberg MD "RTN","TMGRPC1",7,0) ;"GNU General Public License (GPL) applies "RTN","TMGRPC1",8,0) ;"3/24/07 "RTN","TMGRPC1",9,0) "RTN","TMGRPC1",10,0) ;"======================================================================= "RTN","TMGRPC1",11,0) ;" RPC -- Public Functions. "RTN","TMGRPC1",12,0) ;"======================================================================= "RTN","TMGRPC1",13,0) ;"DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) "RTN","TMGRPC1",14,0) ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) "RTN","TMGRPC1",15,0) ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file "RTN","TMGRPC1",16,0) ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File "RTN","TMGRPC1",17,0) ;"GETLONG(GREF,IMAGEIEN) "RTN","TMGRPC1",18,0) ;"GETDFN(RESULT,RECNUM,RECFIELD,LNAME,FNAME,MNAME,DOB,SEX,SSNUM) "RTN","TMGRPC1",19,0) ;"BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) "RTN","TMGRPC1",20,0) ;"AUTOSIGN(RESULT,DOCIEN) "RTN","TMGRPC1",21,0) ;"FNINFO(RESULT,DFN) -- GET PATIENT DEMOGRAPHICS "RTN","TMGRPC1",22,0) ;"PTADD(RESULT,INFO) -- ADD PATIENT "RTN","TMGRPC1",23,0) ;"STPTINFO(RESULT,DFN,INFO) -- SET PATIENT DEMOGRAPHICS "RTN","TMGRPC1",24,0) ;"GETURLS(RESULT) -- TMG CPRS GET URL LIST "RTN","TMGRPC1",25,0) "RTN","TMGRPC1",26,0) ;"======================================================================= "RTN","TMGRPC1",27,0) ;"PRIVATE API FUNCTIONS "RTN","TMGRPC1",28,0) ;"======================================================================= "RTN","TMGRPC1",29,0) ;"ENCODE(GRef,incSubscr,encodeFn) "RTN","TMGRPC1",30,0) ;"DECODE(GRef,incSubscr,decodeFn) "RTN","TMGRPC1",31,0) ;"$$HEXCODER(INPUT) ;"encode the input string. Currently using simple hex encoding/ "RTN","TMGRPC1",32,0) ;"$$B64CODER(INPUT) ;"encode the input string via UUENCODE (actually Base64) "RTN","TMGRPC1",33,0) ;"$$B64DECODER(INPUT) ;"encode the input string via UUDECODE (actually Base64) "RTN","TMGRPC1",34,0) "RTN","TMGRPC1",35,0) ;"======================================================================= "RTN","TMGRPC1",36,0) ;"======================================================================= "RTN","TMGRPC1",37,0) ;"Dependencies: "RTN","TMGRPC1",38,0) ;"TMGBINF "RTN","TMGRPC1",39,0) ;"TMGSTUTL "RTN","TMGRPC1",40,0) ;"RGUTUU "RTN","TMGRPC1",41,0) ;"======================================================================= "RTN","TMGRPC1",42,0) ;"======================================================================= "RTN","TMGRPC1",43,0) "RTN","TMGRPC1",44,0) DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) "RTN","TMGRPC1",45,0) ;"SCOPE: Public "RTN","TMGRPC1",46,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",47,0) ;" will ask for a given file, and it will be passed back in the form "RTN","TMGRPC1",48,0) ;" of an array (in BASE64 ascii encoding) "RTN","TMGRPC1",49,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",50,0) ;" FPATH -- the file path up to, but not including, the filename "RTN","TMGRPC1",51,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1",52,0) ;" FNAME -- the name of the file to pass back "RTN","TMGRPC1",53,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from "RTN","TMGRPC1",54,0) ;" default value is 1 "RTN","TMGRPC1",55,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1",56,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1",57,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1",58,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1",59,0) ;"Output: results are passed out in @GREF "RTN","TMGRPC1",60,0) ;" @GREF@(0)=success; 1=success, 0=failure "RTN","TMGRPC1",61,0) ;" @GREF@(1..xxx) = actual data "RTN","TMGRPC1",62,0) "RTN","TMGRPC1",63,0) set FPATH=$get(FPATH) "RTN","TMGRPC1",64,0) set FNAME=$get(FNAME) "RTN","TMGRPC1",65,0) set LOCIEN=$GET(LOCIEN,1) "RTN","TMGRPC1",66,0) "RTN","TMGRPC1",67,0) new PathRoot "RTN","TMGRPC1",68,0) set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) ;"NOTE: CUSTOM FIELD "RTN","TMGRPC1",69,0) "RTN","TMGRPC1",70,0) new NodeDiv "RTN","TMGRPC1",71,0) set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" NOTE: CUSTOM FIELD "RTN","TMGRPC1",72,0) "RTN","TMGRPC1",73,0) new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot)) "RTN","TMGRPC1",74,0) new StartPath set StartPath=$extract(FPATH,1) "RTN","TMGRPC1",75,0) "RTN","TMGRPC1",76,0) if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do "RTN","TMGRPC1",77,0) . set FPATH=$extract(FPATH,2,1024) "RTN","TMGRPC1",78,0) else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do "RTN","TMGRPC1",79,0) . set PathRoot=PathRoot_NodeDiv "RTN","TMGRPC1",80,0) "RTN","TMGRPC1",81,0) set FPATH=PathRoot_FPATH "RTN","TMGRPC1",82,0) "RTN","TMGRPC1",83,0) set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")" "RTN","TMGRPC1",84,0) "RTN","TMGRPC1",85,0) kill @GREF "RTN","TMGRPC1",86,0) set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3) "RTN","TMGRPC1",87,0) "RTN","TMGRPC1",88,0) do ENCODE($name(@GREF@(1)),3) "RTN","TMGRPC1",89,0) "RTN","TMGRPC1",90,0) quit "RTN","TMGRPC1",91,0) "RTN","TMGRPC1",92,0) "RTN","TMGRPC1",93,0) UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) "RTN","TMGRPC1",94,0) ;"SCOPE: Public "RTN","TMGRPC1",95,0) ;"RPC That calls this: TMG UPLOAD FILE "RTN","TMGRPC1",96,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",97,0) ;" will provide a file for upload (in BASE64 ascii encoding) "RTN","TMGRPC1",98,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",99,0) ;" FPATH -- the file path up to, but not including, the filename "RTN","TMGRPC1",100,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1",101,0) ;" FNAME -- the name of the file to pass back "RTN","TMGRPC1",102,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to "RTN","TMGRPC1",103,0) ;" default value is 1 "RTN","TMGRPC1",104,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1",105,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1",106,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1",107,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1",108,0) ;" ARRAY -- the array that will hold the file, in BASE64 ascii encoding "RTN","TMGRPC1",109,0) ;"Output: results are passed out in RESULT: 1^SuccessMessage or 0^FailureMessage "RTN","TMGRPC1",110,0) "RTN","TMGRPC1",111,0) new result "RTN","TMGRPC1",112,0) new resultMsg set resultMsg="1^Successful Upload" "RTN","TMGRPC1",113,0) "RTN","TMGRPC1",114,0) set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH) "RTN","TMGRPC1",115,0) set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME) "RTN","TMGRPC1",116,0) set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN) "RTN","TMGRPC1",117,0) "RTN","TMGRPC1",118,0) if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone "RTN","TMGRPC1",119,0) set FPATH=$get(FPATH) "RTN","TMGRPC1",120,0) if FPATH="" set resultMsg="0^No file path received" goto UpDone "RTN","TMGRPC1",121,0) set FNAME=$get(FNAME) "RTN","TMGRPC1",122,0) if FNAME="" set resultMsg="0^No file name received" goto UpDone "RTN","TMGRPC1",123,0) set LOCIEN=$GET(LOCIEN,1); "RTN","TMGRPC1",124,0) new GREF "RTN","TMGRPC1",125,0) "RTN","TMGRPC1",126,0) new PathRoot "RTN","TMGRPC1",127,0) set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) "RTN","TMGRPC1",128,0) "RTN","TMGRPC1",129,0) new NodeDiv "RTN","TMGRPC1",130,0) set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" "RTN","TMGRPC1",131,0) "RTN","TMGRPC1",132,0) new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot)) "RTN","TMGRPC1",133,0) new StartPath set StartPath=$extract(FPATH,1) "RTN","TMGRPC1",134,0) if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do "RTN","TMGRPC1",135,0) . set FPATH=$extract(FPATH,2,1024) "RTN","TMGRPC1",136,0) else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do "RTN","TMGRPC1",137,0) . set PathRoot=PathRoot_NodeDiv "RTN","TMGRPC1",138,0) "RTN","TMGRPC1",139,0) set FPATH=PathRoot_FPATH "RTN","TMGRPC1",140,0) "RTN","TMGRPC1",141,0) merge ^TMP("UPLOAD^TMGRPC1",$J,"ENCODED")=ARRAY ;"//TEMP "RTN","TMGRPC1",142,0) do DECODE("ARRAY(0)",1) "RTN","TMGRPC1",143,0) merge ^TMP("UPLOAD^TMGRPC1",$J,"DECODED")=ARRAY ;"//TEMP "RTN","TMGRPC1",144,0) "RTN","TMGRPC1",145,0) if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do "RTN","TMGRPC1",146,0) . set resultMsg="0^Error while saving file" "RTN","TMGRPC1",147,0) "RTN","TMGRPC1",148,0) UpDone "RTN","TMGRPC1",149,0) set RESULT=resultMsg "RTN","TMGRPC1",150,0) quit "RTN","TMGRPC1",151,0) "RTN","TMGRPC1",152,0) "RTN","TMGRPC1",153,0) DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file "RTN","TMGRPC1",154,0) ;"SCOPE: Public "RTN","TMGRPC1",155,0) ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX "RTN","TMGRPC1",156,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",157,0) ;" will request for the file to be placed into in a 'dropbox' file "RTN","TMGRPC1",158,0) ;" location that both the client and server can access. File may be "RTN","TMGRPC1",159,0) ;" moved from there to its final destination by the client. "RTN","TMGRPC1",160,0) ;" This method alloows file-hiding ability on the server side. "RTN","TMGRPC1",161,0) ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",162,0) ;" FPATH -- the file path up to, but not including, the filename. This "RTN","TMGRPC1",163,0) ;" is the path that the file is stored at (relative to a root path, "RTN","TMGRPC1",164,0) ;" see comments below). It is NOT the path of the dropbox. "RTN","TMGRPC1",165,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1",166,0) ;" FNAME -- the name of the file to be uploaded. Note: This is also the "RTN","TMGRPC1",167,0) ;" name of the file to be put into the dropbox. It is the "RTN","TMGRPC1",168,0) ;" responsibility of the client to ensure that there is not already "RTN","TMGRPC1",169,0) ;" a similarly named file in the dropbox before requesting a file "RTN","TMGRPC1",170,0) ;" be put there. It is the responsibility of the client to delete "RTN","TMGRPC1",171,0) ;" the file from the drop box. "RTN","TMGRPC1",172,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from "RTN","TMGRPC1",173,0) ;" default value is 1 "RTN","TMGRPC1",174,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1",175,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1",176,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1",177,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1",178,0) ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 "RTN","TMGRPC1",179,0) ;"NOTE RE DROPBOX: "RTN","TMGRPC1",180,0) ;" This system is designed for a system where by the server and the client have a "RTN","TMGRPC1",181,0) ;" shared filesystem, but the directory paths will be different. For example: "RTN","TMGRPC1",182,0) ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ "RTN","TMGRPC1",183,0) ;" Windows Client has access to dropbox at: V:\Dropbox\ "RTN","TMGRPC1",184,0) "RTN","TMGRPC1",185,0) ;"Output: results are 1^Success, or 0^Error Message "RTN","TMGRPC1",186,0) "RTN","TMGRPC1",187,0) new resultMsg set resultMsg="1^Successful Download" "RTN","TMGRPC1",188,0) "RTN","TMGRPC1",189,0) set FPATH=$get(FPATH) "RTN","TMGRPC1",190,0) if FPATH="" set resultMsg="0^No file path received" goto DnDBxDone "RTN","TMGRPC1",191,0) set FNAME=$get(FNAME) "RTN","TMGRPC1",192,0) if FNAME="" set resultMsg="0^No file name received" goto DnDBxDone "RTN","TMGRPC1",193,0) set LOCIEN=$GET(LOCIEN,1); "RTN","TMGRPC1",194,0) new GREF "RTN","TMGRPC1",195,0) "RTN","TMGRPC1",196,0) new PathRoot "RTN","TMGRPC1",197,0) set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) "RTN","TMGRPC1",198,0) "RTN","TMGRPC1",199,0) new NodeDiv "RTN","TMGRPC1",200,0) set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" "RTN","TMGRPC1",201,0) "RTN","TMGRPC1",202,0) new DropBox "RTN","TMGRPC1",203,0) set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1) "RTN","TMGRPC1",204,0) if DropBox="" do goto UpDBxDone "RTN","TMGRPC1",205,0) . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" "RTN","TMGRPC1",206,0) ;"Ensure DropBox ends in a node divider "RTN","TMGRPC1",207,0) if $extract(DropBox,$length(DropBox))'=NodeDiv do "RTN","TMGRPC1",208,0) . set DropBox=DropBox_NodeDiv "RTN","TMGRPC1",209,0) "RTN","TMGRPC1",210,0) ;"Ensure PathRoot ends in a node divider "RTN","TMGRPC1",211,0) if $extract(PathRoot,$length(PathRoot))'=NodeDiv do "RTN","TMGRPC1",212,0) . set PathRoot=PathRoot_NodeDiv "RTN","TMGRPC1",213,0) "RTN","TMGRPC1",214,0) ;"Ensure Fpath does NOT start in a node divider "RTN","TMGRPC1",215,0) if $extract(FPATH,1)=NodeDiv do "RTN","TMGRPC1",216,0) . set FPATH=$extract(FPATH,2,1024) "RTN","TMGRPC1",217,0) "RTN","TMGRPC1",218,0) set FPATH=PathRoot_FPATH "RTN","TMGRPC1",219,0) "RTN","TMGRPC1",220,0) new SrcNamePath set SrcNamePath=FPATH_FNAME "RTN","TMGRPC1",221,0) ;"new DestNamePath set DestNamePath=DropBox_FNAME "RTN","TMGRPC1",222,0) "RTN","TMGRPC1",223,0) new moveResult "RTN","TMGRPC1",224,0) set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox) "RTN","TMGRPC1",225,0) if moveResult>0 do "RTN","TMGRPC1",226,0) . set resultMsg="0^Move failed, returning OS error code: "_moveResult "RTN","TMGRPC1",227,0) "RTN","TMGRPC1",228,0) DnDBxDone "RTN","TMGRPC1",229,0) set RESULT=resultMsg "RTN","TMGRPC1",230,0) quit "RTN","TMGRPC1",231,0) "RTN","TMGRPC1",232,0) "RTN","TMGRPC1",233,0) UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File "RTN","TMGRPC1",234,0) ;"SCOPE: Public "RTN","TMGRPC1",235,0) ;"RPC That calls this: TMG UPLOAD FILE DROPBOX "RTN","TMGRPC1",236,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",237,0) ;" will put the file in a 'dropbox' file location that both the client "RTN","TMGRPC1",238,0) ;" and server can access. File will be moved from there to its final "RTN","TMGRPC1",239,0) ;" destination. This will provide file-hiding ability on the server side. "RTN","TMGRPC1",240,0) ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",241,0) ;" FPATH -- the file path up to, but not including, the filename. This "RTN","TMGRPC1",242,0) ;" is the path to store the file at. (relative to a root path, "RTN","TMGRPC1",243,0) ;" see comments below). It is NOT the path of the dropbox. "RTN","TMGRPC1",244,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1",245,0) ;" FNAME -- the name of the file to be uploaded. Note: This is also the "RTN","TMGRPC1",246,0) ;" name of the file to be pulled from the dropbox. It is the "RTN","TMGRPC1",247,0) ;" responsibility of the client to ensure that there is not already "RTN","TMGRPC1",248,0) ;" a similarly named file in the dropbox before depositing a file there. "RTN","TMGRPC1",249,0) ;" The server will remove the file from the dropbox, unless there is "RTN","TMGRPC1",250,0) ;" an error with the host OS (which will be returned as an error message) "RTN","TMGRPC1",251,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to "RTN","TMGRPC1",252,0) ;" default value is 1 "RTN","TMGRPC1",253,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1",254,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1",255,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1",256,0) ;" This root path is found in custom field 22700 in file 2005.2 "RTN","TMGRPC1",257,0) ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 "RTN","TMGRPC1",258,0) ;"NOTE RE DROPBOX: "RTN","TMGRPC1",259,0) ;" This system is designed for a system where by the server and the client have a "RTN","TMGRPC1",260,0) ;" shared filesystem, but the directory paths will be different. For example: "RTN","TMGRPC1",261,0) ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ "RTN","TMGRPC1",262,0) ;" Windows Client has access to dropbox at: V:\Dropbox\ "RTN","TMGRPC1",263,0) "RTN","TMGRPC1",264,0) ;"Output: results are passed out in RESULT: "RTN","TMGRPC1",265,0) ;" 1^SuccessMessage or 0^FailureMessage "RTN","TMGRPC1",266,0) "RTN","TMGRPC1",267,0) new result "RTN","TMGRPC1",268,0) new resultMsg set resultMsg="1^Successful Upload" "RTN","TMGRPC1",269,0) "RTN","TMGRPC1",270,0) set FPATH=$get(FPATH) "RTN","TMGRPC1",271,0) if FPATH="" set resultMsg="0^No file path received" goto UpDBxDone "RTN","TMGRPC1",272,0) set FNAME=$get(FNAME) "RTN","TMGRPC1",273,0) if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone "RTN","TMGRPC1",274,0) set LOCIEN=$GET(LOCIEN,1); "RTN","TMGRPC1",275,0) new GREF "RTN","TMGRPC1",276,0) "RTN","TMGRPC1",277,0) new PathRoot "RTN","TMGRPC1",278,0) set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) "RTN","TMGRPC1",279,0) "RTN","TMGRPC1",280,0) new NodeDiv "RTN","TMGRPC1",281,0) set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" "RTN","TMGRPC1",282,0) "RTN","TMGRPC1",283,0) new DropBox "RTN","TMGRPC1",284,0) set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1) "RTN","TMGRPC1",285,0) if DropBox="" do goto UpDBxDone "RTN","TMGRPC1",286,0) . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" "RTN","TMGRPC1",287,0) ;"Ensure DropBox ends in a node divider "RTN","TMGRPC1",288,0) if $extract(DropBox,$length(DropBox))'=NodeDiv do "RTN","TMGRPC1",289,0) . set DropBox=DropBox_NodeDiv "RTN","TMGRPC1",290,0) "RTN","TMGRPC1",291,0) ;"Ensure PathRoot ends in a node divider "RTN","TMGRPC1",292,0) if $extract(PathRoot,$length(PathRoot))'=NodeDiv do "RTN","TMGRPC1",293,0) . set PathRoot=PathRoot_NodeDiv "RTN","TMGRPC1",294,0) "RTN","TMGRPC1",295,0) ;"Ensure Fpath does NOT start in a node divider "RTN","TMGRPC1",296,0) if $extract(FPATH,1)=NodeDiv do "RTN","TMGRPC1",297,0) . set FPATH=$extract(FPATH,2,1024) "RTN","TMGRPC1",298,0) "RTN","TMGRPC1",299,0) set FPATH=PathRoot_FPATH "RTN","TMGRPC1",300,0) "RTN","TMGRPC1",301,0) new SrcNamePath,DestNamePath "RTN","TMGRPC1",302,0) set SrcNamePath=DropBox_FNAME "RTN","TMGRPC1",303,0) set DestNamePath=FPATH_FNAME "RTN","TMGRPC1",304,0) "RTN","TMGRPC1",305,0) new moveResult "RTN","TMGRPC1",306,0) set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath) "RTN","TMGRPC1",307,0) if moveResult>0 do "RTN","TMGRPC1",308,0) . set resultMsg="0^Move failed, returning OS error code: "_moveResult "RTN","TMGRPC1",309,0) "RTN","TMGRPC1",310,0) UpDBxDone "RTN","TMGRPC1",311,0) set RESULT=resultMsg "RTN","TMGRPC1",312,0) quit "RTN","TMGRPC1",313,0) "RTN","TMGRPC1",314,0) "RTN","TMGRPC1",315,0) ENCODE(GRef,incSubscr,encodeFn) "RTN","TMGRPC1",316,0) ;"Purpose: ENCODE a BINARY GLOBAL. "RTN","TMGRPC1",317,0) ;"Input: "RTN","TMGRPC1",318,0) ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved "RTN","TMGRPC1",319,0) ;" (closed root) format. "RTN","TMGRPC1",320,0) ;" Note: "RTN","TMGRPC1",321,0) ;" At least one subscript must be numeric. This will be the incrementing "RTN","TMGRPC1",322,0) ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment "RTN","TMGRPC1",323,0) ;" to store each new global node). This subscript need not be the final "RTN","TMGRPC1",324,0) ;" subscript. For example, to load into a WORD PROCESSING field, the "RTN","TMGRPC1",325,0) ;" incrementing node is the second-to-last subscript; the final subscript "RTN","TMGRPC1",326,0) ;" is always zero. "RTN","TMGRPC1",327,0) ;" REQUIRED "RTN","TMGRPC1",328,0) ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global "RTN","TMGRPC1",329,0) ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and "RTN","TMGRPC1",330,0) ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third "RTN","TMGRPC1",331,0) ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global "RTN","TMGRPC1",332,0) ;" reference, such as ^TMP(115,1,x,0). "RTN","TMGRPC1",333,0) ;" REQUIRED "RTN","TMGRPC1",334,0) ;" encodeFn- (OPTIONAL) the name of a function that will encode a line of data. "RTN","TMGRPC1",335,0) ;" e.g. "CODER^ZZZCODER" or "LOCALCODER". The function should "RTN","TMGRPC1",336,0) ;" take one input variable (the line of raw binary data), and return a converted "RTN","TMGRPC1",337,0) ;" line. e.g. "RTN","TMGRPC1",338,0) ;" CODER(INPUT) "RTN","TMGRPC1",339,0) ;" ... ;"convert INPUT to RESULT "RTN","TMGRPC1",340,0) ;" QUIT RESULT "RTN","TMGRPC1",341,0) ;" default value is B64CODER^TMGRPC1 "RTN","TMGRPC1",342,0) ;" "RTN","TMGRPC1",343,0) ;"Output: @GRef is converted to encoded data "RTN","TMGRPC1",344,0) ;"Result: None "RTN","TMGRPC1",345,0) "RTN","TMGRPC1",346,0) if $get(GRef)="" goto EncodeDone "RTN","TMGRPC1",347,0) if $get(incSubscr)="" goto EncodeDone "RTN","TMGRPC1",348,0) "RTN","TMGRPC1",349,0) set encodeFn=$get(encodeFn,"B64CODER") "RTN","TMGRPC1",350,0) "RTN","TMGRPC1",351,0) new encoder "RTN","TMGRPC1",352,0) set encoder="set temp=$$"_encodeFn_"(.temp)" "RTN","TMGRPC1",353,0) "RTN","TMGRPC1",354,0) for do quit:(GRef="") "RTN","TMGRPC1",355,0) . new temp "RTN","TMGRPC1",356,0) . set temp=$get(@GRef) "RTN","TMGRPC1",357,0) . if temp="" set GRef="" quit "RTN","TMGRPC1",358,0) . xecute encoder ;"i.e. set temp=$$encoderFn(.temp) "RTN","TMGRPC1",359,0) . set @GRef=temp "RTN","TMGRPC1",360,0) . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) "RTN","TMGRPC1",361,0) "RTN","TMGRPC1",362,0) EncodeDone "RTN","TMGRPC1",363,0) quit "RTN","TMGRPC1",364,0) "RTN","TMGRPC1",365,0) "RTN","TMGRPC1",366,0) HEXCODER(INPUT) "RTN","TMGRPC1",367,0) ;"Purpose: to encode the input string. Currently using simple hex encoding/ "RTN","TMGRPC1",368,0) quit $$STRB2H^TMGSTUTL(.INPUT,0,1) "RTN","TMGRPC1",369,0) "RTN","TMGRPC1",370,0) "RTN","TMGRPC1",371,0) B64CODER(INPUT) "RTN","TMGRPC1",372,0) ;"Purpose: to encode the input string via UUENCODE (actually Base64) "RTN","TMGRPC1",373,0) quit $$ENCODE^RGUTUU(.INPUT) "RTN","TMGRPC1",374,0) "RTN","TMGRPC1",375,0) B64DECODER(INPUT) "RTN","TMGRPC1",376,0) ;"Purpose: to encode the input string via UUENCODE (actually Base64) "RTN","TMGRPC1",377,0) quit $$DECODE^RGUTUU(.INPUT) "RTN","TMGRPC1",378,0) "RTN","TMGRPC1",379,0) "RTN","TMGRPC1",380,0) DECODE(GRef,incSubscr,decodeFn) "RTN","TMGRPC1",381,0) ;"Purpose: ENCODE a BINARY GLOBAL. "RTN","TMGRPC1",382,0) ;"Input: "RTN","TMGRPC1",383,0) ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved "RTN","TMGRPC1",384,0) ;" (closed root) format. "RTN","TMGRPC1",385,0) ;" Note: "RTN","TMGRPC1",386,0) ;" At least one subscript must be numeric. This will be the incrementing "RTN","TMGRPC1",387,0) ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment "RTN","TMGRPC1",388,0) ;" to store each new global node). This subscript need not be the final "RTN","TMGRPC1",389,0) ;" subscript. For example, to load into a WORD PROCESSING field, the "RTN","TMGRPC1",390,0) ;" incrementing node is the second-to-last subscript; the final subscript "RTN","TMGRPC1",391,0) ;" is always zero. "RTN","TMGRPC1",392,0) ;" REQUIRED "RTN","TMGRPC1",393,0) ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global "RTN","TMGRPC1",394,0) ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and "RTN","TMGRPC1",395,0) ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third "RTN","TMGRPC1",396,0) ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global "RTN","TMGRPC1",397,0) ;" reference, such as ^TMP(115,1,x,0). "RTN","TMGRPC1",398,0) ;" REQUIRED "RTN","TMGRPC1",399,0) ;" decodeFn- (OPTIONAL) the name of a function that will decode a line of data. "RTN","TMGRPC1",400,0) ;" e.g. "DECODER^ZZZCODER" or "DECODER". The function should take "RTN","TMGRPC1",401,0) ;" one input variable (the line of encoded data), and return a decoded line. e.g. "RTN","TMGRPC1",402,0) ;" DECODER(INPUT) "RTN","TMGRPC1",403,0) ;" ... ;"convert INPUT to RESULT "RTN","TMGRPC1",404,0) ;" QUIT RESULT "RTN","TMGRPC1",405,0) ;" default value is B64DECODER^TMGRPC1 "RTN","TMGRPC1",406,0) ;" "RTN","TMGRPC1",407,0) ;"Output: @GRef is converted to decoded data "RTN","TMGRPC1",408,0) ;"Result: None "RTN","TMGRPC1",409,0) "RTN","TMGRPC1",410,0) if $get(GRef)="" goto DecodeDone "RTN","TMGRPC1",411,0) if $get(incSubscr)="" goto DecodeDone "RTN","TMGRPC1",412,0) set decodeFn=$get(decodeFn,"B64DECODER") "RTN","TMGRPC1",413,0) "RTN","TMGRPC1",414,0) new decoder "RTN","TMGRPC1",415,0) set decoder="set temp=$$"_decodeFn_"(.temp)" "RTN","TMGRPC1",416,0) "RTN","TMGRPC1",417,0) for do quit:(GRef="") "RTN","TMGRPC1",418,0) . new temp "RTN","TMGRPC1",419,0) . set temp=$get(@GRef) "RTN","TMGRPC1",420,0) . if temp="" set GRef="" quit "RTN","TMGRPC1",421,0) . xecute decoder ;"i.e. set temp=$$decoderFn(.temp) "RTN","TMGRPC1",422,0) . set @GRef=temp "RTN","TMGRPC1",423,0) . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) "RTN","TMGRPC1",424,0) "RTN","TMGRPC1",425,0) DecodeDone "RTN","TMGRPC1",426,0) quit "RTN","TMGRPC1",427,0) "RTN","TMGRPC1",428,0) "RTN","TMGRPC1",429,0) GETLONG(GREF,IMAGEIEN) "RTN","TMGRPC1",430,0) ;"SCOPE: Public "RTN","TMGRPC1",431,0) ;"Purpose: To provide an entry point for a RPC call from a client. "RTN","TMGRPC1",432,0) ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005) "RTN","TMGRPC1",433,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",434,0) ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE) "RTN","TMGRPC1",435,0) ;"Output: results are passed out in @GREF "RTN","TMGRPC1",436,0) ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format) "RTN","TMGRPC1",437,0) ;" @GREF@(1) = WP line 1 "RTN","TMGRPC1",438,0) ;" @GREF@(2) = WP line 2 "RTN","TMGRPC1",439,0) ;" @GREF@(3) = WP line 3 "RTN","TMGRPC1",440,0) ;" @GREF@(4) = WP line 4 ... etc. "RTN","TMGRPC1",441,0) "RTN","TMGRPC1",442,0) set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")" "RTN","TMGRPC1",443,0) "RTN","TMGRPC1",444,0) kill @GREF "RTN","TMGRPC1",445,0) "RTN","TMGRPC1",446,0) new i,s,MaxLines,header "RTN","TMGRPC1",447,0) set header="" "RTN","TMGRPC1",448,0) if +$get(IMAGEIEN)>0 do "RTN","TMGRPC1",449,0) . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0 "RTN","TMGRPC1",450,0) set @GREF@(0)=header "RTN","TMGRPC1",451,0) set MaxLines=+$piece(header,"^",3) "RTN","TMGRPC1",452,0) for i=1:1:MaxLines do "RTN","TMGRPC1",453,0) . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0)) "RTN","TMGRPC1",454,0) "RTN","TMGRPC1",455,0) quit "RTN","TMGRPC1",456,0) "RTN","TMGRPC1",457,0) "RTN","TMGRPC1",458,0) "RTN","TMGRPC1",459,0) GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD) "RTN","TMGRPC1",460,0) ;"Purpose: This is a RPC entry point for looking up a patient. "RTN","TMGRPC1",461,0) ;"Input: "RTN","TMGRPC1",462,0) ;" RESULT -- an OUT PARAMETER "RTN","TMGRPC1",463,0) ;" RECNUM -- Record number from a PMS "RTN","TMGRPC1",464,0) ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm) "RTN","TMGRPC1",465,0) ;" FNAME -- First Name "RTN","TMGRPC1",466,0) ;" LNAME -- Last name "RTN","TMGRPC1",467,0) ;" MNAME -- Middle Name or initial "RTN","TMGRPC1",468,0) ;" DOB -- Date of birth in EXTERNAL format "RTN","TMGRPC1",469,0) ;" SEX -- Patient sex: M or F "RTN","TMGRPC1",470,0) ;" SSNUM -- Social security number (digits only) "RTN","TMGRPC1",471,0) ;" AUTOADD -- Automatically register patient if needed (if value=1) "RTN","TMGRPC1",472,0) ;"Output: Patient may be added to database if AUTOADD=1 "RTN","TMGRPC1",473,0) ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error "RTN","TMGRPC1",474,0) "RTN","TMGRPC1",475,0) new Patient,TMGFREG "RTN","TMGRPC1",476,0) set RESULT=-1 ;"default to not found "RTN","TMGRPC1",477,0) "RTN","TMGRPC1",478,0) if $get(LNAME)'="" do "RTN","TMGRPC1",479,0) . set Patient("NAME")=$get(LNAME) "RTN","TMGRPC1",480,0) . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME "RTN","TMGRPC1",481,0) . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME "RTN","TMGRPC1",482,0) set Patient("DOB")=$get(DOB) "RTN","TMGRPC1",483,0) set Patient("SEX")=$get(SEX) "RTN","TMGRPC1",484,0) set Patient("SSNUM")=$get(SSNUM) "RTN","TMGRPC1",485,0) test if $get(AUTOADD)=1 set TMGFREG=1 "RTN","TMGRPC1",486,0) "RTN","TMGRPC1",487,0) if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number "RTN","TMGRPC1",488,0) if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number "RTN","TMGRPC1",489,0) if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number "RTN","TMGRPC1",490,0) "RTN","TMGRPC1",491,0) ;"temp "RTN","TMGRPC1",492,0) ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient "RTN","TMGRPC1",493,0) ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME "RTN","TMGRPC1",494,0) ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME "RTN","TMGRPC1",495,0) ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME "RTN","TMGRPC1",496,0) "RTN","TMGRPC1",497,0) set RESULT=$$GetDFN^TMGGDFN(.Patient) "RTN","TMGRPC1",498,0) "RTN","TMGRPC1",499,0) quit "RTN","TMGRPC1",500,0) "RTN","TMGRPC1",501,0) "RTN","TMGRPC1",502,0) BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) "RTN","TMGRPC1",503,0) ;"Purpose: To create a new, blank TIU note and return it's IEN "RTN","TMGRPC1",504,0) ;"Input: DFN -- IEN in PATIENT file of patient "RTN","TMGRPC1",505,0) ;" PERSON -- Provider NAME "RTN","TMGRPC1",506,0) ;" LOC -- Location for new document "RTN","TMGRPC1",507,0) ;" DOS -- Date of Service "RTN","TMGRPC1",508,0) ;" TITLE -- Title of new document "RTN","TMGRPC1",509,0) ;"Results: IEN in file 8925 is returned in RESULT, "RTN","TMGRPC1",510,0) ;" or -1^ErrMsg1;ErrMsg2... if failure "RTN","TMGRPC1",511,0) ;"Note: This functionality probably duplicates that of RPC call: "RTN","TMGRPC1",512,0) ;" TIU CREATE NOTE -- found after writing this... "RTN","TMGRPC1",513,0) "RTN","TMGRPC1",514,0) new Document,Flag "RTN","TMGRPC1",515,0) "RTN","TMGRPC1",516,0) set Document("DFN")=DFN "RTN","TMGRPC1",517,0) set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON) "RTN","TMGRPC1",518,0) set Document("LOCATION")=$get(LOC) "RTN","TMGRPC1",519,0) set Document("DATE")=$get(DOS) "RTN","TMGRPC1",520,0) set Document("TITLE")=$get(TITLE) "RTN","TMGRPC1",521,0) set Document("TRANSCRIPTIONIST")="" "RTN","TMGRPC1",522,0) set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0 "RTN","TMGRPC1",523,0) "RTN","TMGRPC1",524,0) set RESULT=$$PrepDoc^TMGPUTN0(.Document) "RTN","TMGRPC1",525,0) if +RESULT>0 do ;"change capture method from Upload (default) to RPC "RTN","TMGRPC1",526,0) . new TMGFDA,TMGMSG "RTN","TMGRPC1",527,0) . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC "RTN","TMGRPC1",528,0) . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors. "RTN","TMGRPC1",529,0) else do "RTN","TMGRPC1",530,0) . new i,ErrMsg set ErrMsg="" "RTN","TMGRPC1",531,0) . for i=1:1:+$get(Document("ERROR","NUM")) do "RTN","TMGRPC1",532,0) . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||" "RTN","TMGRPC1",533,0) . if $data(Document("ERROR","FM INFO"))>0 do "RTN","TMGRPC1",534,0) . . new ref set ref="Document(""ERROR"",""FM INFO"")" "RTN","TMGRPC1",535,0) . . set ErrMsg=ErrMsg_"FILEMAN SAYS:" "RTN","TMGRPC1",536,0) . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do "RTN","TMGRPC1",537,0) . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||" "RTN","TMGRPC1",538,0) . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref) "RTN","TMGRPC1",539,0) . if ErrMsg="" set ErrMsg="Unknown error" "RTN","TMGRPC1",540,0) . set ErrMsg=$translate(ErrMsg,"^","@") "RTN","TMGRPC1",541,0) . set $piece(RESULT,"^",2)=ErrMsg "RTN","TMGRPC1",542,0) "RTN","TMGRPC1",543,0) ;"temp "RTN","TMGRPC1",544,0) merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT "RTN","TMGRPC1",545,0) merge ^TMG("TMP","BLANKTIU","Document")=Document "RTN","TMGRPC1",546,0) "RTN","TMGRPC1",547,0) "RTN","TMGRPC1",548,0) quit "RTN","TMGRPC1",549,0) "RTN","TMGRPC1",550,0) "RTN","TMGRPC1",551,0) AUTOSIGN(RESULT,DOCIEN) "RTN","TMGRPC1",552,0) ;"Purpose: To automatically sign TIU note (8925). "RTN","TMGRPC1",553,0) ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed. "RTN","TMGRPC1",554,0) ;"Note: This function will not succeed unless field 1303 holds "R" "RTN","TMGRPC1",555,0) ;" and an Author found for note "RTN","TMGRPC1",556,0) ;"Results: Results passed back in RESULT(0) ARRAY "RTN","TMGRPC1",557,0) ;" -1 = failure. 1= success "RTN","TMGRPC1",558,0) ;" Any error message is passed back in RESULT("DIERR") "RTN","TMGRPC1",559,0) ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture "RTN","TMGRPC1",560,0) ;" code is NOT required "RTN","TMGRPC1",561,0) "RTN","TMGRPC1",562,0) new TMGFDA,TMGMSG "RTN","TMGRPC1",563,0) new AuthorIEN,AuthorName "RTN","TMGRPC1",564,0) new CaptureMethod "RTN","TMGRPC1",565,0) "RTN","TMGRPC1",566,0) set DOCIEN=+$get(DOCIEN) "RTN","TMGRPC1",567,0) set RESULT=-1 ;"default to failure "RTN","TMGRPC1",568,0) "RTN","TMGRPC1",569,0) set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3) "RTN","TMGRPC1",570,0) if CaptureMethod'="R" do goto ASDone "RTN","TMGRPC1",571,0) . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'." "RTN","TMGRPC1",572,0) set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2) "RTN","TMGRPC1",573,0) if AuthorIEN'>0 do goto ASDone "RTN","TMGRPC1",574,0) . set RESULT("DIERR")="Unable to find author of document." "RTN","TMGRPC1",575,0) set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1) "RTN","TMGRPC1",576,0) "RTN","TMGRPC1",577,0) set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS "RTN","TMGRPC1",578,0) set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date "RTN","TMGRPC1",579,0) set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by "RTN","TMGRPC1",580,0) set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name "RTN","TMGRPC1",581,0) set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title "RTN","TMGRPC1",582,0) set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode "RTN","TMGRPC1",583,0) do FILE^DIE("E","TMGFDA","TMGMSG") "RTN","TMGRPC1",584,0) if $data(TMGMSG("DIERR")) do goto ASDone "RTN","TMGRPC1",585,0) . merge RESULT("DIERR")=TMGMSG("DIERR") "RTN","TMGRPC1",586,0) "RTN","TMGRPC1",587,0) set RESULT(0)=1 ;"set success if we got this far. "RTN","TMGRPC1",588,0) ASDone "RTN","TMGRPC1",589,0) quit "RTN","TMGRPC1",590,0) "RTN","TMGRPC1",591,0) "RTN","TMGRPC1",592,0) DFNINFO(RESULT,DFN) "RTN","TMGRPC1",593,0) ;"Purpose: To return array with demographcs details about patient "RTN","TMGRPC1",594,0) ;"Input: RESULT (this is the output array) "RTN","TMGRPC1",595,0) ;" DFN : The record number in file #2 of the patient to inquire about. "RTN","TMGRPC1",596,0) ;"Results: Results passed back in RESULT array. Format as follows: "RTN","TMGRPC1",597,0) ;" The results are in format: KeyName=Value, "RTN","TMGRPC1",598,0) ;" There is no set order these will appear. "RTN","TMGRPC1",599,0) ;" Here are the KeyName names that will be provided. "RTN","TMGRPC1",600,0) ;" If the record has no value, then value will be empty "RTN","TMGRPC1",601,0) ;" IEN=record# "RTN","TMGRPC1",602,0) ;" COMBINED_NAME= "RTN","TMGRPC1",603,0) ;" LNAME= "RTN","TMGRPC1",604,0) ;" FNAME= "RTN","TMGRPC1",605,0) ;" MNAME= "RTN","TMGRPC1",606,0) ;" PREFIX= "RTN","TMGRPC1",607,0) ;" SUFFIX= "RTN","TMGRPC1",608,0) ;" DEGREE "RTN","TMGRPC1",609,0) ;" DOB= "RTN","TMGRPC1",610,0) ;" SEX= "RTN","TMGRPC1",611,0) ;" SS_NUM= "RTN","TMGRPC1",612,0) ;" ADDRESS_LINE_1= "RTN","TMGRPC1",613,0) ;" ADDRESS_LINE_2= "RTN","TMGRPC1",614,0) ;" ADDRESS_LINE_3= "RTN","TMGRPC1",615,0) ;" CITY= "RTN","TMGRPC1",616,0) ;" STATE= "RTN","TMGRPC1",617,0) ;" ZIP4= "RTN","TMGRPC1",618,0) ;" BAD_ADDRESS= "RTN","TMGRPC1",619,0) ;" TEMP_ADDRESS_LINE_1= "RTN","TMGRPC1",620,0) ;" TEMP_ADDRESS_LINE_2= "RTN","TMGRPC1",621,0) ;" TEMP_ADDRESS_LINE_3= "RTN","TMGRPC1",622,0) ;" TEMP_CITY= "RTN","TMGRPC1",623,0) ;" TEMP_STATE= "RTN","TMGRPC1",624,0) ;" TEMP_ZIP4= "RTN","TMGRPC1",625,0) ;" TEMP_STARTING_DATE= "RTN","TMGRPC1",626,0) ;" TEMP_ENDING_DATE= "RTN","TMGRPC1",627,0) ;" TEMP_ADDRESS_ACTIVE= "RTN","TMGRPC1",628,0) ;" CONF_ADDRESS_LINE_1= "RTN","TMGRPC1",629,0) ;" CONF_ADDRESS_LINE_2= "RTN","TMGRPC1",630,0) ;" CONF_ADDRESS_LINE_3= "RTN","TMGRPC1",631,0) ;" CONF_CITY= "RTN","TMGRPC1",632,0) ;" CONF_STATE= "RTN","TMGRPC1",633,0) ;" CONF_ZIP4= "RTN","TMGRPC1",634,0) ;" CONF_STARTING_DATE= "RTN","TMGRPC1",635,0) ;" CONF_ENDING_DATE= "RTN","TMGRPC1",636,0) ;" CONF_ADDRESS_ACTIVE= "RTN","TMGRPC1",637,0) ;" PHONE_RESIDENCE= "RTN","TMGRPC1",638,0) ;" PHONE_WORK= "RTN","TMGRPC1",639,0) ;" PHONE_CELL= "RTN","TMGRPC1",640,0) ;" PHONE_TEMP= "RTN","TMGRPC1",641,0) "RTN","TMGRPC1",642,0) ;"Note, for the following, there may be multiple entries. # is record number "RTN","TMGRPC1",643,0) ;" ALIAS # NAME "RTN","TMGRPC1",644,0) ;" ALIAS # SSN "RTN","TMGRPC1",645,0) "RTN","TMGRPC1",646,0) new TMGFDA,TMGMSG,IENS "RTN","TMGRPC1",647,0) set IENS="" "RTN","TMGRPC1",648,0) new ptrParts set ptrParts=0 "RTN","TMGRPC1",649,0) set DFN=+$get(DFN) "RTN","TMGRPC1",650,0) if DFN>0 do "RTN","TMGRPC1",651,0) . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS "RTN","TMGRPC1",652,0) . set IENS=DFN_"," "RTN","TMGRPC1",653,0) . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG") "RTN","TMGRPC1",654,0) "RTN","TMGRPC1",655,0) new line set line=0 "RTN","TMGRPC1",656,0) set RESULT(line)="IEN="_DFN set line=line+1 "RTN","TMGRPC1",657,0) set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1 "RTN","TMGRPC1",658,0) new s set s="" "RTN","TMGRPC1",659,0) if ptrParts>0 set s=$get(^VA(20,ptrParts,1)) "RTN","TMGRPC1",660,0) set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1 "RTN","TMGRPC1",661,0) set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1 "RTN","TMGRPC1",662,0) set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1 "RTN","TMGRPC1",663,0) set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1 "RTN","TMGRPC1",664,0) set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1 "RTN","TMGRPC1",665,0) set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1 "RTN","TMGRPC1",666,0) set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1 "RTN","TMGRPC1",667,0) set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1 "RTN","TMGRPC1",668,0) set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1 "RTN","TMGRPC1",669,0) set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1 "RTN","TMGRPC1",670,0) set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1 "RTN","TMGRPC1",671,0) set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1 "RTN","TMGRPC1",672,0) set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1 "RTN","TMGRPC1",673,0) set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1 "RTN","TMGRPC1",674,0) if $get(TMGFDA(2,IENS,.1112))'="" do "RTN","TMGRPC1",675,0) . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1112)) set line=line+1 "RTN","TMGRPC1",676,0) else if $get(TMGFDA(2,IENS,.1116))'="" do "RTN","TMGRPC1",677,0) . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1 "RTN","TMGRPC1",678,0) set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1 "RTN","TMGRPC1",679,0) set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1 "RTN","TMGRPC1",680,0) set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1 "RTN","TMGRPC1",681,0) set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1 "RTN","TMGRPC1",682,0) set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1 "RTN","TMGRPC1",683,0) set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1 "RTN","TMGRPC1",684,0) set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1 "RTN","TMGRPC1",685,0) set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1 "RTN","TMGRPC1",686,0) set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1 "RTN","TMGRPC1",687,0) set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1 "RTN","TMGRPC1",688,0) set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1 "RTN","TMGRPC1",689,0) set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1 "RTN","TMGRPC1",690,0) set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1 "RTN","TMGRPC1",691,0) set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1 "RTN","TMGRPC1",692,0) set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1 "RTN","TMGRPC1",693,0) set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1 "RTN","TMGRPC1",694,0) set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1 "RTN","TMGRPC1",695,0) set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1 "RTN","TMGRPC1",696,0) set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1 "RTN","TMGRPC1",697,0) set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1 "RTN","TMGRPC1",698,0) set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1 "RTN","TMGRPC1",699,0) set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.133)) set line=line+1 "RTN","TMGRPC1",700,0) set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1 "RTN","TMGRPC1",701,0) "RTN","TMGRPC1",702,0) ;"the GETS doesn't return ALIAS entries, so will do manually: "RTN","TMGRPC1",703,0) new Itr,IEN "RTN","TMGRPC1",704,0) set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",") "RTN","TMGRPC1",705,0) if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0) "RTN","TMGRPC1",706,0) . new s set s=$get(^DPT(DFN,.01,IEN,0)) "RTN","TMGRPC1",707,0) . if s="" quit "RTN","TMGRPC1",708,0) . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1 "RTN","TMGRPC1",709,0) . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1 "RTN","TMGRPC1",710,0) . ;"maybe later do something with NAME COMPONENTS in Alias. "RTN","TMGRPC1",711,0) "RTN","TMGRPC1",712,0) quit "RTN","TMGRPC1",713,0) "RTN","TMGRPC1",714,0) "RTN","TMGRPC1",715,0) STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO "RTN","TMGRPC1",716,0) ;"Purpose: To set demographcs details about patient "RTN","TMGRPC1",717,0) ;"Input: RESULT (this is the output array) "RTN","TMGRPC1",718,0) ;" DFN : The record number in file #2 of the patient to inquire about. "RTN","TMGRPC1",719,0) ;" INFO: Format as follows: "RTN","TMGRPC1",720,0) ;" The results are in format: INFO("KeyName")=Value, "RTN","TMGRPC1",721,0) ;" There is no set order these will appear. "RTN","TMGRPC1",722,0) ;" Here are the KeyName names that will be provided. "RTN","TMGRPC1",723,0) ;" If the record has no value, then value will be empty "RTN","TMGRPC1",724,0) ;" If a record should be deleted, its value will be @ "RTN","TMGRPC1",725,0) ;" INFO("COMBINED_NAME")= "RTN","TMGRPC1",726,0) ;" INFO("PREFIX")= "RTN","TMGRPC1",727,0) ;" INFO("SUFFIX")= "RTN","TMGRPC1",728,0) ;" INFO("DEGREE")= "RTN","TMGRPC1",729,0) ;" INFO("DOB")= "RTN","TMGRPC1",730,0) ;" INFO("SEX")= "RTN","TMGRPC1",731,0) ;" INFO("SS_NUM")= "RTN","TMGRPC1",732,0) ;" INFO("ADDRESS_LINE_1")= "RTN","TMGRPC1",733,0) ;" INFO("ADDRESS_LINE_2")= "RTN","TMGRPC1",734,0) ;" INFO("ADDRESS_LINE_3")= "RTN","TMGRPC1",735,0) ;" INFO("CITY")= "RTN","TMGRPC1",736,0) ;" INFO("STATE")= "RTN","TMGRPC1",737,0) ;" INFO("ZIP4")= "RTN","TMGRPC1",738,0) ;" INFO("BAD_ADDRESS")= "RTN","TMGRPC1",739,0) ;" INFO("TEMP_ADDRESS_LINE_1")= "RTN","TMGRPC1",740,0) ;" INFO("TEMP_ADDRESS_LINE_2")= "RTN","TMGRPC1",741,0) ;" INFO("TEMP_ADDRESS_LINE_3")= "RTN","TMGRPC1",742,0) ;" INFO("TEMP_CITY")= "RTN","TMGRPC1",743,0) ;" INFO("TEMP_STATE")= "RTN","TMGRPC1",744,0) ;" INFO("TEMP_ZIP4")= "RTN","TMGRPC1",745,0) ;" INFO("TEMP_STARTING_DATE")= "RTN","TMGRPC1",746,0) ;" INFO("TEMP_ENDING_DATE")= "RTN","TMGRPC1",747,0) ;" INFO("TEMP_ADDRESS_ACTIVE")= "RTN","TMGRPC1",748,0) ;" INFO("CONF_ADDRESS_LINE_1")= "RTN","TMGRPC1",749,0) ;" INFO("CONF_ADDRESS_LINE_2")= "RTN","TMGRPC1",750,0) ;" INFO("CONF_ADDRESS_LINE_3")= "RTN","TMGRPC1",751,0) ;" INFO("CONF_CITY")= "RTN","TMGRPC1",752,0) ;" INFO("CONF_STATE")= "RTN","TMGRPC1",753,0) ;" INFO("CONF_ZIP4")= "RTN","TMGRPC1",754,0) ;" INFO("CONF_STARTING_DATE")= "RTN","TMGRPC1",755,0) ;" INFO("CONF_ENDING_DATE")= "RTN","TMGRPC1",756,0) ;" INFO("CONF_ADDRESS_ACTIVE")= "RTN","TMGRPC1",757,0) ;" INFO("PHONE_RESIDENCE")= "RTN","TMGRPC1",758,0) ;" INFO("PHONE_WORK")= "RTN","TMGRPC1",759,0) ;" INFO("PHONE_CELL")= "RTN","TMGRPC1",760,0) ;" INFO("PHONE_TEMP")= "RTN","TMGRPC1",761,0) ;"Note, for the following, there may be multiple entries. # is record number "RTN","TMGRPC1",762,0) ;" If a record should be added, it will be marked +1, +2 etc. "RTN","TMGRPC1",763,0) ;" INFO("ALIAS # NAME")= "RTN","TMGRPC1",764,0) ;" INFO("ALIAS # SSN")= "RTN","TMGRPC1",765,0) ;" "RTN","TMGRPC1",766,0) ;"Results: Results passed back in RESULT string: "RTN","TMGRPC1",767,0) ;" 1 = success "RTN","TMGRPC1",768,0) ;" -1^Message = failure "RTN","TMGRPC1",769,0) "RTN","TMGRPC1",770,0) set RESULT=1 ;"default to success "RTN","TMGRPC1",771,0) "RTN","TMGRPC1",772,0) ;"kill ^TMG("TMP","RPC") "RTN","TMGRPC1",773,0) ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later "RTN","TMGRPC1",774,0) "RTN","TMGRPC1",775,0) new TMGFDA,TMGMSG,IENS "RTN","TMGRPC1",776,0) set IENS=DFN_"," "RTN","TMGRPC1",777,0) new key set key="" "RTN","TMGRPC1",778,0) for set key=$order(INFO(key)) quit:(key="") do "RTN","TMGRPC1",779,0) . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME") "RTN","TMGRPC1",780,0) . else if +key=key set TMGFDA(2,IENS,key)=INFO(key) "RTN","TMGRPC1",781,0) . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB") "RTN","TMGRPC1",782,0) . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX") "RTN","TMGRPC1",783,0) . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM") "RTN","TMGRPC1",784,0) . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1") "RTN","TMGRPC1",785,0) . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2") "RTN","TMGRPC1",786,0) . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3") "RTN","TMGRPC1",787,0) . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY") "RTN","TMGRPC1",788,0) . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE") "RTN","TMGRPC1",789,0) . else if key="ZIP4" set TMGFDA(2,IENS,.1112)=INFO("ZIP4") "RTN","TMGRPC1",790,0) . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS") "RTN","TMGRPC1",791,0) . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1") "RTN","TMGRPC1",792,0) . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2") "RTN","TMGRPC1",793,0) . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3") "RTN","TMGRPC1",794,0) . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY") "RTN","TMGRPC1",795,0) . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE") "RTN","TMGRPC1",796,0) . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.12112)=INFO("TEMP_ZIP4") "RTN","TMGRPC1",797,0) . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE") "RTN","TMGRPC1",798,0) . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE") "RTN","TMGRPC1",799,0) . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE") "RTN","TMGRPC1",800,0) . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1") "RTN","TMGRPC1",801,0) . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2") "RTN","TMGRPC1",802,0) . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3") "RTN","TMGRPC1",803,0) . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY") "RTN","TMGRPC1",804,0) . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE") "RTN","TMGRPC1",805,0) . else if key="CONF_ZIP" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP") "RTN","TMGRPC1",806,0) . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE") "RTN","TMGRPC1",807,0) . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE") "RTN","TMGRPC1",808,0) . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE") "RTN","TMGRPC1",809,0) . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE") "RTN","TMGRPC1",810,0) . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK") "RTN","TMGRPC1",811,0) . else if key="PHONE_CELL" set TMGFDA(2,IENS,.133)=INFO("PHONE_CELL") "RTN","TMGRPC1",812,0) . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP") "RTN","TMGRPC1",813,0) . else if key="EMAIL" set TMGFDA(2,IENS,.133)=INFO("EMAIL") "RTN","TMGRPC1",814,0) "RTN","TMGRPC1",815,0) if $data(TMGFDA) do "RTN","TMGRPC1",816,0) . do FILE^DIE("EKST","TMGFDA","TMGMSG") "RTN","TMGRPC1",817,0) . if $data(TMGMSG("DIERR")) do "RTN","TMGRPC1",818,0) . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) "RTN","TMGRPC1",819,0) . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") "RTN","TMGRPC1",820,0) . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA "RTN","TMGRPC1",821,0) "RTN","TMGRPC1",822,0) ;"now file Alias info separately "RTN","TMGRPC1",823,0) if RESULT=1 do "RTN","TMGRPC1",824,0) . new tempArray,index,key2 "RTN","TMGRPC1",825,0) . new key set key="" "RTN","TMGRPC1",826,0) . for set key=$order(INFO(key)) quit:(key="") do "RTN","TMGRPC1",827,0) . . if key["ALIAS" do "RTN","TMGRPC1",828,0) . . . set index=$piece(key," ",2) quit:(index="") "RTN","TMGRPC1",829,0) . . . set key2=$piece(key," ",3) "RTN","TMGRPC1",830,0) . . . set tempArray(index,key2)=INFO(key) "RTN","TMGRPC1",831,0) . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do "RTN","TMGRPC1",832,0) . . new TMGFDA,TMGMSG,TMGIEN,newRec "RTN","TMGRPC1",833,0) . . set newRec=0 "RTN","TMGRPC1",834,0) . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do "RTN","TMGRPC1",835,0) . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME")) "RTN","TMGRPC1",836,0) . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN")) "RTN","TMGRPC1",837,0) . . . if index["+" set newRec=1 "RTN","TMGRPC1",838,0) . . if $data(TMGFDA) do "RTN","TMGRPC1",839,0) . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG") "RTN","TMGRPC1",840,0) . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG") "RTN","TMGRPC1",841,0) . . if $data(TMGMSG("DIERR")) do "RTN","TMGRPC1",842,0) . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) "RTN","TMGRPC1",843,0) . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") "RTN","TMGRPC1",844,0) . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA "RTN","TMGRPC1",845,0) "RTN","TMGRPC1",846,0) quit "RTN","TMGRPC1",847,0) "RTN","TMGRPC1",848,0) PTADD(RESULT,INFO) ;" ADD PATIENT "RTN","TMGRPC1",849,0) ;"Purpose: To add a patient "RTN","TMGRPC1",850,0) ;"Input: RESULT (this is the output array) "RTN","TMGRPC1",851,0) ;" "RTN","TMGRPC1",852,0) ;" INFO: Format as follows: "RTN","TMGRPC1",853,0) ;" The results are in format: INFO("KeyName")=Value, "RTN","TMGRPC1",854,0) ;" There is no set order these will appear. "RTN","TMGRPC1",855,0) ;" Here are the KeyName names that will be provided. "RTN","TMGRPC1",856,0) ;" If the record has no value, then value will be empty "RTN","TMGRPC1",857,0) ;" If a record should be deleted, its value will be @ "RTN","TMGRPC1",858,0) ;" INFO("COMBINED_NAME")= "RTN","TMGRPC1",859,0) ;" INFO("DOB")= "RTN","TMGRPC1",860,0) ;" INFO("SEX")= "RTN","TMGRPC1",861,0) ;" INFO("SS_NUM")= "RTN","TMGRPC1",862,0) ;" INFO("Veteran")= "RTN","TMGRPC1",863,0) ;" INFO("PtType")= "RTN","TMGRPC1",864,0) ;"Results: Results passed back in RESULT string: "RTN","TMGRPC1",865,0) ;" DFN = success "RTN","TMGRPC1",866,0) ;" -1^Message = failure "RTN","TMGRPC1",867,0) ;" 0^DFN = already exists "RTN","TMGRPC1",868,0) "RTN","TMGRPC1",869,0) set RESULT=1 ;"default to success "RTN","TMGRPC1",870,0) "RTN","TMGRPC1",871,0) kill ^TMG("TMP","RPC") "RTN","TMGRPC1",872,0) merge ^TMG("TMP","RPC")=INFO ;"temp... remove later "RTN","TMGRPC1",873,0) "RTN","TMGRPC1",874,0) new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG "RTN","TMGRPC1",875,0) ;" set IENS=DFN_"," "RTN","TMGRPC1",876,0) new key set key="" "RTN","TMGRPC1",877,0) for set key=$order(INFO(key)) quit:(key="") do "RTN","TMGRPC1",878,0) . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME") "RTN","TMGRPC1",879,0) . else if key="DOB" set PATIENT("DOB")=INFO("DOB") "RTN","TMGRPC1",880,0) . else if key="SEX" set PATIENT("SEX")=INFO("SEX") "RTN","TMGRPC1",881,0) . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM") "RTN","TMGRPC1",882,0) . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran") "RTN","TMGRPC1",883,0) . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType") "RTN","TMGRPC1",884,0) set DFN=$$GetDFN^TMGGDFN(.PATIENT) "RTN","TMGRPC1",885,0) if DFN=-1 do "RTN","TMGRPC1",886,0) . new Entry,result,ErrMsg "RTN","TMGRPC1",887,0) . do Pat2Entry^TMGGDFN(.PATIENT,.Entry) "RTN","TMGRPC1",888,0) . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg) "RTN","TMGRPC1",889,0) . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT) "RTN","TMGRPC1",890,0) . if DFN'>0 do "RTN","TMGRPC1",891,0) . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later "RTN","TMGRPC1",892,0) . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg) "RTN","TMGRPC1",893,0) . else do "RTN","TMGRPC1",894,0) .. set RESULT=DFN "RTN","TMGRPC1",895,0) else do "RTN","TMGRPC1",896,0) . set RESULT="0^"_DFN "RTN","TMGRPC1",897,0) "RTN","TMGRPC1",898,0) quit "RTN","TMGRPC1",899,0) "RTN","TMGRPC1",900,0) "RTN","TMGRPC1",901,0) GETBARCD(GREF,MESSAGE,OPTION) "RTN","TMGRPC1",902,0) ;"SCOPE: Public "RTN","TMGRPC1",903,0) ;"RPC that calls this: TMG BARCODE ENCODE "RTN","TMGRPC1",904,0) ;"Purpose: To provide an entry point for a RPC call from a client. "RTN","TMGRPC1",905,0) ;" A 2D DataMatrix Bar Code will be create and passed to client. "RTN","TMGRPC1",906,0) ;" It will not be stored on server "RTN","TMGRPC1",907,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",908,0) ;" MESSAGE-- The text to use to create the barcode "RTN","TMGRPC1",909,0) ;" OPTION -- Array that may hold optional settings, as follows: "RTN","TMGRPC1",910,0) ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png" "RTN","TMGRPC1",911,0) ;"Output: results are passed out in @GREF "RTN","TMGRPC1",912,0) ;" @GREF@(0)=success; 1=success, 0=failure "RTN","TMGRPC1",913,0) ;" @GREF@(1..xxx) = actual data "RTN","TMGRPC1",914,0) "RTN","TMGRPC1",915,0) ;"NOTE: dmtxread must be installed on linux host. "RTN","TMGRPC1",916,0) ;" I found source code here: "RTN","TMGRPC1",917,0) ;" http://sourceforge.net/projects/libdmtx/ "RTN","TMGRPC1",918,0) ;" After installing (./configure --> make --> make install), I "RTN","TMGRPC1",919,0) ;" copied dmtxread and dmtxwrite, which were found in the "RTN","TMGRPC1",920,0) ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs "RTN","TMGRPC1",921,0) ;" folders, into a folder on the system path. I chose /usr/bin/ "RTN","TMGRPC1",922,0) ;" Also, to achieve compile of above, I had to install required libs. "RTN","TMGRPC1",923,0) ;" See notes included with dmtx source code. "RTN","TMGRPC1",924,0) "RTN","TMGRPC1",925,0) new FileSpec "RTN","TMGRPC1",926,0) new file "RTN","TMGRPC1",927,0) new FName,FPath "RTN","TMGRPC1",928,0) "RTN","TMGRPC1",929,0) set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")" "RTN","TMGRPC1",930,0) kill @GREF "RTN","TMGRPC1",931,0) set @GREF@(0)="" ;"default to failure "RTN","TMGRPC1",932,0) set MESSAGE=$get(MESSAGE) "RTN","TMGRPC1",933,0) if MESSAGE="" goto GBCDone "RTN","TMGRPC1",934,0) "RTN","TMGRPC1",935,0) ;"Create the barcode and get file name and path "RTN","TMGRPC1",936,0) set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION) "RTN","TMGRPC1",937,0) do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") "RTN","TMGRPC1",938,0) "RTN","TMGRPC1",939,0) ;"Load binary image into global array "RTN","TMGRPC1",940,0) set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3) "RTN","TMGRPC1",941,0) "RTN","TMGRPC1",942,0) ;"convert binary data to ascii encoded data "RTN","TMGRPC1",943,0) do ENCODE($name(@GREF@(1)),3) "RTN","TMGRPC1",944,0) "RTN","TMGRPC1",945,0) ;"delete temp image file "RTN","TMGRPC1",946,0) do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") "RTN","TMGRPC1",947,0) set FileSpec(FName)="" "RTN","TMGRPC1",948,0) new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") "RTN","TMGRPC1",949,0) "RTN","TMGRPC1",950,0) GBCDone "RTN","TMGRPC1",951,0) quit "RTN","TMGRPC1",952,0) "RTN","TMGRPC1",953,0) "RTN","TMGRPC1",954,0) DECODEBC(RESULT,ARRAY,IMGTYPE) "RTN","TMGRPC1",955,0) ;"SCOPE: Public "RTN","TMGRPC1",956,0) ;"RPC that calls this: TMG BARCODE DECODE "RTN","TMGRPC1",957,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",958,0) ;" will upload an image file (.png format only) of a barcode (Datamatrix "RTN","TMGRPC1",959,0) ;" format) for decoding. Decoded message is passed back. "RTN","TMGRPC1",960,0) ;"Input: RESULT -- an OUT PARAMETER. See output below. "RTN","TMGRPC1",961,0) ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding "RTN","TMGRPC1",962,0) ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.') "RTN","TMGRPC1",963,0) ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage "RTN","TMGRPC1",964,0) "RTN","TMGRPC1",965,0) ;"NOTE: dmtxread must be installed on linux host. "RTN","TMGRPC1",966,0) ;" I found source code here: "RTN","TMGRPC1",967,0) ;" http://sourceforge.net/projects/libdmtx/ "RTN","TMGRPC1",968,0) ;" After installing (./configure --> make --> make install), I "RTN","TMGRPC1",969,0) ;" copied dmtxread and dmtxwrite, which were found in the "RTN","TMGRPC1",970,0) ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs "RTN","TMGRPC1",971,0) ;" folders, into a folder on the system path. I chose /usr/bin/ "RTN","TMGRPC1",972,0) ;" Also, to achieve compile of above, I had to install required libs. "RTN","TMGRPC1",973,0) ;" See notes included with dmtx source code. "RTN","TMGRPC1",974,0) ;"NOTE: if image types other than .png will be uploaded, then the linux host "RTN","TMGRPC1",975,0) ;" must have ImageMagick utility 'convert' installed for conversion "RTN","TMGRPC1",976,0) ;" between image types. "RTN","TMGRPC1",977,0) "RTN","TMGRPC1",978,0) kill ^TMG("TMP","BARCODE") "RTN","TMGRPC1",979,0) ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp "RTN","TMGRPC1",980,0) "RTN","TMGRPC1",981,0) ;"new Stack do GetStackInfo^TMGIDE2(.Stack) "RTN","TMGRPC1",982,0) ;"merge ^TMG("TMP","BARCODE","STACK")=Stack "RTN","TMGRPC1",983,0) "RTN","TMGRPC1",984,0) new resultMsg "RTN","TMGRPC1",985,0) if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone "RTN","TMGRPC1",986,0) "RTN","TMGRPC1",987,0) new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE)) "RTN","TMGRPC1",988,0) if imageType="" set resultMsg="0^Image type not specified" goto DBCDone "RTN","TMGRPC1",989,0) "RTN","TMGRPC1",990,0) new imageFName set imageFName="/tmp/barcode."_imageType "RTN","TMGRPC1",991,0) set imageFName=$$UNIQUE^%ZISUTL(imageFName) "RTN","TMGRPC1",992,0) new FName,FPath,FileSpec "RTN","TMGRPC1",993,0) do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") "RTN","TMGRPC1",994,0) set FileSpec(FName)="" "RTN","TMGRPC1",995,0) "RTN","TMGRPC1",996,0) ;"temp... "RTN","TMGRPC1",997,0) ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY "RTN","TMGRPC1",998,0) ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE "RTN","TMGRPC1",999,0) "RTN","TMGRPC1",1000,0) ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp "RTN","TMGRPC1",1001,0) ;"Remove BASE64 ascii encoding "RTN","TMGRPC1",1002,0) do DECODE("ARRAY(0)",1) "RTN","TMGRPC1",1003,0) "RTN","TMGRPC1",1004,0) ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp "RTN","TMGRPC1",1005,0) ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)="" "RTN","TMGRPC1",1006,0) "RTN","TMGRPC1",1007,0) ;"Save to host file system "RTN","TMGRPC1",1008,0) if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone "RTN","TMGRPC1",1009,0) . set resultMsg="0^Error while saving file to HFS" "RTN","TMGRPC1",1010,0) "RTN","TMGRPC1",1011,0) ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp "RTN","TMGRPC1",1012,0) "RTN","TMGRPC1",1013,0) ;"convert image file to .png format, if needed "RTN","TMGRPC1",1014,0) if imageType'="png" do "RTN","TMGRPC1",1015,0) . set imageFName=$$Convert^TMGKERNL(imageFName,"png") "RTN","TMGRPC1",1016,0) . if imageFName="" do quit "RTN","TMGRPC1",1017,0) . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format." "RTN","TMGRPC1",1018,0) . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") "RTN","TMGRPC1",1019,0) . set FileSpec(FName)="" "RTN","TMGRPC1",1020,0) if imageFName="" goto DBCDone "RTN","TMGRPC1",1021,0) "RTN","TMGRPC1",1022,0) ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp "RTN","TMGRPC1",1023,0) "RTN","TMGRPC1",1024,0) ;"Decode the barcode.png image "RTN","TMGRPC1",1025,0) new result set result=$$READBC^TMGBARC(imageFName) "RTN","TMGRPC1",1026,0) if result'="" set resultMsg="1^"_result "RTN","TMGRPC1",1027,0) else set resultMsg="0^Unable to Decode Image" "RTN","TMGRPC1",1028,0) "RTN","TMGRPC1",1029,0) ;"delete temp image file "RTN","TMGRPC1",1030,0) ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!! "RTN","TMGRPC1",1031,0) ;"set result=$$DEL^%ZISH(FPath,"FileSpec") "RTN","TMGRPC1",1032,0) "RTN","TMGRPC1",1033,0) DBCDone "RTN","TMGRPC1",1034,0) ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp "RTN","TMGRPC1",1035,0) "RTN","TMGRPC1",1036,0) set RESULT=resultMsg "RTN","TMGRPC1",1037,0) quit "RTN","TMGRPC1",1038,0) "RTN","TMGRPC1",1039,0) ;"-------------------- "RTN","TMGRPC1",1040,0) GETURLS(RESULT) "RTN","TMGRPC1",1041,0) ;"SCOPE: Public "RTN","TMGRPC1",1042,0) ;"RPC that calls this: TMG CPRS GET URL LIST "RTN","TMGRPC1",1043,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",1044,0) ;" will request URLs to display in custom tabs inside CPRS, in an "RTN","TMGRPC1",1045,0) ;" imbedded web browser "RTN","TMGRPC1",1046,0) ;"Input: RESULT -- an OUT PARAMETER. See output below. "RTN","TMGRPC1",1047,0) ;"Output: results are passed out in RESULT: "RTN","TMGRPC1",1048,0) ;" RESULT(0)="1^Success" or "0^SomeFailureMessage" "RTN","TMGRPC1",1049,0) ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1' "RTN","TMGRPC1",1050,0) ;" RESULT(2)="Name2^URL#2" ; etc. "RTN","TMGRPC1",1051,0) ;" RESULT(3)="Name3^URL#3" "RTN","TMGRPC1",1052,0) ;" "RTN","TMGRPC1",1053,0) ;" E.g. RESULT(1)="cnn^www.cnn.com" "RTN","TMGRPC1",1054,0) ;" RESULT(2)="INFO^192.168.0.1/home.html" "RTN","TMGRPC1",1055,0) ;" "RTN","TMGRPC1",1056,0) ;" The number of allowed tabs is determined by code in CPRS "RTN","TMGRPC1",1057,0) ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS "RTN","TMGRPC1",1058,0) ;" If a web tab is NOT specified, then the page previously "RTN","TMGRPC1",1059,0) ;" displayed will be left in place. It will not be cleared. "RTN","TMGRPC1",1060,0) ;" To clear a given page, a url of "about:blank" will cause a "RTN","TMGRPC1",1061,0) ;" blank page to be displayed. e.g. "RTN","TMGRPC1",1062,0) ;" RESULT(3)="^about:blank" "RTN","TMGRPC1",1063,0) ;" To HIDE a tab on CPRS use this: "RTN","TMGRPC1",1064,0) ;" RESULT(3)="^" ;triggers tab #3 to be hidden "RTN","TMGRPC1",1065,0) ;" To have the browser remain UNCHANGED use this: "RTN","TMGRPC1",1066,0) ;" RESULT(3)="^" ;triggers tab #3 to remain unchanged. "RTN","TMGRPC1",1067,0) ;" Note: the rationale for this is that the web tab may have info "RTN","TMGRPC1",1068,0) ;" that should not be refreshed when the patient info is refreshed "RTN","TMGRPC1",1069,0) ;" i.e. the user may have navigated somewhere, and doesn't want "RTN","TMGRPC1",1070,0) ;" to loose their location. "RTN","TMGRPC1",1071,0) ;" --to be implemented. "RTN","TMGRPC1",1072,0) ;" Note: The other way to do this, as above, is to simply have NO "RTN","TMGRPC1",1073,0) ;" entry for a given tab. I.e. don't have any value for RESULT(3) "RTN","TMGRPC1",1074,0) ;" --already implemented. "RTN","TMGRPC1",1075,0) ;"Notice to others: Below is where code should be added to return "RTN","TMGRPC1",1076,0) ;" proper URL's to CPRS. This will be called whenever a new patient "RTN","TMGRPC1",1077,0) ;" is opened, or a Refresh Information is requested. "RTN","TMGRPC1",1078,0) ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used "RTN","TMGRPC1",1079,0) ;" to pass back URLS specific for a given patient. "RTN","TMGRPC1",1080,0) "RTN","TMGRPC1",1081,0) set RESULT(0)="1^Success" "RTN","TMGRPC1",1082,0) set RESULT(1)="Yahoo^www.yahoo.com" "RTN","TMGRPC1",1083,0) set RESULT(2)="(x)^about:blank" "RTN","TMGRPC1",1084,0) set RESULT(3)="^" "RTN","TMGRPC1",1085,0) "RTN","TMGRPC1",1086,0) ;"kill RESULT "RTN","TMGRPC1",1087,0) ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!! "RTN","TMGRPC1",1088,0) "RTN","TMGRPC1",1089,0) quit "VER") 8.0^22.0 **END** **END**