KIDS Distribution saved on Jul 21, 2010@17:07:45 TMG-CPRS-IMAGING*1.0*1 **KIDS**:TMG-CPRS-IMAGING*1.0*1^ **INSTALL NAME** TMG-CPRS-IMAGING*1.0*1 "BLD",7638,0) TMG-CPRS-IMAGING*1.0*1^^0^3100721^n "BLD",7638,1,0) ^^10^10^3100721^^ "BLD",7638,1,1,0) Prior patches for imaging support were in TMG1 namespace "BLD",7638,1,2,0) (e.g. TMG1*1.0*6). This patch changes to TMG-CPRS "BLD",7638,1,3,0) namespace. "BLD",7638,1,4,0) "BLD",7638,1,5,0) This patch provides further support for extended imaging "BLD",7638,1,6,0) functionality in CPRS, namely ability to directly add "BLD",7638,1,7,0) images into notes, and then delete them later if needed. "BLD",7638,1,8,0) "BLD",7638,1,9,0) Image deletion business rules mirror those for deleting "BLD",7638,1,10,0) notes in general. "BLD",7638,4,0) ^9.64PA^^ "BLD",7638,6.3) 2 "BLD",7638,"INID") ^n "BLD",7638,"INIT") PINST1^TMGRPC1D "BLD",7638,"KRN",0) ^9.67PA^8989.52^19 "BLD",7638,"KRN",.4,0) .4 "BLD",7638,"KRN",.401,0) .401 "BLD",7638,"KRN",.402,0) .402 "BLD",7638,"KRN",.403,0) .403 "BLD",7638,"KRN",.5,0) .5 "BLD",7638,"KRN",.84,0) .84 "BLD",7638,"KRN",3.6,0) 3.6 "BLD",7638,"KRN",3.8,0) 3.8 "BLD",7638,"KRN",9.2,0) 9.2 "BLD",7638,"KRN",9.8,0) 9.8 "BLD",7638,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",7638,"KRN",9.8,"NM",1,0) TMGRPC1^^0^B6434 "BLD",7638,"KRN",9.8,"NM",2,0) TMGRPC1B^^0^B3028 "BLD",7638,"KRN",9.8,"NM",3,0) TMGRPC1C^^0^B4701 "BLD",7638,"KRN",9.8,"NM",4,0) TMGRPC1D^^0^B69776678 "BLD",7638,"KRN",9.8,"NM","B","TMGRPC1",1) "BLD",7638,"KRN",9.8,"NM","B","TMGRPC1B",2) "BLD",7638,"KRN",9.8,"NM","B","TMGRPC1C",3) "BLD",7638,"KRN",9.8,"NM","B","TMGRPC1D",4) "BLD",7638,"KRN",19,0) 19 "BLD",7638,"KRN",19.1,0) 19.1 "BLD",7638,"KRN",101,0) 101 "BLD",7638,"KRN",409.61,0) 409.61 "BLD",7638,"KRN",771,0) 771 "BLD",7638,"KRN",870,0) 870 "BLD",7638,"KRN",8989.51,0) 8989.51 "BLD",7638,"KRN",8989.52,0) 8989.52 "BLD",7638,"KRN",8994,0) 8994 "BLD",7638,"KRN",8994,"NM",0) ^9.68A^1^1 "BLD",7638,"KRN",8994,"NM",1,0) TMG IMAGE DELETE^^0 "BLD",7638,"KRN",8994,"NM","B","TMG IMAGE DELETE",1) "BLD",7638,"KRN","B",.4,.4) "BLD",7638,"KRN","B",.401,.401) "BLD",7638,"KRN","B",.402,.402) "BLD",7638,"KRN","B",.403,.403) "BLD",7638,"KRN","B",.5,.5) "BLD",7638,"KRN","B",.84,.84) "BLD",7638,"KRN","B",3.6,3.6) "BLD",7638,"KRN","B",3.8,3.8) "BLD",7638,"KRN","B",9.2,9.2) "BLD",7638,"KRN","B",9.8,9.8) "BLD",7638,"KRN","B",19,19) "BLD",7638,"KRN","B",19.1,19.1) "BLD",7638,"KRN","B",101,101) "BLD",7638,"KRN","B",409.61,409.61) "BLD",7638,"KRN","B",771,771) "BLD",7638,"KRN","B",870,870) "BLD",7638,"KRN","B",8989.51,8989.51) "BLD",7638,"KRN","B",8989.52,8989.52) "BLD",7638,"KRN","B",8994,8994) "BLD",7638,"QDEF") ^^^^NO^^^^NO^^NO "BLD",7638,"QUES",0) ^9.62^^ "BLD",7638,"REQB",0) ^9.611^1^1 "BLD",7638,"REQB",1,0) TMG1*1.0*6^0 "BLD",7638,"REQB","B","TMG1*1.0*6",1) "INIT") PINST1^TMGRPC1D "KRN",8994,2500,-1) 0^1 "KRN",8994,2500,0) TMG IMAGE DELETE^DELIMAGE^TMGRPC1C^1^R^^^^1 "KRN",8994,2500,1,0) ^8994.01^16^16^3100711^^^ "KRN",8994,2500,1,1,0) Provides functionality for deleting or retracting "KRN",8994,2500,1,2,0) an image (or other attached file) added through TMG-CPRS. "KRN",8994,2500,1,3,0) "KRN",8994,2500,1,4,0) NOTE: This function DOES NOT CHECK PERMISSIONS for "KRN",8994,2500,1,5,0) deleting/retracting image. Programmer is responsible "KRN",8994,2500,1,6,0) for ensuring the user has proper permission to use this "KRN",8994,2500,1,7,0) function. "KRN",8994,2500,1,8,0) "KRN",8994,2500,1,9,0) NOTE: If mode is to retract (see below), then the image "KRN",8994,2500,1,10,0) will not be deleted. It will just be marked as retracted, "KRN",8994,2500,1,11,0) and set so that it doesn't appear in CPRS. But if mode "KRN",8994,2500,1,12,0) is DELETE, then the record in the IMAGE file will be "KRN",8994,2500,1,13,0) deleted, AND ALSO the source image will be deleted (with "KRN",8994,2500,1,14,0) no backup). Delete mode is intended for deletion before "KRN",8994,2500,1,15,0) the image has been signed and formally added into the "KRN",8994,2500,1,16,0) medical record. "KRN",8994,2500,2,0) ^8994.02A^3^3 "KRN",8994,2500,2,1,0) TMGIEN^1^^1^1 "KRN",8994,2500,2,1,1,0) ^^2^2^3100711^^ "KRN",8994,2500,2,1,1,1,0) This is the IEN in the IMAGE file (file #2005) "KRN",8994,2500,2,1,1,2,0) to be removed. "KRN",8994,2500,2,2,0) TMGMODE^1^^0^2 "KRN",8994,2500,2,2,1,0) ^8994.021^7^7^3100711^^^ "KRN",8994,2500,2,2,1,1,0) Should be one of the following values: "KRN",8994,2500,2,2,1,2,0) '0' for NONE -- will cause function to exit, no action "KRN",8994,2500,2,2,1,3,0) '1' for DELETE -- delete record and image/file "KRN",8994,2500,2,2,1,4,0) '2' for RETRACT -- mark record as retracted, but NO "KRN",8994,2500,2,2,1,5,0) actual deletion effected. "KRN",8994,2500,2,2,1,6,0) "KRN",8994,2500,2,2,1,7,0) Default value is 0 "KRN",8994,2500,2,3,0) TMGREASON^1^60^0^3 "KRN",8994,2500,2,3,1,0) ^8994.021^3^3^3100711^^^ "KRN",8994,2500,2,3,1,1,0) This is used only for RETRACT mode (TMGMODE=2). "KRN",8994,2500,2,3,1,2,0) "KRN",8994,2500,2,3,1,3,0) Must be 10-60 characters giving reason for retraction. "KRN",8994,2500,2,"B","TMGIEN",1) "KRN",8994,2500,2,"B","TMGMODE",2) "KRN",8994,2500,2,"B","TMGREASON",3) "KRN",8994,2500,2,"PARAMSEQ",1,1) "KRN",8994,2500,2,"PARAMSEQ",2,2) "KRN",8994,2500,2,"PARAMSEQ",3,3) "KRN",8994,2500,3,0) ^^2^2^3100711^^ "KRN",8994,2500,3,1,0) Return value will be: "KRN",8994,2500,3,2,0) '1^Success' or '-1^Error Message' "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "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") NO "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") NO "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") NO "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") 4 "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**;08/18/09;Build 2 "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) GOTO DOWNLOAD+1^TMGRPC1C "RTN","TMGRPC1",46,0) ; "RTN","TMGRPC1",47,0) UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) "RTN","TMGRPC1",48,0) GOTO UPLOAD+1^TMGRPC1C "RTN","TMGRPC1",49,0) ; "RTN","TMGRPC1",50,0) DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file "RTN","TMGRPC1",51,0) GOTO DOWNDROP+1^TMGRPC1C "RTN","TMGRPC1",52,0) ; "RTN","TMGRPC1",53,0) UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File "RTN","TMGRPC1",54,0) GOTO UPLDDROP+1^TMGRPC1C "RTN","TMGRPC1",55,0) ; "RTN","TMGRPC1",56,0) ENCODE(GRef,incSubscr,encodeFn) ;"Purpose: ENCODE a BINARY GLOBAL. "RTN","TMGRPC1",57,0) GOTO ENCODE+1^TMGRPC1C "RTN","TMGRPC1",58,0) ; "RTN","TMGRPC1",59,0) DECODE(GRef,incSubscr,decodeFn) ;"Purpose: ENCODE a BINARY GLOBAL. "RTN","TMGRPC1",60,0) GOTO DECODE+1^TMGRPC1C "RTN","TMGRPC1",61,0) ; "RTN","TMGRPC1",62,0) GETLONG(GREF,IMAGEIEN) "RTN","TMGRPC1",63,0) ;"SCOPE: Public "RTN","TMGRPC1",64,0) ;"Purpose: To provide an entry point for a RPC call from a client. "RTN","TMGRPC1",65,0) ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005) "RTN","TMGRPC1",66,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",67,0) ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE) "RTN","TMGRPC1",68,0) ;"Output: results are passed out in @GREF "RTN","TMGRPC1",69,0) ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format) "RTN","TMGRPC1",70,0) ;" @GREF@(1) = WP line 1 "RTN","TMGRPC1",71,0) ;" @GREF@(2) = WP line 2 "RTN","TMGRPC1",72,0) ;" @GREF@(3) = WP line 3 "RTN","TMGRPC1",73,0) ;" @GREF@(4) = WP line 4 ... etc. "RTN","TMGRPC1",74,0) "RTN","TMGRPC1",75,0) set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")" "RTN","TMGRPC1",76,0) "RTN","TMGRPC1",77,0) kill @GREF "RTN","TMGRPC1",78,0) "RTN","TMGRPC1",79,0) new i,s,MaxLines,header "RTN","TMGRPC1",80,0) set header="" "RTN","TMGRPC1",81,0) if +$get(IMAGEIEN)>0 do "RTN","TMGRPC1",82,0) . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0 "RTN","TMGRPC1",83,0) set @GREF@(0)=header "RTN","TMGRPC1",84,0) set MaxLines=+$piece(header,"^",3) "RTN","TMGRPC1",85,0) for i=1:1:MaxLines do "RTN","TMGRPC1",86,0) . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0)) "RTN","TMGRPC1",87,0) "RTN","TMGRPC1",88,0) quit "RTN","TMGRPC1",89,0) "RTN","TMGRPC1",90,0) "RTN","TMGRPC1",91,0) "RTN","TMGRPC1",92,0) GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD) "RTN","TMGRPC1",93,0) ;"Purpose: This is a RPC entry point for looking up a patient. "RTN","TMGRPC1",94,0) ;"Input: "RTN","TMGRPC1",95,0) ;" RESULT -- an OUT PARAMETER "RTN","TMGRPC1",96,0) ;" RECNUM -- Record number from a PMS "RTN","TMGRPC1",97,0) ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm) "RTN","TMGRPC1",98,0) ;" FNAME -- First Name "RTN","TMGRPC1",99,0) ;" LNAME -- Last name "RTN","TMGRPC1",100,0) ;" MNAME -- Middle Name or initial "RTN","TMGRPC1",101,0) ;" DOB -- Date of birth in EXTERNAL format "RTN","TMGRPC1",102,0) ;" SEX -- Patient sex: M or F "RTN","TMGRPC1",103,0) ;" SSNUM -- Social security number (digits only) "RTN","TMGRPC1",104,0) ;" AUTOADD -- Automatically register patient if needed (if value=1) "RTN","TMGRPC1",105,0) ;"Output: Patient may be added to database if AUTOADD=1 "RTN","TMGRPC1",106,0) ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error "RTN","TMGRPC1",107,0) "RTN","TMGRPC1",108,0) new Patient,TMGFREG "RTN","TMGRPC1",109,0) set RESULT=-1 ;"default to not found "RTN","TMGRPC1",110,0) "RTN","TMGRPC1",111,0) if $get(LNAME)'="" do "RTN","TMGRPC1",112,0) . set Patient("NAME")=$get(LNAME) "RTN","TMGRPC1",113,0) . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME "RTN","TMGRPC1",114,0) . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME "RTN","TMGRPC1",115,0) set Patient("DOB")=$get(DOB) "RTN","TMGRPC1",116,0) set Patient("SEX")=$get(SEX) "RTN","TMGRPC1",117,0) set Patient("SSNUM")=$get(SSNUM) "RTN","TMGRPC1",118,0) test if $get(AUTOADD)=1 set TMGFREG=1 "RTN","TMGRPC1",119,0) "RTN","TMGRPC1",120,0) if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number "RTN","TMGRPC1",121,0) if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number "RTN","TMGRPC1",122,0) if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number "RTN","TMGRPC1",123,0) "RTN","TMGRPC1",124,0) ;"temp "RTN","TMGRPC1",125,0) ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient "RTN","TMGRPC1",126,0) ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME "RTN","TMGRPC1",127,0) ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME "RTN","TMGRPC1",128,0) ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME "RTN","TMGRPC1",129,0) "RTN","TMGRPC1",130,0) set RESULT=$$GetDFN^TMGGDFN(.Patient) "RTN","TMGRPC1",131,0) "RTN","TMGRPC1",132,0) quit "RTN","TMGRPC1",133,0) "RTN","TMGRPC1",134,0) "RTN","TMGRPC1",135,0) BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) "RTN","TMGRPC1",136,0) ;"Purpose: To create a new, blank TIU note and return it's IEN "RTN","TMGRPC1",137,0) ;"Input: DFN -- IEN in PATIENT file of patient "RTN","TMGRPC1",138,0) ;" PERSON -- Provider NAME "RTN","TMGRPC1",139,0) ;" LOC -- Location for new document "RTN","TMGRPC1",140,0) ;" DOS -- Date of Service "RTN","TMGRPC1",141,0) ;" TITLE -- Title of new document "RTN","TMGRPC1",142,0) ;"Results: IEN in file 8925 is returned in RESULT, "RTN","TMGRPC1",143,0) ;" or -1^ErrMsg1;ErrMsg2... if failure "RTN","TMGRPC1",144,0) ;"Note: This functionality probably duplicates that of RPC call: "RTN","TMGRPC1",145,0) ;" TIU CREATE NOTE -- found after writing this... "RTN","TMGRPC1",146,0) "RTN","TMGRPC1",147,0) new Document,Flag "RTN","TMGRPC1",148,0) "RTN","TMGRPC1",149,0) kill ^TMG("TMP","BLANKTIU") "RTN","TMGRPC1",150,0) set ^TMG("TMP","BLANKTIU","DFN")=$G(DFN) "RTN","TMGRPC1",151,0) set ^TMG("TMP","BLANKTIU","PERSON")=$G(PERSON) "RTN","TMGRPC1",152,0) set ^TMG("TMP","BLANKTIU","LOC")=$G(LOC) "RTN","TMGRPC1",153,0) set ^TMG("TMP","BLANKTIU","DOS")=$G(DOS) "RTN","TMGRPC1",154,0) set ^TMG("TMP","BLANKTIU","TITLE")=$G(TITLE) "RTN","TMGRPC1",155,0) "RTN","TMGRPC1",156,0) set Document("DFN")=DFN "RTN","TMGRPC1",157,0) set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON) "RTN","TMGRPC1",158,0) if +LOC=LOC s LOC="`"_LOC "RTN","TMGRPC1",159,0) set Document("LOCATION")=$get(LOC) "RTN","TMGRPC1",160,0) set Document("DATE")=$get(DOS) "RTN","TMGRPC1",161,0) set Document("TITLE")=$get(TITLE) "RTN","TMGRPC1",162,0) set Document("TRANSCRIPTIONIST")="" "RTN","TMGRPC1",163,0) set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0 "RTN","TMGRPC1",164,0) "RTN","TMGRPC1",165,0) set RESULT=$$PrepDoc^TMGPUTN0(.Document) "RTN","TMGRPC1",166,0) if +RESULT>0 do ;"change capture method from Upload (default) to RPC "RTN","TMGRPC1",167,0) . new TMGFDA,TMGMSG "RTN","TMGRPC1",168,0) . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC "RTN","TMGRPC1",169,0) . merge ^TMG("TMP","BLANKTIU","TMGFDA")=TMGFDA "RTN","TMGRPC1",170,0) . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors. "RTN","TMGRPC1",171,0) else do "RTN","TMGRPC1",172,0) . new i,ErrMsg set ErrMsg="" "RTN","TMGRPC1",173,0) . for i=1:1:+$get(Document("ERROR","NUM")) do "RTN","TMGRPC1",174,0) . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||" "RTN","TMGRPC1",175,0) . if $data(Document("ERROR","FM INFO"))>0 do "RTN","TMGRPC1",176,0) . . new ref set ref="Document(""ERROR"",""FM INFO"")" "RTN","TMGRPC1",177,0) . . set ErrMsg=ErrMsg_"FILEMAN SAYS:" "RTN","TMGRPC1",178,0) . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do "RTN","TMGRPC1",179,0) . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||" "RTN","TMGRPC1",180,0) . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref) "RTN","TMGRPC1",181,0) . if ErrMsg="" set ErrMsg="Unknown error" "RTN","TMGRPC1",182,0) . set ErrMsg=$translate(ErrMsg,"^","@") "RTN","TMGRPC1",183,0) . set $piece(RESULT,"^",2)=ErrMsg "RTN","TMGRPC1",184,0) "RTN","TMGRPC1",185,0) ;"temp "RTN","TMGRPC1",186,0) merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT "RTN","TMGRPC1",187,0) merge ^TMG("TMP","BLANKTIU","Document")=Document "RTN","TMGRPC1",188,0) "RTN","TMGRPC1",189,0) "RTN","TMGRPC1",190,0) quit "RTN","TMGRPC1",191,0) "RTN","TMGRPC1",192,0) "RTN","TMGRPC1",193,0) AUTOSIGN(RESULT,DOCIEN) "RTN","TMGRPC1",194,0) ;"Purpose: To automatically sign TIU note (8925). "RTN","TMGRPC1",195,0) ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed. "RTN","TMGRPC1",196,0) ;"Note: This function will not succeed unless field 1303 holds "R" "RTN","TMGRPC1",197,0) ;" and an Author found for note "RTN","TMGRPC1",198,0) ;"Results: Results passed back in RESULT(0) ARRAY "RTN","TMGRPC1",199,0) ;" -1 = failure. 1= success "RTN","TMGRPC1",200,0) ;" Any error message is passed back in RESULT("DIERR") "RTN","TMGRPC1",201,0) ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture "RTN","TMGRPC1",202,0) ;" code is NOT required "RTN","TMGRPC1",203,0) "RTN","TMGRPC1",204,0) new TMGFDA,TMGMSG "RTN","TMGRPC1",205,0) new AuthorIEN,AuthorName "RTN","TMGRPC1",206,0) new CaptureMethod "RTN","TMGRPC1",207,0) "RTN","TMGRPC1",208,0) set DOCIEN=+$get(DOCIEN) "RTN","TMGRPC1",209,0) set RESULT=-1 ;"default to failure "RTN","TMGRPC1",210,0) "RTN","TMGRPC1",211,0) set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3) "RTN","TMGRPC1",212,0) if CaptureMethod'="R" do goto ASDone "RTN","TMGRPC1",213,0) . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'." "RTN","TMGRPC1",214,0) set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2) "RTN","TMGRPC1",215,0) if AuthorIEN'>0 do goto ASDone "RTN","TMGRPC1",216,0) . set RESULT("DIERR")="Unable to find author of document." "RTN","TMGRPC1",217,0) set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1) "RTN","TMGRPC1",218,0) "RTN","TMGRPC1",219,0) set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS "RTN","TMGRPC1",220,0) set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date "RTN","TMGRPC1",221,0) set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by "RTN","TMGRPC1",222,0) set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name "RTN","TMGRPC1",223,0) set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title "RTN","TMGRPC1",224,0) set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode "RTN","TMGRPC1",225,0) do FILE^DIE("E","TMGFDA","TMGMSG") "RTN","TMGRPC1",226,0) if $data(TMGMSG("DIERR")) do goto ASDone "RTN","TMGRPC1",227,0) . merge RESULT("DIERR")=TMGMSG("DIERR") "RTN","TMGRPC1",228,0) "RTN","TMGRPC1",229,0) set RESULT(0)=1 ;"set success if we got this far. "RTN","TMGRPC1",230,0) ASDone "RTN","TMGRPC1",231,0) quit "RTN","TMGRPC1",232,0) "RTN","TMGRPC1",233,0) "RTN","TMGRPC1",234,0) DFNINFO(RESULT,DFN) "RTN","TMGRPC1",235,0) ;"Purpose: To return array with demographcs details about patient "RTN","TMGRPC1",236,0) ;"Input: RESULT (this is the output array) "RTN","TMGRPC1",237,0) ;" DFN : The record number in file #2 of the patient to inquire about. "RTN","TMGRPC1",238,0) ;"Results: Results passed back in RESULT array. Format as follows: "RTN","TMGRPC1",239,0) ;" The results are in format: KeyName=Value, "RTN","TMGRPC1",240,0) ;" There is no set order these will appear. "RTN","TMGRPC1",241,0) ;" Here are the KeyName names that will be provided. "RTN","TMGRPC1",242,0) ;" If the record has no value, then value will be empty "RTN","TMGRPC1",243,0) ;" IEN=record# "RTN","TMGRPC1",244,0) ;" COMBINED_NAME= "RTN","TMGRPC1",245,0) ;" LNAME= "RTN","TMGRPC1",246,0) ;" FNAME= "RTN","TMGRPC1",247,0) ;" MNAME= "RTN","TMGRPC1",248,0) ;" PREFIX= "RTN","TMGRPC1",249,0) ;" SUFFIX= "RTN","TMGRPC1",250,0) ;" DEGREE "RTN","TMGRPC1",251,0) ;" DOB= "RTN","TMGRPC1",252,0) ;" SEX= "RTN","TMGRPC1",253,0) ;" SS_NUM= "RTN","TMGRPC1",254,0) ;" ADDRESS_LINE_1= "RTN","TMGRPC1",255,0) ;" ADDRESS_LINE_2= "RTN","TMGRPC1",256,0) ;" ADDRESS_LINE_3= "RTN","TMGRPC1",257,0) ;" CITY= "RTN","TMGRPC1",258,0) ;" STATE= "RTN","TMGRPC1",259,0) ;" ZIP4= "RTN","TMGRPC1",260,0) ;" BAD_ADDRESS= "RTN","TMGRPC1",261,0) ;" TEMP_ADDRESS_LINE_1= "RTN","TMGRPC1",262,0) ;" TEMP_ADDRESS_LINE_2= "RTN","TMGRPC1",263,0) ;" TEMP_ADDRESS_LINE_3= "RTN","TMGRPC1",264,0) ;" TEMP_CITY= "RTN","TMGRPC1",265,0) ;" TEMP_STATE= "RTN","TMGRPC1",266,0) ;" TEMP_ZIP4= "RTN","TMGRPC1",267,0) ;" TEMP_STARTING_DATE= "RTN","TMGRPC1",268,0) ;" TEMP_ENDING_DATE= "RTN","TMGRPC1",269,0) ;" TEMP_ADDRESS_ACTIVE= "RTN","TMGRPC1",270,0) ;" CONF_ADDRESS_LINE_1= "RTN","TMGRPC1",271,0) ;" CONF_ADDRESS_LINE_2= "RTN","TMGRPC1",272,0) ;" CONF_ADDRESS_LINE_3= "RTN","TMGRPC1",273,0) ;" CONF_CITY= "RTN","TMGRPC1",274,0) ;" CONF_STATE= "RTN","TMGRPC1",275,0) ;" CONF_ZIP4= "RTN","TMGRPC1",276,0) ;" CONF_STARTING_DATE= "RTN","TMGRPC1",277,0) ;" CONF_ENDING_DATE= "RTN","TMGRPC1",278,0) ;" CONF_ADDRESS_ACTIVE= "RTN","TMGRPC1",279,0) ;" PHONE_RESIDENCE= "RTN","TMGRPC1",280,0) ;" PHONE_WORK= "RTN","TMGRPC1",281,0) ;" PHONE_CELL= "RTN","TMGRPC1",282,0) ;" PHONE_TEMP= "RTN","TMGRPC1",283,0) "RTN","TMGRPC1",284,0) ;"Note, for the following, there may be multiple entries. # is record number "RTN","TMGRPC1",285,0) ;" ALIAS # NAME "RTN","TMGRPC1",286,0) ;" ALIAS # SSN "RTN","TMGRPC1",287,0) "RTN","TMGRPC1",288,0) new TMGFDA,TMGMSG,IENS "RTN","TMGRPC1",289,0) set IENS="" "RTN","TMGRPC1",290,0) new ptrParts set ptrParts=0 "RTN","TMGRPC1",291,0) set DFN=+$get(DFN) "RTN","TMGRPC1",292,0) if DFN>0 do "RTN","TMGRPC1",293,0) . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS "RTN","TMGRPC1",294,0) . set IENS=DFN_"," "RTN","TMGRPC1",295,0) . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG") "RTN","TMGRPC1",296,0) "RTN","TMGRPC1",297,0) new line set line=0 "RTN","TMGRPC1",298,0) set RESULT(line)="IEN="_DFN set line=line+1 "RTN","TMGRPC1",299,0) set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1 "RTN","TMGRPC1",300,0) new s set s="" "RTN","TMGRPC1",301,0) if ptrParts>0 set s=$get(^VA(20,ptrParts,1)) "RTN","TMGRPC1",302,0) set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1 "RTN","TMGRPC1",303,0) set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1 "RTN","TMGRPC1",304,0) set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1 "RTN","TMGRPC1",305,0) set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1 "RTN","TMGRPC1",306,0) set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1 "RTN","TMGRPC1",307,0) set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1 "RTN","TMGRPC1",308,0) set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1 "RTN","TMGRPC1",309,0) set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1 "RTN","TMGRPC1",310,0) set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1 "RTN","TMGRPC1",311,0) set RESULT(line)="EMAIL="_$get(TMGFDA(2,IENS,.133)) set line=line+1 "RTN","TMGRPC1",312,0) set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1 "RTN","TMGRPC1",313,0) set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1 "RTN","TMGRPC1",314,0) set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1 "RTN","TMGRPC1",315,0) set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1 "RTN","TMGRPC1",316,0) set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1 "RTN","TMGRPC1",317,0) if $get(TMGFDA(2,IENS,.1122))'="" do "RTN","TMGRPC1",318,0) . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1122)) set line=line+1 "RTN","TMGRPC1",319,0) else if $get(TMGFDA(2,IENS,.1116))'="" do "RTN","TMGRPC1",320,0) . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1 "RTN","TMGRPC1",321,0) set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1 "RTN","TMGRPC1",322,0) set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1 "RTN","TMGRPC1",323,0) set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1 "RTN","TMGRPC1",324,0) set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1 "RTN","TMGRPC1",325,0) set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1 "RTN","TMGRPC1",326,0) set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1 "RTN","TMGRPC1",327,0) set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1 "RTN","TMGRPC1",328,0) set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1 "RTN","TMGRPC1",329,0) set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1 "RTN","TMGRPC1",330,0) set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1 "RTN","TMGRPC1",331,0) set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1 "RTN","TMGRPC1",332,0) set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1 "RTN","TMGRPC1",333,0) set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1 "RTN","TMGRPC1",334,0) set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1 "RTN","TMGRPC1",335,0) set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1 "RTN","TMGRPC1",336,0) set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1 "RTN","TMGRPC1",337,0) set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1 "RTN","TMGRPC1",338,0) set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1 "RTN","TMGRPC1",339,0) set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1 "RTN","TMGRPC1",340,0) set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1 "RTN","TMGRPC1",341,0) set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1 "RTN","TMGRPC1",342,0) set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.134)) set line=line+1 "RTN","TMGRPC1",343,0) set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1 "RTN","TMGRPC1",344,0) "RTN","TMGRPC1",345,0) ;"the GETS doesn't return ALIAS entries, so will do manually: "RTN","TMGRPC1",346,0) new Itr,IEN "RTN","TMGRPC1",347,0) set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",") "RTN","TMGRPC1",348,0) if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0) "RTN","TMGRPC1",349,0) . new s set s=$get(^DPT(DFN,.01,IEN,0)) "RTN","TMGRPC1",350,0) . if s="" quit "RTN","TMGRPC1",351,0) . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1 "RTN","TMGRPC1",352,0) . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1 "RTN","TMGRPC1",353,0) . ;"maybe later do something with NAME COMPONENTS in Alias. "RTN","TMGRPC1",354,0) "RTN","TMGRPC1",355,0) quit "RTN","TMGRPC1",356,0) "RTN","TMGRPC1",357,0) "RTN","TMGRPC1",358,0) STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO "RTN","TMGRPC1",359,0) ;"Purpose: To set demographcs details about patient "RTN","TMGRPC1",360,0) ;"Input: RESULT (this is the output array) "RTN","TMGRPC1",361,0) ;" DFN : The record number in file #2 of the patient to inquire about. "RTN","TMGRPC1",362,0) ;" INFO: Format as follows: "RTN","TMGRPC1",363,0) ;" The results are in format: INFO("KeyName")=Value, "RTN","TMGRPC1",364,0) ;" There is no set order these will appear. "RTN","TMGRPC1",365,0) ;" Here are the KeyName names that will be provided. "RTN","TMGRPC1",366,0) ;" If the record has no value, then value will be empty "RTN","TMGRPC1",367,0) ;" If a record should be deleted, its value will be @ "RTN","TMGRPC1",368,0) ;" INFO("COMBINED_NAME")= "RTN","TMGRPC1",369,0) ;" INFO("PREFIX")= "RTN","TMGRPC1",370,0) ;" INFO("SUFFIX")= "RTN","TMGRPC1",371,0) ;" INFO("DEGREE")= "RTN","TMGRPC1",372,0) ;" INFO("DOB")= "RTN","TMGRPC1",373,0) ;" INFO("SEX")= "RTN","TMGRPC1",374,0) ;" INFO("SS_NUM")= "RTN","TMGRPC1",375,0) ;" INFO("ADDRESS_LINE_1")= "RTN","TMGRPC1",376,0) ;" INFO("ADDRESS_LINE_2")= "RTN","TMGRPC1",377,0) ;" INFO("ADDRESS_LINE_3")= "RTN","TMGRPC1",378,0) ;" INFO("CITY")= "RTN","TMGRPC1",379,0) ;" INFO("STATE")= "RTN","TMGRPC1",380,0) ;" INFO("ZIP4")= "RTN","TMGRPC1",381,0) ;" INFO("BAD_ADDRESS")= "RTN","TMGRPC1",382,0) ;" INFO("TEMP_ADDRESS_LINE_1")= "RTN","TMGRPC1",383,0) ;" INFO("TEMP_ADDRESS_LINE_2")= "RTN","TMGRPC1",384,0) ;" INFO("TEMP_ADDRESS_LINE_3")= "RTN","TMGRPC1",385,0) ;" INFO("TEMP_CITY")= "RTN","TMGRPC1",386,0) ;" INFO("TEMP_STATE")= "RTN","TMGRPC1",387,0) ;" INFO("TEMP_ZIP4")= "RTN","TMGRPC1",388,0) ;" INFO("TEMP_STARTING_DATE")= "RTN","TMGRPC1",389,0) ;" INFO("TEMP_ENDING_DATE")= "RTN","TMGRPC1",390,0) ;" INFO("TEMP_ADDRESS_ACTIVE")= "RTN","TMGRPC1",391,0) ;" INFO("CONF_ADDRESS_LINE_1")= "RTN","TMGRPC1",392,0) ;" INFO("CONF_ADDRESS_LINE_2")= "RTN","TMGRPC1",393,0) ;" INFO("CONF_ADDRESS_LINE_3")= "RTN","TMGRPC1",394,0) ;" INFO("CONF_CITY")= "RTN","TMGRPC1",395,0) ;" INFO("CONF_STATE")= "RTN","TMGRPC1",396,0) ;" INFO("CONF_ZIP4")= "RTN","TMGRPC1",397,0) ;" INFO("CONF_STARTING_DATE")= "RTN","TMGRPC1",398,0) ;" INFO("CONF_ENDING_DATE")= "RTN","TMGRPC1",399,0) ;" INFO("CONF_ADDRESS_ACTIVE")= "RTN","TMGRPC1",400,0) ;" INFO("PHONE_RESIDENCE")= "RTN","TMGRPC1",401,0) ;" INFO("PHONE_WORK")= "RTN","TMGRPC1",402,0) ;" INFO("PHONE_CELL")= "RTN","TMGRPC1",403,0) ;" INFO("PHONE_TEMP")= "RTN","TMGRPC1",404,0) ;"Note, for the following, there may be multiple entries. # is record number "RTN","TMGRPC1",405,0) ;" If a record should be added, it will be marked +1, +2 etc. "RTN","TMGRPC1",406,0) ;" INFO("ALIAS # NAME")= "RTN","TMGRPC1",407,0) ;" INFO("ALIAS # SSN")= "RTN","TMGRPC1",408,0) ;" "RTN","TMGRPC1",409,0) ;"Results: Results passed back in RESULT string: "RTN","TMGRPC1",410,0) ;" 1 = success "RTN","TMGRPC1",411,0) ;" -1^Message = failure "RTN","TMGRPC1",412,0) "RTN","TMGRPC1",413,0) set RESULT=1 ;"default to success "RTN","TMGRPC1",414,0) "RTN","TMGRPC1",415,0) ;"kill ^TMG("TMP","RPC") "RTN","TMGRPC1",416,0) ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later "RTN","TMGRPC1",417,0) "RTN","TMGRPC1",418,0) new TMGFDA,TMGMSG,IENS "RTN","TMGRPC1",419,0) set IENS=DFN_"," "RTN","TMGRPC1",420,0) new key set key="" "RTN","TMGRPC1",421,0) for set key=$order(INFO(key)) quit:(key="") do "RTN","TMGRPC1",422,0) . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME") "RTN","TMGRPC1",423,0) . else if +key=key set TMGFDA(2,IENS,key)=INFO(key) "RTN","TMGRPC1",424,0) . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB") "RTN","TMGRPC1",425,0) . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX") "RTN","TMGRPC1",426,0) . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM") "RTN","TMGRPC1",427,0) . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1") "RTN","TMGRPC1",428,0) . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2") "RTN","TMGRPC1",429,0) . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3") "RTN","TMGRPC1",430,0) . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY") "RTN","TMGRPC1",431,0) . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE") "RTN","TMGRPC1",432,0) . else if key="ZIP4" set TMGFDA(2,IENS,.1112)=INFO("ZIP4") "RTN","TMGRPC1",433,0) . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS") "RTN","TMGRPC1",434,0) . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1") "RTN","TMGRPC1",435,0) . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2") "RTN","TMGRPC1",436,0) . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3") "RTN","TMGRPC1",437,0) . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY") "RTN","TMGRPC1",438,0) . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE") "RTN","TMGRPC1",439,0) . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.12112)=INFO("TEMP_ZIP4") "RTN","TMGRPC1",440,0) . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE") "RTN","TMGRPC1",441,0) . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE") "RTN","TMGRPC1",442,0) . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE") "RTN","TMGRPC1",443,0) . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1") "RTN","TMGRPC1",444,0) . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2") "RTN","TMGRPC1",445,0) . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3") "RTN","TMGRPC1",446,0) . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY") "RTN","TMGRPC1",447,0) . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE") "RTN","TMGRPC1",448,0) . else if key="CONF_ZIP" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP") "RTN","TMGRPC1",449,0) . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE") "RTN","TMGRPC1",450,0) . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE") "RTN","TMGRPC1",451,0) . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE") "RTN","TMGRPC1",452,0) . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE") "RTN","TMGRPC1",453,0) . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK") "RTN","TMGRPC1",454,0) . else if key="PHONE_CELL" set TMGFDA(2,IENS,.134)=INFO("PHONE_CELL") "RTN","TMGRPC1",455,0) . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP") "RTN","TMGRPC1",456,0) . else if key="EMAIL" set TMGFDA(2,IENS,.133)=INFO("EMAIL") "RTN","TMGRPC1",457,0) "RTN","TMGRPC1",458,0) if $data(TMGFDA) do "RTN","TMGRPC1",459,0) . do FILE^DIE("EKST","TMGFDA","TMGMSG") "RTN","TMGRPC1",460,0) . if $data(TMGMSG("DIERR")) do "RTN","TMGRPC1",461,0) . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) "RTN","TMGRPC1",462,0) . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") "RTN","TMGRPC1",463,0) . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA "RTN","TMGRPC1",464,0) "RTN","TMGRPC1",465,0) ;"now file Alias info separately "RTN","TMGRPC1",466,0) if RESULT=1 do "RTN","TMGRPC1",467,0) . new tempArray,index,key2 "RTN","TMGRPC1",468,0) . new key set key="" "RTN","TMGRPC1",469,0) . for set key=$order(INFO(key)) quit:(key="") do "RTN","TMGRPC1",470,0) . . if key["ALIAS" do "RTN","TMGRPC1",471,0) . . . set index=$piece(key," ",2) quit:(index="") "RTN","TMGRPC1",472,0) . . . set key2=$piece(key," ",3) "RTN","TMGRPC1",473,0) . . . set tempArray(index,key2)=INFO(key) "RTN","TMGRPC1",474,0) . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do "RTN","TMGRPC1",475,0) . . new TMGFDA,TMGMSG,TMGIEN,newRec "RTN","TMGRPC1",476,0) . . set newRec=0 "RTN","TMGRPC1",477,0) . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do "RTN","TMGRPC1",478,0) . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME")) "RTN","TMGRPC1",479,0) . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN")) "RTN","TMGRPC1",480,0) . . . if index["+" set newRec=1 "RTN","TMGRPC1",481,0) . . if $data(TMGFDA) do "RTN","TMGRPC1",482,0) . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG") "RTN","TMGRPC1",483,0) . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG") "RTN","TMGRPC1",484,0) . . if $data(TMGMSG("DIERR")) do "RTN","TMGRPC1",485,0) . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) "RTN","TMGRPC1",486,0) . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") "RTN","TMGRPC1",487,0) . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA "RTN","TMGRPC1",488,0) "RTN","TMGRPC1",489,0) quit "RTN","TMGRPC1",490,0) "RTN","TMGRPC1",491,0) PTADD(RESULT,INFO) ;" ADD PATIENT "RTN","TMGRPC1",492,0) ;"Purpose: To add a patient "RTN","TMGRPC1",493,0) ;"Input: RESULT (this is the output array) "RTN","TMGRPC1",494,0) ;" "RTN","TMGRPC1",495,0) ;" INFO: Format as follows: "RTN","TMGRPC1",496,0) ;" The results are in format: INFO("KeyName")=Value, "RTN","TMGRPC1",497,0) ;" There is no set order these will appear. "RTN","TMGRPC1",498,0) ;" Here are the KeyName names that will be provided. "RTN","TMGRPC1",499,0) ;" If the record has no value, then value will be empty "RTN","TMGRPC1",500,0) ;" If a record should be deleted, its value will be @ "RTN","TMGRPC1",501,0) ;" INFO("COMBINED_NAME")= "RTN","TMGRPC1",502,0) ;" INFO("DOB")= "RTN","TMGRPC1",503,0) ;" INFO("SEX")= "RTN","TMGRPC1",504,0) ;" INFO("SS_NUM")= "RTN","TMGRPC1",505,0) ;" INFO("Veteran")= "RTN","TMGRPC1",506,0) ;" INFO("PtType")= "RTN","TMGRPC1",507,0) ;"Results: Results passed back in RESULT string: "RTN","TMGRPC1",508,0) ;" DFN = success "RTN","TMGRPC1",509,0) ;" -1^Message = failure "RTN","TMGRPC1",510,0) ;" 0^DFN = already exists "RTN","TMGRPC1",511,0) "RTN","TMGRPC1",512,0) set RESULT=1 ;"default to success "RTN","TMGRPC1",513,0) "RTN","TMGRPC1",514,0) kill ^TMG("TMP","RPC") "RTN","TMGRPC1",515,0) merge ^TMG("TMP","RPC")=INFO ;"temp... remove later "RTN","TMGRPC1",516,0) "RTN","TMGRPC1",517,0) new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG "RTN","TMGRPC1",518,0) ;" set IENS=DFN_"," "RTN","TMGRPC1",519,0) new key set key="" "RTN","TMGRPC1",520,0) for set key=$order(INFO(key)) quit:(key="") do "RTN","TMGRPC1",521,0) . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME") "RTN","TMGRPC1",522,0) . else if key="DOB" set PATIENT("DOB")=INFO("DOB") "RTN","TMGRPC1",523,0) . else if key="SEX" set PATIENT("SEX")=INFO("SEX") "RTN","TMGRPC1",524,0) . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM") "RTN","TMGRPC1",525,0) . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran") "RTN","TMGRPC1",526,0) . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType") "RTN","TMGRPC1",527,0) set DFN=$$GetDFN^TMGGDFN(.PATIENT) "RTN","TMGRPC1",528,0) if DFN=-1 do "RTN","TMGRPC1",529,0) . new Entry,result,ErrMsg "RTN","TMGRPC1",530,0) . do Pat2Entry^TMGGDFN(.PATIENT,.Entry) "RTN","TMGRPC1",531,0) . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg) "RTN","TMGRPC1",532,0) . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT) "RTN","TMGRPC1",533,0) . if DFN'>0 do "RTN","TMGRPC1",534,0) . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later "RTN","TMGRPC1",535,0) . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg) "RTN","TMGRPC1",536,0) . else do "RTN","TMGRPC1",537,0) .. set RESULT=DFN "RTN","TMGRPC1",538,0) else do "RTN","TMGRPC1",539,0) . set RESULT="0^"_DFN "RTN","TMGRPC1",540,0) "RTN","TMGRPC1",541,0) quit "RTN","TMGRPC1",542,0) "RTN","TMGRPC1",543,0) "RTN","TMGRPC1",544,0) GETBARCD(GREF,MESSAGE,OPTION) "RTN","TMGRPC1",545,0) ;"SCOPE: Public "RTN","TMGRPC1",546,0) ;"RPC that calls this: TMG BARCODE ENCODE "RTN","TMGRPC1",547,0) ;"Purpose: To provide an entry point for a RPC call from a client. "RTN","TMGRPC1",548,0) ;" A 2D DataMatrix Bar Code will be create and passed to client. "RTN","TMGRPC1",549,0) ;" It will not be stored on server "RTN","TMGRPC1",550,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1",551,0) ;" MESSAGE-- The text to use to create the barcode "RTN","TMGRPC1",552,0) ;" OPTION -- Array that may hold optional settings, as follows: "RTN","TMGRPC1",553,0) ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png" "RTN","TMGRPC1",554,0) ;"Output: results are passed out in @GREF "RTN","TMGRPC1",555,0) ;" @GREF@(0)=success; 1=success, 0=failure "RTN","TMGRPC1",556,0) ;" @GREF@(1..xxx) = actual data "RTN","TMGRPC1",557,0) "RTN","TMGRPC1",558,0) ;"NOTE: dmtxread must be installed on linux host. "RTN","TMGRPC1",559,0) ;" I found source code here: "RTN","TMGRPC1",560,0) ;" http://sourceforge.net/projects/libdmtx/ "RTN","TMGRPC1",561,0) ;" After installing (./configure --> make --> make install), I "RTN","TMGRPC1",562,0) ;" copied dmtxread and dmtxwrite, which were found in the "RTN","TMGRPC1",563,0) ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs "RTN","TMGRPC1",564,0) ;" folders, into a folder on the system path. I chose /usr/bin/ "RTN","TMGRPC1",565,0) ;" Also, to achieve compile of above, I had to install required libs. "RTN","TMGRPC1",566,0) ;" See notes included with dmtx source code. "RTN","TMGRPC1",567,0) "RTN","TMGRPC1",568,0) new FileSpec "RTN","TMGRPC1",569,0) new file "RTN","TMGRPC1",570,0) new FName,FPath "RTN","TMGRPC1",571,0) "RTN","TMGRPC1",572,0) set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")" "RTN","TMGRPC1",573,0) kill @GREF "RTN","TMGRPC1",574,0) set @GREF@(0)="" ;"default to failure "RTN","TMGRPC1",575,0) set MESSAGE=$get(MESSAGE) "RTN","TMGRPC1",576,0) if MESSAGE="" goto GBCDone "RTN","TMGRPC1",577,0) "RTN","TMGRPC1",578,0) ;"Create the barcode and get file name and path "RTN","TMGRPC1",579,0) set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION) "RTN","TMGRPC1",580,0) do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") "RTN","TMGRPC1",581,0) "RTN","TMGRPC1",582,0) ;"Load binary image into global array "RTN","TMGRPC1",583,0) set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3) "RTN","TMGRPC1",584,0) "RTN","TMGRPC1",585,0) ;"convert binary data to ascii encoded data "RTN","TMGRPC1",586,0) do ENCODE($name(@GREF@(1)),3) "RTN","TMGRPC1",587,0) "RTN","TMGRPC1",588,0) ;"delete temp image file "RTN","TMGRPC1",589,0) do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") "RTN","TMGRPC1",590,0) set FileSpec(FName)="" "RTN","TMGRPC1",591,0) new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") "RTN","TMGRPC1",592,0) "RTN","TMGRPC1",593,0) GBCDone "RTN","TMGRPC1",594,0) quit "RTN","TMGRPC1",595,0) "RTN","TMGRPC1",596,0) "RTN","TMGRPC1",597,0) DECODEBC(RESULT,ARRAY,IMGTYPE) "RTN","TMGRPC1",598,0) ;"SCOPE: Public "RTN","TMGRPC1",599,0) ;"RPC that calls this: TMG BARCODE DECODE "RTN","TMGRPC1",600,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",601,0) ;" will upload an image file (.png format only) of a barcode (Datamatrix "RTN","TMGRPC1",602,0) ;" format) for decoding. Decoded message is passed back. "RTN","TMGRPC1",603,0) ;"Input: RESULT -- an OUT PARAMETER. See output below. "RTN","TMGRPC1",604,0) ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding "RTN","TMGRPC1",605,0) ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.') "RTN","TMGRPC1",606,0) ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage "RTN","TMGRPC1",607,0) "RTN","TMGRPC1",608,0) ;"NOTE: dmtxread must be installed on linux host. "RTN","TMGRPC1",609,0) ;" I found source code here: "RTN","TMGRPC1",610,0) ;" http://sourceforge.net/projects/libdmtx/ "RTN","TMGRPC1",611,0) ;" After installing (./configure --> make --> make install), I "RTN","TMGRPC1",612,0) ;" copied dmtxread and dmtxwrite, which were found in the "RTN","TMGRPC1",613,0) ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs "RTN","TMGRPC1",614,0) ;" folders, into a folder on the system path. I chose /usr/bin/ "RTN","TMGRPC1",615,0) ;" Also, to achieve compile of above, I had to install required libs. "RTN","TMGRPC1",616,0) ;" See notes included with dmtx source code. "RTN","TMGRPC1",617,0) ;"NOTE: if image types other than .png will be uploaded, then the linux host "RTN","TMGRPC1",618,0) ;" must have ImageMagick utility 'convert' installed for conversion "RTN","TMGRPC1",619,0) ;" between image types. "RTN","TMGRPC1",620,0) "RTN","TMGRPC1",621,0) kill ^TMG("TMP","BARCODE") "RTN","TMGRPC1",622,0) ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp "RTN","TMGRPC1",623,0) "RTN","TMGRPC1",624,0) ;"new Stack do GetStackInfo^TMGIDE2(.Stack) "RTN","TMGRPC1",625,0) ;"merge ^TMG("TMP","BARCODE","STACK")=Stack "RTN","TMGRPC1",626,0) "RTN","TMGRPC1",627,0) new resultMsg "RTN","TMGRPC1",628,0) if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone "RTN","TMGRPC1",629,0) "RTN","TMGRPC1",630,0) new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE)) "RTN","TMGRPC1",631,0) if imageType="" set resultMsg="0^Image type not specified" goto DBCDone "RTN","TMGRPC1",632,0) "RTN","TMGRPC1",633,0) new imageFName set imageFName="/tmp/barcode."_imageType "RTN","TMGRPC1",634,0) set imageFName=$$UNIQUE^%ZISUTL(imageFName) "RTN","TMGRPC1",635,0) new FName,FPath,FileSpec "RTN","TMGRPC1",636,0) do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") "RTN","TMGRPC1",637,0) set FileSpec(FName)="" "RTN","TMGRPC1",638,0) "RTN","TMGRPC1",639,0) ;"temp... "RTN","TMGRPC1",640,0) ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY "RTN","TMGRPC1",641,0) ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE "RTN","TMGRPC1",642,0) "RTN","TMGRPC1",643,0) ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp "RTN","TMGRPC1",644,0) ;"Remove BASE64 ascii encoding "RTN","TMGRPC1",645,0) do DECODE("ARRAY(0)",1) "RTN","TMGRPC1",646,0) "RTN","TMGRPC1",647,0) ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp "RTN","TMGRPC1",648,0) ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)="" "RTN","TMGRPC1",649,0) "RTN","TMGRPC1",650,0) ;"Save to host file system "RTN","TMGRPC1",651,0) if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone "RTN","TMGRPC1",652,0) . set resultMsg="0^Error while saving file to HFS" "RTN","TMGRPC1",653,0) "RTN","TMGRPC1",654,0) ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp "RTN","TMGRPC1",655,0) "RTN","TMGRPC1",656,0) ;"convert image file to .png format, if needed "RTN","TMGRPC1",657,0) if imageType'="png" do "RTN","TMGRPC1",658,0) . set imageFName=$$Convert^TMGKERNL(imageFName,"png") "RTN","TMGRPC1",659,0) . if imageFName="" do quit "RTN","TMGRPC1",660,0) . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format." "RTN","TMGRPC1",661,0) . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") "RTN","TMGRPC1",662,0) . set FileSpec(FName)="" "RTN","TMGRPC1",663,0) if imageFName="" goto DBCDone "RTN","TMGRPC1",664,0) "RTN","TMGRPC1",665,0) ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp "RTN","TMGRPC1",666,0) "RTN","TMGRPC1",667,0) ;"Decode the barcode.png image "RTN","TMGRPC1",668,0) new result set result=$$READBC^TMGBARC(imageFName) "RTN","TMGRPC1",669,0) if result'="" set resultMsg="1^"_result "RTN","TMGRPC1",670,0) else set resultMsg="0^Unable to Decode Image" "RTN","TMGRPC1",671,0) "RTN","TMGRPC1",672,0) ;"delete temp image file "RTN","TMGRPC1",673,0) ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!! "RTN","TMGRPC1",674,0) ;"set result=$$DEL^%ZISH(FPath,"FileSpec") "RTN","TMGRPC1",675,0) "RTN","TMGRPC1",676,0) DBCDone "RTN","TMGRPC1",677,0) ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp "RTN","TMGRPC1",678,0) "RTN","TMGRPC1",679,0) set RESULT=resultMsg "RTN","TMGRPC1",680,0) quit "RTN","TMGRPC1",681,0) "RTN","TMGRPC1",682,0) ;"-------------------- "RTN","TMGRPC1",683,0) GETURLS(RESULT) "RTN","TMGRPC1",684,0) ;"SCOPE: Public "RTN","TMGRPC1",685,0) ;"RPC that calls this: TMG CPRS GET URL LIST "RTN","TMGRPC1",686,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1",687,0) ;" will request URLs to display in custom tabs inside CPRS, in an "RTN","TMGRPC1",688,0) ;" imbedded web browser "RTN","TMGRPC1",689,0) ;"Input: RESULT -- an OUT PARAMETER. See output below. "RTN","TMGRPC1",690,0) ;"Output: results are passed out in RESULT: "RTN","TMGRPC1",691,0) ;" RESULT(0)="1^Success" or "0^SomeFailureMessage" "RTN","TMGRPC1",692,0) ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1' "RTN","TMGRPC1",693,0) ;" RESULT(2)="Name2^URL#2" ; etc. "RTN","TMGRPC1",694,0) ;" RESULT(3)="Name3^URL#3" "RTN","TMGRPC1",695,0) ;" "RTN","TMGRPC1",696,0) ;" E.g. RESULT(1)="cnn^www.cnn.com" "RTN","TMGRPC1",697,0) ;" RESULT(2)="INFO^192.168.0.1/home.html" "RTN","TMGRPC1",698,0) ;" "RTN","TMGRPC1",699,0) ;" The number of allowed tabs is determined by code in CPRS "RTN","TMGRPC1",700,0) ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS "RTN","TMGRPC1",701,0) ;" If a web tab is NOT specified, then the page previously "RTN","TMGRPC1",702,0) ;" displayed will be left in place. It will not be cleared. "RTN","TMGRPC1",703,0) ;" To clear a given page, a url of "about:blank" will cause a "RTN","TMGRPC1",704,0) ;" blank page to be displayed. e.g. "RTN","TMGRPC1",705,0) ;" RESULT(3)="^about:blank" "RTN","TMGRPC1",706,0) ;" To HIDE a tab on CPRS use this: "RTN","TMGRPC1",707,0) ;" RESULT(3)="^" ;triggers tab #3 to be hidden "RTN","TMGRPC1",708,0) ;" To have the browser remain UNCHANGED use this: "RTN","TMGRPC1",709,0) ;" RESULT(3)="^" ;triggers tab #3 to remain unchanged. "RTN","TMGRPC1",710,0) ;" Note: the rationale for this is that the web tab may have info "RTN","TMGRPC1",711,0) ;" that should not be refreshed when the patient info is refreshed "RTN","TMGRPC1",712,0) ;" i.e. the user may have navigated somewhere, and doesn't want "RTN","TMGRPC1",713,0) ;" to loose their location. "RTN","TMGRPC1",714,0) ;" --to be implemented. "RTN","TMGRPC1",715,0) ;" Note: The other way to do this, acs above, is to simply have NO "RTN","TMGRPC1",716,0) ;" entry for a given tab. I.e. don't have any value for RESULT(3) "RTN","TMGRPC1",717,0) ;" --already implemented. "RTN","TMGRPC1",718,0) ;"Notice to others: Below is where code should be added to return "RTN","TMGRPC1",719,0) ;" proper URL's to CPRS. This will be called whenever a new patient "RTN","TMGRPC1",720,0) ;" is opened, or a Refresh Information is requested. "RTN","TMGRPC1",721,0) ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used "RTN","TMGRPC1",722,0) ;" to pass back URLS specific for a given patient. "RTN","TMGRPC1",723,0) "RTN","TMGRPC1",724,0) set RESULT(0)="1^Success" "RTN","TMGRPC1",725,0) set RESULT(1)="MerkMedicus^http://www.merckmedicus.com/pp/us/hcp/hcp_home.jsp" "RTN","TMGRPC1",726,0) set RESULT(2)="Pathgroup^http://pathgroup.com/" "RTN","TMGRPC1",727,0) 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" "RTN","TMGRPC1",728,0) set RESULT(4)="EMedicine^http://emedicine.medscape.com/" "RTN","TMGRPC1",729,0) "RTN","TMGRPC1",730,0) ;"kill RESULT "RTN","TMGRPC1",731,0) ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!! "RTN","TMGRPC1",732,0) "RTN","TMGRPC1",733,0) quit "RTN","TMGRPC1",734,0) "RTN","TMGRPC1",735,0) ; "RTN","TMGRPC1B") 0^2^B3028 "RTN","TMGRPC1B",1,0) TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10, 7/11/10 "RTN","TMGRPC1B",2,0) ;;1.0;TMG-LIB;**1**;3/28/10;Build 2 "RTN","TMGRPC1B",3,0) ; "RTN","TMGRPC1B",4,0) ;"TMG RPC FUNCTIONS "RTN","TMGRPC1B",5,0) ; "RTN","TMGRPC1B",6,0) ;"Copyright Kevin Toppenberg MD "RTN","TMGRPC1B",7,0) ;"Released under GNU General Public License (GPL) "RTN","TMGRPC1B",8,0) ;" "RTN","TMGRPC1B",9,0) ;"======================================================================= "RTN","TMGRPC1B",10,0) ;" RPC -- Public Functions. "RTN","TMGRPC1B",11,0) ;"======================================================================= "RTN","TMGRPC1B",12,0) ;"ENSUREALL -- Ensure all needed TMG RPC entries have been added "RTN","TMGRPC1B",13,0) ; "RTN","TMGRPC1B",14,0) ;"======================================================================= "RTN","TMGRPC1B",15,0) ;"PRIVATE API FUNCTIONS "RTN","TMGRPC1B",16,0) ;"======================================================================= "RTN","TMGRPC1B",17,0) ;"ENSURE1(RPCNAME) -- ensure 1 RPC is in OPTION record OR CPRS GUI CHART "RTN","TMGRPC1B",18,0) ; "RTN","TMGRPC1B",19,0) ;"======================================================================= "RTN","TMGRPC1B",20,0) ;"======================================================================= "RTN","TMGRPC1B",21,0) ;"Dependencies: "RTN","TMGRPC1B",22,0) ;" DIC "RTN","TMGRPC1B",23,0) ;"======================================================================= "RTN","TMGRPC1B",24,0) ;"======================================================================= "RTN","TMGRPC1B",25,0) ; "RTN","TMGRPC1B",26,0) ENSUREAL "RTN","TMGRPC1B",27,0) ;"Ensure all needed TMG RPC entries have been added "RTN","TMGRPC1B",28,0) L1 ;;TMG ADD PATIENT "RTN","TMGRPC1B",29,0) ;;TMG AUTOSIGN TIU DOCUMENT "RTN","TMGRPC1B",30,0) ;;TMG BARCODE DECODE "RTN","TMGRPC1B",31,0) ;;TMG BARCODE ENCODE "RTN","TMGRPC1B",32,0) ;;TMG CHANNEL "RTN","TMGRPC1B",33,0) ;;TMG CPRS GET URL LIST "RTN","TMGRPC1B",34,0) ;;TMG DOWNLOAD FILE "RTN","TMGRPC1B",35,0) ;;TMG DOWNLOAD FILE DROPBOX "RTN","TMGRPC1B",36,0) ;;TMG GET BLANK TIU DOCUMENT "RTN","TMGRPC1B",37,0) ;;TMG GET DFN "RTN","TMGRPC1B",38,0) ;;TMG GET IMAGE LONG DESCRIPTION "RTN","TMGRPC1B",39,0) ;;TMG GET PATIENT DEMOGRAPHICS "RTN","TMGRPC1B",40,0) ;;TMG INIFILE GET "RTN","TMGRPC1B",41,0) ;;TMG INIFILE SET "RTN","TMGRPC1B",42,0) ;;TMG MSGLINK CHANNEL "RTN","TMGRPC1B",43,0) ;;TMG SEARCH CHANNEL "RTN","TMGRPC1B",44,0) ;;TMG SET PATIENT DEMOGRAPHICS "RTN","TMGRPC1B",45,0) ;;TMG UPLOAD FILE "RTN","TMGRPC1B",46,0) ;;TMG UPLOAD FILE DROPBOX "RTN","TMGRPC1B",47,0) ;;TMG IMAGE DELETE "RTN","TMGRPC1B",48,0) ;;MAGGADDIMAGE "RTN","TMGRPC1B",49,0) ;;MAG3 TIU IMAGE "RTN","TMGRPC1B",50,0) ;;MAG3 CPRS TIU NOTE "RTN","TMGRPC1B",51,0) ;; "RTN","TMGRPC1B",52,0) ; "RTN","TMGRPC1B",53,0) NEW TMGI "RTN","TMGRPC1B",54,0) NEW DONE SET DONE=0 "RTN","TMGRPC1B",55,0) FOR TMGI=0:1 DO QUIT:DONE "RTN","TMGRPC1B",56,0) . NEW RPC SET RPC=$PIECE($TEXT(L1+TMGI^TMGRPC1B),";;",2) "RTN","TMGRPC1B",57,0) . IF (RPC="")!(RPC="") SET DONE=1 QUIT "RTN","TMGRPC1B",58,0) . DO ENSURE1(RPC) "RTN","TMGRPC1B",59,0) QUIT "RTN","TMGRPC1B",60,0) ; "RTN","TMGRPC1B",61,0) ENSURE1(RPCNAME) ; "RTN","TMGRPC1B",62,0) ;"Purpose: to ensure 1 RPC is in OPTION record OR CPRS GUI CHART "RTN","TMGRPC1B",63,0) ;" (add if needed) "RTN","TMGRPC1B",64,0) NEW DIC,X,Y,DA "RTN","TMGRPC1B",65,0) SET DIC="^DIC(19,",DIC(0)="M" "RTN","TMGRPC1B",66,0) SET X="OR CPRS GUI CHART" "RTN","TMGRPC1B",67,0) DO ^DIC "RTN","TMGRPC1B",68,0) IF +Y'>0 DO QUIT "RTN","TMGRPC1B",69,0) . WRITE "ERROR. Unable to find [OR CPRS GUI CHART] in file OPTION (#19)",! "RTN","TMGRPC1B",70,0) . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600)) "RTN","TMGRPC1B",71,0) . WRITE ! "RTN","TMGRPC1B",72,0) SET DA(1)=+Y "RTN","TMGRPC1B",73,0) SET DIC=DIC_DA(1)_",""RPC""," "RTN","TMGRPC1B",74,0) SET DIC(0)="ML" ;"LAYGO --> add entry if not found "RTN","TMGRPC1B",75,0) SET X=RPCNAME "RTN","TMGRPC1B",76,0) DO ^DIC "RTN","TMGRPC1B",77,0) IF +Y'>0 DO "RTN","TMGRPC1B",78,0) . WRITE "ERROR. Unable to add or find "_RPCNAME_" for subfile RPC in record",! "RTN","TMGRPC1B",79,0) . WRITE "OR CPRS GUI CHART in file OPTION (#19)",! "RTN","TMGRPC1B",80,0) . NEW TEMP READ "Press [ENTER] to continue...",TEMP:($GET(DTIME,3600)) "RTN","TMGRPC1B",81,0) . WRITE ! "RTN","TMGRPC1B",82,0) QUIT "RTN","TMGRPC1B",83,0) "RTN","TMGRPC1B",84,0) "RTN","TMGRPC1C") 0^3^B4701 "RTN","TMGRPC1C",1,0) TMGRPC1C ;TMG/kst-RPC Functions ;07/09/10 "RTN","TMGRPC1C",2,0) ;;1.0;TMG-LIB;**1**;07/09/10;Build 2 "RTN","TMGRPC1C",3,0) "RTN","TMGRPC1C",4,0) ;"TMG RPC FUNCTIONS especially related to imaging. "RTN","TMGRPC1C",5,0) "RTN","TMGRPC1C",6,0) ;"Kevin Toppenberg MD "RTN","TMGRPC1C",7,0) ;"GNU General Public License (GPL) applies "RTN","TMGRPC1C",8,0) ;"7/09/10 "RTN","TMGRPC1C",9,0) "RTN","TMGRPC1C",10,0) ;"======================================================================= "RTN","TMGRPC1C",11,0) ;" RPC -- Public Functions. "RTN","TMGRPC1C",12,0) ;"======================================================================= "RTN","TMGRPC1C",13,0) ;"GETDEFNL() -- return the default Network Location (file 2005.2) entry "RTN","TMGRPC1C",14,0) ;"GETLOCFPATH(FPATH,LOCIEN) -- get local (absolute) path for storing on host file system "RTN","TMGRPC1C",15,0) ;"GETDROPPATH(LOCIEN,DropBox) -- return path to local dropbox. "RTN","TMGRPC1C",16,0) ;"DOWNLOAD(GREF,FPATH,FNAMEW $$,LOCIEN) "RTN","TMGRPC1C",17,0) ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) "RTN","TMGRPC1C",18,0) ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file "RTN","TMGRPC1C",19,0) ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File "RTN","TMGRPC1C",20,0) ;"DELIMAGE(RESULT,IMGIEN,MODE,REASON) -- Delete or Retract Image "RTN","TMGRPC1C",21,0) ;"UNRETRACT(RESULT,TMGIEN) -- reverse retraction process from DELIMAGE above. "RTN","TMGRPC1C",22,0) ;"======================================================================= "RTN","TMGRPC1C",23,0) ;"PRIVATE API FUNCTIONS "RTN","TMGRPC1C",24,0) ;"======================================================================= "RTN","TMGRPC1C",25,0) ;"ENCODE(GRef,incSubscr,encodeFn) "RTN","TMGRPC1C",26,0) ;"DECODE(GRef,incSubscr,decodeFn) "RTN","TMGRPC1C",27,0) ;"$$HEXCODER(INPUT) ;encode the input string. Currently using simple hex encoding/ "RTN","TMGRPC1C",28,0) ;"$$B64CODER(INPUT) ;encode the input string via UUENCODE (actually Base64) "RTN","TMGRPC1C",29,0) ;"$$B64DECODER(INPUT) ;encode the input string via UUDECODE (actually Base64) "RTN","TMGRPC1C",30,0) ;"ENSUREDIV(FPATH,LOCIEN) ;Ensure that the path ends with an appropriate node divider. "RTN","TMGRPC1C",31,0) "RTN","TMGRPC1C",32,0) ;"======================================================================= "RTN","TMGRPC1C",33,0) ;"Dependancies: "RTN","TMGRPC1C",34,0) ;" DIK, TMGDEBUG "RTN","TMGRPC1C",35,0) ;"======================================================================= "RTN","TMGRPC1C",36,0) ; "RTN","TMGRPC1C",37,0) GETDEFNL() "RTN","TMGRPC1C",38,0) ;"Purpose: to return the default Network Location (file 2005.2) entry "RTN","TMGRPC1C",39,0) ;"Input: None "RTN","TMGRPC1C",40,0) ;"Results: Returns IEN in file 2005.2, or 1 if some problem. "RTN","TMGRPC1C",41,0) ; "RTN","TMGRPC1C",42,0) NEW RESULT SET RESULT=1 ;"Default "RTN","TMGRPC1C",43,0) ; "RTN","TMGRPC1C",44,0) ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file. "RTN","TMGRPC1C",45,0) NEW INSTPTR SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;"Ptr to file $4 (Institution) "RTN","TMGRPC1C",46,0) IF INSTPTR'>0 GOTO GDFNDN "RTN","TMGRPC1C",47,0) ; "RTN","TMGRPC1C",48,0) ;"Now get IMAGING SITE PARAMETERS for Institution Name "RTN","TMGRPC1C",49,0) NEW IMGSPPTR SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0)) "RTN","TMGRPC1C",50,0) IF IMGSPPTR'>0 GOTO GDFNDN "RTN","TMGRPC1C",51,0) ; "RTN","TMGRPC1C",52,0) ;"Now get NETWORK LOCATION stored in IMAGING SITE PARAMETERS record "RTN","TMGRPC1C",53,0) NEW LOCPTR SET LOCPTR=+$PIECE($GET(^MAG(2006.1,IMGSPPTR,0)),"^",3) "RTN","TMGRPC1C",54,0) IF LOCPTR>0 SET RESULT=LOCPTR "RTN","TMGRPC1C",55,0) ; "RTN","TMGRPC1C",56,0) GDFNDN QUIT RESULT "RTN","TMGRPC1C",57,0) ; "RTN","TMGRPC1C",58,0) ; "RTN","TMGRPC1C",59,0) ENSUREDIV(FPATH,LOCIEN) ; "RTN","TMGRPC1C",60,0) ;"Purpose: Ensure that the path ends with an appropriate node divider. "RTN","TMGRPC1C",61,0) set FPATH=$GET(FPATH,"/") "RTN","TMGRPC1C",62,0) set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() "RTN","TMGRPC1C",63,0) "RTN","TMGRPC1C",64,0) ;"default is "/" NOTE: CUSTOM FIELD "RTN","TMGRPC1C",65,0) new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) "RTN","TMGRPC1C",66,0) "RTN","TMGRPC1C",67,0) new EndChar set EndChar=$extract(FPATH,$length(FPATH)) "RTN","TMGRPC1C",68,0) if EndChar'=NodeDiv set FPATH=FPATH_NodeDiv "RTN","TMGRPC1C",69,0) quit FPATH "RTN","TMGRPC1C",70,0) ; "RTN","TMGRPC1C",71,0) GETLOCFPATH(FPATH,LOCIEN) ; "RTN","TMGRPC1C",72,0) ;"Purpose: to get local (absolute) path for storing on host file system "RTN","TMGRPC1C",73,0) ;"Input: FPATH -- the file path up to, but not including, the filename "RTN","TMGRPC1C",74,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1C",75,0) ;" [optional] default is '/' "RTN","TMGRPC1C",76,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from "RTN","TMGRPC1C",77,0) ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default "RTN","TMGRPC1C",78,0) ;" values stored in KERNEL SYSTEM PARAMETERS etc. "RTN","TMGRPC1C",79,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1C",80,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1C",81,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1C",82,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1C",83,0) ;"Returns: A path, that can be passed to KERNEL calls for HFS calls. "RTN","TMGRPC1C",84,0) ;" NOTE: Result WILL end with a node divider "RTN","TMGRPC1C",85,0) ; "RTN","TMGRPC1C",86,0) set FPATH=$GET(FPATH,"/") "RTN","TMGRPC1C",87,0) set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() "RTN","TMGRPC1C",88,0) "RTN","TMGRPC1C",89,0) ;"NOTE: CUSTOM FIELD "RTN","TMGRPC1C",90,0) new PathRoot set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) "RTN","TMGRPC1C",91,0) "RTN","TMGRPC1C",92,0) ;"default is "/" NOTE: CUSTOM FIELD "RTN","TMGRPC1C",93,0) new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) "RTN","TMGRPC1C",94,0) "RTN","TMGRPC1C",95,0) new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot)) "RTN","TMGRPC1C",96,0) new StartPath set StartPath=$extract(FPATH,1) "RTN","TMGRPC1C",97,0) "RTN","TMGRPC1C",98,0) if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do "RTN","TMGRPC1C",99,0) . set FPATH=$extract(FPATH,2,1024) "RTN","TMGRPC1C",100,0) else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do "RTN","TMGRPC1C",101,0) . set PathRoot=PathRoot_NodeDiv "RTN","TMGRPC1C",102,0) "RTN","TMGRPC1C",103,0) set FPATH=$$ENSUREDIV(PathRoot_FPATH,LOCIEN) "RTN","TMGRPC1C",104,0) quit FPATH "RTN","TMGRPC1C",105,0) ; "RTN","TMGRPC1C",106,0) ; "RTN","TMGRPC1C",107,0) GETDROPPATH(LOCIEN,DropBox) ; "RTN","TMGRPC1C",108,0) ;"Purpose: return path to local dropbox. "RTN","TMGRPC1C",109,0) ;"Input: LOCIEN -- the IEN from file 2005.2 (network location) "RTN","TMGRPC1C",110,0) ;" DropBox -- PASS BY REFERENCE. AN OUT PARAMETER. "RTN","TMGRPC1C",111,0) ;"Results: 1 if OK, -1 if error "RTN","TMGRPC1C",112,0) set LOCIEN=+$GET(LOCIEN) "RTN","TMGRPC1C",113,0) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() "RTN","TMGRPC1C",114,0) new Result set Result=1 "RTN","TMGRPC1C",115,0) set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1) "RTN","TMGRPC1C",116,0) if DropBox="" do goto GDPDN "RTN","TMGRPC1C",117,0) . set Result=-1 "RTN","TMGRPC1C",118,0) set DropBox=$$ENSUREDIV(DropBox,LOCIEN) "RTN","TMGRPC1C",119,0) GDPDN quit Result "RTN","TMGRPC1C",120,0) "RTN","TMGRPC1C",121,0) "RTN","TMGRPC1C",122,0) DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) "RTN","TMGRPC1C",123,0) ;"SCOPE: Public "RTN","TMGRPC1C",124,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1C",125,0) ;" will ask for a given file, and it will be passed back in the form "RTN","TMGRPC1C",126,0) ;" of an array (in BASE64 ascii encoding) "RTN","TMGRPC1C",127,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1C",128,0) ;" FPATH -- the file path up to, but not including, the filename "RTN","TMGRPC1C",129,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1C",130,0) ;" [optional] default is '/' "RTN","TMGRPC1C",131,0) ;" FNAME -- the name of the file to pass back "RTN","TMGRPC1C",132,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from "RTN","TMGRPC1C",133,0) ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default "RTN","TMGRPC1C",134,0) ;" values stored in KERNEL SYSTEM PARAMETERS etc. "RTN","TMGRPC1C",135,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1C",136,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1C",137,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1C",138,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1C",139,0) ;"Output: results are passed out in @GREF "RTN","TMGRPC1C",140,0) ;" @GREF@(0)=success; 1=success, 0=failure "RTN","TMGRPC1C",141,0) ;" @GREF@(1..xxx) = actual data "RTN","TMGRPC1C",142,0) "RTN","TMGRPC1C",143,0) set FNAME=$get(FNAME) "RTN","TMGRPC1C",144,0) set LOCIEN=+$GET(LOCIEN) "RTN","TMGRPC1C",145,0) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() "RTN","TMGRPC1C",146,0) set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ; "RTN","TMGRPC1C",147,0) "RTN","TMGRPC1C",148,0) set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")" "RTN","TMGRPC1C",149,0) kill @GREF "RTN","TMGRPC1C",150,0) set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3) "RTN","TMGRPC1C",151,0) "RTN","TMGRPC1C",152,0) do ENCODE($name(@GREF@(1)),3) "RTN","TMGRPC1C",153,0) "RTN","TMGRPC1C",154,0) quit "RTN","TMGRPC1C",155,0) "RTN","TMGRPC1C",156,0) "RTN","TMGRPC1C",157,0) UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) "RTN","TMGRPC1C",158,0) ;"SCOPE: Public "RTN","TMGRPC1C",159,0) ;"RPC That calls this: TMG UPLOAD FILE "RTN","TMGRPC1C",160,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1C",161,0) ;" will provide a file for upload (in BASE64 ascii encoding) "RTN","TMGRPC1C",162,0) ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1C",163,0) ;" FPATH -- the file path up to, but not including, the filename "RTN","TMGRPC1C",164,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1C",165,0) ;" [optional] default is '/' "RTN","TMGRPC1C",166,0) ;" FNAME -- the name of the file to pass back "RTN","TMGRPC1C",167,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to "RTN","TMGRPC1C",168,0) ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default "RTN","TMGRPC1C",169,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1C",170,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1C",171,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1C",172,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1C",173,0) ;" ARRAY -- the array that will hold the file, in BASE64 ascii encoding "RTN","TMGRPC1C",174,0) ;"Output: results are passed out in RESULT: 1^SuccessMessage or 0^FailureMessage "RTN","TMGRPC1C",175,0) "RTN","TMGRPC1C",176,0) new result "RTN","TMGRPC1C",177,0) new resultMsg set resultMsg="1^Successful Upload" "RTN","TMGRPC1C",178,0) "RTN","TMGRPC1C",179,0) set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH) "RTN","TMGRPC1C",180,0) set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME) "RTN","TMGRPC1C",181,0) set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN) "RTN","TMGRPC1C",182,0) "RTN","TMGRPC1C",183,0) if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone "RTN","TMGRPC1C",184,0) set FNAME=$get(FNAME) "RTN","TMGRPC1C",185,0) if FNAME="" do goto UpDone "RTN","TMGRPC1C",186,0) . set resultMsg="0^No file name received" "RTN","TMGRPC1C",187,0) "RTN","TMGRPC1C",188,0) set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() "RTN","TMGRPC1C",189,0) "RTN","TMGRPC1C",190,0) set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ; "RTN","TMGRPC1C",191,0) "RTN","TMGRPC1C",192,0) do DECODE("ARRAY(0)",1) "RTN","TMGRPC1C",193,0) "RTN","TMGRPC1C",194,0) if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do "RTN","TMGRPC1C",195,0) . set resultMsg="0^Error while saving file" "RTN","TMGRPC1C",196,0) "RTN","TMGRPC1C",197,0) UpDone set RESULT=resultMsg "RTN","TMGRPC1C",198,0) quit "RTN","TMGRPC1C",199,0) "RTN","TMGRPC1C",200,0) "RTN","TMGRPC1C",201,0) DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file "RTN","TMGRPC1C",202,0) ;"SCOPE: Public "RTN","TMGRPC1C",203,0) ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX "RTN","TMGRPC1C",204,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1C",205,0) ;" will request for the file to be placed into in a 'dropbox' file "RTN","TMGRPC1C",206,0) ;" location that both the client and server can access. File may be "RTN","TMGRPC1C",207,0) ;" moved from there to its final destination by the client. "RTN","TMGRPC1C",208,0) ;" This method alloows file-hiding ability on the server side. "RTN","TMGRPC1C",209,0) ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1C",210,0) ;" FPATH -- the file path up to, but not including, the filename. This "RTN","TMGRPC1C",211,0) ;" is the path that the file is stored at (relative to a root path, "RTN","TMGRPC1C",212,0) ;" see comments below). It is NOT the path of the dropbox. "RTN","TMGRPC1C",213,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1C",214,0) ;" [optional] default is '/' "RTN","TMGRPC1C",215,0) ;" FNAME -- the name of the file to be uploaded. Note: This is also the "RTN","TMGRPC1C",216,0) ;" name of the file to be put into the dropbox. It is the "RTN","TMGRPC1C",217,0) ;" responsibility of the client to ensure that there is not already "RTN","TMGRPC1C",218,0) ;" a similarly named file in the dropbox before requesting a file "RTN","TMGRPC1C",219,0) ;" be put there. It is the responsibility of the client to delete "RTN","TMGRPC1C",220,0) ;" the file from the drop box. "RTN","TMGRPC1C",221,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from "RTN","TMGRPC1C",222,0) ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default "RTN","TMGRPC1C",223,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1C",224,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1C",225,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1C",226,0) ;" This root path is found in custom field 22701 in file 2005.2 "RTN","TMGRPC1C",227,0) ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 "RTN","TMGRPC1C",228,0) ;"NOTE RE DROPBOX: "RTN","TMGRPC1C",229,0) ;" This system is designed for a system where by the server and the client have a "RTN","TMGRPC1C",230,0) ;" shared filesystem, but the directory paths will be different. For example: "RTN","TMGRPC1C",231,0) ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ "RTN","TMGRPC1C",232,0) ;" Windows Client has access to dropbox at: V:\Dropbox\ "RTN","TMGRPC1C",233,0) "RTN","TMGRPC1C",234,0) ;"Output: results are 1^Success^FileSize (in bytes), or 0^Error Message "RTN","TMGRPC1C",235,0) "RTN","TMGRPC1C",236,0) new DropBox,moveResult,SrcNamePath "RTN","TMGRPC1C",237,0) "RTN","TMGRPC1C",238,0) new resultMsg set resultMsg="1^Successful Download" "RTN","TMGRPC1C",239,0) "RTN","TMGRPC1C",240,0) set FNAME=$get(FNAME) if FNAME="" do goto DnDBxDone "RTN","TMGRPC1C",241,0) . set resultMsg="0^No file name received" "RTN","TMGRPC1C",242,0) "RTN","TMGRPC1C",243,0) set FPATH=$$GETLOCFPATH(.FPATH,.LOCIEN) ; "RTN","TMGRPC1C",244,0) "RTN","TMGRPC1C",245,0) if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do goto DnDBxDone "RTN","TMGRPC1C",246,0) . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" "RTN","TMGRPC1C",247,0) "RTN","TMGRPC1C",248,0) set SrcNamePath=FPATH_FNAME "RTN","TMGRPC1C",249,0) "RTN","TMGRPC1C",250,0) set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox) "RTN","TMGRPC1C",251,0) if moveResult>0 do "RTN","TMGRPC1C",252,0) . set resultMsg="0^Move failed, returning OS error code: "_moveResult "RTN","TMGRPC1C",253,0) else do "RTN","TMGRPC1C",254,0) . set resultMsg=resultMsg_"^"_$$FileSize^TMGKERNL(SrcNamePath) "RTN","TMGRPC1C",255,0) "RTN","TMGRPC1C",256,0) DnDBxDone "RTN","TMGRPC1C",257,0) set RESULT=resultMsg "RTN","TMGRPC1C",258,0) quit "RTN","TMGRPC1C",259,0) "RTN","TMGRPC1C",260,0) "RTN","TMGRPC1C",261,0) UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File "RTN","TMGRPC1C",262,0) ;"SCOPE: Public "RTN","TMGRPC1C",263,0) ;"RPC That calls this: TMG UPLOAD FILE DROPBOX "RTN","TMGRPC1C",264,0) ;"Purpose: To provide an entry point for a RPC call from a client. The client "RTN","TMGRPC1C",265,0) ;" will put the file in a 'dropbox' file location that both the client "RTN","TMGRPC1C",266,0) ;" and server can access. File will be moved from there to its final "RTN","TMGRPC1C",267,0) ;" destination. This will provide file-hiding ability on the server side. "RTN","TMGRPC1C",268,0) ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) "RTN","TMGRPC1C",269,0) ;" FPATH -- the file path up to, but not including, the filename. This "RTN","TMGRPC1C",270,0) ;" is the path to store the file at. (relative to a root path, "RTN","TMGRPC1C",271,0) ;" see comments below). It is NOT the path of the dropbox. "RTN","TMGRPC1C",272,0) ;" Use '/' to NOT specify any subdirectory "RTN","TMGRPC1C",273,0) ;" [optional] default is '/' "RTN","TMGRPC1C",274,0) ;" FNAME -- the name of the file to be uploaded. Note: This is also the "RTN","TMGRPC1C",275,0) ;" name of the file to be pulled from the dropbox. It is the "RTN","TMGRPC1C",276,0) ;" responsibility of the client to ensure that there is not already "RTN","TMGRPC1C",277,0) ;" a similarly named file in the dropbox before depositing a file there. "RTN","TMGRPC1C",278,0) ;" The server will remove the file from the dropbox, unless there is "RTN","TMGRPC1C",279,0) ;" an error with the host OS (which will be returned as an error message) "RTN","TMGRPC1C",280,0) ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to "RTN","TMGRPC1C",281,0) ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default "RTN","TMGRPC1C",282,0) ;" Note: For security reasons, all path requests will be considered relative to a root path. "RTN","TMGRPC1C",283,0) ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: "RTN","TMGRPC1C",284,0) ;" /var/local/Dir1/Dir2/download/SomeFile.jpg "RTN","TMGRPC1C",285,0) ;" This root path is found in custom field 22700 in file 2005.2 "RTN","TMGRPC1C",286,0) ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 "RTN","TMGRPC1C",287,0) ;"NOTE RE DROPBOX: "RTN","TMGRPC1C",288,0) ;" This system is designed for a system where by the server and the client have a "RTN","TMGRPC1C",289,0) ;" shared filesystem, but the directory paths will be different. For example: "RTN","TMGRPC1C",290,0) ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ "RTN","TMGRPC1C",291,0) ;" Windows Client has access to dropbox at: V:\Dropbox\ "RTN","TMGRPC1C",292,0) "RTN","TMGRPC1C",293,0) ;"Output: results are passed out in RESULT: "RTN","TMGRPC1C",294,0) ;" 1^SuccessMessage or 0^FailureMessage "RTN","TMGRPC1C",295,0) "RTN","TMGRPC1C",296,0) new SrcNamePath,DestNamePath,moveResult "RTN","TMGRPC1C",297,0) new resultMsg set resultMsg="1^Successful Upload" "RTN","TMGRPC1C",298,0) "RTN","TMGRPC1C",299,0) set FNAME=$get(FNAME) "RTN","TMGRPC1C",300,0) if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone "RTN","TMGRPC1C",301,0) "RTN","TMGRPC1C",302,0) new DropBox "RTN","TMGRPC1C",303,0) if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do goto UpDBxDone "RTN","TMGRPC1C",304,0) . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" "RTN","TMGRPC1C",305,0) "RTN","TMGRPC1C",306,0) set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ; "RTN","TMGRPC1C",307,0) "RTN","TMGRPC1C",308,0) set SrcNamePath=DropBox_FNAME "RTN","TMGRPC1C",309,0) set DestNamePath=FPATH_FNAME "RTN","TMGRPC1C",310,0) "RTN","TMGRPC1C",311,0) set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath) "RTN","TMGRPC1C",312,0) if moveResult>0 do "RTN","TMGRPC1C",313,0) . set resultMsg="0^Move failed, returning OS error code: "_moveResult "RTN","TMGRPC1C",314,0) "RTN","TMGRPC1C",315,0) UpDBxDone "RTN","TMGRPC1C",316,0) set RESULT=resultMsg "RTN","TMGRPC1C",317,0) quit "RTN","TMGRPC1C",318,0) "RTN","TMGRPC1C",319,0) "RTN","TMGRPC1C",320,0) ENCODE(GRef,incSubscr,encodeFn) "RTN","TMGRPC1C",321,0) ;"Purpose: ENCODE a BINARY GLOBAL. "RTN","TMGRPC1C",322,0) ;"Input: "RTN","TMGRPC1C",323,0) ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved "RTN","TMGRPC1C",324,0) ;" (closed root) format. "RTN","TMGRPC1C",325,0) ;" Note: "RTN","TMGRPC1C",326,0) ;" At least one subscript must be numeric. This will be the incrementing "RTN","TMGRPC1C",327,0) ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment "RTN","TMGRPC1C",328,0) ;" to store each new global node). This subscript need not be the final "RTN","TMGRPC1C",329,0) ;" subscript. For example, to load into a WORD PROCESSING field, the "RTN","TMGRPC1C",330,0) ;" incrementing node is the second-to-last subscript; the final subscript "RTN","TMGRPC1C",331,0) ;" is always zero. "RTN","TMGRPC1C",332,0) ;" REQUIRED "RTN","TMGRPC1C",333,0) ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global "RTN","TMGRPC1C",334,0) ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and "RTN","TMGRPC1C",335,0) ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third "RTN","TMGRPC1C",336,0) ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global "RTN","TMGRPC1C",337,0) ;" reference, such as ^TMP(115,1,x,0). "RTN","TMGRPC1C",338,0) ;" REQUIRED "RTN","TMGRPC1C",339,0) ;" encodeFn- (OPTIONAL) the name of a function that will encode a line of data. "RTN","TMGRPC1C",340,0) ;" e.g. "CODER^ZZZCODER" or "LOCALCODER". The function should "RTN","TMGRPC1C",341,0) ;" take one input variable (the line of raw binary data), and return a converted "RTN","TMGRPC1C",342,0) ;" line. e.g. "RTN","TMGRPC1C",343,0) ;" CODER(INPUT) "RTN","TMGRPC1C",344,0) ;" ... ;"convert INPUT to RESULT "RTN","TMGRPC1C",345,0) ;" QUIT RESULT "RTN","TMGRPC1C",346,0) ;" default value is B64CODER^TMGRPC1 "RTN","TMGRPC1C",347,0) ;" "RTN","TMGRPC1C",348,0) ;"Output: @GRef is converted to encoded data "RTN","TMGRPC1C",349,0) ;"Result: None "RTN","TMGRPC1C",350,0) "RTN","TMGRPC1C",351,0) if $get(GRef)="" goto EncodeDone "RTN","TMGRPC1C",352,0) if $get(incSubscr)="" goto EncodeDone "RTN","TMGRPC1C",353,0) "RTN","TMGRPC1C",354,0) set encodeFn=$get(encodeFn,"B64CODER") "RTN","TMGRPC1C",355,0) "RTN","TMGRPC1C",356,0) new encoder "RTN","TMGRPC1C",357,0) set encoder="set temp=$$"_encodeFn_"(.temp)" "RTN","TMGRPC1C",358,0) "RTN","TMGRPC1C",359,0) for do quit:(GRef="") "RTN","TMGRPC1C",360,0) . new temp "RTN","TMGRPC1C",361,0) . set temp=$get(@GRef) "RTN","TMGRPC1C",362,0) . if temp="" set GRef="" quit "RTN","TMGRPC1C",363,0) . xecute encoder ;"i.e. set temp=$$encoderFn(.temp) "RTN","TMGRPC1C",364,0) . set @GRef=temp "RTN","TMGRPC1C",365,0) . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) "RTN","TMGRPC1C",366,0) "RTN","TMGRPC1C",367,0) EncodeDone "RTN","TMGRPC1C",368,0) quit "RTN","TMGRPC1C",369,0) "RTN","TMGRPC1C",370,0) "RTN","TMGRPC1C",371,0) HEXCODER(INPUT) "RTN","TMGRPC1C",372,0) ;"Purpose: to encode the input string. Currently using simple hex encoding/ "RTN","TMGRPC1C",373,0) quit $$STRB2H^TMGSTUTL(.INPUT,0,1) "RTN","TMGRPC1C",374,0) "RTN","TMGRPC1C",375,0) "RTN","TMGRPC1C",376,0) B64CODER(INPUT) "RTN","TMGRPC1C",377,0) ;"Purpose: to encode the input string via UUENCODE (actually Base64) "RTN","TMGRPC1C",378,0) quit $$ENCODE^RGUTUU(.INPUT) "RTN","TMGRPC1C",379,0) "RTN","TMGRPC1C",380,0) B64DECODER(INPUT) "RTN","TMGRPC1C",381,0) ;"Purpose: to encode the input string via UUENCODE (actually Base64) "RTN","TMGRPC1C",382,0) quit $$DECODE^RGUTUU(.INPUT) "RTN","TMGRPC1C",383,0) "RTN","TMGRPC1C",384,0) "RTN","TMGRPC1C",385,0) DECODE(GRef,incSubscr,decodeFn) "RTN","TMGRPC1C",386,0) ;"Purpose: ENCODE a BINARY GLOBAL. "RTN","TMGRPC1C",387,0) ;"Input: "RTN","TMGRPC1C",388,0) ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved "RTN","TMGRPC1C",389,0) ;" (closed root) format. "RTN","TMGRPC1C",390,0) ;" Note: "RTN","TMGRPC1C",391,0) ;" At least one subscript must be numeric. This will be the incrementing "RTN","TMGRPC1C",392,0) ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment "RTN","TMGRPC1C",393,0) ;" to store each new global node). This subscript need not be the final "RTN","TMGRPC1C",394,0) ;" subscript. For example, to load into a WORD PROCESSING field, the "RTN","TMGRPC1C",395,0) ;" incrementing node is the second-to-last subscript; the final subscript "RTN","TMGRPC1C",396,0) ;" is always zero. "RTN","TMGRPC1C",397,0) ;" REQUIRED "RTN","TMGRPC1C",398,0) ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global "RTN","TMGRPC1C",399,0) ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and "RTN","TMGRPC1C",400,0) ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third "RTN","TMGRPC1C",401,0) ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global "RTN","TMGRPC1C",402,0) ;" reference, such as ^TMP(115,1,x,0). "RTN","TMGRPC1C",403,0) ;" REQUIRED "RTN","TMGRPC1C",404,0) ;" decodeFn- (OPTIONAL) the name of a function that will decode a line of data. "RTN","TMGRPC1C",405,0) ;" e.g. "DECODER^ZZZCODER" or "DECODER". The function should take "RTN","TMGRPC1C",406,0) ;" one input variable (the line of encoded data), and return a decoded line. e.g. "RTN","TMGRPC1C",407,0) ;" DECODER(INPUT) "RTN","TMGRPC1C",408,0) ;" ... ;"convert INPUT to RESULT "RTN","TMGRPC1C",409,0) ;" QUIT RESULT "RTN","TMGRPC1C",410,0) ;" default value is B64DECODER^TMGRPC1 "RTN","TMGRPC1C",411,0) ;" "RTN","TMGRPC1C",412,0) ;"Output: @GRef is converted to decoded data "RTN","TMGRPC1C",413,0) ;"Result: None "RTN","TMGRPC1C",414,0) "RTN","TMGRPC1C",415,0) if $get(GRef)="" goto DecodeDone "RTN","TMGRPC1C",416,0) if $get(incSubscr)="" goto DecodeDone "RTN","TMGRPC1C",417,0) set decodeFn=$get(decodeFn,"B64DECODER") "RTN","TMGRPC1C",418,0) "RTN","TMGRPC1C",419,0) new decoder "RTN","TMGRPC1C",420,0) set decoder="set temp=$$"_decodeFn_"(.temp)" "RTN","TMGRPC1C",421,0) "RTN","TMGRPC1C",422,0) for do quit:(GRef="") "RTN","TMGRPC1C",423,0) . new temp "RTN","TMGRPC1C",424,0) . set temp=$get(@GRef) "RTN","TMGRPC1C",425,0) . if temp="" set GRef="" quit "RTN","TMGRPC1C",426,0) . xecute decoder ;"i.e. set temp=$$decoderFn(.temp) "RTN","TMGRPC1C",427,0) . set @GRef=temp "RTN","TMGRPC1C",428,0) . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) "RTN","TMGRPC1C",429,0) "RTN","TMGRPC1C",430,0) DecodeDone "RTN","TMGRPC1C",431,0) quit "RTN","TMGRPC1C",432,0) ; "RTN","TMGRPC1C",433,0) ; "RTN","TMGRPC1C",434,0) DELIMAGE(RESULT,TMGIEN,TMGMODE,TMGREASON) ; "RTN","TMGRPC1C",435,0) ;"Purpose: Provide functionality for deleting or retacting an image from CPRS "RTN","TMGRPC1C",436,0) ;"NOTE: MAGG IMAGE DELETE is not used because it does things like archive "RTN","TMGRPC1C",437,0) ;" the images before deletion. I don't have this system fully integrated "RTN","TMGRPC1C",438,0) ;" In the future, that could possibly be used. "RTN","TMGRPC1C",439,0) ;"NOTE: This function DOES NOT CHECK PERMISSIONS for deleting the images. "RTN","TMGRPC1C",440,0) ;" It is assumed that that has been doine PRIOR to calling this function. "RTN","TMGRPC1C",441,0) ;"NOTE: It mode is to retract (see below), then the image will not be "RTN","TMGRPC1C",442,0) ;" actually be deleted. It will just be marked as retracted and "RTN","TMGRPC1C",443,0) ;" set so that it doesn't appear in CPRS. "RTN","TMGRPC1C",444,0) ;" --But if mode is to delete, then the record in the IMAGE file "RTN","TMGRPC1C",445,0) ;" will be deleted AND ALSO the actual image (with no backup.) This "RTN","TMGRPC1C",446,0) ;" mode is for deletion before signing, and the image has not been "RTN","TMGRPC1C",447,0) ;" formally entered into the record. "RTN","TMGRPC1C",448,0) ;"Input: RESULT -- an OUT Parameter. (See results below) "RTN","TMGRPC1C",449,0) ;" TMGIEN -- the IEN in the IMAGE file (2005) to remove "RTN","TMGRPC1C",450,0) ;" TMGMODE -- 0 for NONE <-- just exit and do nothing "RTN","TMGRPC1C",451,0) ;" 1 for DELETE <-- delete record and image file "RTN","TMGRPC1C",452,0) ;" 2 for RETRACT <-- mark record as retracted, don't delete iamge file. "RTN","TMGRPC1C",453,0) ;" TMGREASON -- String (10-60 chars) giving reason for deletion. "RTN","TMGRPC1C",454,0) ;" This is only used for mode RETRACT. "RTN","TMGRPC1C",455,0) ;"Output: RESULT="1^Success" or "-1^Some Failure Message" <-- set up as SINGLE VALUE type in RPC BROKER "RTN","TMGRPC1C",456,0) ; "RTN","TMGRPC1C",457,0) SET RESULT="1^Success" ;"Default to success "RTN","TMGRPC1C",458,0) SET TMGIEN=$GET(TMGIEN,0) "RTN","TMGRPC1C",459,0) IF +TMGIEN'>0 DO GOTO DIDN "RTN","TMGRPC1C",460,0) . SET RESULT="-1^Invalid IEN: "_TMGIEN "RTN","TMGRPC1C",461,0) SET TMGIEN=+TMGIEN "RTN","TMGRPC1C",462,0) SET TMGMODE=+$GET(TMGMODE) "RTN","TMGRPC1C",463,0) IF TMGMODE=0 DO GOTO DIDN "RTN","TMGRPC1C",464,0) . SET RESULT="1^Delete not done because mode=0" "RTN","TMGRPC1C",465,0) SET TMGREASON=$GET(TMGREASON,"(Not Specified)") "RTN","TMGRPC1C",466,0) NEW TMGPTR SET TMGPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",8) ;"2;8 ==> Field 18 = PARENT DATA FILE IMAGE POINTER "RTN","TMGRPC1C",467,0) IF TMGPTR'>0 DO GOTO DIDN "RTN","TMGRPC1C",468,0) . SET RESULT="-1^FILE 2005, IEN "_TMGIEN_", Field 18 does not point to valid record in file 8925.91" "RTN","TMGRPC1C",469,0) NEW TMGTIUPTR SET TMGTIUPTR=+$PIECE($GET(^TIU(8925.91,TMGPTR,0)),"^",1) ;"0;1 ==> Field .01 = DOCUMENT (ptr to 8925) "RTN","TMGRPC1C",470,0) IF TMGMODE=1 DO GOTO:(+RESULT'>0) DIDN ;"Delete mode "RTN","TMGRPC1C",471,0) . NEW FNAME SET FNAME=$PIECE($GET(^MAG(2005,TMGIEN,0)),"^",2) "RTN","TMGRPC1C",472,0) . NEW TMGPATH SET TMGPATH=$$GETLOCFPATH() "RTN","TMGRPC1C",473,0) . NEW TMGARRAY,DELRSLT "RTN","TMGRPC1C",474,0) . SET TMGARRAY(FNAME)="" "RTN","TMGRPC1C",475,0) . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY") "RTN","TMGRPC1C",476,0) . IF DELRSLT=0 DO QUIT "RTN","TMGRPC1C",477,0) . . SET RESULT="-1^Unable to delete file: "_TMGPATH_FNAME "RTN","TMGRPC1C",478,0) . KILL TMGARRAY "RTN","TMGRPC1C",479,0) . NEW FNAME2 SET FNAME2=FNAME "RTN","TMGRPC1C",480,0) . SET $PIECE(FNAME2,",",$LENGTH(FNAME2,"."))="ABS" "RTN","TMGRPC1C",481,0) . SET TMGARRAY(FNAME2)="" "RTN","TMGRPC1C",482,0) . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY") ;"Ingnore results. Thumbnail not always present "RTN","TMGRPC1C",483,0) . NEW DIK SET DIK="^MAG(2005," "RTN","TMGRPC1C",484,0) . NEW DA SET DA=TMGIEN "RTN","TMGRPC1C",485,0) . DO ^DIK ;"Kill Record in 2005 "RTN","TMGRPC1C",486,0) ELSE IF TMGMODE=2 DO GOTO:(+RESULT'>0) DIDN ;"Retract mode "RTN","TMGRPC1C",487,0) . NEW TMGFDA,TMGMSG,TMGIENS "RTN","TMGRPC1C",488,0) . SET TMGIENS=TMGIEN_"," "RTN","TMGRPC1C",489,0) . SET TMGFDA(2005,TMGIENS,30)="`"_+DUZ "RTN","TMGRPC1C",490,0) . SET TMGFDA(2005,TMGIENS,30.1)="NOW" "RTN","TMGRPC1C",491,0) . SET TMGFDA(2005,TMGIENS,30.2)=TMGREASON "RTN","TMGRPC1C",492,0) . SET TMGFDA(2005,TMGIENS,18)="@" "RTN","TMGRPC1C",493,0) . ;"NOTE: Fld 17 already holds IEN of linked 8925 document "RTN","TMGRPC1C",494,0) . DO FILE^DIE("EKT","TMGFDA","TMGMSG") "RTN","TMGRPC1C",495,0) . IF $DATA(TMGMSG("DIERR")) DO "RTN","TMGRPC1C",496,0) . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) "RTN","TMGRPC1C",497,0) DO ;"Do this for both DELETE and RETRACT modes. "RTN","TMGRPC1C",498,0) . NEW DIK SET DIK="^TIU(8925.91," "RTN","TMGRPC1C",499,0) . NEW DA SET DA=TMGPTR "RTN","TMGRPC1C",500,0) . DO ^DIK ;"Kill record in 8925.91 "RTN","TMGRPC1C",501,0) ; "RTN","TMGRPC1C",502,0) DIDN QUIT "RTN","TMGRPC1C",503,0) ; "RTN","TMGRPC1C",504,0) UNRETRACT(RESULT,TMGIEN) ; "RTN","TMGRPC1C",505,0) ;"Purpose: to reverse retraction process from DELIMAGE above. "RTN","TMGRPC1C",506,0) ;"Input: RESULT -- an OUT Parameter. (See results below) "RTN","TMGRPC1C",507,0) ;" TMGIEN -- the IEN in the IMAGE file (2005) to remove "RTN","TMGRPC1C",508,0) ;"Output: RESULT="1^Success" or "-1^Some Failure Message" <-- set up as SINGLE VALUE type in RPC BROKER "RTN","TMGRPC1C",509,0) SET TMGIEN=$GET(TMGIEN) "RTN","TMGRPC1C",510,0) IF +TMGIEN'>0 DO GOTO URDN "RTN","TMGRPC1C",511,0) . SET RESULT="-1^Invalid IEN supplied: "_TMGIEN "RTN","TMGRPC1C",512,0) SET TMGIEN=+TMGIEN "RTN","TMGRPC1C",513,0) NEW TIUPTR SET TIUPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",7) "RTN","TMGRPC1C",514,0) IF TIUPTR'>0 DO GOTO URDN "RTN","TMGRPC1C",515,0) . SET RESULT="-1^Record 2005 doesn't hold link to TIU DOCUMENT in field 17" "RTN","TMGRPC1C",516,0) NEW TMGFDA,TMGFDA,TMGIENS "RTN","TMGRPC1C",517,0) ;"-- Recreate TIU EXTERNAL DATA LINK record "RTN","TMGRPC1C",518,0) KILL TMGFDA "RTN","TMGRPC1C",519,0) SET TMGIENS="+1," "RTN","TMGRPC1C",520,0) SET TMGFDA(8925.91,TMGIENS,.01)=TIUPTR "RTN","TMGRPC1C",521,0) SET TMGFDA(8925.91,TMGIENS,.02)=TMGIEN "RTN","TMGRPC1C",522,0) DO UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") "RTN","TMGRPC1C",523,0) IF $DATA(TMGMSG("DIERR")) DO GOTO URDN "RTN","TMGRPC1C",524,0) . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) "RTN","TMGRPC1C",525,0) NEW TIUIMGPTR SET TIUIMGPTR=+$GET(TMGIEN(1)) "RTN","TMGRPC1C",526,0) IF TIUIMGPTR'>0 DO GOTO URDN "RTN","TMGRPC1C",527,0) . SET RESULT="-1^Unable to locate recreated TIU EXTERNAL DATA LINK record" "RTN","TMGRPC1C",528,0) ;"-- remove DELETED info from IMAGE record -- "RTN","TMGRPC1C",529,0) NEW TMGFDA,TMGFDA,TMGIENS "RTN","TMGRPC1C",530,0) SET TMGIENS=TMGIEN_"," "RTN","TMGRPC1C",531,0) SET TMGFDA(2005,TMGIENS,30)="@" "RTN","TMGRPC1C",532,0) SET TMGFDA(2005,TMGIENS,30.1)="@" "RTN","TMGRPC1C",533,0) SET TMGFDA(2005,TMGIENS,30.2)="@" "RTN","TMGRPC1C",534,0) SET TMGFDA(2005,TMGIENS,18)=TIUIMGPTR "RTN","TMGRPC1C",535,0) DO FILE^DIE("EKT","TMGFDA","TMGMSG") "RTN","TMGRPC1C",536,0) IF $DATA(TMGMSG("DIERR")) DO GOTO URDN "RTN","TMGRPC1C",537,0) . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) "RTN","TMGRPC1C",538,0) "RTN","TMGRPC1C",539,0) URDN QUIT "RTN","TMGRPC1D") 0^4^B69776678 "RTN","TMGRPC1D",1,0) TMGRPC1D ;TMG/kst-RPC Functions ;07/21/10 "RTN","TMGRPC1D",2,0) ;;1.0;TMG-LIB;**1**;07/21/10;Build 2 "RTN","TMGRPC1D",3,0) "RTN","TMGRPC1D",4,0) ;"TMG RPC FUNCTIONS especially related to imaging. "RTN","TMGRPC1D",5,0) "RTN","TMGRPC1D",6,0) ;"Kevin Toppenberg MD "RTN","TMGRPC1D",7,0) ;"GNU General Public License (GPL) applies "RTN","TMGRPC1D",8,0) ;"7/21/10 "RTN","TMGRPC1D",9,0) "RTN","TMGRPC1D",10,0) ;"======================================================================= "RTN","TMGRPC1D",11,0) ;" RPC -- Public Functions. "RTN","TMGRPC1D",12,0) ;"======================================================================= "RTN","TMGRPC1D",13,0) ;"CONFIG -- Set up imaging site parameters, so that TMG-CPRS works. "RTN","TMGRPC1D",14,0) ;"TESTCFG -- Test configuration "RTN","TMGRPC1D",15,0) ;"======================================================================= "RTN","TMGRPC1D",16,0) ;"PRIVATE API FUNCTIONS "RTN","TMGRPC1D",17,0) ;"======================================================================= "RTN","TMGRPC1D",18,0) ;"PINST1 - entry point for POST-INSTALL routine for patch TMG-CPRS-IMAGING*1.0*1 "RTN","TMGRPC1D",19,0) ; "RTN","TMGRPC1D",20,0) ;"======================================================================= "RTN","TMGRPC1D",21,0) ;"Dependancies: TMGKERNL,TMGUSRIF "RTN","TMGRPC1D",22,0) ;"======================================================================= "RTN","TMGRPC1D",23,0) ; "RTN","TMGRPC1D",24,0) CONFIG ; "RTN","TMGRPC1D",25,0) ;"Purpose: Set up imaging site parameters, so that TMG-CPRS works. "RTN","TMGRPC1D",26,0) ;"Input: None "RTN","TMGRPC1D",27,0) ;"Results: none "RTN","TMGRPC1D",28,0) ; "RTN","TMGRPC1D",29,0) WRITE " ------------------------------------------",! "RTN","TMGRPC1D",30,0) WRITE " - Configuration of TMG Imaging -",! "RTN","TMGRPC1D",31,0) WRITE " ------------------------------------------",!,! "RTN","TMGRPC1D",32,0) ; "RTN","TMGRPC1D",33,0) ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file. "RTN","TMGRPC1D",34,0) NEW %,DA,DR,DIE,DIC,X,Y,DIK "RTN","TMGRPC1D",35,0) NEW TMGFDA,TMGMSG,TMGDIV,TMGDROP,TMGSTORE,TMGNODIV "RTN","TMGRPC1D",36,0) NEW INSTPTR,IMGSPPTR "RTN","TMGRPC1D",37,0) CF1 SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;"Ptr to file $4 (Institution) "RTN","TMGRPC1D",38,0) IF INSTPTR>0 DO GOTO CF2 "RTN","TMGRPC1D",39,0) . WRITE "Using DEFAULT INSTITUTION: ",$$GET1^DIQ(4,INSTPTR,.01),! "RTN","TMGRPC1D",40,0) WRITE "No value for DEFAULT INSTITUTION found in field 217 in file KERNEL SYSTEM PARAMETERS",! "RTN","TMGRPC1D",41,0) WRITE "Edit settings now to correct this" "RTN","TMGRPC1D",42,0) SET %=1 DO YN^DICN WRITE ! "RTN","TMGRPC1D",43,0) IF %'=1 GOTO CFDN "RTN","TMGRPC1D",44,0) SET DA=1,DR="[XUSITEPARM]",DIE=8989.3 "RTN","TMGRPC1D",45,0) DO XUDIE^XUS5 ;"Launch screenman form to edit KERNEL SYSTEM PARAMETERS. "RTN","TMGRPC1D",46,0) GOTO CF1 "RTN","TMGRPC1D",47,0) ; "RTN","TMGRPC1D",48,0) CF2 ;"Now get IMAGING SITE PARAMETERS for Institution Name "RTN","TMGRPC1D",49,0) SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0)) "RTN","TMGRPC1D",50,0) IF IMGSPPTR>0 DO GOTO CF3 "RTN","TMGRPC1D",51,0) . WRITE "Using IMAGING SITE PARAMETERS IEN #",IMGSPPTR,", " "RTN","TMGRPC1D",52,0) . WRITE $$GET1^DIQ(2006.1,IMGSPPTR,.01),! "RTN","TMGRPC1D",53,0) WRITE "Next, a entry in IMAGING SITE PARAMENTERS file must be linked in.",! "RTN","TMGRPC1D",54,0) WRITE "Please select entry to use, or add a new one if needed.",! "RTN","TMGRPC1D",55,0) DO PRESSTOCONT^TMGUSRIF "RTN","TMGRPC1D",56,0) SET DIC=2006.1,DIC(0)="MAEQL" "RTN","TMGRPC1D",57,0) DO ^DIC WRITE ! "RTN","TMGRPC1D",58,0) IF Y>-1 SET IMGSPPTR=+Y GOTO CF2B "RTN","TMGRPC1D",59,0) WRITE "Valid entry in IMAGING SITE PARAMETERS file not selected.",! "RTN","TMGRPC1D",60,0) SET %=1 "RTN","TMGRPC1D",61,0) WRITE "Start over" DO YN^DICN WRITE ! "RTN","TMGRPC1D",62,0) IF %=1 GOTO CF1 "RTN","TMGRPC1D",63,0) GOTO ABORT "RTN","TMGRPC1D",64,0) CF2B KILL TMGFDA,TMGMSG "RTN","TMGRPC1D",65,0) SET TMGFDA(2006.1,IMGSPPTR_",",.01)=INSTPTR "RTN","TMGRPC1D",66,0) DO FILE^DIE("K","TMGFDA","TMGMSG") "RTN","TMGRPC1D",67,0) IF $DATA(TMGMSG("DIERR")) DO GOTO ABORT "RTN","TMGRPC1D",68,0) . DO ShowDIERR^TMGDEBUG(.TMGMSG) "RTN","TMGRPC1D",69,0) GOTO CF2 ;"loop back just be sure the B index is setup. "RTN","TMGRPC1D",70,0) ; "RTN","TMGRPC1D",71,0) CF3 ;"Now get NETWORK LOCATION stored in IMAGING SITE PARAMETERS record "RTN","TMGRPC1D",72,0) NEW LOCPTR SET LOCPTR=+$PIECE($GET(^MAG(2006.1,IMGSPPTR,0)),"^",3) "RTN","TMGRPC1D",73,0) IF LOCPTR>0 DO GOTO CF4 "RTN","TMGRPC1D",74,0) . WRITE "Using NETWORK LOCATION IEN #",LOCPTR,", " "RTN","TMGRPC1D",75,0) . WRITE $$GET1^DIQ(2005.2,LOCPTR,.01),! "RTN","TMGRPC1D",76,0) WRITE "Next, a entry in NETWORK LOCATION file must be linked in.",! "RTN","TMGRPC1D",77,0) WRITE "Please select entry to use, or add a new one if needed.",! "RTN","TMGRPC1D",78,0) DO PRESSTOCONT^TMGUSRIF "RTN","TMGRPC1D",79,0) SET DIC=2005.1,DIC(0)="MAEQL" "RTN","TMGRPC1D",80,0) IF Y>-1 SET LOCPTR=+Y GOTO CF4 "RTN","TMGRPC1D",81,0) WRITE "Valid entry in NETWORK LOCATION file not selected.",! "RTN","TMGRPC1D",82,0) SET %=1 "RTN","TMGRPC1D",83,0) WRITE "Start over" DO YN^DICN WRITE ! "RTN","TMGRPC1D",84,0) IF %=1 GOTO CF1 "RTN","TMGRPC1D",85,0) GOTO ABORT "RTN","TMGRPC1D",86,0) ; "RTN","TMGRPC1D",87,0) CF4 ;"Now set up NETWORK LOCATION file. "RTN","TMGRPC1D",88,0) WRITE !,"A NODE DIVIDER is the symbol used to separt folders in a path",! "RTN","TMGRPC1D",89,0) WRITE "E.g. for UNIX, with a sample path of '/opt/var/me', uses '/'",! "RTN","TMGRPC1D",90,0) WRITE "For Windows, with sample path of 'c:\temp\me', uses '\'",! "RTN","TMGRPC1D",91,0) SET %=1,TMGNODIV=0 "RTN","TMGRPC1D",92,0) SET TMGDIV=$$GET1^DIQ(2005.2,LOCPTR,22701) "RTN","TMGRPC1D",93,0) IF TMGDIV'="" DO "RTN","TMGRPC1D",94,0) . WRITE "Current Node divider= '",TMGDIV,"'" "RTN","TMGRPC1D",95,0) . SET %=2 "RTN","TMGRPC1D",96,0) . IF TMGDIV="/" WRITE " (UNIX filesystem)",! "RTN","TMGRPC1D",97,0) . ELSE IF TMGDIV="\" WRITE " (WINDOWS filesystem)",! "RTN","TMGRPC1D",98,0) . ELSE WRITE " (?? filesystem)",! SET %=1 "RTN","TMGRPC1D",99,0) WRITE "Do you want to specify a NODE DIVIDER" DO YN^DICN WRITE ! "RTN","TMGRPC1D",100,0) IF %=-1 GOTO ABORT "RTN","TMGRPC1D",101,0) IF %=2 SET TMGNODIV=1 GOTO CF4A "RTN","TMGRPC1D",102,0) ; "RTN","TMGRPC1D",103,0) WRITE "Is the server running on a Linux/Unix box" DO YN^DICN WRITE ! "RTN","TMGRPC1D",104,0) IF %=-1 GOTO ABORT "RTN","TMGRPC1D",105,0) IF %=1 SET TMGDIV="/" "RTN","TMGRPC1D",106,0) ELSE SET TMGDIV="\" "RTN","TMGRPC1D",107,0) ; "RTN","TMGRPC1D",108,0) CF4A WRITE !,"A DROPBOX is a file folder where the server may place files for",! "RTN","TMGRPC1D",109,0) WRITE "pick up by a client (i.e. CPRS). This folder could be on a ",! "RTN","TMGRPC1D",110,0) WRITE "separate file system (e.g. a windows file system mounted into",! "RTN","TMGRPC1D",111,0) WRITE "the server file system.) This is a security measure that negates",! "RTN","TMGRPC1D",112,0) WRITE "a need for the client to have read access to the entire images",! "RTN","TMGRPC1D",113,0) WRITE "folder. A dropbox path is only required if client is configured",! "RTN","TMGRPC1D",114,0) WRITE "to use it.",! "RTN","TMGRPC1D",115,0) SET %=1 "RTN","TMGRPC1D",116,0) SET TMGDROP=$$GET1^DIQ(2005.2,LOCPTR,22702) "RTN","TMGRPC1D",117,0) IF TMGDROP'="" DO "RTN","TMGRPC1D",118,0) . WRITE "Current DROPBOX: ",TMGDROP,!,! "RTN","TMGRPC1D",119,0) . SET %=2 "RTN","TMGRPC1D",120,0) WRITE "Do you want to specify a DROPBOX FOLDER" DO YN^DICN WRITE ! "RTN","TMGRPC1D",121,0) IF %=-1 GOTO ABORT "RTN","TMGRPC1D",122,0) IF %=2 SET TMGDROP="" GOTO CF4C "RTN","TMGRPC1D",123,0) ; "RTN","TMGRPC1D",124,0) CF4B WRITE "Enter full path of the DROPBOX is it would be accessed on the ",! "RTN","TMGRPC1D",125,0) WRITE "server (**NOT the path that the client would use**)",! "RTN","TMGRPC1D",126,0) READ "Enter full DROPBOX path (^ to abort): ",TMGDROP:DTIME,! "RTN","TMGRPC1D",127,0) IF TMGDROP="^" GOTO ABORT "RTN","TMGRPC1D",128,0) IF TMGDROP="" WRITE ! GOTO CF4A "RTN","TMGRPC1D",129,0) IF $$IsDir^TMGKERNL(TMGDROP,TMGDIV)=1 GOTO CF4B "RTN","TMGRPC1D",130,0) WRITE "ERROR: Path specified is not valid. Does folder exist?",!,! "RTN","TMGRPC1D",131,0) GOTO CF4B "RTN","TMGRPC1D",132,0) ; "RTN","TMGRPC1D",133,0) CF4C WRITE !,"A STORE PATH is the file folder that the server will use to",! "RTN","TMGRPC1D",134,0) WRITE "store images. This should be a complete and valid path.",! "RTN","TMGRPC1D",135,0) SET %=1 "RTN","TMGRPC1D",136,0) SET TMGSTORE=$$GET1^DIQ(2005.2,LOCPTR,22700) "RTN","TMGRPC1D",137,0) IF TMGSTORE'="" DO "RTN","TMGRPC1D",138,0) . WRITE "Current image file storage path: ",TMGSTORE,! "RTN","TMGRPC1D",139,0) . SET %=2 "RTN","TMGRPC1D",140,0) WRITE "Do you want to specify a STORE FOLDER" DO YN^DICN WRITE ! "RTN","TMGRPC1D",141,0) IF %=-1 GOTO ABORT "RTN","TMGRPC1D",142,0) IF %=2 SET TMGSTORE="" GOTO CF4D "RTN","TMGRPC1D",143,0) ; "RTN","TMGRPC1D",144,0) READ "Enter store path (^ to abort): ",TMGSTORE:DTIME,! "RTN","TMGRPC1D",145,0) IF TMGDROP="^" GOTO ABORT "RTN","TMGRPC1D",146,0) IF TMGSTORE="" WRITE ! GOTO CF4C "RTN","TMGRPC1D",147,0) IF $$IsDir^TMGKERNL(TMGSTORE,TMGDIV)=1 GOTO CF4D "RTN","TMGRPC1D",148,0) WRITE "ERROR: Path specified is not valid. Does folder exist?",!,! "RTN","TMGRPC1D",149,0) GOTO CF4C "RTN","TMGRPC1D",150,0) ; "RTN","TMGRPC1D",151,0) CF4D ;"Next force field 1 (PHYSICAL REFERENCE) to be same as TMGDIV "RTN","TMGRPC1D",152,0) IF $PIECE($GET(^MAG(2005.2,LOCPTR,0)),"^",2)=TMGDIV GOTO CF4E "RTN","TMGRPC1D",153,0) SET DIK="^MAG(2005.2," "RTN","TMGRPC1D",154,0) SET DA=LOCPTR "RTN","TMGRPC1D",155,0) DO ^DIK ;"Kill prior entry. Leaves DIK and DA unchanged "RTN","TMGRPC1D",156,0) ;"Note: Input transform doesn't allow the value I put in here. "RTN","TMGRPC1D",157,0) SET $PIECE(^MAG(2005.2,LOCPTR,0),"^",2)=TMGDIV ;"NOTE!! Low-level write "RTN","TMGRPC1D",158,0) SET DIK(1)=1 ;"Field 1 = PHYSICAL REFERENCE "RTN","TMGRPC1D",159,0) DO EN^DIK ;"Reindex field, to populate crossrefences with new value. "RTN","TMGRPC1D",160,0) ; "RTN","TMGRPC1D",161,0) CF4E KILL TMGFDA,TMGMSG "RTN","TMGRPC1D",162,0) IF TMGSTORE'="" SET TMGFDA(2005.2,LOCPTR_",",22700)=TMGSTORE "RTN","TMGRPC1D",163,0) IF TMGNODIV=0 SET TMGFDA(2005.2,LOCPTR_",",22701)=TMGDIV "RTN","TMGRPC1D",164,0) IF TMGDROP'="" SET TMGFDA(2005.2,LOCPTR_",",22702)=TMGDROP "RTN","TMGRPC1D",165,0) IF $DATA(TMGFDA) DO FILE^DIE("K","TMGFDA","TMGMSG") "RTN","TMGRPC1D",166,0) IF $DATA(TMGMSG("DIERR")) DO GOTO ABORT "RTN","TMGRPC1D",167,0) . DO ShowDIERR^TMGDEBUG(.TMGMSG) "RTN","TMGRPC1D",168,0) WRITE !,"Done with configuration.",!,! "RTN","TMGRPC1D",169,0) DO TESTCFG "RTN","TMGRPC1D",170,0) GOTO CFDN "RTN","TMGRPC1D",171,0) ; "RTN","TMGRPC1D",172,0) ABORT WRITE "Aborting configuration process.",! "RTN","TMGRPC1D",173,0) WRITE "Try again later, using 'DO CONFIG^TMGRPC1D'",! "RTN","TMGRPC1D",174,0) CFDN QUIT "RTN","TMGRPC1D",175,0) ; "RTN","TMGRPC1D",176,0) ; "RTN","TMGRPC1D",177,0) TESTCFG ; "RTN","TMGRPC1D",178,0) ;"Purpose: Test configuration "RTN","TMGRPC1D",179,0) NEW LOCPTR SET LOCPTR=$$GETDEFNL^TMGRPC1C() "RTN","TMGRPC1D",180,0) IF LOCPTR'>0 DO QUIT "RTN","TMGRPC1D",181,0) . WRITE "ERROR: Can't find NETWORK LOCATION to use",! "RTN","TMGRPC1D",182,0) WRITE "Storage path: ",$$GETLOCFPATH^TMGRPC1C("/"),! "RTN","TMGRPC1D",183,0) NEW DROPPATH "RTN","TMGRPC1D",184,0) IF $$GETDROPPATH^TMGRPC1C(LOCPTR,.DROPPATH)=-1 DO QUIT "RTN","TMGRPC1D",185,0) . WRITE "ERROR: Unable to get Dropbox path",! "RTN","TMGRPC1D",186,0) WRITE "Dropbox path: ",DROPPATH,! "RTN","TMGRPC1D",187,0) QUIT "RTN","TMGRPC1D",188,0) ; "RTN","TMGRPC1D",189,0) PINST1 ; "RTN","TMGRPC1D",190,0) ;"Purpose: This is an entry point for POST-INSTALL routine for patch "RTN","TMGRPC1D",191,0) ;" TMG-CPRS-IMAGING*1.0*1 "RTN","TMGRPC1D",192,0) DO ENSUREAL^TMGRPC1B "RTN","TMGRPC1D",193,0) DO CONFIG "RTN","TMGRPC1D",194,0) QUIT "RTN","TMGRPC1D",195,0) ; "VER") 8.0^22.0 **END** **END**