SDES2GETPATDEMO ;ALB/BLB/JDJ - SDES2 GET PATIENT DEMOGRAPHICS ;JUN 5,2024
;;5.3;Scheduling;**877,880**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;---------------------------------------------------------------
Q
;
GETDEMOGRAPHICS(JSON,SDCONTEXT,PATIENT) ;
N ERRORS,DEMOGRAPHICS,VAL
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
D VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,2,$G(PATIENT("DFN")),1,,1,2)
I $D(ERRORS) S ERRORS("PatientDemographics")="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D BUILDDEMO(.DEMOGRAPHICS,$G(PATIENT("DFN")))
D BUILDJSON^SDES2JSON(.JSON,.DEMOGRAPHICS)
Q
;
BUILDDEMO(DEMOGRAPHICS,DFN) ;
N RACECOUNT,RACETOTAL,VADM,VAERR,VA
;
D DEM^VADPT
S DEMOGRAPHICS("PatientDemographics","Religion")=$P($G(VADM(9)),U,2)
S DEMOGRAPHICS("PatientDemographics","MaritalStatus")=$P($G(VADM(10)),U,2)
S DEMOGRAPHICS("PatientDemographics","Ethnicity")=$P($G(VADM(11,1)),U,2)
;
S RACETOTAL=$G(VADM(12))
I RACETOTAL=0 S DEMOGRAPHICS("PatientDemographics","RaceInformation",1,"Race")="" Q
S RACECOUNT=0 F S RACECOUNT=$O(VADM(12,RACECOUNT)) Q:'RACECOUNT D
.S DEMOGRAPHICS("PatientDemographics","RaceInformation",RACECOUNT,"Race")=$P($G(VADM(12,RACECOUNT)),U,2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETPATDEMO 1268 printed Nov 22, 2024@18:04:01 Page 2
SDES2GETPATDEMO ;ALB/BLB/JDJ - SDES2 GET PATIENT DEMOGRAPHICS ;JUN 5,2024
+1 ;;5.3;Scheduling;**877,880**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;---------------------------------------------------------------
+4 QUIT
+5 ;
GETDEMOGRAPHICS(JSON,SDCONTEXT,PATIENT) ;
+1 NEW ERRORS,DEMOGRAPHICS,VAL
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 DO VALFILEIEN^SDES2VALUTIL(.VAL,.ERRORS,2,$GET(PATIENT("DFN")),1,,1,2)
+5 IF $DATA(ERRORS)
SET ERRORS("PatientDemographics")=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+6 ;
+7 DO BUILDDEMO(.DEMOGRAPHICS,$GET(PATIENT("DFN")))
+8 DO BUILDJSON^SDES2JSON(.JSON,.DEMOGRAPHICS)
+9 QUIT
+10 ;
BUILDDEMO(DEMOGRAPHICS,DFN) ;
+1 NEW RACECOUNT,RACETOTAL,VADM,VAERR,VA
+2 ;
+3 DO DEM^VADPT
+4 SET DEMOGRAPHICS("PatientDemographics","Religion")=$PIECE($GET(VADM(9)),U,2)
+5 SET DEMOGRAPHICS("PatientDemographics","MaritalStatus")=$PIECE($GET(VADM(10)),U,2)
+6 SET DEMOGRAPHICS("PatientDemographics","Ethnicity")=$PIECE($GET(VADM(11,1)),U,2)
+7 ;
+8 SET RACETOTAL=$GET(VADM(12))
+9 IF RACETOTAL=0
SET DEMOGRAPHICS("PatientDemographics","RaceInformation",1,"Race")=""
QUIT
+10 SET RACECOUNT=0
FOR
SET RACECOUNT=$ORDER(VADM(12,RACECOUNT))
if 'RACECOUNT
QUIT
Begin DoDot:1
+11 SET DEMOGRAPHICS("PatientDemographics","RaceInformation",RACECOUNT,"Race")=$PIECE($GET(VADM(12,RACECOUNT)),U,2)
End DoDot:1
+12 QUIT
+13 ;
