Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESPATSEARCH

SDESPATSEARCH.m

Go to the documentation of this file. 
  1. SDESPATSEARCH  ;ALB/BLB - SDES PATIENT SEARCH; Jun 02, 2023@02:00
  1.  ;;5.3;Scheduling;**833,838,842,843,844,846**;Aug 13, 1993;Build 12
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  ; Reference to PATIENT in ICR #7030
  1.  ; Reference to PATIENT in ICR #7029
  1.  ; Reference to PATIENT in ICR #1476
  1.  ; Reference to PATIENT in ICR #10035
  1.  ; Reference to RATED DISABILITIES sub-file in ICR #4807
  1.  ; Reference to DISABILITY CONDITION in #733
  1.  ;
  1.  Q
  1.  ;
  1.  N RETURN,ERRORS,PATIENTLIST,INDEX
  1.  ;
  1.  D VALIDATENUMREC(.NUMOFRECORDS,.ERRORS)
  1.  I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
  1.  ;
  1.  S INDEX=$$INDEX(.SEARCHSTRING)
  1.  I SEARCHSTRING'="",SEARCHSTRING'[",",$L(SEARCHSTRING)<3 S PATIENTLIST("Patient",1)="" M RETURN=PATIENTLIST D BUILDJSON(.JSONRETURN,.RETURN) Q
  1.  ;
  1.  D BUILDPATIENTLIST(.PATIENTLIST,$G(SEARCHSTRING),$G(NUMOFRECORDS),$G(INDEX))
  1.  ;
  1.  I '$D(PATIENTLIST) S PATIENTLIST("Patient",1)=""
  1.  M RETURN=PATIENTLIST D BUILDJSON(.JSONRETURN,.RETURN)
  1.  Q
  1.  ;
  1. INDEX(SEARCHSTRING) ; returns the index to be searched in ^DPT
  1.  I $G(SEARCHSTRING)?1A4N Q "BS5" ;initial+4SSN
  1.  ;
  1.  I $$ISOTFM^SDAMUTDT($G(SEARCHSTRING))'=-1 D  Q "ADOB" ;DOB
  1.  .S SEARCHSTRING=$$ISOTFM^SDAMUTDT($G(SEARCHSTRING))
  1.  ;
  1.  I $G(SEARCHSTRING)?9N!($G(SEARCHSTRING)?3N1"-"2N1"-"4N)!($G(SEARCHSTRING)?9N.1"P")!($G(SEARCHSTRING)?3N1"-"2N1"-"4N.1"P") D  Q "SSN" ;SSN
  1.  .S SEARCHSTRING=$TR($G(SEARCHSTRING),"-","")
  1.  ;
  1.  Q "B"
  1.  ;
  1. BUILDPATIENTLIST(PATIENTLIST,SEARCHSTRING,NUMOFRECORDS,INDEX) ;
  1.  N NUM,PATIENTNAME,DFN,SEARCHCRITERIA
  1.  ;
  1.  I INDEX="B" S SEARCHSTRING=$$TRAILINGSPACES(SEARCHSTRING)
  1.  S SEARCHCRITERIA=$$GETSUB^SDECU(SEARCHSTRING) ;decrements all input types by 1
  1.  I $G(SEARCHSTRING)="" S SEARCHCRITERIA=0
  1.  S NUM=0
  1.  F  S SEARCHCRITERIA=$O(^DPT(INDEX,SEARCHCRITERIA)) Q:SEARCHCRITERIA=""!(NUM=NUMOFRECORDS)!(SEARCHCRITERIA'[SEARCHSTRING)  D
  1.  .S DFN=0
  1.  .F  S DFN=$O(^DPT(INDEX,SEARCHCRITERIA,DFN)) Q:'DFN!(NUM=NUMOFRECORDS)  D
  1.  ..S NUM=NUM+1
  1.  ..D POPULATE(.PATIENTLIST,$G(DFN),NUM)
  1.  Q
  1.  ;
  1. POPULATE(PATIENTLIST,DFN,NUM) ;
  1.  N PATIENTDATA
  1.  ;
  1.  D GETS^DIQ(2,DFN,".01;.02;.024;.03;.1;.2405;.301;.302;.351;.361;391;1100.01","IE","PATIENTDATA")
  1.  S PATIENTLIST("Patient",NUM,"DFN")=DFN
  1.  S PATIENTLIST("Patient",NUM,"Name")=$G(PATIENTDATA(2,DFN_",",.01,"E"))
  1.  S PATIENTLIST("Patient",NUM,"DateOfBirth")=$$FMTISO^SDAMUTDT($G(PATIENTDATA(2,DFN_",",.03,"I")))
  1.  S PATIENTLIST("Patient",NUM,"DateOfDeath")=$$FMTISO^SDAMUTDT($G(PATIENTDATA(2,DFN_",",.351,"I")))
  1.  S PATIENTLIST("Patient",NUM,"PreferredName")=$G(PATIENTDATA(2,DFN_",",.2405,"E"))
  1.  S PATIENTLIST("Patient",NUM,"PatientType")=$G(PATIENTDATA(2,DFN_",",391,"E"))
  1.  S PATIENTLIST("Patient",NUM,"Ward")=$G(PATIENTDATA(2,DFN_",",.1,"E")) ;.1
  1.  S PATIENTLIST("Patient",NUM,"FugitiveFelon")=$G(PATIENTDATA(2,DFN_",",1100.01,"E"))
  1.  S PATIENTLIST("Patient",NUM,"Gender")=$G(PATIENTDATA(2,DFN_",",.02,"E")) ;.02
  1.  S PATIENTLIST("Patient",NUM,"GenderIdentity")=$G(PATIENTDATA(2,DFN_",",.024,"E"))
  1.  S PATIENTLIST("Patient",NUM,"MentalHealthProvider")=$P($$START^SCMCMHTC(DFN),U,2)
  1.  S PATIENTLIST("Patient",NUM,"PrimaryCarePractitioner")=$P($$OUTPTPR^SDUTL3(DFN),U,2)
  1.  S PATIENTLIST("Patient",NUM,"ICNNumber")=$$GETICN(DFN)
  1.  S PATIENTLIST("Patient",NUM,"Last4SSN")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
  1.  ;
  1.  D GETSENSITIVEPAT(.PATIENTLIST,DFN,NUM)
  1.  ;
  1.  I $D(^DGPF(26.13,"C",DFN)) D GETFLAGS(.PATIENTLIST,DFN,NUM)
  1.  I '$D(^DGPF(26.13,"C",DFN)) S PATIENTLIST("Patient",NUM,"Flag")=""
  1.  ;
  1.  I $D(^DGS(41.41,"B",DFN)) D GETLASTDEMOUPDAT(.PATIENTLIST,DFN,NUM)
  1.  I '$D(^DGS(41.41,"B",DFN)) S PATIENTLIST("Patient",NUM,"DemographicsUpdated")=""
  1.  ;
  1.  I $D(^DPT(DFN,"E","B")) D GETELIGIBILITY(.PATIENTLIST,DFN,NUM)
  1.  I '$D(^DPT(DFN,"E","B")) S PATIENTLIST("Patient",NUM,"Eligibility")=""
  1.  ;
  1.  I $D(^DPT(DFN,.373)) D GETCONDITIONS(.PATIENTLIST,DFN,NUM)
  1.  I '$D(^DPT(DFN,.373)) S PATIENTLIST("Patient",NUM,"ServiceConnectedCondition")=""
  1.  ;
  1.  I $D(^DPT(DFN,.372)) D GETDISABILITIES(.PATIENTLIST,DFN,NUM)
  1.  I '$D(^DPT(DFN,.372)) S PATIENTLIST("Patient",NUM,"RatedDisabilities")=""
  1.  ;
  1.  I $G(PATIENTDATA(2,DFN_",",.301,"I"))="Y" S PATIENTLIST("Patient",NUM,"ServiceConnected")="YES"_" "_"("_$G(PATIENTDATA(2,DFN_",",.302,"I"))_"%)"
  1.  I $G(PATIENTDATA(2,DFN_",",.301,"I"))="N" S PATIENTLIST("Patient",NUM,"ServiceConnected")="NO"
  1.  Q
  1.  ;
  1. GETSENSITIVEPAT(PATIENTLIST,DFN,NUM) ;
  1.  N SENSITIVE
  1.  D PTSEC^DGSEC4(.SENSITIVE,DFN)
  1.  S PATIENTLIST("Patient",NUM,"SensitivePatientRestrictedRecord")=$S($G(SENSITIVE(1)):1,1:0)
  1.  Q
  1.  ;
  1. GETFLAGS(PATIENTLIST,DFN,NUM) ;
  1.  N NATLOCALFLAGS,FLAGS,FLAGCOUNT,NARRATIVECOUNT
  1.  D GETFLAGS^SDESPATFLAGS(.NATLOCALFLAGS,DFN)
  1.  D DECODE^XLFJSON("NATLOCALFLAGS","FLAGS")
  1.  S FLAGCOUNT=0
  1.  F  S FLAGCOUNT=$O(FLAGS("Flag",FLAGCOUNT)) Q:'FLAGCOUNT  D
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"ApprovedBy")=$G(FLAGS("Flag",FLAGCOUNT,"ApprovedBy"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"AssignedDate")=$G(FLAGS("Flag",FLAGCOUNT,"AssignedDate"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Category")=$G(FLAGS("Flag",FLAGCOUNT,"Category"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"FlagName")=$G(FLAGS("Flag",FLAGCOUNT,"Name"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OriginatingSiteID")=$G(FLAGS("Flag",FLAGCOUNT,"OriginatingSiteID"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OriginatingSiteName")=$G(FLAGS("Flag",FLAGCOUNT,"OriginatingSiteName"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OwnerSiteID")=$G(FLAGS("Flag",FLAGCOUNT,"OwnerSiteID"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OwnerSiteName")=$G(FLAGS("Flag",FLAGCOUNT,"OwnerSiteName"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"ReviewDate")=$G(FLAGS("Flag",FLAGCOUNT,"ReviewDate"))
  1.  .S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Type")=$G(FLAGS("Flag",FLAGCOUNT,"Type"))
  1.  .S NARRATIVECOUNT=0
  1.  .F  S NARRATIVECOUNT=$O(FLAGS("Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT)) Q:'NARRATIVECOUNT  D
  1.  ..S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT)=$G(FLAGS("Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT))
  1.  Q
  1.  ;
  1. GETLASTDEMOUPDAT(PATIENTLIST,DFN,NUM) ; last patient demographic update
  1.  N PREREGIEN,DEMODIFF
  1.  ;
  1.  S PREREGIEN=0,PREREGIEN=$O(^DGS(41.41,"B",DFN,"A"),-1)
  1.  S DEMODIFF=$$FMDIFF^XLFDT(DT,$$GET1^DIQ(41.41,PREREGIEN_",",1,"I"))
  1.  S PATIENTLIST("Patient",NUM,"DemographicsUpdated")=$P($$FMTISO^SDAMUTDT($$GET1^DIQ(41.41,PREREGIEN_",",1,"I")),"T")
  1.  S PATIENTLIST("Patient",NUM,"DemographicsNeedUpdate")=$S(DEMODIFF>179:1,DEMODIFF<180:0)
  1.  Q
  1.  ;
  1. GETELIGIBILITY(PATIENTLIST,DFN,NUM) ; top level primary code + secondary eligibilities
  1.  N ELIGIBILITYIEN,COUNT
  1.  ;
  1.  S COUNT=1
  1.  S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"PrimaryEligibilityCode")=$$GET1^DIQ(2,DFN_",",.361,"E")
  1.  S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"PrimaryEligibilityCodeType")=$$GET1^DIQ(8,$$GET1^DIQ(2,DFN_",",.361,"I"),4,"E")
  1.  ;
  1.  S ELIGIBILITYIEN=0
  1.  F  S ELIGIBILITYIEN=$O(^DPT(DFN,"E","B",ELIGIBILITYIEN)) Q:ELIGIBILITYIEN="B"!(ELIGIBILITYIEN="")  D
  1.  .I $$GET1^DIQ(2.0361,ELIGIBILITYIEN_","_DFN_",",.01,"I")=$$GET1^DIQ(2,DFN_",",.361,"I") Q
  1.  .S COUNT=COUNT+1
  1.  .S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"SecondaryEligibilityCode")=$$GET1^DIQ(2.0361,ELIGIBILITYIEN_","_DFN_",",.01,"E")
  1.  .S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"SecondaryEligibilityCodeType")=$$GET1^DIQ(8,ELIGIBILITYIEN,4,"E")
  1.  Q
  1.  ;
  1. GETCONDITIONS(PATIENTLIST,DFN,NUM) ; service connected conditions
  1.  N CONDITIONIEN,COUNT
  1.  ;
  1.  S CONDITIONIEN=0,COUNT=0
  1.  F  S CONDITIONIEN=$O(^DPT(DFN,.373,CONDITIONIEN)) Q:'CONDITIONIEN  D
  1.  .S COUNT=COUNT+1
  1.  .S PATIENTLIST("Patient",NUM,"ServiceConnectedCondition",COUNT,"Condition")=$$GET1^DIQ(2.05,CONDITIONIEN_","_DFN_",",.01,"E")
  1.  Q
  1.  ;
  1. GETDISABILITIES(PATIENTLIST,DFN,NUM) ; rated disabilities
  1.  N AECODE,AFFECTED,COUNT,RATEDARRAY
  1.  ;
  1.  D RDIS^DGRPDB(DFN,.RATEDARRAY) ; ICR #4807
  1.  I '$D(RATEDARRAY) D  Q
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities")=""
  1.  ;
  1.  S COUNT=0
  1.  F  S COUNT=$O(RATEDARRAY(COUNT)) Q:'COUNT  D
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"RatedDisability")=$$GET1^DIQ(31,$P(RATEDARRAY(COUNT),"^")_",",.01,"E") ; ICR #733
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"DisabilityPercent")=$P(RATEDARRAY(COUNT),"^",2)
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"ServiceConnected")=$S($P(RATEDARRAY(COUNT),"^",3)=1:"YES",1:"NO")
  1.  . S AECODE=$P(RATEDARRAY(COUNT),"^",4)
  1.  . S AFFECTED=$S(AECODE="BL":"BOTH LOWER",AECODE="BU":"BOTH UPPER",AECODE="RL":"RIGHT LOWER",AECODE="RU":"RIGHT UPPER",AECODE="LL":"LEFT LOWER",AECODE="LU":"LEFT UPPER",1:"")
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"ExtremityAffected")=AFFECTED
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"OriginalEffectiveDate")=$$FMTISO^SDAMUTDT($P(RATEDARRAY(COUNT),"^",5))
  1.  . S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"CurrentEffectiveDate")=$$FMTISO^SDAMUTDT($P(RATEDARRAY(COUNT),"^",6))
  1.  Q
  1.  ;
  1. GETICN(DFN) ; patient ICN
  1.  N ICN
  1.  ;
  1.  S ICN=$$GETICN^MPIF001(DFN)
  1.  I ICN["-1",$$GET1^DIQ(8989.3,1,.01,"E")["TEST" Q $$GET1^DIQ(2,DFN,991.1)
  1.  Q ICN
  1.  ;
  1. VALIDATENUMREC(NUMOFRECORDS,ERRORS) ; number of records to return
  1.  I $G(NUMOFRECORDS)="" S NUMOFRECORDS=10 Q
  1.  I $G(NUMOFRECORDS)>50!($G(NUMOFRECORDS)<1) D ERRLOG^SDESJSON(.ERRORS,382)
  1.  Q
  1.  ;
  1. TRAILINGSPACES(NAME) ;
  1.  N FIRSTNAME,LASTNAME
  1.  ;
  1.  S FIRSTNAME=$P(NAME,",")
  1.  S LASTNAME=$P(NAME,",",2)
  1.  I $E(LASTNAME)=" " D
  1.  .S LASTNAME=$E(LASTNAME,2,$L(LASTNAME))
  1.  .S NAME=FIRSTNAME_","_LASTNAME
  1.  Q NAME
  1.  ;
  1. BUILDJSON(JSONRETURN,RETURN) ;
  1.  N JSONERROR
  1.  D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
  1.  Q
  1.  ;