SDES2GETDEMOS ;ALB/BLB,BWF - SDES2 GET DEMOGRAPHICS ;MAY 20,2024
;;5.3;Scheduling;**877,878**;Aug 13, 1993;Build 11
;;Per VHA Directive 6402, this routine should not be modified
;---------------------------------------------------------------
; Reference to DGUTL4 in ICR #3799
; Reference to MARITAL STATUS in ICR #428
; Reference to RELIGION in ICR #1414
;
Q
;
GETDEMOGRAPHICS(JSON,SDCONTEXT) ;
N DEMOGRAPHICS,ERRORS
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Demographics")="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D BUILDRACE(.DEMOGRAPHICS)
D BUILDRELIGION(.DEMOGRAPHICS)
D BUILDETHNICITY(.DEMOGRAPHICS)
D BUILDMARITALSTAT(.DEMOGRAPHICS)
D BUILDJSON^SDES2JSON(.JSON,.DEMOGRAPHICS)
Q
;
BUILDRACE(DEMOGRAPHICS) ;
N RACEIEN,RACECOUNT
;
S RACEIEN=0,RACECOUNT=0
F S RACEIEN=$O(^DIC(10,RACEIEN)) Q:'RACEIEN D
.Q:+$$INACTIVE^DGUTL4(RACEIEN,1)
.S RACECOUNT=RACECOUNT+1
.S DEMOGRAPHICS("Demographics","Race",RACECOUNT)=$$PTR2TEXT^DGUTL4(RACEIEN,1)
Q
;
BUILDRELIGION(DEMOGRAPHICS) ;
N RELIGIONIEN,RELIGIONCOUNT
;
S RELIGIONIEN=0,RELIGIONCOUNT=0
F S RELIGIONIEN=$O(^DIC(13,RELIGIONIEN)) Q:'RELIGIONIEN D
.S RELIGIONCOUNT=RELIGIONCOUNT+1
.S DEMOGRAPHICS("Demographics","Religion",RELIGIONCOUNT)=$$GET1^DIQ(13,RELIGIONIEN,.01,"E")
Q
;
BUILDETHNICITY(DEMOGRAPHICS) ;
N ETHNICITYIEN,ETHNICITYCOUNT
;
S ETHNICITYIEN=0,ETHNICITYCOUNT=0
F S ETHNICITYIEN=$O(^DIC(10.2,ETHNICITYIEN)) Q:'ETHNICITYIEN D
.Q:+$$INACTIVE^DGUTL4(ETHNICITYIEN,2)
.S ETHNICITYCOUNT=ETHNICITYCOUNT+1
.S DEMOGRAPHICS("Demographics","Ethnicity",ETHNICITYCOUNT)=$$PTR2TEXT^DGUTL4(ETHNICITYIEN,2)
Q
;
BUILDMARITALSTAT(DEMOGRAPHICS) ;
N MARITALIEN,MARITALCOUNT
;
S MARITALIEN=0,MARITALCOUNT=0
F S MARITALIEN=$O(^DIC(11,MARITALIEN)) Q:'MARITALIEN D
.S MARITALCOUNT=MARITALCOUNT+1
.S DEMOGRAPHICS("Demographics","MaritalStatus",MARITALCOUNT)=$$GET1^DIQ(11,MARITALIEN,.01,"E")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETDEMOS 1990 printed Dec 13, 2024@02:53:58 Page 2
SDES2GETDEMOS ;ALB/BLB,BWF - SDES2 GET DEMOGRAPHICS ;MAY 20,2024
+1 ;;5.3;Scheduling;**877,878**;Aug 13, 1993;Build 11
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;---------------------------------------------------------------
+4 ; Reference to DGUTL4 in ICR #3799
+5 ; Reference to MARITAL STATUS in ICR #428
+6 ; Reference to RELIGION in ICR #1414
+7 ;
+8 QUIT
+9 ;
GETDEMOGRAPHICS(JSON,SDCONTEXT) ;
+1 NEW DEMOGRAPHICS,ERRORS
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Demographics")=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+5 ;
+6 DO BUILDRACE(.DEMOGRAPHICS)
+7 DO BUILDRELIGION(.DEMOGRAPHICS)
+8 DO BUILDETHNICITY(.DEMOGRAPHICS)
+9 DO BUILDMARITALSTAT(.DEMOGRAPHICS)
+10 DO BUILDJSON^SDES2JSON(.JSON,.DEMOGRAPHICS)
+11 QUIT
+12 ;
BUILDRACE(DEMOGRAPHICS) ;
+1 NEW RACEIEN,RACECOUNT
+2 ;
+3 SET RACEIEN=0
SET RACECOUNT=0
+4 FOR
SET RACEIEN=$ORDER(^DIC(10,RACEIEN))
if 'RACEIEN
QUIT
Begin DoDot:1
+5 if +$$INACTIVE^DGUTL4(RACEIEN,1)
QUIT
+6 SET RACECOUNT=RACECOUNT+1
+7 SET DEMOGRAPHICS("Demographics","Race",RACECOUNT)=$$PTR2TEXT^DGUTL4(RACEIEN,1)
End DoDot:1
+8 QUIT
+9 ;
BUILDRELIGION(DEMOGRAPHICS) ;
+1 NEW RELIGIONIEN,RELIGIONCOUNT
+2 ;
+3 SET RELIGIONIEN=0
SET RELIGIONCOUNT=0
+4 FOR
SET RELIGIONIEN=$ORDER(^DIC(13,RELIGIONIEN))
if 'RELIGIONIEN
QUIT
Begin DoDot:1
+5 SET RELIGIONCOUNT=RELIGIONCOUNT+1
+6 SET DEMOGRAPHICS("Demographics","Religion",RELIGIONCOUNT)=$$GET1^DIQ(13,RELIGIONIEN,.01,"E")
End DoDot:1
+7 QUIT
+8 ;
BUILDETHNICITY(DEMOGRAPHICS) ;
+1 NEW ETHNICITYIEN,ETHNICITYCOUNT
+2 ;
+3 SET ETHNICITYIEN=0
SET ETHNICITYCOUNT=0
+4 FOR
SET ETHNICITYIEN=$ORDER(^DIC(10.2,ETHNICITYIEN))
if 'ETHNICITYIEN
QUIT
Begin DoDot:1
+5 if +$$INACTIVE^DGUTL4(ETHNICITYIEN,2)
QUIT
+6 SET ETHNICITYCOUNT=ETHNICITYCOUNT+1
+7 SET DEMOGRAPHICS("Demographics","Ethnicity",ETHNICITYCOUNT)=$$PTR2TEXT^DGUTL4(ETHNICITYIEN,2)
End DoDot:1
+8 QUIT
+9 ;
BUILDMARITALSTAT(DEMOGRAPHICS) ;
+1 NEW MARITALIEN,MARITALCOUNT
+2 ;
+3 SET MARITALIEN=0
SET MARITALCOUNT=0
+4 FOR
SET MARITALIEN=$ORDER(^DIC(11,MARITALIEN))
if 'MARITALIEN
QUIT
Begin DoDot:1
+5 SET MARITALCOUNT=MARITALCOUNT+1
+6 SET DEMOGRAPHICS("Demographics","MaritalStatus",MARITALCOUNT)=$$GET1^DIQ(11,MARITALIEN,.01,"E")
End DoDot:1
+7 QUIT
+8 ;
