Index: cprs/branches/GUI-config/KIDS Server patch/TMG_GUI_CONFIG-1-1.kid =================================================================== --- cprs/branches/GUI-config/KIDS Server patch/TMG_GUI_CONFIG-1-1.kid (revision 480) +++ (revision ) @@ -1,2516 +1,0 @@ -KIDS Distribution saved on Aug 20, 2008@19:39:18 -This patch supports the WorldVistA Config Utility GUI -**KIDS**:TMG-GUI-CONFIG*1.0*1^ - -**INSTALL NAME** -TMG-GUI-CONFIG*1.0*1 -"BLD",5421,0) -TMG-GUI-CONFIG*1.0*1^^0^3080820^n -"BLD",5421,1,0) -^^12^12^3080820^^ -"BLD",5421,1,1,0) -This will contain one source file (TMGRPC3.m) and RPC's -"BLD",5421,1,2,0) -to support the WorldVistA Config Utility (a Windows -"BLD",5421,1,3,0) -GUI client for performing Fileman tasks. -"BLD",5421,1,4,0) - -"BLD",5421,1,5,0) -Note, user will need to have the menu option: -"BLD",5421,1,6,0) - TMG RPC CONTEXT GUI_CONFIG -"BLD",5421,1,7,0) -added to their secondary menu to be authorized for use. -"BLD",5421,1,8,0) - -"BLD",5421,1,9,0) -Note: This utility will allow an authorized user to perform -"BLD",5421,1,10,0) -arbitrary Fileman writes, and could potentially cause -"BLD",5421,1,11,0) -significant problems. So careful consideration should be -"BLD",5421,1,12,0) -given to determining who can use this GUI utility. -"BLD",5421,4,0) -^9.64PA^^0 -"BLD",5421,"KRN",0) -^9.67PA^8989.52^19 -"BLD",5421,"KRN",.4,0) -.4 -"BLD",5421,"KRN",.401,0) -.401 -"BLD",5421,"KRN",.402,0) -.402 -"BLD",5421,"KRN",.403,0) -.403 -"BLD",5421,"KRN",.5,0) -.5 -"BLD",5421,"KRN",.84,0) -.84 -"BLD",5421,"KRN",3.6,0) -3.6 -"BLD",5421,"KRN",3.8,0) -3.8 -"BLD",5421,"KRN",9.2,0) -9.2 -"BLD",5421,"KRN",9.8,0) -9.8 -"BLD",5421,"KRN",9.8,"NM",0) -^9.68A^1^1 -"BLD",5421,"KRN",9.8,"NM",1,0) -TMGRPC3^^0^B43913 -"BLD",5421,"KRN",9.8,"NM","B","TMGRPC3",1) - -"BLD",5421,"KRN",19,0) -19 -"BLD",5421,"KRN",19,"NM",0) -^9.68A^1^1 -"BLD",5421,"KRN",19,"NM",1,0) -TMG RPC CONTEXT GUI_CONFIG^^0 -"BLD",5421,"KRN",19,"NM","B","TMG RPC CONTEXT GUI_CONFIG",1) - -"BLD",5421,"KRN",19.1,0) -19.1 -"BLD",5421,"KRN",101,0) -101 -"BLD",5421,"KRN",409.61,0) -409.61 -"BLD",5421,"KRN",771,0) -771 -"BLD",5421,"KRN",870,0) -870 -"BLD",5421,"KRN",8989.51,0) -8989.51 -"BLD",5421,"KRN",8989.52,0) -8989.52 -"BLD",5421,"KRN",8994,0) -8994 -"BLD",5421,"KRN",8994,"NM",0) -^9.68A^1^1 -"BLD",5421,"KRN",8994,"NM",1,0) -TMG CHANNEL^^0 -"BLD",5421,"KRN",8994,"NM","B","TMG CHANNEL",1) - -"BLD",5421,"KRN","B",.4,.4) - -"BLD",5421,"KRN","B",.401,.401) - -"BLD",5421,"KRN","B",.402,.402) - -"BLD",5421,"KRN","B",.403,.403) - -"BLD",5421,"KRN","B",.5,.5) - -"BLD",5421,"KRN","B",.84,.84) - -"BLD",5421,"KRN","B",3.6,3.6) - -"BLD",5421,"KRN","B",3.8,3.8) - -"BLD",5421,"KRN","B",9.2,9.2) - -"BLD",5421,"KRN","B",9.8,9.8) - -"BLD",5421,"KRN","B",19,19) - -"BLD",5421,"KRN","B",19.1,19.1) - -"BLD",5421,"KRN","B",101,101) - -"BLD",5421,"KRN","B",409.61,409.61) - -"BLD",5421,"KRN","B",771,771) - -"BLD",5421,"KRN","B",870,870) - -"BLD",5421,"KRN","B",8989.51,8989.51) - -"BLD",5421,"KRN","B",8989.52,8989.52) - -"BLD",5421,"KRN","B",8994,8994) - -"BLD",5421,"QUES",0) -^9.62^^ -"KRN",19,10090,-1) -0^1 -"KRN",19,10090,0) -TMG RPC CONTEXT GUI_CONFIG^GUIConfig 1.0.0.0^^B^^^^^^^^FP OF GREENEVILLE (TMG) -"KRN",19,10090,1,0) -^^2^2^3080720^^ -"KRN",19,10090,1,1,0) -This will be the context file for GUI_Config -"KRN",19,10090,1,2,0) -It will hold the list of all allowed RPC calls. -"KRN",19,10090,"RPC",0) -^19.05P^1^1 -"KRN",19,10090,"RPC",1,0) -TMG CHANNEL -"KRN",19,10090,"U") -GUICONFIG 1.0.0.0 -"KRN",8994,1785,-1) -0^1 -"KRN",8994,1785,0) -TMG CHANNEL^CHANNEL^TMGRPC3^2^^^^1^1 -"KRN",8994,1785,1,0) -^8994.01^2^2^3080805^^^ -"KRN",8994,1785,1,1,0) -This RPC will be used to pass multiple requests back -"KRN",8994,1785,1,2,0) -and forth from client to server -"KRN",8994,1785,2,0) -^8994.02A^1^1 -"KRN",8994,1785,2,1,0) -INPUT^3^^1^1 -"KRN",8994,1785,2,1,1,0) -^8994.021^2^2^3080805^^^ -"KRN",8994,1785,2,1,1,1,0) -This is the data array sent from client. -"KRN",8994,1785,2,1,1,2,0) -Format still to be decided. -"KRN",8994,1785,2,"B","INPUT",1) - -"KRN",8994,1785,2,"PARAMSEQ",1,1) - -"KRN",8994,1785,3,0) -^8994.03^3^3^3080805^^^ -"KRN",8994,1785,3,1,0) -This is the result array passed from server back to client. -"KRN",8994,1785,3,2,0) -Format still to be decided. -"KRN",8994,1785,3,3,0) -See documentation in CHANNEL^TMGRPC3 -"MBREQ") -0 -"ORD",16,8994) -8994;16;1;;;;;;;RPCDEL^XPDIA1 -"ORD",16,8994,0) -REMOTE PROCEDURE -"ORD",18,19) -19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA -"ORD",18,19,0) -OPTION -"QUES","XPF1",0) -Y -"QUES","XPF1","??") -^D REP^XPDH -"QUES","XPF1","A") -Shall I write over your |FLAG| File -"QUES","XPF1","B") -YES -"QUES","XPF1","M") -D XPF1^XPDIQ -"QUES","XPF2",0) -Y -"QUES","XPF2","??") -^D DTA^XPDH -"QUES","XPF2","A") -Want my data |FLAG| yours -"QUES","XPF2","B") -YES -"QUES","XPF2","M") -D XPF2^XPDIQ -"QUES","XPI1",0) -YO -"QUES","XPI1","??") -^D INHIBIT^XPDH -"QUES","XPI1","A") -Want KIDS to INHIBIT LOGONs during the install -"QUES","XPI1","B") -YES -"QUES","XPI1","M") -D XPI1^XPDIQ -"QUES","XPM1",0) -PO^VA(200,:EM -"QUES","XPM1","??") -^D MG^XPDH -"QUES","XPM1","A") -Enter the Coordinator for Mail Group '|FLAG|' -"QUES","XPM1","B") - -"QUES","XPM1","M") -D XPM1^XPDIQ -"QUES","XPO1",0) -Y -"QUES","XPO1","??") -^D MENU^XPDH -"QUES","XPO1","A") -Want KIDS to Rebuild Menu Trees Upon Completion of Install -"QUES","XPO1","B") -YES -"QUES","XPO1","M") -D XPO1^XPDIQ -"QUES","XPZ1",0) -Y -"QUES","XPZ1","??") -^D OPT^XPDH -"QUES","XPZ1","A") -Want to DISABLE Scheduled Options, Menu Options, and Protocols -"QUES","XPZ1","B") -YES -"QUES","XPZ1","M") -D XPZ1^XPDIQ -"QUES","XPZ2",0) -Y -"QUES","XPZ2","??") -^D RTN^XPDH -"QUES","XPZ2","A") -Want to MOVE routines to other CPUs -"QUES","XPZ2","B") -NO -"QUES","XPZ2","M") -D XPZ2^XPDIQ -"RTN") -1 -"RTN","TMGRPC3") -0^1^B43913 -"RTN","TMGRPC3",1,0) -TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08 -"RTN","TMGRPC3",2,0) - ;;1.0;TMG-LIB;**1**;07/20/08 -"RTN","TMGRPC3",3,0) - -"RTN","TMGRPC3",4,0) - ;"TMG RPC FUNCTIONS for a GUI config program -"RTN","TMGRPC3",5,0) - -"RTN","TMGRPC3",6,0) - ;"Kevin Toppenberg MD -"RTN","TMGRPC3",7,0) - ;"GNU Lesser General Public License (LGPL) applies -"RTN","TMGRPC3",8,0) - ;"7/20/08 -"RTN","TMGRPC3",9,0) - -"RTN","TMGRPC3",10,0) - ;"======================================================================= -"RTN","TMGRPC3",11,0) - ;" RPC -- Public Functions. -"RTN","TMGRPC3",12,0) - ;"======================================================================= -"RTN","TMGRPC3",13,0) - ;"CHANNEL(RESULT,INPUT) -- general purpose channel RPC from a GUI config program -"RTN","TMGRPC3",14,0) - -"RTN","TMGRPC3",15,0) - ;"======================================================================= -"RTN","TMGRPC3",16,0) - ;"PRIVATE API FUNCTIONS -"RTN","TMGRPC3",17,0) - ;"======================================================================= -"RTN","TMGRPC3",18,0) - ;"GetUserList(OutArray,param) -- fill list with users on the system. -"RTN","TMGRPC3",19,0) - ;"GetRecordsList(OutArray,param) -- fill list with records in file on the system -"RTN","TMGRPC3",20,0) - ;"GetOneUser(OutArray,IEN) -- Get one user's record -"RTN","TMGRPC3",21,0) - ;"GetOneRecord(OutArray,params) -- get one record in file -"RTN","TMGRPC3",22,0) - ;"ExtractFields(OutArray,TMGARRAY,Flag) -- convert output from GETS^DIQ into another format -"RTN","TMGRPC3",23,0) - ;"GetFileSubset(OutArray,params) -- return a subset of entries a file's .01 names -"RTN","TMGRPC3",24,0) - ;"GetSubRecsList(OutArray,params) -- Get all .01 sub record entries for a subfile -"RTN","TMGRPC3",25,0) - ;"PostData(OutArray,Data) -- Post Changes to database via Fileman -"RTN","TMGRPC3",26,0) - ;"QtTermUser(XUDA) -- quietly inactive a given user -"RTN","TMGRPC3",27,0) - ;"QtReactUser(TMGDA) -- launch quiet reactivation code -"RTN","TMGRPC3",28,0) - ;"GetEmptyEntry(OutArray,params) -- get stub entries for a file (typically a subfile) -"RTN","TMGRPC3",29,0) - ;"CloneUser(OutArray,params) -- replicate a record into a new record, including all subrecs. -"RTN","TMGRPC3",30,0) - ;"CloneRecord(OutArray,params) --- replicate a record into a new record, including all subrecs. -"RTN","TMGRPC3",31,0) - ;"GetHelpMsg(OutArray,param) -- retrieve the help message for a given field. -"RTN","TMGRPC3",32,0) - ;"StubNewRecord(File,NewValue,OutArray) -- create a stub entry in the file (200), to be filled in elsewhere -"RTN","TMGRPC3",33,0) - ;"GetIfWPField(OutArray,params) -- return if filenumber is a WP subfile -"RTN","TMGRPC3",34,0) - ;"GetWPField(OutArray,params) -- retrieve on word processing (WP) field entry -"RTN","TMGRPC3",35,0) - ;"PostWPField(OutArray,params,INPUT) -- store a word processing (WP) field entry -"RTN","TMGRPC3",36,0) - ;"RegPatient(OutArray,params) -- register a new patient into VistA, providing not already been registered. -"RTN","TMGRPC3",37,0) - ;"SrchPtExact(Array) -- search for a preexisting patient, using an exact search -"RTN","TMGRPC3",38,0) - ;"GetErrStr(ErrArray) -- convert a standard DIERR array into a string for output -"RTN","TMGRPC3",39,0) - -"RTN","TMGRPC3",40,0) - ;"======================================================================= -"RTN","TMGRPC3",41,0) - ;"======================================================================= -"RTN","TMGRPC3",42,0) - ;"Dependencies: -"RTN","TMGRPC3",43,0) - ;" No TMG* dependencies -"RTN","TMGRPC3",44,0) - -"RTN","TMGRPC3",45,0) - ;"======================================================================= -"RTN","TMGRPC3",46,0) - ;"======================================================================= -"RTN","TMGRPC3",47,0) - -"RTN","TMGRPC3",48,0) -CHANNEL(RESULT,INPUT) -"RTN","TMGRPC3",49,0) - ;"Purpose: This will be a general purpose channel RPC from a GUI config program -"RTN","TMGRPC3",50,0) - ;"Input: RESULT -- this is an OUT parameter, and it is always passed by reference -"RTN","TMGRPC3",51,0) - ;" INPUT -- this will be array of data sent from the GUI client. Defined below: -"RTN","TMGRPC3",52,0) - ;" -"RTN","TMGRPC3",53,0) - ;" INPUT("REQUEST")="cmd^params" Valid values for "cmd" are: -"RTN","TMGRPC3",54,0) - ;" "GET USER LIST" -"RTN","TMGRPC3",55,0) - ;" params: or NODISUSER -"RTN","TMGRPC3",56,0) - ;" "GET RECORDS LIST" -- get list of all .01 fields for file. -"RTN","TMGRPC3",57,0) - ;" params: FileNumber (e.g. 'GET RECORDS LIST^8989.3') -"RTN","TMGRPC3",58,0) - ;" "GET ONE USER" -"RTN","TMGRPC3",59,0) - ;" params: IEN (e.g. 'GET ONE USER^12345') -"RTN","TMGRPC3",60,0) - ;" "GET ONE RECORD" -"RTN","TMGRPC3",61,0) - ;" params: FileNum^IENS (e.g. 'GET ONE RECORD^200^73,') -"RTN","TMGRPC3",62,0) - ;" "GET ONE WP FIELD" -"RTN","TMGRPC3",63,0) - ;" params: FileNum^Field^IENS^ (e.g. 'GET ONE WP FIELD^200^2^73,') -"RTN","TMGRPC3",64,0) - ;" "FILE ENTRY SUBSET" -"RTN","TMGRPC3",65,0) - ;" params: FileNum^ListStartValue^direction^MaxCount(optional, def=44) -"RTN","TMGRPC3",66,0) - ;" "GET SUB RECS LIST" -- get all .01 sub record entries for a subfile -"RTN","TMGRPC3",67,0) - ;" params: SubFileNum^ParentIENS -"RTN","TMGRPC3",68,0) - ;" "POST DATA" -"RTN","TMGRPC3",69,0) - ;" params: (not used) -"RTN","TMGRPC3",70,0) - ;" INPUT(0)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue -"RTN","TMGRPC3",71,0) - ;" INPUT(1)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue -"RTN","TMGRPC3",72,0) - ;" ... (note: FieldName and oldValue are not used) -"RTN","TMGRPC3",73,0) - ;" "POST WP FIELD" -"RTN","TMGRPC3",74,0) - ;" params: FileNum^FieldNum^IENS (e.g. 'POST WP FIELD^200^2^73,') -"RTN","TMGRPC3",75,0) - ;" WP field itself is stored as follows: -"RTN","TMGRPC3",76,0) - ;" INPUT(0)=0TH line -"RTN","TMGRPC3",77,0) - ;" INPUT(1)=1st line -"RTN","TMGRPC3",78,0) - ;" INPUT(2)=2nd line -"RTN","TMGRPC3",79,0) - ;" ... -"RTN","TMGRPC3",80,0) - ;" Note: don't include INPUT("REQUEST") with text. -"RTN","TMGRPC3",81,0) - ;" "GET EMPTY ENTRY" -- getting stub entries for subfiles typically -"RTN","TMGRPC3",82,0) - ;" params: file entry (file or subfile number) -"RTN","TMGRPC3",83,0) - ;" "GET CURRENT USER NAME" -- return name of DUZ (current) user -"RTN","TMGRPC3",84,0) - ;" (params: not used) -"RTN","TMGRPC3",85,0) - ;" "CLONE USER" -"RTN","TMGRPC3",86,0) - ;" params: SourceIENS^New.01Value -"RTN","TMGRPC3",87,0) - ;" "CLONE RECORD" -"RTN","TMGRPC3",88,0) - ;" params: FileNum^SourceIENS^New.01Value -"RTN","TMGRPC3",89,0) - ;" "GET HELP MSG" -"RTN","TMGRPC3",90,0) - ;" params : FileNum^FieldNum^HelpType -"RTN","TMGRPC3",91,0) - ;" "IS WP FIELD" -"RTN","TMGRPC3",92,0) - ;" params: FileNum^FieldNum -"RTN","TMGRPC3",93,0) - ;" "GET ONE WP FIELD" -- retrieve on word processing (WP) field entry -"RTN","TMGRPC3",94,0) - ;" param -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^2^73,') -"RTN","TMGRPC3",95,0) - ;" "REGISTER PATIENT" -"RTN","TMGRPC3",96,0) - ;" param -- FieldNum1^FieldValue1^FieldNum2^FieldValue2^FieldNum3^FieldValue3^... -"RTN","TMGRPC3",97,0) - ;"Output: results of this function should be put into RESULTS array. -"RTN","TMGRPC3",98,0) - ;" For cmd: -"RTN","TMGRPC3",99,0) - ;" "GET USER LIST" -"RTN","TMGRPC3",100,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",101,0) - ;" RESULT(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N" -"RTN","TMGRPC3",102,0) - ;" RESULT(2)=Name^IEN^200^DISUSER -"RTN","TMGRPC3",103,0) - ;" etc ... -"RTN","TMGRPC3",104,0) - ;" "GET RECORDS LIST" -"RTN","TMGRPC3",105,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",106,0) - ;" RESULT(1)=.01Value^IEN^FileNum -"RTN","TMGRPC3",107,0) - ;" RESULT(2)=.01Value^IEN^FileNum -"RTN","TMGRPC3",108,0) - ;" etc ... -"RTN","TMGRPC3",109,0) - ;" "GET ONE USER" -"RTN","TMGRPC3",110,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",111,0) - ;" RESULT(1)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",112,0) - ;" RESULT(2)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",113,0) - ;" etc ... -"RTN","TMGRPC3",114,0) - ;" "GET ONE RECORD" -"RTN","TMGRPC3",115,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",116,0) - ;" RESULT(1)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",117,0) - ;" RESULT(2)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",118,0) - ;" ... -"RTN","TMGRPC3",119,0) - ;" "GET ONE WP FIELD" -"RTN","TMGRPC3",120,0) - ;" RESULT(0): "1^Success" or "-1^Message" -"RTN","TMGRPC3",121,0) - ;" RESULT(1) will contain Fileman error, if any -"RTN","TMGRPC3",122,0) - ;" - or to return WP array - -"RTN","TMGRPC3",123,0) - ;" RESULT(1)=1st line of text -"RTN","TMGRPC3",124,0) - ;" RESULT(2)=2nd line of text -"RTN","TMGRPC3",125,0) - ;" etc.. -"RTN","TMGRPC3",126,0) - ;" "FILE ENTRY SUBSET" -"RTN","TMGRPC3",127,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",128,0) - ;" RESULT(1)=Value -"RTN","TMGRPC3",129,0) - ;" RESULT(2)=Value -"RTN","TMGRPC3",130,0) - ;" etc ... -"RTN","TMGRPC3",131,0) - ;" "GET SUB RECS LIST" -"RTN","TMGRPC3",132,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",133,0) - ;" RESULT(1)=IEN^Value -"RTN","TMGRPC3",134,0) - ;" RESULT(2)=IEN^Value -"RTN","TMGRPC3",135,0) - ;" ... -"RTN","TMGRPC3",136,0) - ;" "POST DATA" -"RTN","TMGRPC3",137,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",138,0) - ;" RESULT(1)=Fileman message (long) (if generated) -"RTN","TMGRPC3",139,0) - ;" -or (if +1 etc values used)- -"RTN","TMGRPC3",140,0) - ;" RESULT(1)=+5^1234 <-- results of IEN array returned (+5 converted to record 1234) -"RTN","TMGRPC3",141,0) - ;" RESULT(2)=+3^2341 <-- results of IEN array returned (+3 converted to record 2341) -"RTN","TMGRPC3",142,0) - ;" ... -"RTN","TMGRPC3",143,0) - ;" "GET EMPTY ENTRY" -"RTN","TMGRPC3",144,0) - ;" RESULT(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",145,0) - ;" RESULT(1)=File^^FieldNum^^DDInfo... -"RTN","TMGRPC3",146,0) - ;" RESULT(2)=File^^FieldNum^^DDInfo... -"RTN","TMGRPC3",147,0) - ;" etc ... -"RTN","TMGRPC3",148,0) - ;" "GET CURRENT USER NAME" -- return name of DUZ (current) user -"RTN","TMGRPC3",149,0) - ;" RESULT(0)="1^Success^UserName" or "-1^Message" -"RTN","TMGRPC3",150,0) - ;" "CLONE USER" -"RTN","TMGRPC3",151,0) - ;" RESULT(0)="1^Success^NewIENS" or "-1^Message" -"RTN","TMGRPC3",152,0) - ;" RESULT(1)=Long Fileman message (if -1 error) -"RTN","TMGRPC3",153,0) - ;" "CLONE RECORD" -"RTN","TMGRPC3",154,0) - ;" RESULT(0)="1^Success^NewIENS" or "-1^Message" -"RTN","TMGRPC3",155,0) - ;" RESULT(1)=Fileman message (long) (if generated) -"RTN","TMGRPC3",156,0) - ;" "GET HELP MSG" -"RTN","TMGRPC3",157,0) - ;" RESULT(0)="1^Success^NewIENS" or "-1^Message" -"RTN","TMGRPC3",158,0) - ;" RESULT(1)=Fileman message (long) (if generated) -"RTN","TMGRPC3",159,0) - ;" "IS WP FIELD" -"RTN","TMGRPC3",160,0) - ;" RESULT(0)="1^Success^YES/NO" or "-1^Message" -"RTN","TMGRPC3",161,0) - ;" "YES" if is a WP subfile, otherwise "NO" -"RTN","TMGRPC3",162,0) - ;" RESULT(1)=Fileman message (long) (if generated) -"RTN","TMGRPC3",163,0) - ;" "REGISTER PATIENT" -"RTN","TMGRPC3",164,0) - ;" RESULT(0)="1^Success^NewIEN" or "-1^Message" -"RTN","TMGRPC3",165,0) - ;" RESULT(1)=Fileman message (long) (if generated) -"RTN","TMGRPC3",166,0) - -"RTN","TMGRPC3",167,0) - ;"Result: none -"RTN","TMGRPC3",168,0) - -"RTN","TMGRPC3",169,0) - new command,params -"RTN","TMGRPC3",170,0) - set command=$$TRIM^XLFSTR($$UP^XLFSTR($piece($get(INPUT("REQUEST")),"^",1))) -"RTN","TMGRPC3",171,0) - set params=$$UP^XLFSTR($piece($get(INPUT("REQUEST")),"^",2,199)) -"RTN","TMGRPC3",172,0) - set RESULT(0)="-1^No command requested." ;"default to error state. -"RTN","TMGRPC3",173,0) - if command="GET USER LIST" do -"RTN","TMGRPC3",174,0) - . do GetUserList(.RESULT,params) -"RTN","TMGRPC3",175,0) - if command="GET RECORDS LIST" do -"RTN","TMGRPC3",176,0) - . do GetRecordsList(.RESULT,params) -"RTN","TMGRPC3",177,0) - else if command="GET ONE USER" do -"RTN","TMGRPC3",178,0) - . do GetOneUser(.RESULT,params) -"RTN","TMGRPC3",179,0) - else if command="GET ONE RECORD" do -"RTN","TMGRPC3",180,0) - . do GetOneRecord(.RESULT,params) -"RTN","TMGRPC3",181,0) - else if command="FILE ENTRY SUBSET" do -"RTN","TMGRPC3",182,0) - . do GetFileSubset(.RESULT,params) -"RTN","TMGRPC3",183,0) - else if command="GET SUB RECS LIST" do -"RTN","TMGRPC3",184,0) - . do GetSubRecsList(.RESULT,params) -"RTN","TMGRPC3",185,0) - else if command="POST DATA" do -"RTN","TMGRPC3",186,0) - . kill INPUT("REQUEST") -"RTN","TMGRPC3",187,0) - . do PostData(.RESULT,.INPUT) -"RTN","TMGRPC3",188,0) - else if command="GET EMPTY ENTRY" do -"RTN","TMGRPC3",189,0) - . do GetEmptyEntry(.RESULT,params) -"RTN","TMGRPC3",190,0) - else if command="GET CURRENT USER NAME" do -"RTN","TMGRPC3",191,0) - . set RESULT(0)="1^Success^"_$piece($get(^VA(200,DUZ,0)),"^",1) -"RTN","TMGRPC3",192,0) - else if command="CLONE RECORD" do -"RTN","TMGRPC3",193,0) - . do CloneRecord(.RESULT,params) -"RTN","TMGRPC3",194,0) - else if command="CLONE USER" do -"RTN","TMGRPC3",195,0) - . do CloneUser(.RESULT,params) -"RTN","TMGRPC3",196,0) - else if command="GET HELP MSG" do -"RTN","TMGRPC3",197,0) - . do GetHelpMsg(.RESULT,params) -"RTN","TMGRPC3",198,0) - else if command="IS WP FIELD" do -"RTN","TMGRPC3",199,0) - . do GetIfWPField(.RESULT,params) -"RTN","TMGRPC3",200,0) - else if command="GET ONE WP FIELD" do -"RTN","TMGRPC3",201,0) - . do GetWPField(.RESULT,params) -"RTN","TMGRPC3",202,0) - else if command="POST WP FIELD" do -"RTN","TMGRPC3",203,0) - . kill INPUT("REQUEST") -"RTN","TMGRPC3",204,0) - . do PostWPField(.RESULT,params,.INPUT) -"RTN","TMGRPC3",205,0) - else if command="REGISTER PATIENT" do -"RTN","TMGRPC3",206,0) - . do RegPatient(.RESULT,params) -"RTN","TMGRPC3",207,0) - -"RTN","TMGRPC3",208,0) - -"RTN","TMGRPC3",209,0) - quit -"RTN","TMGRPC3",210,0) - -"RTN","TMGRPC3",211,0) - ;"======================================================================= -"RTN","TMGRPC3",212,0) - -"RTN","TMGRPC3",213,0) -GetUserList(OutArray,param) -"RTN","TMGRPC3",214,0) - ;"Purpose: to fill list with users on the system. -"RTN","TMGRPC3",215,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",216,0) - ;" param -- either "" or "NODISUSER" if not to return DISUSER=YES users -"RTN","TMGRPC3",217,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",218,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",219,0) - ;" OutArray(1)=Name^IEN^200^DISUSER DISUSER will be 1 for "Y" or 0 for "N" -"RTN","TMGRPC3",220,0) - ;" OutArray(2)=Name^IEN^200^DISUSER -"RTN","TMGRPC3",221,0) - ;"Results: none -"RTN","TMGRPC3",222,0) - -"RTN","TMGRPC3",223,0) - new onlyActive set onlyActive=($get(param)="NODISUSER") -"RTN","TMGRPC3",224,0) - new index set index=1 -"RTN","TMGRPC3",225,0) - new name set name="" -"RTN","TMGRPC3",226,0) - for set name=$order(^VA(200,"B",name)) quit:(name="") do -"RTN","TMGRPC3",227,0) - . new IEN set IEN="" -"RTN","TMGRPC3",228,0) - . for set IEN=$order(^VA(200,"B",name,IEN)) quit:(+IEN'>0) do -"RTN","TMGRPC3",229,0) - . . new disUser set disUser=$piece($get(^VA(200,IEN,0)),"^",7) -"RTN","TMGRPC3",230,0) - . . if onlyActive&disUser quit -"RTN","TMGRPC3",231,0) - . . new name set name=$piece($get(^VA(200,IEN,0)),"^",1) -"RTN","TMGRPC3",232,0) - . . set OutArray(index)=name_"^"_IEN_"^200^"_disUser -"RTN","TMGRPC3",233,0) - . . set index=index+1 -"RTN","TMGRPC3",234,0) - -"RTN","TMGRPC3",235,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",236,0) - -"RTN","TMGRPC3",237,0) - quit -"RTN","TMGRPC3",238,0) - -"RTN","TMGRPC3",239,0) -GetRecordsList(OutArray,param) -"RTN","TMGRPC3",240,0) - ;"Purpose: to fill list with records in file on the system. -"RTN","TMGRPC3",241,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",242,0) - ;" param -- Filenumber -"RTN","TMGRPC3",243,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",244,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",245,0) - ;" OutArray(1)=.01Value^IEN^FileNum -"RTN","TMGRPC3",246,0) - ;" OutArray(2)=.01Value^IEN^FileNum -"RTN","TMGRPC3",247,0) - ;"Results: none -"RTN","TMGRPC3",248,0) - -"RTN","TMGRPC3",249,0) - new index set index=1 -"RTN","TMGRPC3",250,0) - new name set name="" -"RTN","TMGRPC3",251,0) - new FileNum set FileNum=+$get(param) -"RTN","TMGRPC3",252,0) - if FileNum'>0 do goto GRLDone -"RTN","TMGRPC3",253,0) - . set OutArray(0)="-1^Valid file number not found" -"RTN","TMGRPC3",254,0) - new ref set ref=$get(^DIC(FileNum,0,"GL")) -"RTN","TMGRPC3",255,0) - set ref=$$CREF^DILF(ref) -"RTN","TMGRPC3",256,0) - if ref="" do goto GRLDone -"RTN","TMGRPC3",257,0) - . set OutArray(0)="-1^Unable to find global reference for file: "_FileNum -"RTN","TMGRPC3",258,0) - new loc,pce -"RTN","TMGRPC3",259,0) - set loc=$piece(^DD(FileNum,.01,0),"^",4) -"RTN","TMGRPC3",260,0) - set pce=$piece(loc,";",2) -"RTN","TMGRPC3",261,0) - set loc=$piece(loc,";",1) -"RTN","TMGRPC3",262,0) - for set name=$order(@ref@("B",name)) quit:(name="") do -"RTN","TMGRPC3",263,0) - . new IEN set IEN="" -"RTN","TMGRPC3",264,0) - . for set IEN=$order(@ref@("B",name,IEN)) quit:(+IEN'>0) do -"RTN","TMGRPC3",265,0) - . . new name set name=$piece($get(@ref@(IEN,loc)),"^",pce) -"RTN","TMGRPC3",266,0) - . . set OutArray(index)=name_"^"_IEN_"^"_FileNum -"RTN","TMGRPC3",267,0) - . . set index=index+1 -"RTN","TMGRPC3",268,0) - -"RTN","TMGRPC3",269,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",270,0) -GRLDone -"RTN","TMGRPC3",271,0) - quit -"RTN","TMGRPC3",272,0) - -"RTN","TMGRPC3",273,0) -GetOneUser(OutArray,IEN) -"RTN","TMGRPC3",274,0) - ;"Purpose: to get record of one user -"RTN","TMGRPC3",275,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",276,0) - ;" IEN -- the IEN in file 200 to get -"RTN","TMGRPC3",277,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",278,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",279,0) - ;" OutArray(1)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",280,0) - ;" OutArray(2)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",281,0) - ;"Note: the fields to return are decided HERE -"RTN","TMGRPC3",282,0) - ;"Results: none -"RTN","TMGRPC3",283,0) - -"RTN","TMGRPC3",284,0) - new IENS set IENS=+$get(IEN)_"," -"RTN","TMGRPC3",285,0) - do GetOneRecord(.OutArray,"200^"_IENS) -"RTN","TMGRPC3",286,0) - quit -"RTN","TMGRPC3",287,0) - -"RTN","TMGRPC3",288,0) - -"RTN","TMGRPC3",289,0) -GetOneRecord(OutArray,params) -"RTN","TMGRPC3",290,0) - ;"Purpose: to get one record in file -"RTN","TMGRPC3",291,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",292,0) - ;" params: File^IENS -"RTN","TMGRPC3",293,0) - ;" File -- the file or subfile to retrieve from -"RTN","TMGRPC3",294,0) - ;" IENS -- if File is a subfile, then IENS should be full IENS to get (e.g. '2,103,') -"RTN","TMGRPC3",295,0) - ;" if File is not a subfile, then IENS can be just IEN or IEN_"," -"RTN","TMGRPC3",296,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",297,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",298,0) - ;" OutArray(1)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",299,0) - ;" OutArray(2)=File^IENS^FieldNum^ExternalValue^DDInfo... -"RTN","TMGRPC3",300,0) - ;"Note: the fields to return are decided HERE -"RTN","TMGRPC3",301,0) - ;"Results: none -"RTN","TMGRPC3",302,0) - -"RTN","TMGRPC3",303,0) - set OutArray(0)="1^Success" ;"default to success -"RTN","TMGRPC3",304,0) - new TMGARRAY,TMGMSG -"RTN","TMGRPC3",305,0) - new ref set ref="TMGARRAY" -"RTN","TMGRPC3",306,0) - set params=$get(params) -"RTN","TMGRPC3",307,0) - new file set file=$piece(params,"^",1) -"RTN","TMGRPC3",308,0) - if +file'>0 do goto GORDone -"RTN","TMGRPC3",309,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",310,0) - new IENS set IENS=$piece(params,"^",2) -"RTN","TMGRPC3",311,0) - if IENS="" do goto GORDone -"RTN","TMGRPC3",312,0) - . set OutArray(0)="-1^No IENS supplied" -"RTN","TMGRPC3",313,0) - -"RTN","TMGRPC3",314,0) - do GETS^DIQ(file,IENS,"**","IE",ref,"TMGMSG") -"RTN","TMGRPC3",315,0) - -"RTN","TMGRPC3",316,0) - if $data(TMGMSG("DIERR")) do goto GORDone -"RTN","TMGRPC3",317,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",318,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",319,0) - -"RTN","TMGRPC3",320,0) - do ExtractFields(.OutArray,.TMGARRAY,"E") -"RTN","TMGRPC3",321,0) - -"RTN","TMGRPC3",322,0) -GORDone -"RTN","TMGRPC3",323,0) - quit -"RTN","TMGRPC3",324,0) - -"RTN","TMGRPC3",325,0) - -"RTN","TMGRPC3",326,0) -ExtractFields(OutArray,TMGARRAY,Flag) -"RTN","TMGRPC3",327,0) - ;"Purpose: convert output from GETS^DIQ into another format -"RTN","TMGRPC3",328,0) - -"RTN","TMGRPC3",329,0) - new index set index=1 -"RTN","TMGRPC3",330,0) - new file,field,IENS -"RTN","TMGRPC3",331,0) - set file="" -"RTN","TMGRPC3",332,0) - for set file=$order(TMGARRAY(file)) quit:(file="") do -"RTN","TMGRPC3",333,0) - . set IENS="" -"RTN","TMGRPC3",334,0) - . for set IENS=$order(TMGARRAY(file,IENS)) quit:(IENS="") do -"RTN","TMGRPC3",335,0) - . . set field=0 -"RTN","TMGRPC3",336,0) - . . for set field=$order(^DD(file,field)) quit:(+field'>0) do -"RTN","TMGRPC3",337,0) - . . . if $get(TMGARRAY(file,IENS,field,Flag))="" do -"RTN","TMGRPC3",338,0) - . . . . set TMGARRAY(file,IENS,field,Flag)="" -"RTN","TMGRPC3",339,0) - . . set field="" -"RTN","TMGRPC3",340,0) - . . for set field=$order(TMGARRAY(file,IENS,field)) quit:(field="") do -"RTN","TMGRPC3",341,0) - . . . new Value set Value=$get(TMGARRAY(file,IENS,field,Flag)) -"RTN","TMGRPC3",342,0) - . . . new DDInfo set DDInfo=$piece($get(^DD(file,field,0)),"^",1,4) -"RTN","TMGRPC3",343,0) - . . . if $piece(DDInfo,"^",2)["D" do ;"convert data format to one Delphi can use -"RTN","TMGRPC3",344,0) - . . . . if Flag="I" quit -"RTN","TMGRPC3",345,0) - . . . . new X set X=$get(TMGARRAY(file,IENS,field,"I")) -"RTN","TMGRPC3",346,0) - . . . . set Value=$$FMTE^XLFDT(X,5) -"RTN","TMGRPC3",347,0) - . . . set OutArray(index)=file_"^"_IENS_"^"_field_"^"_Value -"RTN","TMGRPC3",348,0) - . . . set OutArray(index)=OutArray(index)_"^"_DDInfo -"RTN","TMGRPC3",349,0) - . . . set index=index+1 -"RTN","TMGRPC3",350,0) - -"RTN","TMGRPC3",351,0) - quit -"RTN","TMGRPC3",352,0) - -"RTN","TMGRPC3",353,0) -GetFileSubset(OutArray,params) -"RTN","TMGRPC3",354,0) - ;"Purpose: to return a subset of entries a file's .01 names -"RTN","TMGRPC3",355,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",356,0) - ;" params -- FileNum^StartFrom^Direction^maxCount -"RTN","TMGRPC3",357,0) - ;" FileNum - filename file to traverse -"RTN","TMGRPC3",358,0) - ;" StartFrom -- text to $order() from -- OPTIONAL -"RTN","TMGRPC3",359,0) - ;" Direction -- $order(xx,Direction) direction (should be 1 or -1) -- OPTIONAL -"RTN","TMGRPC3",360,0) - ;" maxCt -- OPTIONAL -- the max number of entries to return. -"RTN","TMGRPC3",361,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",362,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",363,0) - ;" OutArray(1)=IEN^Value -"RTN","TMGRPC3",364,0) - ;" OutArray(2)=IEN^Value -"RTN","TMGRPC3",365,0) - ;" ... -"RTN","TMGRPC3",366,0) - ;"Results: none -"RTN","TMGRPC3",367,0) - ;"NOTE: does NOT work with sub files. -"RTN","TMGRPC3",368,0) - -"RTN","TMGRPC3",369,0) - new File set File=+$piece(params,"^",1) -"RTN","TMGRPC3",370,0) - if File'>0 do goto GFSDone -"RTN","TMGRPC3",371,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",372,0) - new From set From=$piece(params,"^",2) -"RTN","TMGRPC3",373,0) - new dir set dir=$piece(params,"^",3) -"RTN","TMGRPC3",374,0) - if dir'=-1 set dir=1 -"RTN","TMGRPC3",375,0) - new maxCt set maxCt=+$piece(params,"^",4) -"RTN","TMGRPC3",376,0) - if maxCt=0 set maxCt=44 -"RTN","TMGRPC3",377,0) - -"RTN","TMGRPC3",378,0) - new i set i=0 -"RTN","TMGRPC3",379,0) - new last set last="" -"RTN","TMGRPC3",380,0) - new prev set prev="" -"RTN","TMGRPC3",381,0) - new ref set ref=$get(^DIC(File,0,"GL")) -"RTN","TMGRPC3",382,0) - set ref=$$CREF^DILF(ref) ;"convert open --> closed reference -"RTN","TMGRPC3",383,0) - if ref="" do goto GFSDone -"RTN","TMGRPC3",384,0) - . set OutArray(0)="-1^Unable to obtain global ref for file #"_File -"RTN","TMGRPC3",385,0) - -"RTN","TMGRPC3",386,0) - for set From=$order(@ref@("B",From),dir) quit:(From="")!(i=maxCt) do -"RTN","TMGRPC3",387,0) - . new IEN set IEN="" -"RTN","TMGRPC3",388,0) - . for set IEN=$order(@ref@("B",From,IEN),dir) quit:(+IEN'>0) do -"RTN","TMGRPC3",389,0) - . . set i=i+1 -"RTN","TMGRPC3",390,0) - . . set OutArray(i)=IEN_"^"_$$GET1^DIQ(File,IEN_",",.01) -"RTN","TMGRPC3",391,0) - . . ;"set OutArray(i)=$$GET1^DIQ(File,IEN_",",.01) -"RTN","TMGRPC3",392,0) - -"RTN","TMGRPC3",393,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",394,0) -GFSDone -"RTN","TMGRPC3",395,0) - quit -"RTN","TMGRPC3",396,0) - -"RTN","TMGRPC3",397,0) - -"RTN","TMGRPC3",398,0) -GetSubRecsList(OutArray,params) -"RTN","TMGRPC3",399,0) - ;"Purpose: Get all .01 sub record entries for a subfile -"RTN","TMGRPC3",400,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",401,0) - ;" params -- SubFileNum^ParentIENS -"RTN","TMGRPC3",402,0) - ;" SubFileNum - Subfile Number to get list from. -"RTN","TMGRPC3",403,0) - ;" ParentIENS -- IENS for parent to get list from (e.g. "73," -"RTN","TMGRPC3",404,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",405,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",406,0) - ;" OutArray(1)=IEN^Value -"RTN","TMGRPC3",407,0) - ;" OutArray(2)=IEN^Value -"RTN","TMGRPC3",408,0) - ;" ... -"RTN","TMGRPC3",409,0) - ;"Results: none -"RTN","TMGRPC3",410,0) - -"RTN","TMGRPC3",411,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",412,0) - new subFile set subFile=+$piece(params,"^",1) -"RTN","TMGRPC3",413,0) - if subFile'>0 do goto GSRLDone -"RTN","TMGRPC3",414,0) - . set OutArray(0)="-1^No Subfile number supplied" -"RTN","TMGRPC3",415,0) - new ParentIENS set ParentIENS=$piece(params,"^",2) -"RTN","TMGRPC3",416,0) - if ParentIENS="" do goto GSRLDone -"RTN","TMGRPC3",417,0) - . set OutArray(0)="-1^No Parent IENS supplied" -"RTN","TMGRPC3",418,0) - new IENS set IENS=","_ParentIENS -"RTN","TMGRPC3",419,0) - -"RTN","TMGRPC3",420,0) - do LIST^DIC(subFile,IENS,,"PU","*",,,,,,"TMGMSG","TMGERR") -"RTN","TMGRPC3",421,0) - -"RTN","TMGRPC3",422,0) - if $data(TMGMSG("DIERR")) do goto GSRLDone -"RTN","TMGRPC3",423,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",424,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",425,0) - -"RTN","TMGRPC3",426,0) - new count set count=1 -"RTN","TMGRPC3",427,0) - new i set i=0 -"RTN","TMGRPC3",428,0) - for set i=$order(TMGMSG("DILIST",i)) quit:(+i'>0) do -"RTN","TMGRPC3",429,0) - . new oneEntry set oneEntry=$get(TMGMSG("DILIST",i,0)) -"RTN","TMGRPC3",430,0) - . if oneEntry="" quit -"RTN","TMGRPC3",431,0) - . new IEN set IEN=$piece(oneEntry,"^",1) -"RTN","TMGRPC3",432,0) - . set $piece(oneEntry,"^",1)=IEN_","_ParentIENS -"RTN","TMGRPC3",433,0) - . set OutArray(count)=oneEntry -"RTN","TMGRPC3",434,0) - . set count=count+1 -"RTN","TMGRPC3",435,0) - -"RTN","TMGRPC3",436,0) -GSRLDone -"RTN","TMGRPC3",437,0) - quit -"RTN","TMGRPC3",438,0) - -"RTN","TMGRPC3",439,0) - -"RTN","TMGRPC3",440,0) -PostData(OutArray,Data,Flag) -"RTN","TMGRPC3",441,0) - ;"Post Changes to database via Fileman -"RTN","TMGRPC3",442,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",443,0) - ;" Data -- Entries to be filed. Format: -"RTN","TMGRPC3",444,0) - ;" Data(0)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue -"RTN","TMGRPC3",445,0) - ;" Data(1)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue -"RTN","TMGRPC3",446,0) - ;" Data(2)=FileNum^IENS^FieldNum^FieldName^newValue^oldValue -"RTN","TMGRPC3",447,0) - ;" ... -"RTN","TMGRPC3",448,0) - ;" Note: FieldName, oldValue pieces are not used (optional) -"RTN","TMGRPC3",449,0) - ;" Flag -- OPTIONAL, "E" is default. Flag passed to FILE^DIE or UPDATE^DIE -"RTN","TMGRPC3",450,0) - ;" should be "E" or "I" -"RTN","TMGRPC3",451,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",452,0) - ;" OutArray(0)="1^Success" or "-1^Short Message" -"RTN","TMGRPC3",453,0) - ;" OutArray(1)=Fileman message (long) -"RTN","TMGRPC3",454,0) - ;" -or if new records added: -"RTN","TMGRPC3",455,0) - ;" OutArray(1)=5^1234 <-- results of IEN array returned (+5 converted to record 1234) -"RTN","TMGRPC3",456,0) - ;" OutArray(2)=3^2341 <-- results of IEN array returned (+3 converted to record 2341) -"RTN","TMGRPC3",457,0) - ;" ... -"RTN","TMGRPC3",458,0) - ;"Results: none -"RTN","TMGRPC3",459,0) - -"RTN","TMGRPC3",460,0) - new AVC set AVC=0 ;"AVC=AccessVerifyCode. Default to no change. -"RTN","TMGRPC3",461,0) - new InactUser,ReactUser -"RTN","TMGRPC3",462,0) - set Flag=$get(Flag,"E") -"RTN","TMGRPC3",463,0) - new i set i="" -"RTN","TMGRPC3",464,0) - new TMGFDA,TMGNEWFDA,TMGMSG,TMGIEN,DIC -"RTN","TMGRPC3",465,0) - new TMGintFDA -"RTN","TMGRPC3",466,0) - for set i=$order(Data(i)) quit:(i="") do -"RTN","TMGRPC3",467,0) - . new file,IENS,field,value,oneEntry -"RTN","TMGRPC3",468,0) - . new internalValue set internalValue=0 -"RTN","TMGRPC3",469,0) - . new continue set continue=0 -"RTN","TMGRPC3",470,0) - . set oneEntry=$get(Data(i)) -"RTN","TMGRPC3",471,0) - . set file=$piece(oneEntry,"^",1) -"RTN","TMGRPC3",472,0) - . set IENS=$piece(oneEntry,"^",2) -"RTN","TMGRPC3",473,0) - . set field=$piece(oneEntry,"^",3) -"RTN","TMGRPC3",474,0) - . set value=$piece(oneEntry,"^",5) -"RTN","TMGRPC3",475,0) - . if file=200 do -"RTN","TMGRPC3",476,0) - . . if field=2 do ;"2 = Access Code -"RTN","TMGRPC3",477,0) - . . . if IENS["+" do quit -"RTN","TMGRPC3",478,0) - . . . . set continue=1 -"RTN","TMGRPC3",479,0) - . . . . set OutArray(1)="Can't set Access code when first adding new user. Try again." -"RTN","TMGRPC3",480,0) - . . . ;"NOTICE: currently this code does NOT force code of certain length etc. -"RTN","TMGRPC3",481,0) - . . . ;"S Y=$$VCHK(XV2,XUH) Q:Y Y ;check for valid verify code, returns 0 (for OK), or 1^msg -"RTN","TMGRPC3",482,0) - . . . ;"set value=$$UP^XLFSTR(value) ;"access code must be upper case elh -"RTN","TMGRPC3",483,0) - . . . set value=$$EN^XUSHSH(value) ;"access code is supposed to be hashed first -"RTN","TMGRPC3",484,0) - . . . set AVC=1 ;"signal change -"RTN","TMGRPC3",485,0) - . . . set AVC("DA")=+IENS -"RTN","TMGRPC3",486,0) - . . . set internalValue=1 -"RTN","TMGRPC3",487,0) - . . else if field=11 do ;"11 = Verify Code -"RTN","TMGRPC3",488,0) - . . . if IENS["+" do quit -"RTN","TMGRPC3",489,0) - . . . . set continue=1 -"RTN","TMGRPC3",490,0) - . . . . set OutArray(1)="Can't set Verify code when first adding new user. Try again." -"RTN","TMGRPC3",491,0) - . . . ;"NOTICE: currently this code does NOT force code of certain length etc. -"RTN","TMGRPC3",492,0) - . . . ;"S Y=$$VCHK(XV2,XUH) Q:Y Y ;check for valid verify code, returns 0 (for OK), or 1^msg -"RTN","TMGRPC3",493,0) - . . . ;"set value=$$UP^XLFSTR(value) ;"verify code must be upper case elh -"RTN","TMGRPC3",494,0) - . . . set value=$$EN^XUSHSH(value) ;"verify code is supposed to be hashed first -"RTN","TMGRPC3",495,0) - . . . set AVC=1 ;"signal change -"RTN","TMGRPC3",496,0) - . . . set AVC("DA")=+IENS -"RTN","TMGRPC3",497,0) - . . . set internalValue=1 -"RTN","TMGRPC3",498,0) - . . else if field=7 do ;"7 = DISUSER Value should be 'YES' or 'NO' -"RTN","TMGRPC3",499,0) - . . . if IENS["+" do quit -"RTN","TMGRPC3",500,0) - . . . . set continue=1 -"RTN","TMGRPC3",501,0) - . . . . set OutArray(1)="Can't set DISUSER code when first adding new user. Try again." -"RTN","TMGRPC3",502,0) - . . . if value="YES" do -"RTN","TMGRPC3",503,0) - . . . . set TMGFDA(200,IENS,9.2)="NOW" ;"add 9.2 = termination date -"RTN","TMGRPC3",504,0) - . . . . set InactUser("DA")=+IENS -"RTN","TMGRPC3",505,0) - . . . if (value="NO")!(value="@") do -"RTN","TMGRPC3",506,0) - . . . . set TMGFDA(200,IENS,9.2)="@" ;"delete 9.2 = termination date -"RTN","TMGRPC3",507,0) - . . . . set TMGFDA(200,IENS,9.4)="@" ;"delete 9.4 = termination reason -"RTN","TMGRPC3",508,0) - . . . . set ReactUser("DA")=+IENS -"RTN","TMGRPC3",509,0) - . . else if field=3 do ;"3 = FILE MANAGER ACCESS CODE (i.e. @ etc) -"RTN","TMGRPC3",510,0) - . . . if value'["^" do -"RTN","TMGRPC3",511,0) - . . . . set $piece(^VA(200,+IENS,0),"^",4)=value ;"force value in with low-level write -"RTN","TMGRPC3",512,0) - . . . . set continue=1 -"RTN","TMGRPC3",513,0) - . if continue quit -"RTN","TMGRPC3",514,0) - . if IENS["+" do -"RTN","TMGRPC3",515,0) - . . set TMGNEWFDA(file,IENS,field)=value -"RTN","TMGRPC3",516,0) - . else do -"RTN","TMGRPC3",517,0) - . . if internalValue=1 set TMGintFDA(file,IENS,field)=value -"RTN","TMGRPC3",518,0) - . . else set TMGFDA(file,IENS,field)=value -"RTN","TMGRPC3",519,0) - -"RTN","TMGRPC3",520,0) - set OutArray(0)="1^Success" ;"default to success -"RTN","TMGRPC3",521,0) - if $data(TMGFDA) do -"RTN","TMGRPC3",522,0) - . do FILE^DIE(Flag_"K","TMGFDA","TMGMSG") -"RTN","TMGRPC3",523,0) - if $data(TMGMSG("DIERR")) do -"RTN","TMGRPC3",524,0) - . set OutArray(0)="-1^See Fileman message re posting" -"RTN","TMGRPC3",525,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG)_";"_$get(OutArray(1)) -"RTN","TMGRPC3",526,0) - -"RTN","TMGRPC3",527,0) - if $data(TMGintFDA) do ;"process FDA with INTERNAL values -"RTN","TMGRPC3",528,0) - . do FILE^DIE("K","TMGintFDA","TMGMSG") -"RTN","TMGRPC3",529,0) - if $data(TMGMSG("DIERR")) do -"RTN","TMGRPC3",530,0) - . set OutArray(0)="-1^See Fileman message re posting" -"RTN","TMGRPC3",531,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG)_";"_$get(OutArray(1)) -"RTN","TMGRPC3",532,0) - -"RTN","TMGRPC3",533,0) - if $data(TMGNEWFDA) do -"RTN","TMGRPC3",534,0) - . do UPDATE^DIE(Flag_"K","TMGNEWFDA","TMGIEN","TMGMSG") -"RTN","TMGRPC3",535,0) - if $data(TMGMSG("DIERR")) do -"RTN","TMGRPC3",536,0) - . set OutArray(0)="-1^See Fileman message re posting" -"RTN","TMGRPC3",537,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG)_";"_$get(OutArray(1)) -"RTN","TMGRPC3",538,0) - -"RTN","TMGRPC3",539,0) - if ($piece(OutArray(0),"^",1)=1)&($data(TMGIEN)) do -"RTN","TMGRPC3",540,0) - . new count set count=1 -"RTN","TMGRPC3",541,0) - . new i set i="" -"RTN","TMGRPC3",542,0) - . for set i=$order(TMGIEN(i)) quit:(i="") do -"RTN","TMGRPC3",543,0) - . . set OutArray(count)=i_"^"_$get(TMGIEN(i)) -"RTN","TMGRPC3",544,0) - . . set count=count+1 -"RTN","TMGRPC3",545,0) - -"RTN","TMGRPC3",546,0) - ;"If Access code / Verify code changed, then finish some follow up business -"RTN","TMGRPC3",547,0) - ;" as per BRCVC^XUS2<--CVC^XUSRB<--called by RPC 'XUS CVC' -"RTN","TMGRPC3",548,0) - if AVC do -"RTN","TMGRPC3",549,0) - . new DA set DA=AVC("DA") -"RTN","TMGRPC3",550,0) - . do CALL^XUSERP(DA,2) ;"Call for Kernel Create, **Update**, Disuser or Terminate events -"RTN","TMGRPC3",551,0) - . ;"The above sets Taskman job -->DEQUE^XUSERP--> --> D HL7^ALPBGEN -"RTN","TMGRPC3",552,0) - -"RTN","TMGRPC3",553,0) - if $data(InactUser) do ;"Finish up inactivating user with VistA code -"RTN","TMGRPC3",554,0) - . new result -"RTN","TMGRPC3",555,0) - . set result=$$QtTermUser(InactUser("DA")) ;"finish termination of user code -"RTN","TMGRPC3",556,0) - . if +result'=0 do -"RTN","TMGRPC3",557,0) - . . set OutArray(0)="-1^See Fileman message re terminating user" -"RTN","TMGRPC3",558,0) - . . set OutArray(1)=OutArray(1)_";"_result -"RTN","TMGRPC3",559,0) - -"RTN","TMGRPC3",560,0) - if $data(ReactUser) do ;"finish up reactivating user with VistA code -"RTN","TMGRPC3",561,0) - . new result -"RTN","TMGRPC3",562,0) - . set result=$$QtReactUser(ReactUser("DA")) ;"launch quiet reactivation code -"RTN","TMGRPC3",563,0) - . if +result'=0 do -"RTN","TMGRPC3",564,0) - . . set OutArray(0)="-1^See Fileman message re reactivating user" -"RTN","TMGRPC3",565,0) - . . set OutArray(1)=OutArray(1)_";"_result -"RTN","TMGRPC3",566,0) - -"RTN","TMGRPC3",567,0) - quit -"RTN","TMGRPC3",568,0) - -"RTN","TMGRPC3",569,0) - -"RTN","TMGRPC3",570,0) -QtTermUser(XUDA) -"RTN","TMGRPC3",571,0) - ;"Purpose: to quietly inactive a given user -"RTN","TMGRPC3",572,0) - ;" I traced through menu option XUSERDEACT --> XUSTERM to create below -"RTN","TMGRPC3",573,0) - ;"Input: XUDA -- the IEN in 200 of user to inactivate -"RTN","TMGRPC3",574,0) - ;"Note: based on code from XUSTERM -"RTN","TMGRPC3",575,0) - ;"Results: 0 = OK, or 1^message if error -"RTN","TMGRPC3",576,0) - -"RTN","TMGRPC3",577,0) - new result set result=0 -"RTN","TMGRPC3",578,0) - new TMGFDA,TMGMSG,XUDT,DIC -"RTN","TMGRPC3",579,0) - set TMGFDA(200,+XUDA_",",9.2)="NOW" -"RTN","TMGRPC3",580,0) - do FILE^DIE("EK","TMGFDA","TMGMSG") -"RTN","TMGRPC3",581,0) - if $data(TMGMSG("DIERR")) do goto QTUDone -"RTN","TMGRPC3",582,0) - . set result="1^"_$$GetErrStr(.TMGMSG)_";"_$get(OutArray(1)) -"RTN","TMGRPC3",583,0) - set XUDT=$P(^VA(200,+XUDA,0),"^",11) ;" field 9.2 termination date -"RTN","TMGRPC3",584,0) - do GET^XUSTERM ;"load up info about mail, mailboxes, keys ? needed ? -"RTN","TMGRPC3",585,0) - set ZTDTH=XUDT ;"Task Start time. VA FileMan or $HOROLOG format -"RTN","TMGRPC3",586,0) - set ZTRTN="DQ1^XUSTERM1" ;"routine to be fired -"RTN","TMGRPC3",587,0) - set ZTDESC="DEACTIVATE USER" ;"description -"RTN","TMGRPC3",588,0) - set ZTSAVE("XUDA")="" ;"save variable XUDA for use in task -"RTN","TMGRPC3",589,0) - set ZTIO="" ;"no IO device needed -"RTN","TMGRPC3",590,0) - do ^%ZTLOAD ;"que a taskman task -"RTN","TMGRPC3",591,0) -QTUDone -"RTN","TMGRPC3",592,0) - quit result -"RTN","TMGRPC3",593,0) - -"RTN","TMGRPC3",594,0) - -"RTN","TMGRPC3",595,0) -QtReactUser(TMGDA) -"RTN","TMGRPC3",596,0) - ;"Purpose: launch quiet reactivation code -"RTN","TMGRPC3",597,0) - ;" I traced through menu option XUSERREACT --> REACT^XUSERNEW to create below -"RTN","TMGRPC3",598,0) - ;"Input: TMGDA -- the IEN in 200 to be reactivated -"RTN","TMGRPC3",599,0) - ;"Results: 0 if OK, or 1^ErrMsg -"RTN","TMGRPC3",600,0) - ;"NOTE: when user is deleated through VistA code, the access and verify codes -"RTN","TMGRPC3",601,0) - ;" are deleted. This function does NOT replace these. -"RTN","TMGRPC3",602,0) - -"RTN","TMGRPC3",603,0) - new result set result=0 -"RTN","TMGRPC3",604,0) - new TMGFDA,TMGMSG,DIC -"RTN","TMGRPC3",605,0) - set TMGFDA(200,TMGDA_",",9.2)="@" ;"Clear the Termination date -"RTN","TMGRPC3",606,0) - do FILE^DIE("EK","TMGFDA","TMGMSG") ;"Post data -"RTN","TMGRPC3",607,0) - if $data(TMGMSG("DIERR")) do goto QRUDone -"RTN","TMGRPC3",608,0) - . set result="1^"_$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",609,0) - -"RTN","TMGRPC3",610,0) - K XMZ ;" if null, then user can access old mail. -"RTN","TMGRPC3",611,0) - S Y=TMGDA ;"set user to work on. -"RTN","TMGRPC3",612,0) - D NEW^XM ;"mailman driver -- create a mailbox for user Y -"RTN","TMGRPC3",613,0) - -"RTN","TMGRPC3",614,0) - if +$piece($get(^VA(200,TMGDA,201)),"^",1)'>0 do ;"201;1 = PRIMARY MENU OPTION (#201) -"RTN","TMGRPC3",615,0) - . set TMGFDA(200,TMGDA_",",201)="EVE" ;"set default primary menu to EVE (high level!) -"RTN","TMGRPC3",616,0) - . do FILE^DIE("EK","TMGFDA","TMGMSG") -"RTN","TMGRPC3",617,0) - . if $data(TMGMSG("DIERR")) do -"RTN","TMGRPC3",618,0) - . . set result="1^"_$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",619,0) - if +result>0 goto QRUDone -"RTN","TMGRPC3",620,0) - -"RTN","TMGRPC3",621,0) - K XMDT,XMM,XMZ -"RTN","TMGRPC3",622,0) - D REACT^XQ84(TMGDA) ;"See if this user's menu trees need to be rebuilt -"RTN","TMGRPC3",623,0) -QRUDone -"RTN","TMGRPC3",624,0) - Q result -"RTN","TMGRPC3",625,0) - -"RTN","TMGRPC3",626,0) - -"RTN","TMGRPC3",627,0) -GetEmptyEntry(OutArray,params) -"RTN","TMGRPC3",628,0) - ;"Purpose: to get stub entries for a file (typically a subfile) -"RTN","TMGRPC3",629,0) - ;" "GET EMPTY ENTRY" -- getting stub entries for subfiles typically -"RTN","TMGRPC3",630,0) - ;" params: file entry (file or subfile number) -"RTN","TMGRPC3",631,0) - ;"Input: OutArray --an OUT ARRAY, filled as follows: -"RTN","TMGRPC3",632,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",633,0) - ;" OutArray(1)=File^^FieldNum^^DDInfo... -"RTN","TMGRPC3",634,0) - ;" OutArray(2)=File^^FieldNum^^DDInfo... -"RTN","TMGRPC3",635,0) - ;" Etc ... -"RTN","TMGRPC3",636,0) - ;" Params: filenumber (typically a subfilenumber) -"RTN","TMGRPC3",637,0) - ;"Result: None -"RTN","TMGRPC3",638,0) - -"RTN","TMGRPC3",639,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",640,0) - new count set count=1 -"RTN","TMGRPC3",641,0) - new fileNum set fileNum=+$get(params) -"RTN","TMGRPC3",642,0) - new fieldNum set fieldNum=0 -"RTN","TMGRPC3",643,0) - for set fieldNum=$order(^DD(fileNum,fieldNum)) quit:(+fieldNum'>0) do -"RTN","TMGRPC3",644,0) - . new DDInfo set DDInfo=$piece($get(^DD(fileNum,fieldNum,0)),"^",1,4) -"RTN","TMGRPC3",645,0) - . set OutArray(count)=fileNum_"^^"_fieldNum_"^^"_DDInfo -"RTN","TMGRPC3",646,0) - . set count=count+1 -"RTN","TMGRPC3",647,0) - -"RTN","TMGRPC3",648,0) - quit -"RTN","TMGRPC3",649,0) - -"RTN","TMGRPC3",650,0) - -"RTN","TMGRPC3",651,0) -CloneUser(OutArray,params) -"RTN","TMGRPC3",652,0) - ;"Purpose: to replicate a record into a new record, including all subrecs. -"RTN","TMGRPC3",653,0) - ;" Implementation of "CLONE RECORD" request -"RTN","TMGRPC3",654,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",655,0) - ;" params -- SourceIENS^New.01Value -"RTN","TMGRPC3",656,0) - ;" FileNum - filename file that is to be worked in -"RTN","TMGRPC3",657,0) - ;" SourceIENS -- source IENS for new record, (i.e. '123,' not '123') -"RTN","TMGRPC3",658,0) - ;" New.01Value -- new value to be put into the .01 field (to distinguish it from the old record) -"RTN","TMGRPC3",659,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",660,0) - ;" OutArray(0)="1^Success^NewIENS" or "-1^Message" -"RTN","TMGRPC3",661,0) - ;" OutArray(1)=Long Fileman message (if -1 error) -"RTN","TMGRPC3",662,0) - -"RTN","TMGRPC3",663,0) - set params="200^"_params -"RTN","TMGRPC3",664,0) - do CloneRecord(.OutArray,params) -"RTN","TMGRPC3",665,0) - new TMGFDA,TMGMSG -"RTN","TMGRPC3",666,0) - if +OutArray(0)'=1 goto CUDone -"RTN","TMGRPC3",667,0) - new newIEN,newIENS -"RTN","TMGRPC3",668,0) - set newIEN=+$piece(OutArray(0),"^",3) -"RTN","TMGRPC3",669,0) - if newIEN="" do goto CUDone -"RTN","TMGRPC3",670,0) - . set OutArray(0)="-1^Can't find IEN of added record" -"RTN","TMGRPC3",671,0) - -"RTN","TMGRPC3",672,0) - ;"Set new user to inactive (needs editing before it is active) -"RTN","TMGRPC3",673,0) - new data -"RTN","TMGRPC3",674,0) - set data(0)="200^"_newIEN_",^7^^YES" -"RTN","TMGRPC3",675,0) - do PostData(.OutArray,.data,"E") -"RTN","TMGRPC3",676,0) - if +OutArray(0)=1 set $piece(OutArray(0),"^",3)=newIEN -"RTN","TMGRPC3",677,0) - -"RTN","TMGRPC3",678,0) -CUDone -"RTN","TMGRPC3",679,0) - quit -"RTN","TMGRPC3",680,0) - -"RTN","TMGRPC3",681,0) -CloneRecord(OutArray,params) -"RTN","TMGRPC3",682,0) - ;"Purpose: to replicate a record into a new record, including all subrecs. -"RTN","TMGRPC3",683,0) - ;" Implementation of "CLONE RECORD" request -"RTN","TMGRPC3",684,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",685,0) - ;" params -- FileNum^SourceIENS^New.01Value -"RTN","TMGRPC3",686,0) - ;" FileNum - filename file that is to be worked in -"RTN","TMGRPC3",687,0) - ;" SourceIENS -- the source IENS for the new record, (i.e. 123, not 123) -"RTN","TMGRPC3",688,0) - ;" New.01Value -- the new value to be put into the .01 field (to distinguish it from the old record) -"RTN","TMGRPC3",689,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",690,0) - ;" OutArray(0)="1^Success^NewIENS" or "-1^Message" -"RTN","TMGRPC3",691,0) - ;" OutArray(1)=Long Fileman message (if -1 error) -"RTN","TMGRPC3",692,0) - ;"NOTE: This hasn't been tested on subfiles yet... -"RTN","TMGRPC3",693,0) - -"RTN","TMGRPC3",694,0) - new File,IENS,new01Value -"RTN","TMGRPC3",695,0) - set OutArray(0)="-1^Error" ;"default to error -"RTN","TMGRPC3",696,0) - -"RTN","TMGRPC3",697,0) - set File=+$piece(params,"^",1) -"RTN","TMGRPC3",698,0) - if File'>0 do goto CRDone -"RTN","TMGRPC3",699,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",700,0) - set IENS=$piece(params,"^",2) -"RTN","TMGRPC3",701,0) - if IENS="" do goto CRDone -"RTN","TMGRPC3",702,0) - . set OutArray(0)="-1^IENS supplied" -"RTN","TMGRPC3",703,0) - if +IENS=IENS do -"RTN","TMGRPC3",704,0) - . if IENS'["," set IENS=IENS_"," -"RTN","TMGRPC3",705,0) - set new01Value=$piece(params,"^",3) -"RTN","TMGRPC3",706,0) - if new01Value="" do goto CRDone -"RTN","TMGRPC3",707,0) - . set OutArray(0)="-1^No new value supplied for .01 value" -"RTN","TMGRPC3",708,0) - -"RTN","TMGRPC3",709,0) - new oldRec,TMGARRAY,TMGMSG,TMGTEMP -"RTN","TMGRPC3",710,0) - new ref set ref="TMGARRAY" -"RTN","TMGRPC3",711,0) - -"RTN","TMGRPC3",712,0) - do StubNewRecord(File,new01Value,.OutArray) -"RTN","TMGRPC3",713,0) - if +OutArray(0)'=1 do goto CRDone -"RTN","TMGRPC3",714,0) - . set $piece(OutArray(0),"^",2)="Unable to stub in new record. "_$piece(OutArray(0),"^",2) -"RTN","TMGRPC3",715,0) - new newIEN set newIEN=$piece(OutArray(0),"^",3) -"RTN","TMGRPC3",716,0) - ;"Write "The IENS of the new record is: ",newIEN,! ;"TEMP!!! -"RTN","TMGRPC3",717,0) - -"RTN","TMGRPC3",718,0) - ;"Note: Using a "X" flag is VERY slow, because it reindexes -"RTN","TMGRPC3",719,0) - ;" ALL XREFS for ALL entries in file (e.g. 60 seconds) -"RTN","TMGRPC3",720,0) - ;"do TRNMRG^TMGDIT("M",File,File,IENS,newIEN_",") ;"do actual record copy. -"RTN","TMGRPC3",721,0) - do TRNMRG^DIT("M",File,File,IENS,newIEN_",") ;"do actual record copy. -"RTN","TMGRPC3",722,0) - new DA,DIK -"RTN","TMGRPC3",723,0) - set DIK=$get(^DIC(File,0,"GL")) -"RTN","TMGRPC3",724,0) - set DA=newIEN -"RTN","TMGRPC3",725,0) - if (+DA>0)&(DIK'="") do IX1^DIK ;"index just the new record -"RTN","TMGRPC3",726,0) - -"RTN","TMGRPC3",727,0) - ;"OK if we got this far (can't check error from TRNMRG) -"RTN","TMGRPC3",728,0) - set OutArray(0)="1^Success^"_newIEN -"RTN","TMGRPC3",729,0) - -"RTN","TMGRPC3",730,0) -CRDone quit -"RTN","TMGRPC3",731,0) - -"RTN","TMGRPC3",732,0) - -"RTN","TMGRPC3",733,0) -GetHelpMsg(OutArray,param) -"RTN","TMGRPC3",734,0) - ;"Purpose: to retrieve the help message for a given field. -"RTN","TMGRPC3",735,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",736,0) - ;" param -- file^field^HelpType -"RTN","TMGRPC3",737,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",738,0) - ;" OutArray(0)="1^Success" or "-1^Message" -"RTN","TMGRPC3",739,0) - ;" OutArray(1...?)=Help Message -"RTN","TMGRPC3",740,0) - -"RTN","TMGRPC3",741,0) - new TMGMSG -"RTN","TMGRPC3",742,0) - new index set index=1 -"RTN","TMGRPC3",743,0) - new File set File=+$piece(params,"^",1) -"RTN","TMGRPC3",744,0) - new Field set Field=+$piece(params,"^",2) -"RTN","TMGRPC3",745,0) - new HelpType set HelpType=$piece(params,"^",3) -"RTN","TMGRPC3",746,0) - if File'>0 do goto GHMDone -"RTN","TMGRPC3",747,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",748,0) - if Field'>0 do goto GHMDone -"RTN","TMGRPC3",749,0) - . set OutArray(0)="-1^No Field Number supplied" -"RTN","TMGRPC3",750,0) - do HELP^DIE(File,,Field,HelpType,"TMGMSG") -"RTN","TMGRPC3",751,0) - set i="" -"RTN","TMGRPC3",752,0) - for set i=$order(TMGMSG("DIHELP",i)) quit:(i="") do -"RTN","TMGRPC3",753,0) - . set OutArray(index)=TMGMSG("DIHELP",i) -"RTN","TMGRPC3",754,0) - . set index=index+1 -"RTN","TMGRPC3",755,0) - -"RTN","TMGRPC3",756,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",757,0) - -"RTN","TMGRPC3",758,0) -GHMDone -"RTN","TMGRPC3",759,0) - quit -"RTN","TMGRPC3",760,0) - -"RTN","TMGRPC3",761,0) - -"RTN","TMGRPC3",762,0) -StubNewRecord(File,NewValue,OutArray) -"RTN","TMGRPC3",763,0) - ;"Purpose: to create a stub entry in the file (200), to be filled in elsewhere -"RTN","TMGRPC3",764,0) - ;"Input: NewValue -- a value for the .01 field -"RTN","TMGRPC3",765,0) - ;" OutArray -- PASS BY REFERENCE, an OUT PARAMETER. -"RTN","TMGRPC3",766,0) - ;"Output: A new record will be added to file, if no errors -"RTN","TMGRPC3",767,0) - ;" OutArray(0): 1^Success^NewIEN or -1^See Fileman message -"RTN","TMGRPC3",768,0) - ;" OutArray(1) will contain Fileman error, if any -"RTN","TMGRPC3",769,0) - ;"Results: none -"RTN","TMGRPC3",770,0) - ;"NOTICE: This function makes no promise that the creation of the -"RTN","TMGRPC3",771,0) - ;" new record will succeed. For example, if there are required -"RTN","TMGRPC3",772,0) - ;" fields, the creation will fail. So users should check for success -"RTN","TMGRPC3",773,0) - ;" result and error feedback. -"RTN","TMGRPC3",774,0) - ;"Results: none -"RTN","TMGRPC3",775,0) - -"RTN","TMGRPC3",776,0) - new TMGFDA,TMGIEN,TMGMSG,DIC -"RTN","TMGRPC3",777,0) - set DIC(0)="" ;"I get a crash without this, for some reason... -"RTN","TMGRPC3",778,0) - set TMGFDA(File,"+1,",.01)=NewValue -"RTN","TMGRPC3",779,0) - do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") -"RTN","TMGRPC3",780,0) - -"RTN","TMGRPC3",781,0) - if $data(TMGMSG("DIERR")) do goto SNPDone -"RTN","TMGRPC3",782,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",783,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",784,0) - -"RTN","TMGRPC3",785,0) - set OutArray(0)="1^Success^"_$get(TMGIEN(1)) -"RTN","TMGRPC3",786,0) - -"RTN","TMGRPC3",787,0) -SNPDone -"RTN","TMGRPC3",788,0) - quit -"RTN","TMGRPC3",789,0) - -"RTN","TMGRPC3",790,0) - -"RTN","TMGRPC3",791,0) -GetIfWPField(OutArray,params) -"RTN","TMGRPC3",792,0) - ;"Purpose: to return if filenumber is a WP subfile -"RTN","TMGRPC3",793,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",794,0) - ;" param -- file^field -"RTN","TMGRPC3",795,0) - ;"Output: -"RTN","TMGRPC3",796,0) - ;" OutArray(0): "1^Success^YES/NO" or "-1^Message" -"RTN","TMGRPC3",797,0) - ;" "YES" if is a WP subfile, otherwise "NO" -"RTN","TMGRPC3",798,0) - ;" OutArray(1) will contain Fileman error, if any -"RTN","TMGRPC3",799,0) - ;"Results: none -"RTN","TMGRPC3",800,0) - -"RTN","TMGRPC3",801,0) - new result -"RTN","TMGRPC3",802,0) - new File set File=+$piece(params,"^",1) -"RTN","TMGRPC3",803,0) - new Field set Field=+$piece(params,"^",2) -"RTN","TMGRPC3",804,0) - if File'>0 do goto GWPSDone -"RTN","TMGRPC3",805,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",806,0) - if Field'>0 do goto GWPSDone -"RTN","TMGRPC3",807,0) - . set OutArray(0)="-1^No Field Number supplied" -"RTN","TMGRPC3",808,0) - -"RTN","TMGRPC3",809,0) - do FIELD^DID(File,Field,"","TYPE","TMGARRAY","TMGMSG") -"RTN","TMGRPC3",810,0) - -"RTN","TMGRPC3",811,0) - if $data(TMGMSG("DIERR")) do goto GWPSDone -"RTN","TMGRPC3",812,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",813,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",814,0) - -"RTN","TMGRPC3",815,0) - if $get(TMGARRAY("TYPE"))="WORD-PROCESSING" do -"RTN","TMGRPC3",816,0) - . set result="YES" -"RTN","TMGRPC3",817,0) - else do -"RTN","TMGRPC3",818,0) - . set result="NO" -"RTN","TMGRPC3",819,0) - -"RTN","TMGRPC3",820,0) - set OutArray(0)="1^Success^"_result -"RTN","TMGRPC3",821,0) - -"RTN","TMGRPC3",822,0) -GWPSDone -"RTN","TMGRPC3",823,0) - quit -"RTN","TMGRPC3",824,0) - -"RTN","TMGRPC3",825,0) - -"RTN","TMGRPC3",826,0) -GetWPField(OutArray,params) -"RTN","TMGRPC3",827,0) - ;"Purpose: To retrieve on word processing (WP) field entry -"RTN","TMGRPC3",828,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",829,0) - ;" param -- FileNum^Field^IENS (e.g. 'GET ONE WP FIELD^200^73,') -"RTN","TMGRPC3",830,0) - ;"Output: -"RTN","TMGRPC3",831,0) - ;" OutArray(0): "1^Success" or "-1^Message" -"RTN","TMGRPC3",832,0) - ;" OutArray(1) will contain Fileman error, if any -"RTN","TMGRPC3",833,0) - ;" - or to return WP array - -"RTN","TMGRPC3",834,0) - ;" OutArray(1)=1st line of text -"RTN","TMGRPC3",835,0) - ;" OutArray(2)=2nd line of text -"RTN","TMGRPC3",836,0) - ;" etc.. -"RTN","TMGRPC3",837,0) - ;"Results: None -"RTN","TMGRPC3",838,0) - -"RTN","TMGRPC3",839,0) - new File set File=+$piece(params,"^",1) -"RTN","TMGRPC3",840,0) - new Field set Field=+$piece(params,"^",2) -"RTN","TMGRPC3",841,0) - new IENS set IENS=+$piece(params,"^",3) -"RTN","TMGRPC3",842,0) - if File'>0 do goto GWPDone -"RTN","TMGRPC3",843,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",844,0) - if Field'>0 do goto GWPDone -"RTN","TMGRPC3",845,0) - . set OutArray(0)="-1^No Field Number supplied" -"RTN","TMGRPC3",846,0) - if IENS="" do goto GWPDone -"RTN","TMGRPC3",847,0) - . set OutArray(0)="-1^No IENS supplied" -"RTN","TMGRPC3",848,0) - -"RTN","TMGRPC3",849,0) - new temp -"RTN","TMGRPC3",850,0) - set temp=$$GET1^DIQ(File,IENS,Field,"","TMGARRAY","TMGMSG") -"RTN","TMGRPC3",851,0) - if $data(TMGMSG("DIERR")) do goto GWPDone -"RTN","TMGRPC3",852,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",853,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",854,0) - -"RTN","TMGRPC3",855,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",856,0) - new index,i -"RTN","TMGRPC3",857,0) - set i=0 -"RTN","TMGRPC3",858,0) - set index=1 -"RTN","TMGRPC3",859,0) - for set i=$order(TMGARRAY(i)) quit:(i="") do -"RTN","TMGRPC3",860,0) - . set OutArray(index)=TMGARRAY(i) -"RTN","TMGRPC3",861,0) - . set index=index+1 -"RTN","TMGRPC3",862,0) - -"RTN","TMGRPC3",863,0) -GWPDone -"RTN","TMGRPC3",864,0) - quit -"RTN","TMGRPC3",865,0) - -"RTN","TMGRPC3",866,0) - -"RTN","TMGRPC3",867,0) -PostWPField(OutArray,params,INPUT) -"RTN","TMGRPC3",868,0) - ;"Purpose: To store a word processing (WP) field entry -"RTN","TMGRPC3",869,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",870,0) - ;" param -- FileNum^FieldNum^IENS (e.g. 'GET ONE WP FIELD^200^73,') -"RTN","TMGRPC3",871,0) - ;" INPUT -- holds the WP itself to be stored: -"RTN","TMGRPC3",872,0) - ;" INPUT(0)=0TH line -"RTN","TMGRPC3",873,0) - ;" INPUT(1)=1st line -"RTN","TMGRPC3",874,0) - ;" INPUT(2)=2nd line -"RTN","TMGRPC3",875,0) - ;" ... -"RTN","TMGRPC3",876,0) - ;"Output: -"RTN","TMGRPC3",877,0) - ;" OutArray(0): "1^Success" or "-1^Message" -"RTN","TMGRPC3",878,0) - ;" OutArray(1) will contain Fileman error, if any -"RTN","TMGRPC3",879,0) - ;"Results: None -"RTN","TMGRPC3",880,0) - -"RTN","TMGRPC3",881,0) - new File set File=+$piece(params,"^",1) -"RTN","TMGRPC3",882,0) - new Field set Field=+$piece(params,"^",2) -"RTN","TMGRPC3",883,0) - new IENS set IENS=+$piece(params,"^",3) -"RTN","TMGRPC3",884,0) - if File'>0 do goto PWPDone -"RTN","TMGRPC3",885,0) - . set OutArray(0)="-1^No file number supplied" -"RTN","TMGRPC3",886,0) - if Field'>0 do goto PWPDone -"RTN","TMGRPC3",887,0) - . set OutArray(0)="-1^No Field Number supplied" -"RTN","TMGRPC3",888,0) - if IENS="" do goto PWPDone -"RTN","TMGRPC3",889,0) - . set OutArray(0)="-1^No IENS supplied" -"RTN","TMGRPC3",890,0) - if $length(IENS,",")=1 set IENS=IENS_"," -"RTN","TMGRPC3",891,0) - -"RTN","TMGRPC3",892,0) - do WP^DIE(File,IENS,Field,"K","INPUT","TMGMSG") -"RTN","TMGRPC3",893,0) - -"RTN","TMGRPC3",894,0) - if $data(TMGMSG("DIERR")) do goto GWPDone -"RTN","TMGRPC3",895,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",896,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",897,0) - -"RTN","TMGRPC3",898,0) - set OutArray(0)="1^Success" -"RTN","TMGRPC3",899,0) - -"RTN","TMGRPC3",900,0) -PWPDone -"RTN","TMGRPC3",901,0) - quit -"RTN","TMGRPC3",902,0) - -"RTN","TMGRPC3",903,0) - -"RTN","TMGRPC3",904,0) -RegPatient(OutArray,params) -"RTN","TMGRPC3",905,0) - ;"Purpose: to register a new patient into VistA, providing that they have not -"RTN","TMGRPC3",906,0) - ;" already been registered. -"RTN","TMGRPC3",907,0) - ;"Note: The search for preexisting records is exact, meaning that DOE,JOHN -"RTN","TMGRPC3",908,0) - ;" would be considered different from DOE,JOHN H -"RTN","TMGRPC3",909,0) - ;"Input: OutArray -- an OUT PARAMETER, PASS BY REFERENCE. -"RTN","TMGRPC3",910,0) - ;" param -- FieldNum1^FieldValue1^FieldNum2^FieldValue2^FieldNum3^FieldValue3^... -"RTN","TMGRPC3",911,0) - ;" NOTE: Because I want to be able to specify here the HealthRecordNumber (HRN), -"RTN","TMGRPC3",912,0) - ;" even though it is not truly a field in the PATIENT file, I am going -"RTN","TMGRPC3",913,0) - ;" to manually allow a field of '0' (HRN) to be specified as a FieldNumber -"RTN","TMGRPC3",914,0) - ;"Output: OutArray is filled as follows: -"RTN","TMGRPC3",915,0) - ;" OutArray(0)="1^Success^NewIEN" or "-1^Message" -"RTN","TMGRPC3",916,0) - ;" OutArray(1)=Long Fileman message (if -1 error) -"RTN","TMGRPC3",917,0) - -"RTN","TMGRPC3",918,0) - new array -"RTN","TMGRPC3",919,0) - for do quit:($length(params,"^"))<2 -"RTN","TMGRPC3",920,0) - . new pair,field,value -"RTN","TMGRPC3",921,0) - . set pair=$piece(params,"^",1,2) -"RTN","TMGRPC3",922,0) - . set field=$piece(pair,"^",1) -"RTN","TMGRPC3",923,0) - . set value=$piece(pair,"^",2) -"RTN","TMGRPC3",924,0) - . set params=$extract(params,$length(pair)+2,999) -"RTN","TMGRPC3",925,0) - . if (field="")!(value="") quit -"RTN","TMGRPC3",926,0) - . set array(field)=value -"RTN","TMGRPC3",927,0) - -"RTN","TMGRPC3",928,0) - new IEN set IEN=$$SrchPtExact(.array) -"RTN","TMGRPC3",929,0) - if +IEN>0 do goto RPtDone -"RTN","TMGRPC3",930,0) - . set OutArray(0)="-1^Patient already registered^"_IEN -"RTN","TMGRPC3",931,0) - -"RTN","TMGRPC3",932,0) - new TMGFDA,TMGMSG,TMGIEN -"RTN","TMGRPC3",933,0) - if $get(array(.01))="" do goto RPtDone -"RTN","TMGRPC3",934,0) - . set OutArray(0)="-1^Patient name (.01 field) missing" -"RTN","TMGRPC3",935,0) - set TMGFDA(2,"+1,",.01)=array(.01) -"RTN","TMGRPC3",936,0) - if $get(array(.02))="" do goto RPtDone -"RTN","TMGRPC3",937,0) - . set OutArray(0)="-1^Patient sex (.02 field) missing" -"RTN","TMGRPC3",938,0) - set TMGFDA(2,"+1,",.02)=array(.02) -"RTN","TMGRPC3",939,0) - if $get(array(.03))="" do goto RPtDone -"RTN","TMGRPC3",940,0) - . set OutArray(0)="-1^Patient DOB (.03 field) missing" -"RTN","TMGRPC3",941,0) - set TMGFDA(2,"+1,",.03)=array(.03) -"RTN","TMGRPC3",942,0) - if $get(array(.09))'="" do ;"let fileman decide if field is required -"RTN","TMGRPC3",943,0) - . set TMGFDA(2,"+1,",.09)=array(.09) -"RTN","TMGRPC3",944,0) - -"RTN","TMGRPC3",945,0) - ;"Create basic record first, then add other fields on subsequent post -"RTN","TMGRPC3",946,0) - ;"(I think I have had problems trying to load some fields when the -"RTN","TMGRPC3",947,0) - ;" record has not already been created.) -"RTN","TMGRPC3",948,0) - do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") -"RTN","TMGRPC3",949,0) - if $data(TMGMSG("DIERR")) do goto RPtDone -"RTN","TMGRPC3",950,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",951,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",952,0) - -"RTN","TMGRPC3",953,0) - set IEN=$get(TMGIEN(1)) -"RTN","TMGRPC3",954,0) - if IEN'>0 do goto RPtDone -"RTN","TMGRPC3",955,0) - . set OutArray(0)="-1^Unable to find IEN of added record" -"RTN","TMGRPC3",956,0) - -"RTN","TMGRPC3",957,0) - new field set field="" -"RTN","TMGRPC3",958,0) - kill TMGFDA,TMGIEN,TMGMSG -"RTN","TMGRPC3",959,0) - for set field=$order(array(field)) quit:(field="") do -"RTN","TMGRPC3",960,0) - . if (field=".01")!(field=".02")!(field=".03")!(field=".09")!(field="0") quit -"RTN","TMGRPC3",961,0) - . new value set value=$get(array(field)) -"RTN","TMGRPC3",962,0) - . if value="" quit -"RTN","TMGRPC3",963,0) - . set TMGFDA(2,IEN_",",field)=value -"RTN","TMGRPC3",964,0) - -"RTN","TMGRPC3",965,0) - if $data(TMGFDA) do -"RTN","TMGRPC3",966,0) - . do FILE^DIE("E","TMGFDA","TMGMSG") -"RTN","TMGRPC3",967,0) - if $data(TMGMSG("DIERR")) do goto RPtDone -"RTN","TMGRPC3",968,0) - . set OutArray(0)="-1^See Fileman message" -"RTN","TMGRPC3",969,0) - . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",970,0) - -"RTN","TMGRPC3",971,0) - set OutArray(0)="1^Success^"_IEN -"RTN","TMGRPC3",972,0) - -"RTN","TMGRPC3",973,0) - new HRN set HRN=$get(array("0"))="" ;" pseudoField '0' from client will hold HRN -"RTN","TMGRPC3",974,0) - if HRN="" goto RPtDone -"RTN","TMGRPC3",975,0) - ;"Set HRN field in file 9000001 (^AUPNPAT), linked to Patient entry -"RTN","TMGRPC3",976,0) - -"RTN","TMGRPC3",977,0) - new LocIEN,InstIEN -"RTN","TMGRPC3",978,0) - ;"Get DEFAULT INSTITUTION from KERNEL SYSTEM PARAMETERS. -"RTN","TMGRPC3",979,0) - set InstIEN=$piece($get(^XTV(8989.3,1,"XUS")),17) ;" XUS;17 = DEFAULT INSTITUTION -"RTN","TMGRPC3",980,0) - if +InstIEN'>0 do goto RPtDone -"RTN","TMGRPC3",981,0) - . set OutArray(0)="1^Success (but see message)^"_IEN -"RTN","TMGRPC3",982,0) - . set OutArray(1)="Unable to add HRN because couldn't find value for DEFAULT INSTITUTION in KERNEL SYSTEM PARAMETERS file." -"RTN","TMGRPC3",983,0) - -"RTN","TMGRPC3",984,0) - ;"Get LOCATION file entry pointing to this INSTITUTION -"RTN","TMGRPC3",985,0) - set LocIEN=$order(^AUTTLOC("B",InstIEN,"")) -"RTN","TMGRPC3",986,0) - if +LocIEN'>0 do goto RPtDone -"RTN","TMGRPC3",987,0) - . set OutArray(0)="1^Success (but see message)^"_IEN -"RTN","TMGRPC3",988,0) - . set OutArray(1)="Unable to add HRN because couldn't find `"_InstIEN_" in LOCATION file" -"RTN","TMGRPC3",989,0) - -"RTN","TMGRPC3",990,0) - new HRNIEN set HRNIEN=+$order(^AUNPNPAT("B",IEN,"")) -"RTN","TMGRPC3",991,0) - if HRNIEN'>0 do goto RPtDone -"RTN","TMGRPC3",992,0) - . set OutArray(0)="1^Success (but see message)^"_IEN -"RTN","TMGRPC3",993,0) - . set OutArray(1)="Unable to add HRN because couldn't find record in PATIENT/IHS file" -"RTN","TMGRPC3",994,0) - -"RTN","TMGRPC3",995,0) - kill TMGFDA,TMGMSG,TMGIEN -"RTN","TMGRPC3",996,0) - ;"Now see if there already is an entry for LocIEN (DINUM in play, so subFile record#=LocIEN) -"RTN","TMGRPC3",997,0) - if $get(^AUPNPAT(HRNIEN,41,LocIEN,0))="" do -"RTN","TMGRPC3",998,0) - . ;"Put HRN into value for current subfile entry -"RTN","TMGRPC3",999,0) - . set TMGFDA(9000001.41,LocIEN_","_HRNIEN_",",.02)=HRN -"RTN","TMGRPC3",1000,0) - . do FILE^DIE("","TMGFDA","TMGMSG") -"RTN","TMGRPC3",1001,0) - . if $data(TMGMSG("DIERR")) do -"RTN","TMGRPC3",1002,0) - . . set OutArray(0)="1^Success (but see message)^"_IEN -"RTN","TMGRPC3",1003,0) - . . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",1004,0) - else do -"RTN","TMGRPC3",1005,0) - . ;"Add new subfile entry for HRN -"RTN","TMGRPC3",1006,0) - . set TMGFDA(9000001.41,LocIEN_","_HRNIEN_",",.01)=LocIEN -"RTN","TMGRPC3",1007,0) - . set TMGFDA(9000001.41,LocIEN_","_HRNIEN_",",.02)=HRN -"RTN","TMGRPC3",1008,0) - . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") -"RTN","TMGRPC3",1009,0) - . if $data(TMGMSG("DIERR")) do -"RTN","TMGRPC3",1010,0) - . . set OutArray(0)="1^Success (but see message)^"_IEN -"RTN","TMGRPC3",1011,0) - . . set OutArray(1)=$$GetErrStr(.TMGMSG) -"RTN","TMGRPC3",1012,0) - -"RTN","TMGRPC3",1013,0) -RPtDone -"RTN","TMGRPC3",1014,0) - quit -"RTN","TMGRPC3",1015,0) - -"RTN","TMGRPC3",1016,0) -SrchPtExact(Array) -"RTN","TMGRPC3",1017,0) - ;"Purpose: to search for a preexisting patient, using an exact search -"RTN","TMGRPC3",1018,0) - ;" By exact search, I mean that DOE,JOHN would be considered different -"RTN","TMGRPC3",1019,0) - ;" from DOE,JOHN H because it is a different ascii string. Etc. -"RTN","TMGRPC3",1020,0) - ;" However, see search description below. -"RTN","TMGRPC3",1021,0) - ;"Input: Array -- PASS BY REFERENCE. Search info. Format: -"RTN","TMGRPC3",1022,0) - ;" Array(.01)=PatientName, e.g. DOE,JOHN -"RTN","TMGRPC3",1023,0) - ;" Array(.02)=Sex e.g. M -"RTN","TMGRPC3",1024,0) - ;" Array(.03)=DOB e.g. 01-04-69 (an external date format) -"RTN","TMGRPC3",1025,0) - ;" Array(.09)=SSNum e.g. 123-45-6789 -"RTN","TMGRPC3",1026,0) - ;"Result: returns DFN (patient IEN), or 0^Message if not found. -"RTN","TMGRPC3",1027,0) - ;"Notes: -"RTN","TMGRPC3",1028,0) - ;" The following are sufficient for search: -"RTN","TMGRPC3",1029,0) - ;" -- SSNum only -"RTN","TMGRPC3",1030,0) - ;" -- or Name-Sex-DOB -"RTN","TMGRPC3",1031,0) - -"RTN","TMGRPC3",1032,0) - ;" Search technique: -"RTN","TMGRPC3",1033,0) - ;" 1. Search for SSN, if found then no further comparison made. -"RTN","TMGRPC3",1034,0) - ;" 2. Search for exact name match, no none found, then exit with 0 -"RTN","TMGRPC3",1035,0) - ;" 3. ... -"RTN","TMGRPC3",1036,0) - -"RTN","TMGRPC3",1037,0) - new result set result=0 -"RTN","TMGRPC3",1038,0) - -"RTN","TMGRPC3",1039,0) - ;"Search by SSN. Quit if match found -"RTN","TMGRPC3",1040,0) - new SSN set SSN=$translate($get(Array(.09)),"-","") -"RTN","TMGRPC3",1041,0) - if SSN'="" set result=+$order(^DPT("SSN",SSN,"")) -"RTN","TMGRPC3",1042,0) - if result>0 goto PSEDone -"RTN","TMGRPC3",1043,0) - -"RTN","TMGRPC3",1044,0) - new name,sex,DOB -"RTN","TMGRPC3",1045,0) - set name=$get(Array(.01)) -"RTN","TMGRPC3",1046,0) - if name="" do goto PSEDone -"RTN","TMGRPC3",1047,0) - . set result="0^No Name (.01 field) provided" -"RTN","TMGRPC3",1048,0) - -"RTN","TMGRPC3",1049,0) - set sex=$get(Array(.02)) -"RTN","TMGRPC3",1050,0) - if sex="" do goto PSEDone -"RTN","TMGRPC3",1051,0) - . set result="0^Sex (.02 field) not specified" -"RTN","TMGRPC3",1052,0) - if (sex'="M")&(sex'="F") do goto PSEDone -"RTN","TMGRPC3",1053,0) - . set result="0^Sex should be 'Y' or 'N'. Value provided="_sex -"RTN","TMGRPC3",1054,0) - -"RTN","TMGRPC3",1055,0) - set DOB=$get(Array(.03)) -"RTN","TMGRPC3",1056,0) - if DOB="" do goto PSEDone -"RTN","TMGRPC3",1057,0) - . set result="0^No DOB (.03 field) provided" -"RTN","TMGRPC3",1058,0) - new %DT,X,Y set %DT="P" ;"P-Post dates assumed -"RTN","TMGRPC3",1059,0) - set X=DOB do ^%DT set DOB=Y ;"convert external date into internal format -"RTN","TMGRPC3",1060,0) - if +DOB'>0 do goto PSEDone -"RTN","TMGRPC3",1061,0) - . set result="0^Invalid date: "_$get(Array(.03)) -"RTN","TMGRPC3",1062,0) - -"RTN","TMGRPC3",1063,0) - new matches merge matches=^DPT("B",name) -"RTN","TMGRPC3",1064,0) - if $data(matches)=0 do goto PSEDone -"RTN","TMGRPC3",1065,0) - . set result="0^No match for name" -"RTN","TMGRPC3",1066,0) - -"RTN","TMGRPC3",1067,0) - ;"Now compare each name match for also matching sex and DOB -"RTN","TMGRPC3",1068,0) - new IEN set IEN="" -"RTN","TMGRPC3",1069,0) - for set IEN=$order(matches(IEN)) quit:(+IEN'>0) do -"RTN","TMGRPC3",1070,0) - . new node0 set node0=$get(^DPT(IEN,0)) -"RTN","TMGRPC3",1071,0) - . if $piece(node0,"^",2)'=sex do quit -"RTN","TMGRPC3",1072,0) - . . kill matches(IEN) -"RTN","TMGRPC3",1073,0) - . if $piece(node0,"^",3)'=DOB do quit -"RTN","TMGRPC3",1074,0) - . . kill matches(IEN) -"RTN","TMGRPC3",1075,0) - -"RTN","TMGRPC3",1076,0) - ;"matches should contain all entries matching name+sex+DOB -"RTN","TMGRPC3",1077,0) - set result=+$order(matches("")) -"RTN","TMGRPC3",1078,0) - ;"Now check for more than one match -"RTN","TMGRPC3",1079,0) - if $order(matches(result))'="" do goto PSEDone -"RTN","TMGRPC3",1080,0) - . set result="0^More than one match found for Name+Sex+DOB" -"RTN","TMGRPC3",1081,0) - -"RTN","TMGRPC3",1082,0) -PSEDone -"RTN","TMGRPC3",1083,0) - quit result -"RTN","TMGRPC3",1084,0) - -"RTN","TMGRPC3",1085,0) - -"RTN","TMGRPC3",1086,0) -GetErrStr(ErrArray) -"RTN","TMGRPC3",1087,0) - ;"Purpose: convert a standard DIERR array into a string for output -"RTN","TMGRPC3",1088,0) - ;"Input: ErrArray -- PASS BY REFERENCE. example: -"RTN","TMGRPC3",1089,0) - ;" array("DIERR")="1^1" -"RTN","TMGRPC3",1090,0) - ;" array("DIERR",1)=311 -"RTN","TMGRPC3",1091,0) - ;" array("DIERR",1,"PARAM",0)=3 -"RTN","TMGRPC3",1092,0) - ;" array("DIERR",1,"PARAM","FIELD")=.02 -"RTN","TMGRPC3",1093,0) - ;" array("DIERR",1,"PARAM","FILE")=2 -"RTN","TMGRPC3",1094,0) - ;" array("DIERR",1,"PARAM","IENS")="+1," -"RTN","TMGRPC3",1095,0) - ;" array("DIERR",1,"TEXT",1)="The new record '+1,' lacks some required identifiers." -"RTN","TMGRPC3",1096,0) - ;" array("DIERR","E",311,1)="" -"RTN","TMGRPC3",1097,0) - ;"Results: returns one long equivalent string from above array. -"RTN","TMGRPC3",1098,0) - ;"Note: This is a copy of the function GetErrStr^TMGDEBUG -"RTN","TMGRPC3",1099,0) - ;" I copied it here so that this file has no TMG* dependencies. -"RTN","TMGRPC3",1100,0) - -"RTN","TMGRPC3",1101,0) - new ErrStr -"RTN","TMGRPC3",1102,0) - new TMGIDX -"RTN","TMGRPC3",1103,0) - new ErrNum -"RTN","TMGRPC3",1104,0) - -"RTN","TMGRPC3",1105,0) - set ErrStr="" -"RTN","TMGRPC3",1106,0) - for ErrNum=1:1:+$get(ErrArray("DIERR")) do -"RTN","TMGRPC3",1107,0) - . set ErrStr=ErrStr_"Fileman says: '" -"RTN","TMGRPC3",1108,0) - . if ErrNum'=1 set ErrStr=ErrStr_"(Error# "_ErrNum_") " -"RTN","TMGRPC3",1109,0) - . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT","")) -"RTN","TMGRPC3",1110,0) - . if TMGIDX'="" for do quit:(TMGIDX="") -"RTN","TMGRPC3",1111,0) - . . set ErrStr=ErrStr_$get(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX))_" " -"RTN","TMGRPC3",1112,0) - . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX)) -"RTN","TMGRPC3",1113,0) - . if $get(ErrArray("DIERR",ErrNum,"PARAM",0))>0 do -"RTN","TMGRPC3",1114,0) - . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",0)) -"RTN","TMGRPC3",1115,0) - . . set ErrStr=ErrStr_"Details: " -"RTN","TMGRPC3",1116,0) - . . for do quit:(TMGIDX="") -"RTN","TMGRPC3",1117,0) - . . . if TMGIDX="" quit -"RTN","TMGRPC3",1118,0) - . . . set ErrStr=ErrStr_"["_TMGIDX_"]="_$get(ErrArray("DIERR",1,"PARAM",TMGIDX))_" " -"RTN","TMGRPC3",1119,0) - . . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",TMGIDX)) -"RTN","TMGRPC3",1120,0) - -"RTN","TMGRPC3",1121,0) - quit ErrStr -"RTN","TMGRPC3",1122,0) - -"RTN","TMGRPC3",1123,0) - -"VER") -8.0^22.0 -**END** -**END**