SDES2PATSEARCH ;ALB/ANU,BLB,BWF - SDES2 PATIENT SEARCH; OCT 13, 2023@02:00
;;5.3;Scheduling;**864,866,881**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
; clone of SDESPATSEARCH - BLB
;
; Reference to PATIENT in ICR #7030
; Reference to PATIENT in ICR #7029
; Reference to PATIENT in ICR #1476
; Reference to PATIENT in ICR #10035
; Reference to RATED DISABILITIES sub-file in ICR #4807
; Reference to DISABILITY CONDITION in #733
;
Q
;
SEARCH(JSONRETURN,SDCONTEXT,PARAMS) ; SDES2 PATIENT SEARCH
N RETURN,ERRORS,PATIENTLIST,INDEX,VALRET,SDDFN,NUMOFRECORDS,SEARCHSTRING,PARAMETERS,SDDUZ
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Patient",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":$G(SDCONTEXT("USER DUZ")),1:DUZ)
;
D POPULATEINPUTS(.PARAMS,.SEARCHSTRING,.NUMOFRECORDS,.INDEX)
D VALIDATE(.ERRORS,.NUMOFRECORDS,SEARCHSTRING)
I $D(ERRORS) S ERRORS("Patient",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
;
D BUILDPATIENTLIST(.PATIENTLIST,$G(SEARCHSTRING),$G(NUMOFRECORDS),$G(INDEX),SDDUZ)
;
I '$D(PATIENTLIST) S PATIENTLIST("Patient",1)=""
M RETURN=PATIENTLIST D BUILDJSON(.JSONRETURN,.RETURN)
Q
;
POPULATEINPUTS(PARAMS,SEARCHSTRING,NUMOFRECORDS,INDEX) ;
S NUMOFRECORDS=$G(PARAMS("NUMOFRECORDS"))
S SEARCHSTRING=$G(PARAMS("SEARCHSTRING"))
S INDEX=$$INDEX(.SEARCHSTRING)
Q
;
INDEX(SEARCHSTRING) ; returns the index to be searched in ^DPT
I $G(SEARCHSTRING)?1A4N Q "BS5" ;initial+4SSN
;
I $$ISOTFM^SDAMUTDT($G(SEARCHSTRING))'=-1 D Q "ADOB" ;DOB
.S SEARCHSTRING=$$ISOTFM^SDAMUTDT($G(SEARCHSTRING))
;
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
.S SEARCHSTRING=$TR($G(SEARCHSTRING),"-","")
;
Q "B"
;
BUILDPATIENTLIST(PATIENTLIST,SEARCHSTRING,NUMOFRECORDS,INDEX,SDDUZ) ;
N NUM,PATIENTNAME,DFN,SEARCHCRITERIA
;
I INDEX="B" S SEARCHSTRING=$$TRAILINGSPACES(SEARCHSTRING)
S SEARCHCRITERIA=$$GETSUB^SDES2UTIL(SEARCHSTRING) ;decrements all input types by 1
I $G(SEARCHSTRING)="" S SEARCHCRITERIA=0
S NUM=0
F S SEARCHCRITERIA=$O(^DPT(INDEX,SEARCHCRITERIA)) Q:SEARCHCRITERIA=""!(NUM=NUMOFRECORDS)!(SEARCHCRITERIA'[SEARCHSTRING) D
.S DFN=0
.F S DFN=$O(^DPT(INDEX,SEARCHCRITERIA,DFN)) Q:'DFN!(NUM=NUMOFRECORDS) D
..S NUM=NUM+1
..D POPULATE(.PATIENTLIST,$G(DFN),SDDUZ,NUM)
Q
;
POPULATE(PATIENTLIST,DFN,SDDUZ,NUM) ;
N PATIENTDATA
;
D GETS^DIQ(2,DFN,".01;.02;.024;.03;.1;.2405;.301;.302;.351;.361;391;1100.01","IE","PATIENTDATA")
S PATIENTLIST("Patient",NUM,"DFN")=DFN
S PATIENTLIST("Patient",NUM,"Name")=$G(PATIENTDATA(2,DFN_",",.01,"E"))
S PATIENTLIST("Patient",NUM,"DateOfBirth")=$$FMTISO^SDAMUTDT($G(PATIENTDATA(2,DFN_",",.03,"I")))
S PATIENTLIST("Patient",NUM,"DateOfDeath")=$$FMTISO^SDAMUTDT($G(PATIENTDATA(2,DFN_",",.351,"I")))
S PATIENTLIST("Patient",NUM,"PreferredName")=$G(PATIENTDATA(2,DFN_",",.2405,"E"))
S PATIENTLIST("Patient",NUM,"PatientType")=$G(PATIENTDATA(2,DFN_",",391,"E"))
S PATIENTLIST("Patient",NUM,"Ward")=$G(PATIENTDATA(2,DFN_",",.1,"E")) ;.1
S PATIENTLIST("Patient",NUM,"FugitiveFelon")=$G(PATIENTDATA(2,DFN_",",1100.01,"E"))
S PATIENTLIST("Patient",NUM,"Gender")=$G(PATIENTDATA(2,DFN_",",.02,"E")) ;.02
S PATIENTLIST("Patient",NUM,"GenderIdentity")=$G(PATIENTDATA(2,DFN_",",.024,"E"))
S PATIENTLIST("Patient",NUM,"MentalHealthProvider")=$P($$START^SCMCMHTC(DFN),U,2)
S PATIENTLIST("Patient",NUM,"PrimaryCarePractitioner")=$P($$OUTPTPR^SDUTL3(DFN),U,2)
S PATIENTLIST("Patient",NUM,"ICNNumber")=$$GETICN(DFN)
S PATIENTLIST("Patient",NUM,"Last4SSN")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
S PATIENTLIST("Patient",NUM,"NewGAFRequired")=$S($$NEWGAF^SDUTL2(DFN):"New GAF Required",1:"No new GAF required")
S PATIENTLIST("Patient",NUM,"PriorityGroup")=$$GET1^DIQ(27.11,$$GET1^DIQ(2,DFN,27.01,"I"),.07,"E")
S PATIENTLIST("Patient",NUM,"EnrollmentSubGroup")=$$GET1^DIQ(27.11,$$GET1^DIQ(2,DFN,27.01,"I"),.12,"E")
;
D GETSENSITIVEPAT(.PATIENTLIST,DFN,SDDUZ,NUM)
;
I $D(^DGPF(26.13,"C",DFN)) D GETFLAGS(.PATIENTLIST,DFN,NUM)
I '$D(^DGPF(26.13,"C",DFN)) S PATIENTLIST("Patient",NUM,"Flag")=""
;
I $D(^DGS(41.41,"B",DFN)) D GETLASTDEMOUPDAT(.PATIENTLIST,DFN,NUM)
I '$D(^DGS(41.41,"B",DFN)) S PATIENTLIST("Patient",NUM,"DemographicsUpdated")=""
;
I $D(^DPT(DFN,"E","B")) D GETELIGIBILITY(.PATIENTLIST,DFN,NUM)
I '$D(^DPT(DFN,"E","B")) S PATIENTLIST("Patient",NUM,"Eligibility")=""
;
I $D(^DPT(DFN,.373)) D GETCONDITIONS(.PATIENTLIST,DFN,NUM)
I '$D(^DPT(DFN,.373)) S PATIENTLIST("Patient",NUM,"ServiceConnectedCondition")=""
;
I $D(^DPT(DFN,.372)) D GETDISABILITIES(.PATIENTLIST,DFN,NUM)
I '$D(^DPT(DFN,.372)) S PATIENTLIST("Patient",NUM,"RatedDisabilities")=""
;
I $G(PATIENTDATA(2,DFN_",",.301,"I"))="Y" S PATIENTLIST("Patient",NUM,"ServiceConnected")="YES"_" "_"("_$G(PATIENTDATA(2,DFN_",",.302,"I"))_"%)"
I $G(PATIENTDATA(2,DFN_",",.301,"I"))="N" S PATIENTLIST("Patient",NUM,"ServiceConnected")="NO"
Q
;
GETSENSITIVEPAT(PATIENTLIST,DFN,SDDUZ,NUM) ;
N SENSITIVE,MESLOOP,MESCNT
D SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,SDDUZ)
S PATIENTLIST("Patient",NUM,"SensitivePatientRestrictedRecord")=$S($G(SENSITIVE(1)):1,1:0)
S PATIENTLIST("Patient",NUM,"SensitivePatientType")=$G(SENSITIVE(1))
S MESCNT=0
S MESLOOP=1 F S MESLOOP=$O(SENSITIVE(MESLOOP)) Q:'MESLOOP D
.S MESCNT=MESCNT+1
.S PATIENTLIST("Patient",NUM,"SensitiveRecordMessage",MESCNT,"Text")=$G(SENSITIVE(MESLOOP))
I '$D(PATIENTLIST("Patient",NUM,"SensitiveRecordMessage")) S PATIENTLIST("Patient",NUM,"SensitiveRecordMessage",1)=""
Q
;
GETFLAGS(PATIENTLIST,DFN,NUM) ;
N NATLOCALFLAGS,FLAGS,FLAGCOUNT,NARRATIVECOUNT
D GETFLAGS^SDESPATFLAGS(.NATLOCALFLAGS,DFN)
D DECODE^XLFJSON("NATLOCALFLAGS","FLAGS")
S FLAGCOUNT=0
F S FLAGCOUNT=$O(FLAGS("Flag",FLAGCOUNT)) Q:'FLAGCOUNT D
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"ApprovedBy")=$G(FLAGS("Flag",FLAGCOUNT,"ApprovedBy"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"AssignedDate")=$G(FLAGS("Flag",FLAGCOUNT,"AssignedDate"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Category")=$G(FLAGS("Flag",FLAGCOUNT,"Category"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"FlagName")=$G(FLAGS("Flag",FLAGCOUNT,"Name"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OriginatingSiteID")=$G(FLAGS("Flag",FLAGCOUNT,"OriginatingSiteID"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OriginatingSiteName")=$G(FLAGS("Flag",FLAGCOUNT,"OriginatingSiteName"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OwnerSiteID")=$G(FLAGS("Flag",FLAGCOUNT,"OwnerSiteID"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OwnerSiteName")=$G(FLAGS("Flag",FLAGCOUNT,"OwnerSiteName"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"ReviewDate")=$G(FLAGS("Flag",FLAGCOUNT,"ReviewDate"))
.S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Type")=$G(FLAGS("Flag",FLAGCOUNT,"Type"))
.S NARRATIVECOUNT=0
.F S NARRATIVECOUNT=$O(FLAGS("Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT)) Q:'NARRATIVECOUNT D
..S PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT)=$G(FLAGS("Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT))
Q
;
GETLASTDEMOUPDAT(PATIENTLIST,DFN,NUM) ; last patient demographic update
N PREREGIEN,DEMODIFF
;
S PREREGIEN=0,PREREGIEN=$O(^DGS(41.41,"B",DFN,"A"),-1)
S DEMODIFF=$$FMDIFF^XLFDT(DT,$$GET1^DIQ(41.41,PREREGIEN_",",1,"I"))
S PATIENTLIST("Patient",NUM,"DemographicsUpdated")=$P($$FMTISO^SDAMUTDT($$GET1^DIQ(41.41,PREREGIEN_",",1,"I")),"T")
S PATIENTLIST("Patient",NUM,"DemographicsNeedUpdate")=$S(DEMODIFF>179:1,DEMODIFF<180:0)
Q
;
GETELIGIBILITY(PATIENTLIST,DFN,NUM) ; top level primary code + secondary eligibilities
N ELIGIBILITYIEN,COUNT
;
S COUNT=1
S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"PrimaryEligibilityCode")=$$GET1^DIQ(2,DFN_",",.361,"E")
S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"PrimaryEligibilityCodeType")=$$GET1^DIQ(8,$$GET1^DIQ(2,DFN_",",.361,"I"),4,"E")
;
S ELIGIBILITYIEN=0
F S ELIGIBILITYIEN=$O(^DPT(DFN,"E","B",ELIGIBILITYIEN)) Q:ELIGIBILITYIEN="B"!(ELIGIBILITYIEN="") D
.I $$GET1^DIQ(2.0361,ELIGIBILITYIEN_","_DFN_",",.01,"I")=$$GET1^DIQ(2,DFN_",",.361,"I") Q
.S COUNT=COUNT+1
.S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"SecondaryEligibilityCode")=$$GET1^DIQ(2.0361,ELIGIBILITYIEN_","_DFN_",",.01,"E")
.S PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"SecondaryEligibilityCodeType")=$$GET1^DIQ(8,ELIGIBILITYIEN,4,"E")
Q
;
GETCONDITIONS(PATIENTLIST,DFN,NUM) ; service connected conditions
N CONDITIONIEN,COUNT
;
S CONDITIONIEN=0,COUNT=0
F S CONDITIONIEN=$O(^DPT(DFN,.373,CONDITIONIEN)) Q:'CONDITIONIEN D
.S COUNT=COUNT+1
.S PATIENTLIST("Patient",NUM,"ServiceConnectedCondition",COUNT,"Condition")=$$GET1^DIQ(2.05,CONDITIONIEN_","_DFN_",",.01,"E")
Q
;
GETDISABILITIES(PATIENTLIST,DFN,NUM) ; rated disabilities
N AECODE,AFFECTED,COUNT,RATEDARRAY
;
D RDIS^DGRPDB(DFN,.RATEDARRAY) ; ICR #4807
I '$D(RATEDARRAY) D Q
. S PATIENTLIST("Patient",NUM,"RatedDisabilities")=""
;
S COUNT=0
F S COUNT=$O(RATEDARRAY(COUNT)) Q:'COUNT D
. S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"RatedDisability")=$$GET1^DIQ(31,$P(RATEDARRAY(COUNT),"^")_",",.01,"E") ; ICR #733
. S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"DisabilityPercent")=$P(RATEDARRAY(COUNT),"^",2)
. S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"ServiceConnected")=$S($P(RATEDARRAY(COUNT),"^",3)=1:"YES",1:"NO")
. S AECODE=$P(RATEDARRAY(COUNT),"^",4)
. 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:"")
. S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"ExtremityAffected")=AFFECTED
. S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"OriginalEffectiveDate")=$$FMTISO^SDAMUTDT($P(RATEDARRAY(COUNT),"^",5))
. S PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"CurrentEffectiveDate")=$$FMTISO^SDAMUTDT($P(RATEDARRAY(COUNT),"^",6))
Q
;
GETICN(DFN) ; patient ICN
N ICN
;
S ICN=$$GETICN^MPIF001(DFN)
I ICN["-1",$$GET1^DIQ(8989.3,1,.01,"E")["TEST" Q $$GET1^DIQ(2,DFN,991.1)
Q ICN
;
VALIDATE(ERRORS,NUMOFRECORDS,SEARCHSTRING) ;
I $G(NUMOFRECORDS)="" S NUMOFRECORDS=10 Q
I $G(NUMOFRECORDS)>50!($G(NUMOFRECORDS)<1) D ERRLOG^SDESJSON(.ERRORS,382)
;
I SEARCHSTRING'="",SEARCHSTRING'[",",$L(SEARCHSTRING)<3 S PATIENTLIST("Patient",1)="" D ERRLOG^SDESJSON(.ERRORS,473)
Q
;
TRAILINGSPACES(NAME) ;
N FIRSTNAME,LASTNAME
;
S FIRSTNAME=$P(NAME,",")
S LASTNAME=$P(NAME,",",2)
I $E(LASTNAME)=" " D
.S LASTNAME=$E(LASTNAME,2,$L(LASTNAME))
.S NAME=FIRSTNAME_","_LASTNAME
Q NAME
;
BUILDJSON(JSONRETURN,RETURN) ;
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2PATSEARCH 10955 printed Oct 16, 2024@18:54:56 Page 2
SDES2PATSEARCH ;ALB/ANU,BLB,BWF - SDES2 PATIENT SEARCH; OCT 13, 2023@02:00
+1 ;;5.3;Scheduling;**864,866,881**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; clone of SDESPATSEARCH - BLB
+5 ;
+6 ; Reference to PATIENT in ICR #7030
+7 ; Reference to PATIENT in ICR #7029
+8 ; Reference to PATIENT in ICR #1476
+9 ; Reference to PATIENT in ICR #10035
+10 ; Reference to RATED DISABILITIES sub-file in ICR #4807
+11 ; Reference to DISABILITY CONDITION in #733
+12 ;
+13 QUIT
+14 ;
SEARCH(JSONRETURN,SDCONTEXT,PARAMS) ; SDES2 PATIENT SEARCH
+1 NEW RETURN,ERRORS,PATIENTLIST,INDEX,VALRET,SDDFN,NUMOFRECORDS,SEARCHSTRING,PARAMETERS,SDDUZ
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Patient",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+5 SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":$GET(SDCONTEXT("USER DUZ")),1:DUZ)
+6 ;
+7 DO POPULATEINPUTS(.PARAMS,.SEARCHSTRING,.NUMOFRECORDS,.INDEX)
+8 DO VALIDATE(.ERRORS,.NUMOFRECORDS,SEARCHSTRING)
+9 IF $DATA(ERRORS)
SET ERRORS("Patient",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)
QUIT
+10 ;
+11 DO BUILDPATIENTLIST(.PATIENTLIST,$GET(SEARCHSTRING),$GET(NUMOFRECORDS),$GET(INDEX),SDDUZ)
+12 ;
+13 IF '$DATA(PATIENTLIST)
SET PATIENTLIST("Patient",1)=""
+14 MERGE RETURN=PATIENTLIST
DO BUILDJSON(.JSONRETURN,.RETURN)
+15 QUIT
+16 ;
POPULATEINPUTS(PARAMS,SEARCHSTRING,NUMOFRECORDS,INDEX) ;
+1 SET NUMOFRECORDS=$GET(PARAMS("NUMOFRECORDS"))
+2 SET SEARCHSTRING=$GET(PARAMS("SEARCHSTRING"))
+3 SET INDEX=$$INDEX(.SEARCHSTRING)
+4 QUIT
+5 ;
INDEX(SEARCHSTRING) ; returns the index to be searched in ^DPT
+1 ;initial+4SSN
IF $GET(SEARCHSTRING)?1A4N
QUIT "BS5"
+2 ;
+3 ;DOB
IF $$ISOTFM^SDAMUTDT($GET(SEARCHSTRING))'=-1
Begin DoDot:1
+4 SET SEARCHSTRING=$$ISOTFM^SDAMUTDT($GET(SEARCHSTRING))
End DoDot:1
QUIT "ADOB"
+5 ;
+6 ;SSN
IF $GET(SEARCHSTRING)?9N!($GET(SEARCHSTRING)?3N1"-"2N1"-"4N)!($GET(SEARCHSTRING)?9N.1"P")!($GET(SEARCHSTRING)?3N1"-"2N1"-"4N.1"P")
Begin DoDot:1
+7 SET SEARCHSTRING=$TRANSLATE($GET(SEARCHSTRING),"-","")
End DoDot:1
QUIT "SSN"
+8 ;
+9 QUIT "B"
+10 ;
BUILDPATIENTLIST(PATIENTLIST,SEARCHSTRING,NUMOFRECORDS,INDEX,SDDUZ) ;
+1 NEW NUM,PATIENTNAME,DFN,SEARCHCRITERIA
+2 ;
+3 IF INDEX="B"
SET SEARCHSTRING=$$TRAILINGSPACES(SEARCHSTRING)
+4 ;decrements all input types by 1
SET SEARCHCRITERIA=$$GETSUB^SDES2UTIL(SEARCHSTRING)
+5 IF $GET(SEARCHSTRING)=""
SET SEARCHCRITERIA=0
+6 SET NUM=0
+7 FOR
SET SEARCHCRITERIA=$ORDER(^DPT(INDEX,SEARCHCRITERIA))
if SEARCHCRITERIA=""!(NUM=NUMOFRECORDS)!(SEARCHCRITERIA'[SEARCHSTRING)
QUIT
Begin DoDot:1
+8 SET DFN=0
+9 FOR
SET DFN=$ORDER(^DPT(INDEX,SEARCHCRITERIA,DFN))
if 'DFN!(NUM=NUMOFRECORDS)
QUIT
Begin DoDot:2
+10 SET NUM=NUM+1
+11 DO POPULATE(.PATIENTLIST,$GET(DFN),SDDUZ,NUM)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
POPULATE(PATIENTLIST,DFN,SDDUZ,NUM) ;
+1 NEW PATIENTDATA
+2 ;
+3 DO GETS^DIQ(2,DFN,".01;.02;.024;.03;.1;.2405;.301;.302;.351;.361;391;1100.01","IE","PATIENTDATA")
+4 SET PATIENTLIST("Patient",NUM,"DFN")=DFN
+5 SET PATIENTLIST("Patient",NUM,"Name")=$GET(PATIENTDATA(2,DFN_",",.01,"E"))
+6 SET PATIENTLIST("Patient",NUM,"DateOfBirth")=$$FMTISO^SDAMUTDT($GET(PATIENTDATA(2,DFN_",",.03,"I")))
+7 SET PATIENTLIST("Patient",NUM,"DateOfDeath")=$$FMTISO^SDAMUTDT($GET(PATIENTDATA(2,DFN_",",.351,"I")))
+8 SET PATIENTLIST("Patient",NUM,"PreferredName")=$GET(PATIENTDATA(2,DFN_",",.2405,"E"))
+9 SET PATIENTLIST("Patient",NUM,"PatientType")=$GET(PATIENTDATA(2,DFN_",",391,"E"))
+10 ;.1
SET PATIENTLIST("Patient",NUM,"Ward")=$GET(PATIENTDATA(2,DFN_",",.1,"E"))
+11 SET PATIENTLIST("Patient",NUM,"FugitiveFelon")=$GET(PATIENTDATA(2,DFN_",",1100.01,"E"))
+12 ;.02
SET PATIENTLIST("Patient",NUM,"Gender")=$GET(PATIENTDATA(2,DFN_",",.02,"E"))
+13 SET PATIENTLIST("Patient",NUM,"GenderIdentity")=$GET(PATIENTDATA(2,DFN_",",.024,"E"))
+14 SET PATIENTLIST("Patient",NUM,"MentalHealthProvider")=$PIECE($$START^SCMCMHTC(DFN),U,2)
+15 SET PATIENTLIST("Patient",NUM,"PrimaryCarePractitioner")=$PIECE($$OUTPTPR^SDUTL3(DFN),U,2)
+16 SET PATIENTLIST("Patient",NUM,"ICNNumber")=$$GETICN(DFN)
+17 SET PATIENTLIST("Patient",NUM,"Last4SSN")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
+18 SET PATIENTLIST("Patient",NUM,"NewGAFRequired")=$SELECT($$NEWGAF^SDUTL2(DFN):"New GAF Required",1:"No new GAF required")
+19 SET PATIENTLIST("Patient",NUM,"PriorityGroup")=$$GET1^DIQ(27.11,$$GET1^DIQ(2,DFN,27.01,"I"),.07,"E")
+20 SET PATIENTLIST("Patient",NUM,"EnrollmentSubGroup")=$$GET1^DIQ(27.11,$$GET1^DIQ(2,DFN,27.01,"I"),.12,"E")
+21 ;
+22 DO GETSENSITIVEPAT(.PATIENTLIST,DFN,SDDUZ,NUM)
+23 ;
+24 IF $DATA(^DGPF(26.13,"C",DFN))
DO GETFLAGS(.PATIENTLIST,DFN,NUM)
+25 IF '$DATA(^DGPF(26.13,"C",DFN))
SET PATIENTLIST("Patient",NUM,"Flag")=""
+26 ;
+27 IF $DATA(^DGS(41.41,"B",DFN))
DO GETLASTDEMOUPDAT(.PATIENTLIST,DFN,NUM)
+28 IF '$DATA(^DGS(41.41,"B",DFN))
SET PATIENTLIST("Patient",NUM,"DemographicsUpdated")=""
+29 ;
+30 IF $DATA(^DPT(DFN,"E","B"))
DO GETELIGIBILITY(.PATIENTLIST,DFN,NUM)
+31 IF '$DATA(^DPT(DFN,"E","B"))
SET PATIENTLIST("Patient",NUM,"Eligibility")=""
+32 ;
+33 IF $DATA(^DPT(DFN,.373))
DO GETCONDITIONS(.PATIENTLIST,DFN,NUM)
+34 IF '$DATA(^DPT(DFN,.373))
SET PATIENTLIST("Patient",NUM,"ServiceConnectedCondition")=""
+35 ;
+36 IF $DATA(^DPT(DFN,.372))
DO GETDISABILITIES(.PATIENTLIST,DFN,NUM)
+37 IF '$DATA(^DPT(DFN,.372))
SET PATIENTLIST("Patient",NUM,"RatedDisabilities")=""
+38 ;
+39 IF $GET(PATIENTDATA(2,DFN_",",.301,"I"))="Y"
SET PATIENTLIST("Patient",NUM,"ServiceConnected")="YES"_" "_"("_$GET(PATIENTDATA(2,DFN_",",.302,"I"))_"%)"
+40 IF $GET(PATIENTDATA(2,DFN_",",.301,"I"))="N"
SET PATIENTLIST("Patient",NUM,"ServiceConnected")="NO"
+41 QUIT
+42 ;
GETSENSITIVEPAT(PATIENTLIST,DFN,SDDUZ,NUM) ;
+1 NEW SENSITIVE,MESLOOP,MESCNT
+2 DO SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,SDDUZ)
+3 SET PATIENTLIST("Patient",NUM,"SensitivePatientRestrictedRecord")=$SELECT($GET(SENSITIVE(1)):1,1:0)
+4 SET PATIENTLIST("Patient",NUM,"SensitivePatientType")=$GET(SENSITIVE(1))
+5 SET MESCNT=0
+6 SET MESLOOP=1
FOR
SET MESLOOP=$ORDER(SENSITIVE(MESLOOP))
if 'MESLOOP
QUIT
Begin DoDot:1
+7 SET MESCNT=MESCNT+1
+8 SET PATIENTLIST("Patient",NUM,"SensitiveRecordMessage",MESCNT,"Text")=$GET(SENSITIVE(MESLOOP))
End DoDot:1
+9 IF '$DATA(PATIENTLIST("Patient",NUM,"SensitiveRecordMessage"))
SET PATIENTLIST("Patient",NUM,"SensitiveRecordMessage",1)=""
+10 QUIT
+11 ;
GETFLAGS(PATIENTLIST,DFN,NUM) ;
+1 NEW NATLOCALFLAGS,FLAGS,FLAGCOUNT,NARRATIVECOUNT
+2 DO GETFLAGS^SDESPATFLAGS(.NATLOCALFLAGS,DFN)
+3 DO DECODE^XLFJSON("NATLOCALFLAGS","FLAGS")
+4 SET FLAGCOUNT=0
+5 FOR
SET FLAGCOUNT=$ORDER(FLAGS("Flag",FLAGCOUNT))
if 'FLAGCOUNT
QUIT
Begin DoDot:1
+6 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"ApprovedBy")=$GET(FLAGS("Flag",FLAGCOUNT,"ApprovedBy"))
+7 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"AssignedDate")=$GET(FLAGS("Flag",FLAGCOUNT,"AssignedDate"))
+8 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Category")=$GET(FLAGS("Flag",FLAGCOUNT,"Category"))
+9 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"FlagName")=$GET(FLAGS("Flag",FLAGCOUNT,"Name"))
+10 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OriginatingSiteID")=$GET(FLAGS("Flag",FLAGCOUNT,"OriginatingSiteID"))
+11 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OriginatingSiteName")=$GET(FLAGS("Flag",FLAGCOUNT,"OriginatingSiteName"))
+12 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OwnerSiteID")=$GET(FLAGS("Flag",FLAGCOUNT,"OwnerSiteID"))
+13 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"OwnerSiteName")=$GET(FLAGS("Flag",FLAGCOUNT,"OwnerSiteName"))
+14 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"ReviewDate")=$GET(FLAGS("Flag",FLAGCOUNT,"ReviewDate"))
+15 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Type")=$GET(FLAGS("Flag",FLAGCOUNT,"Type"))
+16 SET NARRATIVECOUNT=0
+17 FOR
SET NARRATIVECOUNT=$ORDER(FLAGS("Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT))
if 'NARRATIVECOUNT
QUIT
Begin DoDot:2
+18 SET PATIENTLIST("Patient",NUM,"Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT)=$GET(FLAGS("Flag",FLAGCOUNT,"Narrative",NARRATIVECOUNT))
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
GETLASTDEMOUPDAT(PATIENTLIST,DFN,NUM) ; last patient demographic update
+1 NEW PREREGIEN,DEMODIFF
+2 ;
+3 SET PREREGIEN=0
SET PREREGIEN=$ORDER(^DGS(41.41,"B",DFN,"A"),-1)
+4 SET DEMODIFF=$$FMDIFF^XLFDT(DT,$$GET1^DIQ(41.41,PREREGIEN_",",1,"I"))
+5 SET PATIENTLIST("Patient",NUM,"DemographicsUpdated")=$PIECE($$FMTISO^SDAMUTDT($$GET1^DIQ(41.41,PREREGIEN_",",1,"I")),"T")
+6 SET PATIENTLIST("Patient",NUM,"DemographicsNeedUpdate")=$SELECT(DEMODIFF>179:1,DEMODIFF<180:0)
+7 QUIT
+8 ;
GETELIGIBILITY(PATIENTLIST,DFN,NUM) ; top level primary code + secondary eligibilities
+1 NEW ELIGIBILITYIEN,COUNT
+2 ;
+3 SET COUNT=1
+4 SET PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"PrimaryEligibilityCode")=$$GET1^DIQ(2,DFN_",",.361,"E")
+5 SET PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"PrimaryEligibilityCodeType")=$$GET1^DIQ(8,$$GET1^DIQ(2,DFN_",",.361,"I"),4,"E")
+6 ;
+7 SET ELIGIBILITYIEN=0
+8 FOR
SET ELIGIBILITYIEN=$ORDER(^DPT(DFN,"E","B",ELIGIBILITYIEN))
if ELIGIBILITYIEN="B"!(ELIGIBILITYIEN="")
QUIT
Begin DoDot:1
+9 IF $$GET1^DIQ(2.0361,ELIGIBILITYIEN_","_DFN_",",.01,"I")=$$GET1^DIQ(2,DFN_",",.361,"I")
QUIT
+10 SET COUNT=COUNT+1
+11 SET PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"SecondaryEligibilityCode")=$$GET1^DIQ(2.0361,ELIGIBILITYIEN_","_DFN_",",.01,"E")
+12 SET PATIENTLIST("Patient",NUM,"Eligibility",COUNT,"SecondaryEligibilityCodeType")=$$GET1^DIQ(8,ELIGIBILITYIEN,4,"E")
End DoDot:1
+13 QUIT
+14 ;
GETCONDITIONS(PATIENTLIST,DFN,NUM) ; service connected conditions
+1 NEW CONDITIONIEN,COUNT
+2 ;
+3 SET CONDITIONIEN=0
SET COUNT=0
+4 FOR
SET CONDITIONIEN=$ORDER(^DPT(DFN,.373,CONDITIONIEN))
if 'CONDITIONIEN
QUIT
Begin DoDot:1
+5 SET COUNT=COUNT+1
+6 SET PATIENTLIST("Patient",NUM,"ServiceConnectedCondition",COUNT,"Condition")=$$GET1^DIQ(2.05,CONDITIONIEN_","_DFN_",",.01,"E")
End DoDot:1
+7 QUIT
+8 ;
GETDISABILITIES(PATIENTLIST,DFN,NUM) ; rated disabilities
+1 NEW AECODE,AFFECTED,COUNT,RATEDARRAY
+2 ;
+3 ; ICR #4807
DO RDIS^DGRPDB(DFN,.RATEDARRAY)
+4 IF '$DATA(RATEDARRAY)
Begin DoDot:1
+5 SET PATIENTLIST("Patient",NUM,"RatedDisabilities")=""
End DoDot:1
QUIT
+6 ;
+7 SET COUNT=0
+8 FOR
SET COUNT=$ORDER(RATEDARRAY(COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+9 ; ICR #733
SET PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"RatedDisability")=$$GET1^DIQ(31,$PIECE(RATEDARRAY(COUNT),"^")_",",.01,"E")
+10 SET PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"DisabilityPercent")=$PIECE(RATEDARRAY(COUNT),"^",2)
+11 SET PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"ServiceConnected")=$SELECT($PIECE(RATEDARRAY(COUNT),"^",3)=1:"YES",1:"NO")
+12 SET AECODE=$PIECE(RATEDARRAY(COUNT),"^",4)
+13 SET AFFECTED=$SELECT(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:"")
+14 SET PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"ExtremityAffected")=AFFECTED
+15 SET PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"OriginalEffectiveDate")=$$FMTISO^SDAMUTDT($PIECE(RATEDARRAY(COUNT),"^",5))
+16 SET PATIENTLIST("Patient",NUM,"RatedDisabilities",COUNT,"CurrentEffectiveDate")=$$FMTISO^SDAMUTDT($PIECE(RATEDARRAY(COUNT),"^",6))
End DoDot:1
+17 QUIT
+18 ;
GETICN(DFN) ; patient ICN
+1 NEW ICN
+2 ;
+3 SET ICN=$$GETICN^MPIF001(DFN)
+4 IF ICN["-1"
IF $$GET1^DIQ(8989.3,1,.01,"E")["TEST"
QUIT $$GET1^DIQ(2,DFN,991.1)
+5 QUIT ICN
+6 ;
VALIDATE(ERRORS,NUMOFRECORDS,SEARCHSTRING) ;
+1 IF $GET(NUMOFRECORDS)=""
SET NUMOFRECORDS=10
QUIT
+2 IF $GET(NUMOFRECORDS)>50!($GET(NUMOFRECORDS)<1)
DO ERRLOG^SDESJSON(.ERRORS,382)
+3 ;
+4 IF SEARCHSTRING'=""
IF SEARCHSTRING'[","
IF $LENGTH(SEARCHSTRING)<3
SET PATIENTLIST("Patient",1)=""
DO ERRLOG^SDESJSON(.ERRORS,473)
+5 QUIT
+6 ;
TRAILINGSPACES(NAME) ;
+1 NEW FIRSTNAME,LASTNAME
+2 ;
+3 SET FIRSTNAME=$PIECE(NAME,",")
+4 SET LASTNAME=$PIECE(NAME,",",2)
+5 IF $EXTRACT(LASTNAME)=" "
Begin DoDot:1
+6 SET LASTNAME=$EXTRACT(LASTNAME,2,$LENGTH(LASTNAME))
+7 SET NAME=FIRSTNAME_","_LASTNAME
End DoDot:1
+8 QUIT NAME
+9 ;
BUILDJSON(JSONRETURN,RETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
+3 QUIT
+4 ;
