TMGGDFN ;TMG/kst-Get A Patient's IEN (DFN) ;01/01/04 ;;1.0;TMG-LIB;**1**;06/04/08 ;"TMG GET DFN (TMGGDFN) ;" ;"Purpose: This module will provide functionality for getting a DFN ;" (which is the database record number) for a given patient. ;" If the patient has not been encountered before, then the patient ;" will be added to the database. ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"$$GetDFN(Info) -- Ensure that a patient is registered, return IEN ;"$$GetDFN2(Entry,AutoRegister) -- Get patient DFN (i.e. IEN), possibly registering if needed. ;" This function is very similar to GetDFN, but slightly streamlined. ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"Pat2Entry(Patient,Entry) convert a named-node entry, into numeric 'Entry' array: ;"LookupPatient(Entry) ;"SSNumLookup(SSNum) ;"PMSNumLookup(PMSNum) ;"ParadigmNumLookup(PMSNum) ;"Compare(TestData,dbData,EntryNum) ;"CompEntry(TestData,dbDataEntry) ;"$$AddToPat(DFN,Entry) ;"$$AddNewPt(Entry) ;"======================================================================= ;"PRIVATE FUNCTIONS ;"======================================================================= ;"SSNum2Lookup(SSNum) <--- depreciated GetDFN(Patient) ;"Purpose: This code is to ensure that a patient is registered ;" It is intended for use during upload of old records ;" from another EMR. As each dictation is processed, ;" this function will be called with the header info. ;" If the patient is already registered, then this function ;" will have no effect other than to return the DFN. ;" Otherwise, the patient will be registered. ;" ??? *I'll have this function used another way as well: If ;" only the TMGPTNUM is passed, it will load valid values ;" into TMGNAME etc., which can be passed back to the calling ;" function (providing that values were passed by reference) ;"Input: Patient: Array is loaded with Patient, like this: ;" Patient("SSNUM")="123-45-6789" ;" Patient("NAME")="DOE,JOHN" ;" Patient("DOB")="01-04-69" ;" Patient("PATIENTNUM")="12345677" <-- Medic account number ;" Patient("SEQUELNUM")="234567890" <-- SequelMedSystems Account number ;" Patient("PARADIGMNUM")="234567890" <-- Pardigm Account number ;" Patient("SEX")="M" ;" Patient("ALIAS")="DOE,JOHNNY" ;" -Note: The following are optional, only used if adding a patient ;" If adding a patient, and these are not supplied, then defaults of ;" Not a veteran, NON-VETERAN type, Not service connected are used ;" Patient("VETERAN")= VETERAN Y/N --For my purposes, use NO -- optional ;" Patient("PT_TYPE")= "SERVICE CONNECTED?" -- required field -- optional ;" Patient("SERVICE_CONNECTED")= "TYPE" - required field -- optional ;" (TMGFREG) Also, variable with global scope, TMGFREG, is used ;" if TMGFREG=1, and patient is not found, then ;" patient will be automatically registered as a new patient. ;" ;"Output: The patient's info is used to register the patient, if they are ;" are not already registered ;"Result: RETURNS DFN (patient internal entry number), or -1 if not found or added. ;"------------------------------------------------------------------------------ new result,Entry do Pat2Entry(.Patient,.Entry) set result=$$LookupPatient(.Entry) if result>0 goto ERDone ;"1-18-2005 I am going to stop adding patients automatically--I think it ;" will make duplicate entries. I should have all patients in now... ;"10-15-2005 I will allow the patient to be added automatically if the variable ;" with global scope TMGFREG=1 (stands for: TMG FORCE REGISTRATION) ;" At this time, this will only be set from ERRORS^TMGUPLD set result=-1 ;"signal failure as default if $get(TMGFREG)=1 do ;"Allowed gobal-scope variable to force add. . set result=$$AddNewPt(.Entry) . if result'>0 set result=-1 ERDone quit result ;"result=DFN GetDFN2(Entry,AutoRegister) ;"Purpose: Get patient DFN (i.e. IEN), possibly registering if needed. ;" This function is very similar to GetDFN, but slightly streamlined. ;"Input: Entry: Array is loaded with Patient, like this: ;" Entry(.01)=PatientName, e.g. DOE,JOHN ;" Entry(.02)=Sex e.g. M ;" Entry(.03)=DOB e.g. 01-04-69 ;" --Below are optional (depending if fields have Fileman 'required' status) ;" Entry(.09)=SSNum e.g. 123-45-6789 ;" Entry(10,.01)=ALIAS e.g. DOE,JOHNNY ;" Entry(1901)=VETERAN ;" Entry(.301)=PT_TYPE ;" Entry(391)=SERVICE_CONNECTED ;" Entry(22700)=PatientNum ;" Entry(22701)=PMS ACCOUNT NUM ;" Entry(22701)=SEQUELNUM ;" Entry(22702)=PARADIGM ;" AutoRegister: if 1, then patient will be registered if not found. ;"Output: The patient's info is used to register the patient, if they are ;" are not already registered ;"Result: DFN (patient IEN), or 0 if not found/added. ;"------------------------------------------------------------------------------ new result set result=$$LookupPatient(.Entry) if result>0 goto DFN2Done if $get(AutoRegister)=1 set result=$$AddNewPt(.Entry) DFN2Done quit result ;"result=DFN ;"====================================================================== Pat2Entry(Patient,Entry) ;"Purpose: to convert a named-node entry, into numeric 'Entry' array: ;"Input: Patient: PASS BY REFERENCE. Array loaded with patient info: ;" Patient("SSNUM")="123-45-6789" ;" Patient("NAME")="DOE,JOHN" ;" Patient("DOB")="01-04-69" ;" Patient("PATIENTNUM")="12345677" <-- Medic account number ;" Patient("SEQUELNUM")="234567890" <-- SequelMedSystems Account number ;" Patient("PARADIGMNUM")="234567890" <-- Pardigm Account number ;" Patient("SEX")="M" ;" Patient("ALIAS")="DOE,JOHNNY" ;" -Note: The following are optional, only used if adding a patient ;" If adding a patient, and these are not supplied, then defaults of ;" Not a veteran, NON-VETERAN type, Not service connected are used ;" Patient("VETERAN")= VETERAN Y/N --For my purposes, use NO -- optional ;" Patient("PT_TYPE")= "SERVICE CONNECTED?" -- required field -- optional ;" Patient("SERVICE_CONNECTED")= "TYPE" - required field -- optional ;" Entry; PASS BY REFERENCE, an OUT PARAMETER. ;" Entry(.01)=PatientName ;" Entry(.02)=Sex ;" Entry(.03)=DOB ;" Entry(.09)=SSNum ;" Entry(22700)=PatientNum ;" Entry(22701)=PMS ACCOUNT NUM ;" Entry(22701)=SEQUELNUM ;" Entry(22702)=PARADIGM ;" Entry(10,.01)=ALIAS ;" Entry(1901)=VETERAN ;" Entry(.301)=PT_TYPE ;" Entry(391)=SERVICE_CONNECTED ;"Results: None if $data(Patient("NAME")) set Entry(.01)=$get(Patient("NAME")) if $data(Patient("SEX")) set Entry(.02)=$get(Patient("SEX")) if $data(Patient("DOB")) set Entry(.03)=$get(Patient("DOB")) if $data(Patient("SSNUM")) set Entry(.09)=$get(Patient("SSNUM")) if $data(Patient("PATIENTNUM")) set Entry(22700)=$get(Patient("PATIENTNUM")) if $data(Patient("PMS ACCOUNT NUM")) set Entry(22701)=$get(Patient("PMS ACCOUNT NUM")) if $data(Patient("SEQUELNUM")) set Entry(22701)=$get(Patient("SEQUELNUM")) if $data(Patient("PARADIGMNUM")) set Entry(22702)=$get(Patient("PARADIGM")) if $data(Patient("ALIAS")) set Entry(10,.01)=$get(Patient("ALIAS")) if $data(Patient("VETERAN")) set Entry(1901)=Patient("VETERAN") if $data(Patient("PT_TYPE")) set Entry(.301)=Patient("PT_TYPE") if $data(Patient("SERVICE_CONNECTED")) set Entry(391)=Patient("SERVICE_CONNECTED") quit LookupPatient(Entry) ;"Purpose: Search for Patient (an existing entry in the database) ;"Input: Entry -- Array is loaded with info, like this: ;" set Entry(.01)=Name ;" set Entry(.02)=Sex ;" set Entry(.03)=DOB ;" set Entry(.09)=SSNum ;" set Entry(22700)=PtNum ;" set Entry(22701)=SequelSystems PMS AccountNumber ;" set Entry(22702)=Paradigm PMS AccountNumber ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found ;"NOTE: For now, I am ignoring any passed Alias info. ;"------------------------------------------------------------------------------ if $data(cConflict)#10=0 new cConflict set cConflict=0 if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 new Missing set Missing=0 new BailOut set BailOut=0 new result set result=0 ;"set default to no match, or conflict found new TMGErrMsg,TMGOutput new RecComp ;"If can find patient by SSNum, then don't look any further (if successful) if +$get(Entry(.09))>0 set result=$$SSNumLookup(Entry(.09)) if result>0 goto LUDone ;"If can find patient by SequelMedSystem account number, then don't look any further (if successful) if (+$get(Entry(22701))>0),$$FieldExists(22701) set result=$$PMSNumLookup(Entry(22701)) if result>0 goto LUDone ;"If can find patient by Paradigm account number, then don't look any further (if successful) if (+$get(Entry(22702))>0),$$FieldExists(22702) set result=$$ParadigmNumLookup(Entry(22702)) if result>0 goto LUDone ;"Below specifies fields to get back. new Value set Value=$get(Entry(.01)) ;"========================================================= ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) do . new File set File=2 ;"PATIENT file. . new IENS set IENS="" . new Fields set Fields="@;.01;.02;.03;.09" . if $$FieldExists(22700) set Fields=Fields_";22700" . ;"new Fields set Fields=".01" . new Flags set Flags="M" . new MatchValue set MatchValue=Value . new Number set Number="*" ;"i.e. max number to return *=all entries. . new Indexes set Indexes="" . new ScreenCode set ScreenCode="" ;"option screening M code . new Ident set Ident="" ;"optional text to accompany each found entry . new OutVarP set OutVarP="TMGOutput" . new ErrVarP set ErrVarP="TMGErrMsg" . do FIND^DIC(File,IENS,Fields,Flags,MatchValue,Number,Indexes,ScreenCode,Ident,OutVarP,ErrVarP) ;"----------------------------------------------------------- ;"Here is an example of the output of FIND^DIC(): ;"TMGOutput("DILIST",0)="2^*^0^" <-2 matches ;"TMGOutput("DILIST",0,"MAP")=".01^.02^.03^.09^22700" ;"TMGOutput("DILIST",2,1)=16 ;"TMGOutput("DILIST",2,2)=2914 ;"TMGOutput("DILIST","ID",1,.01)="VIRIATO,ENEAS" ;"TMGOutput("DILIST","ID",1,.02)="MALE" ;"TMGOutput("DILIST","ID",1,.03)="01/20/1957" ;"TMGOutput("DILIST","ID",1,.09)=123237654 ;"TMGOutput("DILIST","ID",1,22700)=3542340 ;"TMGOutput("DILIST","ID",2,.01)="VOID,BURT" ;"TMGOutput("DILIST","ID",2,.02)="FEMALE" ;"TMGOutput("DILIST","ID",2,.03)="" ;"TMGOutput("DILIST","ID",2,.09)="" ;"TMGOutput("DILIST","ID",1,22700)=000455454 ;"----------------------------------------------- if $data(TMGErrMsg("DIERR")) do ShowDIERR^TMGDEBUG(.TMGErrMsg,.PriorErrorFound) if $data(TMGOutput)'=0 do . new NumMatch,Num . set NumMatch=+$PIECE(TMGOutput("DILIST",0),"^",1) ;"Get first part of entry like this: '8^*^0^' <-8 matches . for Num=1:1:NumMatch do ;"Compare all entries found. If NumMatch=0-->no 1st loop . . set RecComp=$$Compare(.Entry,.TMGOutput,Num) . . if (RecComp=cInsufficient)&(NumMatch=1) do . . . ;"Fileman has said there is 1 (and only 1) match. . . . ;"Even if the supplied info is lacking, it is still a match. . . . ;"We still needed to call $$Compare to check for cExtraInfo . . . set RecComp=cFullMatch . . if (RecComp=cFullMatch)!(RecComp=cExtraInfo) do . . . set result=TMGOutput("DILIST",2,Num) ;"This is DFN (record) number . . . if RecComp=cExtraInfo do . . . . new temp set temp=$$AddToPat(result,.Entry) . . . set Num=NumMatch+1 ;"some value to abort loop LUDone; quit result ;" return patient internal entry number (DFN) FieldExists(FieldNum) ;"Purpose: to ensure a given field exists in File 2 ;"Input: FieldNum: NUMBER of field in file 2 ;"Output: 1=field exists, 0=doesn't exist quit ($data(^DD(2,FieldNum,0))'=0) ExtraLookup(Entry,Intensity) ;"Purpose: Search for Patient (an existing entry in the database) ;"Input: Entry -- Array is loaded with info, like this: ;" Entry(.01)=Name ;" Entry(.02)=Sex ;" Entry(.03)=DOB ;" Entry(.09)=SSNum ;" Entry(22701)=SequelMedSystem Account Number ;" Intensity -- How intense to search. ;" NOTE: Because this returns the FIRST match, is it advised that this function ;" be run with intensity 1 first, then 2-->3-->4 ;"Result: returns FIRST matching DFN (patient internal entry number), or 0 if none found ;"NOTE: For now, I am ignoring any passed Alias info. ;"Note: I am assuming that LookupPatient(Entry) has been called, and failed. ;" Thus I am not going to compare SSNums, Medic or SequelMed's account numbers. ;"------------------------------------------------------------------------------ if $data(cConflict)#10=0 new cConflict set cConflict=0 if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 set Intensity=$get(Intensity,1) if Intensity=1 set Threshold=1 ;"(exact match) if Intensity=2 set Threshold=.75 ;"(probable match) if Intensity=3 set Threshold=.5 ;"(possible match) if Intensity=4 set Threshold=.25 ;"(doubtful match) new Missing set Missing=0 new BailOut set BailOut=0 new result set result=0 ;"set default to no match, or conflict found new TMGErrMsg,TMGOutput new RecComp ;"If can find patient by SSNum, then don't look any further (if successful) if +$get(Entry(.09))>0 set result=$$SSNumLookup(Entry(.09)) if result>0 goto LUDone ;"If can find patient by SequelMedSystem account number, then don't look any further (if successful) if (+$get(Entry(22701))>0),$$FieldExists(22701) set result=$$PMSNumLookup(Entry(22701)) if result>0 goto LUDone ;"If can find patient by Paradigm account number, then don't look any further (if successful) if (+$get(Entry(22702))>0),$$FieldExists(22702) set result=$$ParadigmNumLookup(Entry(22702)) if result>0 goto LUDone new SearchName set SearchName=$get(Entry(.01)) if SearchName="" goto XLUDone set SearchName=$$FormatName^TMGMISC(SearchName,1) do STDNAME^XLFNAME(.SearchName,"C",.TMGErrMsg) ;"parse into component array if Intensity>0 kill SearchName("SUFFIX") if Intensity>1 kill SearchName("MIDDLE") if Intensity>2 set SearchName("GIVEN")=$EXTRACT(SearchName("GIVEN"),1,3) if Intensity>3 do . set SearchName("GIVEN")=$EXTRACT(SearchName("GIVEN"),1,1) . set SearchName("FAMILY")=$EXTRACT(SearchName("FAMILY"),1,3) set SearchName=$$BLDNAME^XLFNAME(.SearchName) ;"========================================================= ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) do . new Fields set Fields="@;.01;.02;.03" . do FIND^DIC(2,"",Fields,"M",SearchName,"*","","","","TMGOutput","TMGErrMsg") ;"========================================================= if $data(TMGErrMsg("DIERR")) goto XLUDone if $data(TMGOutput)'=0 do . new NumMatch,Num . set NumMatch=+$get(TMGOutput("DILIST",0),0) ;"Get first part of entry like this: '8^*^0^' <-8 matches . for Num=1:1:NumMatch do ;"Compare all entries found. If NumMatch=0-->no 1st loop . . new dbDataEntry . . merge dbDataEntry=TMGOutput("DILIST","ID",Num) . . set RecComp=$$XCompEntry(.Entry,.dbDataEntry,.Threshold) . . if (RecComp=cInsufficient)&(NumMatch=1) do . . . ;"Fileman has said there is 1 (and only 1) match. . . . ;"Even if the supplied info is lacking, it is still a match. . . . set RecComp=cFullMatch . . if (RecComp=cFullMatch)!(RecComp=cExtraInfo) do . . . set result=$get(TMGOutput("DILIST",2,Num),0) ;"This is DFN (record) number . . . set Num=NumMatch+1 ;"some value to abort loop XLUDone; quit result ;" return patient internal entry number (DFN) XCompEntry(TestData,dbDataEntry,Threshold) ; ;"PURPOSE: To compare two entries for certain fields, and return a comparison code. ;"INPUT: TestData -- array holding uploaded data, that is being tested against preexisting data ;" See CompEntry for Format ;" dbDataEntry -- array derived from output from FIND^DIC. See CompEntry for Format ;" Threshold -- OPTIONAL --How strict to be during the comparison ;" default is 1. ;" e.g. 0.5 --> comparison value must >= 0.5 ;" Valid values are: .25, .5, .75, 1 ;"Results: ;" return value = cConflict (0) if entries conflict ;" return value = cFullMatch (1) if entries match (to the degreee specified by Threshold) ;" return value = cExtraInfo (2) if entries have no conflict, but tEntry has extra info. ;" return value = cInsufficient (3) Insufficient data to make match, but no conflict. ;"Note: This function IS DIFFERENT then CompEntry (which this was originally copied from) ;" --It's purpose is to look for matches after a partial fileman search, ;" Smi,Jo for Smith,John if $data(cConflict)#10=0 new cConflict set cConflict=0 if $data(cConsistent)#10=0 new cConsistent set cConsistent=0.5 if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 set Threshold=$get(Threshold,1) if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 new tD,dbD new CResult set CResult=cFullMatch ;"set default to match new result set result=cFullMatch ;"default is Success. new WorstScore set WorstScore=1 new Extra set Extra=0 ;"0=false if $data(TestData(.01))#10'=0 do . set tD=$get(TestData(.01)) ;"field .01 = NAME . set dbD=$get(dbDataEntry(.01)) . set result=$$CompName^TMGMISC(tD,dbD) if result=cConflict goto CmpEDone if resultWorstScore set result=WorstScore set result=(result'success if ($data(TestData(.01))#10=0)&($data(TestData(.03))=0) set result=cInsufficient XCmpEDone quit result SSNumLookup(SSNum) ;"PURPOSE: To lookup patient by social security number ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found ;" new result set result=0 new DIC set DIC=2 set DIC(0)="M" set X=SSNum do ^DIC if +Y>0 set result=+Y quit result SSNum2Lookup(SSNum) ;"NOTICE: I have learned to be more effecient, so will not use this function anymore ;" Will use SSNumLookup instead ;"PURPOSE: To lookup patient by social security number ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found ;" ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SSNLookup^TMGGDFN") new result set result=0 ;"set default to no match, or conflict found new TMGErrMsg,TMGOutput ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'Entry' passed for processing:") ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") ;"Below specifies fields to get back. Note: file 2 is PATIENT file. new Value set Value=$get(SSNum) ;"========================================================= ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FIND^DIC") ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) do . new File set File=2 . new IENS set IENS="" . new Fields set Fields="@;.01;.02;.03;.09" . if $$FieldExists(22700) set Fields=Fields_";22700" . new Flags set Flags="M" . new MatchValue set MatchValue=Value . new Number set Number="*" ;"i.e. max number to return *=all entries. . new Indexes set Indexes="" . new ScreenCode set ScreenCode="" ;"option screening M code . new Ident set Ident="" ;"optional text to accompany each found entry . new OutVarP set OutVarP="TMGOutput" . new ErrVarP set ErrVarP="TMGErrMsg" . do FIND^DIC(File,IENS,Fields,Flags,MatchValue,Number,Indexes,ScreenCode,Ident,OutVarP,ErrVarP) ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FIND^DIC") ;"========================================================= ;"if ($get(TMGDEBUG)>0) do ;". if $data(TMGOutput)>0 do ArrayDump^TMGDEBUG("TMGOutput") ;". else do DebugMsg^TMGDEBUG(.DBIndent,"No TMGOutput found.") ;". if $data(TMGErrMsg)>0 do ArrayDump^TMGDEBUG("TMGErrMsg") ;". else do DebugMsg^TMGDEBUG(.DBIndent,"No TMGErrMsg found") if $data(TMGErrMsg("DIERR")) do ShowDIERR^TMGDEBUG(.TMGErrMsg,.PriorErrorFound) if $data(TMGOutput)'=0 do . new NumMatch,Num . set NumMatch=+$PIECE(TMGOutput("DILIST",0),"^",1) ;"Get first part of entry like this: '8^*^0^' <-8 matches . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,NumMatch," matches found in database") . if NumMatch>0 set result=$get(TMGOutput("DILIST",2,1)) SSLUDone ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Result (patient DFN#)=",result) ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SSNLookup^TMGGDFN") quit result ;" return patient internal entry number (DFN) PMSNumLookup(PMSNum) ;"PURPOSE: To lookup patient by SequelSystem account number ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found ;" new result set result=0 ;"set default to no match, or conflict found new TMGErrMsg,TMGOutput ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) ;"Uses custom TMGS index. do FIND^DIC(2,"",".01","",PMSNum,"*","TMGS","","","TMGOutput","TMGErrMsg") if '$data(TMGErrMsg("DIERR")) set result=$get(TMGOutput("DILIST",2,1),0) quit result ;" return patient internal entry number (DFN) ParadigmNumLookup(PMSNum) ;"PURPOSE: To lookup patient by Paradigm account number ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found new result set result=0 ;"set default to no match, or conflict found new TMGErrMsg,TMGOutput ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) ;"Uses custom TMGS index. do FIND^DIC(2,"",".01","",PMSNum,"*","TMGP","","","TMGOutput","TMGErrMsg") if '$data(TMGErrMsg("DIERR")) set result=$get(TMGOutput("DILIST",2,1),0) quit result ;" return patient internal entry number (DFN) Compare(TestData,dbData,EntryNum) ; ;"PURPOSE: To compare two entries for certain fields, and return a comparison code. ;"INPUT: TestData -- array holding uploaded data, that is being tested against preexisting data ;" Format is: ;" TestData(FieldNumber)=Value ;" TestData(FieldNumber)=Value ;" TestData(FieldNumber)=Value ;" dbData -- array returned from FIND^DIC. ;" EntryNum -- Entry number in dbData ;"Results: ;" return value = cConflict (0) if entries conflict ;" return value = cFullMatch (1) if entries completely match ;" return value = cExtraInfo (2) if entries have no conflict, but tEntry has extra info. ;" return value = cInsufficient (3) Insufficient data to make match, but no conflict. ;"Note: The following data sets will be sufficient for a match: ;" 1. SSNumber (not a P/pseudo value) ;" 2. Patient Identifier (field 22700) ;" 3. Name, DOB ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"Compare^TMGGDFN") if $data(cConflict)#10=0 new cConflict set cConflict=0 if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 new dbDataEntry,result ;"First, ensure no conflict between TestData and dbData merge dbDataEntry=dbData("DILIST","ID",EntryNum) set result=$$CompEntry(.TestData,.dbDataEntry) if result=cConflict goto CompDone ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No conflict found so far") if $get(TestData(.01))="" kill TestData(.01) if $get(TestData(.03))="" kill TestData(.03) if $get(TestData(.09))="" kill TestData(.09) if $get(TestData(22700))="" kill TestData(22700) if $get(TestData(22701))="" kill TestData(22701) ;"OK, no conflict. But is there sufficient data for a match? if (+$get(TestData(.09))>0)&($get(TestData(.09))'["P") goto CompDone ;".09=SSNum --> success if ($data(TestData(22700))#10'=0) goto CompDone ;"22700=Pt. Identifier --> success if ($data(TestData(.01))#10'=0)&($data(TestData(.03))) goto CompDone ;"Name & DOB-->success ;"If here, then we don't have enough data for a match set result=cInsufficient CompDone ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"Compare^TMGGDFN") quit result CompEntry(TestData,dbDataEntry) ; ;"PURPOSE: To compare two entries for certain fields, and return a comparison code. ;"INPUT: TestData -- array holding uploaded data, that is being tested against preexisting data ;" Format is: ;" TestData(FieldNumber)=Value ;" TestData(FieldNumber)=Value ;" TestData(FieldNumber)=Value ;" dbDataEntry -- array derived from output from FIND^DIC. ;" Format is: ;" dbDataEntry(FieldNumber)=Value ;" dbDataEntry(FieldNumber)=Value ;" dbDataEntry(FieldNumber)=Value ;" EntryNum -- Entry number in dbDataEntry ;"Results: ;" return value = cConflict (0) if entries conflict ;" return value = cFullMatch (1) if entries completely match ;" return value = cExtraInfo (2) if entries have no conflict, but tEntry has extra info. ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CompEntry^TMGGDFN") if $data(cConflict)#10=0 new cConflict set cConflict=0 if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'TestData' passed for processing:") ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TestData") ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'dbDataEntry' passed for processing:") ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("dbDataEntry") new tD,dbD new CResult set CResult=cFullMatch ;"set default to match (so data won't be entered into database) new result set result=cFullMatch ;"default is Success. new Extra set Extra=0 ;"0=false ;"I am not going to test field .01 (NAME) because Fileman has already done this, and ;" feels that the names it has returned are compatible. ;" I was having a problem with input like this: ;" TestData(.01)="DOE,JOHN" ;" dbDataEntry(.01)="DOE,JOHN J" ;" And this was failing the match. It shouldn't have. ;"if $data(TestData(.01))#10'=0 do ;". set tD=$get(TestData(.01)) ;"field .01 = NAME ;". set dbD=$get(dbDataEntry(.01)) ;". set result=$$FieldCompare^TMGDBAPI(tD,dbD) ;"if result=cConflict goto CmpEDone ;"if result=cExtraInfo set Extra=1 if $data(TestData(.09))#10'=0 do . set tD=$get(TestData(.09)) ;"field .09 = SSNUM . set dbD=$get(dbDataEntry(.09)) . set result=$$FieldCompare^TMGDBAPI(tD,dbD,"SSNUM") if result=cConflict goto CmpEDone if result=cExtraInfo set Extra=1 if $data(TestData(.02))#10'=0 do . set tD=$get(TestData(.02)) ;"field .02 = SEX . set dbD=$get(dbDataEntry(.02)) . set result=$$FieldCompare^TMGDBAPI(tD,dbD,"SEX") if result=cConflict goto CmpEDone if result=cExtraInfo set Extra=1 if $data(TestData(.03))#10'=0 do . set tD=$get(TestData(.03)) ;"field .03 = DOB . set dbD=$get(dbDataEntry(.03)) . set result=$$FieldCompare^TMGDBAPI(tD,dbD,"DATE") if result=cConflict goto CmpEDone if result=cExtraInfo set Extra=1 ;"if $data(TestData(22700))#10'=0 do ;". set tD=$get(TestData(22700)) ;"field 22700 = Patient ID number ;". set dbD=$get(dbDataEntry(22700)) ;". set result=$$FieldCompare^TMGDBAPI(tD,dbD,"NUMBER") ;"if result=cConflict goto CmpEDone ;"if result=cExtraInfo set Extra=1 ;"If we are here, then there is no conflict. set result=cFullMatch ;"If extra info present, reflect this in result if Extra=1 set result=cExtraInfo CmpEDone ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"CompEntry^TMGGDFN") quit result AddToPat(PatIEN,Entry) ;"PURPOSE: Stuffs Entry into record number PatIEN (RecNum must already exist) ;"INPUT: PatIEN -- the record number, in file 2, that is to be updated ;" Entry -- the record to put in ;" Format is: ;" Entry(FieldNumber)=Value ;" Entry(FieldNumber)=Value ;" Entry(FieldNumber)=Value ;" The following FieldNumbers will be used if avail. ;" .01,.02,.03,.09,22700 ;"Results: cOKToCont (1) or cAbort(0) if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 if $data(cAbort)#10=0 new cAbort set cAbort=0 ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"AddToPat^TMGGDFN") new TMGFDA,TMGMsg new result set result=cOKToCont ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is Entry passed for processing") ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") if $get(Entry(.01))'="" set TMGFDA(2,PatIEN_",",.01)=Entry(.01) ;"field .01 = NAME if $get(Entry(.02))'="" set TMGFDA(2,PatIEN_",",.02)=Entry(.02) ;"field .02 = SEX if $get(Entry(.03))'="" set TMGFDA(2,PatIEN_",",.03)=Entry(.03) ;"field .03 = DOB if $get(Entry(.09))'=""&($get(Entry(.09))'["P") do . set TMGFDA(2,PatIEN_",",.09)=Entry(.09) ;"field .09 = SSNUM if $get(Entry(22700))'="" set TMGFDA(2,PatIEN_",",22700)=Entry(22700) ;"field 22700 = Patient Medic ID Num (custom field) set result=$$dbWrite^TMGDBAPI(.TMGFDA,1) if result=cAbort goto ATRDone ATRDone ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"AddToPat") quit result AddNewPt(Entry,ErrArray) ;"Purpose: Create a new entry in file 2 (Patient File) ;"Input: 'Entry' array should be set up prior to calling. See those items expected below ;" Entry(.01)=Patient Name ;" Entry(.03)=DOB ;" Entry(.09)=SS Num ;" Entry(22700)=Medic Pt Identifier -- optional ;" Entry(1901)=field 1901 = VETERAN Y/N --For my purposes, use NO -- optional ;" Entry(.301)=field .301 = "SERVICE CONNECTED?" -- required field -- optional ;" Entry(391)=field 391 = "TYPE" - required field -- optional ;" ErrArray (OPTIONAL) -- PASS BY REFERENCE. An OUT parameter to receive ;" Fileman "DIERR" message, if any ;" Note: To use this, and have the function not display the Fileman ;" Error to the screen, ** must SET ErrArray=-1 (-1 = extra quiet mode) ;" If TMGDEBUG is defined, then this quit mode described above will NOT be used, ;" and existing values for TMGDEBUG will be used. ;"Output: Returns internal entry number (DFN) if successful, otherwise 0 ;"Note: The following data sets must be available for a patient to be entered: ;" Patient name (.01) -- always required ;" Patient sex (.02) -- always required ;" And ONE of the following... ;" 1. SSNumber (.09) (not a P/pseudo value) ;" 2. Patient Identifier (field 22700) ;" 3. DOB (.03) ;"Results: returns the DFN of the added record, or 0 if not added/error ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"AddNewPt^TMGGDFN") if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 if $data(cAbort)#10=0 new cAbort set cAbort=0 ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'Entry' passed for processing:") ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") new TMGFDA,TMGIEN,TMGMSG new result set result=cOKToCont ;"default it success. if ($Data(Entry(.09))#10'=0) do ;"Kill SSNum if it isn't in right format . set Entry(.09)=$translate(Entry(.09),"- ","") . if Entry(.09)'?9N0.1"P" kill Entry(.09) if ($Data(Entry(.01))#10=0) goto ANPDone ;"Abort if ($Data(Entry(.03))#10'=0) goto ANPOK ;"OK to make record if ($Data(Entry(.09))#10'=0) goto ANPOK ;"OK to make record if ($Data(Entry(22700))#10'=0) goto ANPOK ;"OK to make record ;"If we get to this point, then insufficient data to add record... so abort ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Not enough info to create unique patient record.") set result=cAbort goto ANPDone ;"Abort ANPOK ;"Note: the "2" means file 2 (PATIENT file), and "+1" means "add entry" set TMGFDA(2,"+1,",.096)="`"_DUZ ;"field .096 = WHO ENTERED PATIENT (`DUZ=current user) set TMGFDA(2,"+1,",.01)=Entry(.01) ;"field .01 = NAME if $data(Entry(.02)) set TMGFDA(2,"+1,",.02)=Entry(.02) ;"field .02 = SEX if $data(Entry(.03)) set TMGFDA(2,"+1,",.03)=Entry(.03) ;"field .03 = DOB if +$get(Entry(.09))>0 set TMGFDA(2,"+1,",.09)=Entry(.09) ;"field .09 = SSNUM if $data(Entry(22700)),$$FieldExists(22700) set TMGFDA(2,"+1,",22700)=Entry(22700) ;"field 22700 = Patient ID Num (custom field) ;"These fields below *USED TO BE* required. I changed the filemans status for these fields to NOT required if $data(Entry(1901)) set TMGFDA(2,"+1,",1901)=Entry(1901) else set TMGFDA(2,"+1,",1901)="NO" ;"field 1901 = VETERAN Y/N --For my purposes, use NO if $data(Entry(.301)) set TMGFDA(2,"+1,",.301)=Entry(.301) else set TMGFDA(2,"+1,",.301)="NO" ;"field .301 = SERVICE CONNECTED? -- required field if $data(Entry(391)) set TMGFDA(2,"+1,",391)=Entry(391) else set TMGFDA(2,"+1,",391)="NON-VETERAN (OTHER)" ;"field 391 = "TYPE" - required field if $data(TMGDEBUG)=0 new TMGDEBUG set TMGDEBUG=$get(ErrArray,0) ;"set result=$$dbWrite^TMGDBAPI(.TMGFDA,0,.TMGIEN,,.ErrArray) do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") if $data(TMGMSG("DIERR")) do . ;"TMGDEBUG=-1 --> extra quiet mode . if $get(TMGDEBUG)>-1 do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . merge ErrArray("DIERR")=TMGMSG("DIERR") . set result=cAbort if result=cAbort goto ANPDone set result=+$get(TMGIEN(1)) ;"result is the added patient's IEN if result'>0 goto ANPDone ;"Add subfile entry for Alias if an alias was specified. if $data(Entry(10,.01)) do ;"field 10 in file 2 = ALIAS, .01 subfield=ALIAS . kill TMGFDA,TMGMsg,TMGIEN,tempresult . set TMGFDA(2.01,"+1,"_result_",",.01)=Entry(10,.01) . ;"set tempresult=$$dbWrite^TMGDBAPI(.TMGFDA,0,.TMGIEN,,.ErrArray) . do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") . if $data(TMGMSG("DIERR")) do . . ;"TMGDEBUG=-1 --> extra quiet mode . . if $get(TMGDEBUG)>-1 do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . . merge ErrArray("DIERR")=TMGMSG("DIERR") ;"Now, manually add a record in the file 9000001 (^AUPNPAT) with IEN (stored in result) ;"This is done because some PATIENT fields don't point to the PATIENT file, but instead ;" point to the PATIENT/IHS file (9000001), which in turn points to the PATIENT file. set ^AUPNPAT(result,0)=result set ^AUPNPAT("B",result,result)="" if $data(Entry(.09)) do . set ^AUPNPAT(result,41,0)="^9000001.41P^1^1" . set ^AUPNPAT(result,41,1,0)="1^"_Entry(.09) ANPDone ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result / IEN of added record=",result) ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"AddNewPt^TMGGDFN") quit result