SDES2EDITPATDEMO.m

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 ---SDES2EDITPATDEMO   3646     printed  Feb 19, 2025@00:20:14                                                                                                                                                                                            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