SDES2EDITPATDEMO ;ALB/BLB,BWF,JDJ - SDES2 EDIT PATIENT DEMOGRAPHICS ;JUN 17,2024
;;5.3;Scheduling;**877,878,881**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;---------------------------------------------------------------
Q
;
EDITDEMOGRAPHICS(JSON,SDCONTEXT,PATIENT) ;
N ERRORS,RETURN
;
D VALIDATE(.ERRORS,.PATIENT,.SDCONTEXT)
I $D(ERRORS) S ERRORS("EditPatientDemographics")="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D EDITDEMO($G(PATIENT("DFN")))
S RETURN("EditPatientDemographics")=1
D BUILDJSON^SDES2JSON(.JSON,.RETURN)
Q
;
VALIDATE(ERRORS,PATIENT,SDCONTEXT) ;
N RACECOUNT
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,2,$G(PATIENT("DFN")),1,,1,2)
;
S RACECOUNT=0
F S RACECOUNT=$O(PATIENT("RACE",RACECOUNT)) Q:'RACECOUNT D
.I $G(PATIENT("RACE",RACECOUNT))="" K PATIENT("RACE",RACECOUNT) Q
.D VALDEMO(.ERRORS,$E($G(PATIENT("RACE",RACECOUNT)),1,30),"RACE")
I $G(PATIENT("ETHNICITY"))'="" D VALDEMO(.ERRORS,$G(PATIENT("ETHNICITY")),"ETHNICITY")
I $G(PATIENT("MARITAL STATUS"))'="" D VALDEMO(.ERRORS,$G(PATIENT("MARITAL STATUS")),"MARITAL STATUS")
I $G(PATIENT("RELIGION"))'="" D VALDEMO(.ERRORS,$G(PATIENT("RELIGION")),"RELIGION")
Q
;
EDITDEMO(DFN) ;
N TOPLEVELFDA,ETHNICITYFDA,RACEFDA,ETHNICITYIEN,RACECOUNT,SUBIEN,IENS,ERROR
;
; top level patient
I $L($G(PATIENT("RELIGION"))) D
.S TOPLEVELFDA(2,DFN_",",.08)=$$GETDEMOIEN($G(PATIENT("RELIGION")),"RELIGION")
I $L($G(PATIENT("MARITAL STATUS"))) D
.S TOPLEVELFDA(2,DFN_",",.05)=$$GETDEMOIEN($G(PATIENT("MARITAL STATUS")),"MARITAL STATUS")
I $D(TOPLEVELFDA) D
.D FILE^DIE(,"TOPLEVELFDA") K TOPLEVELFDA
;
; sub level race
I $D(PATIENT("RACE")) D
.S SUBIEN=0
.F S SUBIEN=$O(^DPT(DFN,.02,SUBIEN)) Q:'SUBIEN D
..S IENS=SUBIEN_","_DFN_","
..S RACEFDA(2.02,IENS,.01)="@"
..D FILE^DIE(,"RACEFDA") K RACEFDA
.;
.S RACECOUNT=0
.F S RACECOUNT=$O(PATIENT("RACE",RACECOUNT)) Q:'RACECOUNT D
..S IENS="+1,"_DFN_","
..S RACEFDA(2.02,IENS,.01)=$$GETDEMOIEN($E($G(PATIENT("RACE",RACECOUNT)),1,30),"RACE")
..S RACEFDA(2.02,IENS,.02)=1
..D UPDATE^DIE(,"RACEFDA",,"ERROR") K RACEFDA
;
; sub level ethnicity
I $L($G(PATIENT("ETHNICITY"))) D
.S ETHNICITYIEN=0,ETHNICITYIEN=$O(^DPT(DFN,.06,ETHNICITYIEN))
.;
.I '$G(ETHNICITYIEN) D Q
..S ETHNICITYFDA(2.06,"+1,"_DFN_",",.01)=$$GETDEMOIEN($G(PATIENT("ETHNICITY")),"ETHNICITY")
..S ETHNICITYFDA(2.06,"+1,"_DFN_",",.02)=1
..D UPDATE^DIE(,"ETHNICITYFDA") K ETHNICITYFDA
.;
.S ETHNICITYFDA(2.06,ETHNICITYIEN_","_DFN_",",.01)=$$GETDEMOIEN($G(PATIENT("ETHNICITY")),"ETHNICITY")
.S ETHNICITYFDA(2.06,ETHNICITYIEN_","_DFN_",",.02)=1
.D FILE^DIE(,"ETHNICITYFDA") K ETHNICITYFDA
Q
;
GETDEMOIEN(DEMO,TYPE) ;
Q $S(TYPE="RELIGION":$O(^DIC(13,"B",DEMO,"")),TYPE="RACE":$O(^DIC(10,"B",DEMO,"")),TYPE="ETHNICITY":$O(^DIC(10.2,"B",DEMO,"")),TYPE="MARITAL STATUS":$O(^DIC(11,"B",DEMO,"")),1:"")
;
VALDEMO(ERRORS,DEMOGRAPHIC,TYPE) ;
N FILENUM,DEMOIEN
I '$L(DEMOGRAPHIC) Q
S FILENUM=$S(TYPE="RELIGION":13,TYPE="RACE":10,TYPE="ETHNICITY":10.2,TYPE="MARITAL STATUS":11,1:"")
I FILENUM="" D ERRLOG^SDES2JSON(.ERRORS,565) Q
I '$D(^DIC(FILENUM,"B",DEMOGRAPHIC)) D ERRLOG^SDES2JSON(.ERRORS,565) Q
S DEMOIEN=$O(^DIC(FILENUM,"B",DEMOGRAPHIC,0))
I 'DEMOIEN D ERRLOG^SDES2JSON(.ERRORS,52,"Unable to locate "_DEMOGRAPHIC) Q
I TYPE="RACE" D:+$$INACTIVE^DGUTL4(DEMOIEN,1) ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Race: "_DEMOGRAPHIC)
I TYPE="ETHNICITY" D:+$$INACTIVE^DGUTL4(DEMOIEN,2) ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Ethnicity: "_DEMOGRAPHIC)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2EDITPATDEMO 3646 printed Sep 15, 2024@22:17:43 Page 2
SDES2EDITPATDEMO ;ALB/BLB,BWF,JDJ - SDES2 EDIT PATIENT DEMOGRAPHICS ;JUN 17,2024
+1 ;;5.3;Scheduling;**877,878,881**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;---------------------------------------------------------------
+4 QUIT
+5 ;
EDITDEMOGRAPHICS(JSON,SDCONTEXT,PATIENT) ;
+1 NEW ERRORS,RETURN
+2 ;
+3 DO VALIDATE(.ERRORS,.PATIENT,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("EditPatientDemographics")=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+5 ;
+6 DO EDITDEMO($GET(PATIENT("DFN")))
+7 SET RETURN("EditPatientDemographics")=1
+8 DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
+9 QUIT
+10 ;
VALIDATE(ERRORS,PATIENT,SDCONTEXT) ;
+1 NEW RACECOUNT
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,2,$GET(PATIENT("DFN")),1,,1,2)
+5 ;
+6 SET RACECOUNT=0
+7 FOR
SET RACECOUNT=$ORDER(PATIENT("RACE",RACECOUNT))
if 'RACECOUNT
QUIT
Begin DoDot:1
+8 IF $GET(PATIENT("RACE",RACECOUNT))=""
KILL PATIENT("RACE",RACECOUNT)
QUIT
+9 DO VALDEMO(.ERRORS,$EXTRACT($GET(PATIENT("RACE",RACECOUNT)),1,30),"RACE")
End DoDot:1
+10 IF $GET(PATIENT("ETHNICITY"))'=""
DO VALDEMO(.ERRORS,$GET(PATIENT("ETHNICITY")),"ETHNICITY")
+11 IF $GET(PATIENT("MARITAL STATUS"))'=""
DO VALDEMO(.ERRORS,$GET(PATIENT("MARITAL STATUS")),"MARITAL STATUS")
+12 IF $GET(PATIENT("RELIGION"))'=""
DO VALDEMO(.ERRORS,$GET(PATIENT("RELIGION")),"RELIGION")
+13 QUIT
+14 ;
EDITDEMO(DFN) ;
+1 NEW TOPLEVELFDA,ETHNICITYFDA,RACEFDA,ETHNICITYIEN,RACECOUNT,SUBIEN,IENS,ERROR
+2 ;
+3 ; top level patient
+4 IF $LENGTH($GET(PATIENT("RELIGION")))
Begin DoDot:1
+5 SET TOPLEVELFDA(2,DFN_",",.08)=$$GETDEMOIEN($GET(PATIENT("RELIGION")),"RELIGION")
End DoDot:1
+6 IF $LENGTH($GET(PATIENT("MARITAL STATUS")))
Begin DoDot:1
+7 SET TOPLEVELFDA(2,DFN_",",.05)=$$GETDEMOIEN($GET(PATIENT("MARITAL STATUS")),"MARITAL STATUS")
End DoDot:1
+8 IF $DATA(TOPLEVELFDA)
Begin DoDot:1
+9 DO FILE^DIE(,"TOPLEVELFDA")
KILL TOPLEVELFDA
End DoDot:1
+10 ;
+11 ; sub level race
+12 IF $DATA(PATIENT("RACE"))
Begin DoDot:1
+13 SET SUBIEN=0
+14 FOR
SET SUBIEN=$ORDER(^DPT(DFN,.02,SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:2
+15 SET IENS=SUBIEN_","_DFN_","
+16 SET RACEFDA(2.02,IENS,.01)="@"
+17 DO FILE^DIE(,"RACEFDA")
KILL RACEFDA
End DoDot:2
+18 ;
+19 SET RACECOUNT=0
+20 FOR
SET RACECOUNT=$ORDER(PATIENT("RACE",RACECOUNT))
if 'RACECOUNT
QUIT
Begin DoDot:2
+21 SET IENS="+1,"_DFN_","
+22 SET RACEFDA(2.02,IENS,.01)=$$GETDEMOIEN($EXTRACT($GET(PATIENT("RACE",RACECOUNT)),1,30),"RACE")
+23 SET RACEFDA(2.02,IENS,.02)=1
+24 DO UPDATE^DIE(,"RACEFDA",,"ERROR")
KILL RACEFDA
End DoDot:2
End DoDot:1
+25 ;
+26 ; sub level ethnicity
+27 IF $LENGTH($GET(PATIENT("ETHNICITY")))
Begin DoDot:1
+28 SET ETHNICITYIEN=0
SET ETHNICITYIEN=$ORDER(^DPT(DFN,.06,ETHNICITYIEN))
+29 ;
+30 IF '$GET(ETHNICITYIEN)
Begin DoDot:2
+31 SET ETHNICITYFDA(2.06,"+1,"_DFN_",",.01)=$$GETDEMOIEN($GET(PATIENT("ETHNICITY")),"ETHNICITY")
+32 SET ETHNICITYFDA(2.06,"+1,"_DFN_",",.02)=1
+33 DO UPDATE^DIE(,"ETHNICITYFDA")
KILL ETHNICITYFDA
End DoDot:2
QUIT
+34 ;
+35 SET ETHNICITYFDA(2.06,ETHNICITYIEN_","_DFN_",",.01)=$$GETDEMOIEN($GET(PATIENT("ETHNICITY")),"ETHNICITY")
+36 SET ETHNICITYFDA(2.06,ETHNICITYIEN_","_DFN_",",.02)=1
+37 DO FILE^DIE(,"ETHNICITYFDA")
KILL ETHNICITYFDA
End DoDot:1
+38 QUIT
+39 ;
GETDEMOIEN(DEMO,TYPE) ;
+1 QUIT $SELECT(TYPE="RELIGION":$ORDER(^DIC(13,"B",DEMO,"")),TYPE="RACE":$ORDER(^DIC(10,"B",DEMO,"")),TYPE="ETHNICITY":$ORDER(^DIC(10.2,"B",DEMO,"")),TYPE="MARITAL STATUS":$ORDER(^DIC(11,"B",DEMO,"")),1:"")
+2 ;
VALDEMO(ERRORS,DEMOGRAPHIC,TYPE) ;
+1 NEW FILENUM,DEMOIEN
+2 IF '$LENGTH(DEMOGRAPHIC)
QUIT
+3 SET FILENUM=$SELECT(TYPE="RELIGION":13,TYPE="RACE":10,TYPE="ETHNICITY":10.2,TYPE="MARITAL STATUS":11,1:"")
+4 IF FILENUM=""
DO ERRLOG^SDES2JSON(.ERRORS,565)
QUIT
+5 IF '$DATA(^DIC(FILENUM,"B",DEMOGRAPHIC))
DO ERRLOG^SDES2JSON(.ERRORS,565)
QUIT
+6 SET DEMOIEN=$ORDER(^DIC(FILENUM,"B",DEMOGRAPHIC,0))
+7 IF 'DEMOIEN
DO ERRLOG^SDES2JSON(.ERRORS,52,"Unable to locate "_DEMOGRAPHIC)
QUIT
+8 IF TYPE="RACE"
if +$$INACTIVE^DGUTL4(DEMOIEN,1)
DO ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Race: "_DEMOGRAPHIC)
+9 IF TYPE="ETHNICITY"
if +$$INACTIVE^DGUTL4(DEMOIEN,2)
DO ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Ethnicity: "_DEMOGRAPHIC)
+10 QUIT
