SDESEDITNEEDPREF ;ALB/BLB - SDES EDIT SPEC NEEDS PREFS; MAY 08, 2023@6:10pm
;;5.3;Scheduling;**845**;Aug 13, 1993;Build 8
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EDITNEEDSPREFS(JSON,NEEDSPREFS) ;
N ERRORS,RETURN
;
D VALIDATEDFN^SDESCRTNEEDPREFS(.ERRORS,$G(NEEDSPREFS("PATIENT DFN")))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
;
S NEEDSPREFS("IEN")=0,NEEDSPREFS("IEN")=$O(^SDEC(409.845,"B",NEEDSPREFS("PATIENT DFN"),NEEDSPREFS("IEN")))
I '$G(NEEDSPREFS("IEN")) D ERRLOG^SDESJSON(.ERRORS,436)
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
;
D VALIDATENEEDPREF(.ERRORS,.NEEDSPREFS)
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
;
D BUILD(.NEEDSPREFS)
S RETURN(1)=1 D BUILDJSON(.JSON,.RETURN) Q
Q
;
BUILD(NEEDSPREFS) ;
N PATIENTFDA,PATIENTFDAERR,NEEDSPREFSFDAERR,RETURNIEN,COUNT,RETURNPREFIEN,IENS,PREFNAME,NOPREF,INTERNALPREF
S COUNT=0,NOPREF=0
F S COUNT=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)) Q:'COUNT D
.S PREFERENCE=""
.F S PREFERENCE=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE)) Q:PREFERENCE="" D
..N NEEDSPREFSFDA,RETURNPREFIEN,REMARK,SUBIEN
..;
..S INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)
..S SUBIEN=0,SUBIEN=$O(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF,SUBIEN))
..S IENS=SUBIEN_","_$G(NEEDSPREFS("IEN"))_","
..I $G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))="@" D
...S NEEDSPREFSFDA(409.8451,IENS,.01)=$G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))
...D FILE^DIE(,"NEEDSPREFSFDA","NEEDSPREFSFDAERR") K FDA
..;
..; sub level word processing entry
..I $D(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS")) D
...S REMARK(COUNT)=NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS")
...D WP^DIE(409.8451,SUBIEN_","_NEEDSPREFS("IEN")_",",6,,"REMARK")
Q
;
VALIDATENEEDPREF(ERRORS,NEEDSPREFS) ;
N COUNT,PREFERENCE,NOPREF,INTERNALPREF
S COUNT=0,NOPREF=0,INTERNALPREF=""
F S COUNT=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)) Q:'COUNT!(NOPREF=1) D
.S PREFERENCE=""
.F S PREFERENCE=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE)) Q:PREFERENCE=""!(NOPREF=1) D
..D VALSETOFCODES^SDESCRTNEEDPREFS(.ERRORS,PREFERENCE,409.8451,.01,"Invalid special need or preference") I $D(ERRORS) S NOPREF=1 Q
..I $G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))="",'$L($G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS"))) D ERRLOG^SDESJSON(.ERRORS,439) S NOPREF=1 Q
..I $G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))'="@",'$L($G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS"))) D ERRLOG^SDESJSON(.ERRORS,440) S NOPREF=1 Q
..S INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)
..I '$D(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF)) D ERRLOG^SDESJSON(.ERRORS,437) S NOPREF=1 Q
Q
;
BUILDJSON(JSONRETURN,RETURN) ;
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESEDITNEEDPREF 3098 printed Nov 22, 2024@18:06:26 Page 2
SDESEDITNEEDPREF ;ALB/BLB - SDES EDIT SPEC NEEDS PREFS; MAY 08, 2023@6:10pm
+1 ;;5.3;Scheduling;**845**;Aug 13, 1993;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
EDITNEEDSPREFS(JSON,NEEDSPREFS) ;
+1 NEW ERRORS,RETURN
+2 ;
+3 DO VALIDATEDFN^SDESCRTNEEDPREFS(.ERRORS,$GET(NEEDSPREFS("PATIENT DFN")))
+4 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSON,.RETURN)
QUIT
+5 ;
+6 SET NEEDSPREFS("IEN")=0
SET NEEDSPREFS("IEN")=$ORDER(^SDEC(409.845,"B",NEEDSPREFS("PATIENT DFN"),NEEDSPREFS("IEN")))
+7 IF '$GET(NEEDSPREFS("IEN"))
DO ERRLOG^SDESJSON(.ERRORS,436)
+8 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSON,.RETURN)
QUIT
+9 ;
+10 DO VALIDATENEEDPREF(.ERRORS,.NEEDSPREFS)
+11 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSON,.RETURN)
QUIT
+12 ;
+13 DO BUILD(.NEEDSPREFS)
+14 SET RETURN(1)=1
DO BUILDJSON(.JSON,.RETURN)
QUIT
+15 QUIT
+16 ;
BUILD(NEEDSPREFS) ;
+1 NEW PATIENTFDA,PATIENTFDAERR,NEEDSPREFSFDAERR,RETURNIEN,COUNT,RETURNPREFIEN,IENS,PREFNAME,NOPREF,INTERNALPREF
+2 SET COUNT=0
SET NOPREF=0
+3 FOR
SET COUNT=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+4 SET PREFERENCE=""
+5 FOR
SET PREFERENCE=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))
if PREFERENCE=""
QUIT
Begin DoDot:2
+6 NEW NEEDSPREFSFDA,RETURNPREFIEN,REMARK,SUBIEN
+7 ;
+8 SET INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)
+9 SET SUBIEN=0
SET SUBIEN=$ORDER(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF,SUBIEN))
+10 SET IENS=SUBIEN_","_$GET(NEEDSPREFS("IEN"))_","
+11 IF $GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))="@"
Begin DoDot:3
+12 SET NEEDSPREFSFDA(409.8451,IENS,.01)=$GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))
+13 DO FILE^DIE(,"NEEDSPREFSFDA","NEEDSPREFSFDAERR")
KILL FDA
End DoDot:3
+14 ;
+15 ; sub level word processing entry
+16 IF $DATA(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS"))
Begin DoDot:3
+17 SET REMARK(COUNT)=NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS")
+18 DO WP^DIE(409.8451,SUBIEN_","_NEEDSPREFS("IEN")_",",6,,"REMARK")
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
VALIDATENEEDPREF(ERRORS,NEEDSPREFS) ;
+1 NEW COUNT,PREFERENCE,NOPREF,INTERNALPREF
+2 SET COUNT=0
SET NOPREF=0
SET INTERNALPREF=""
+3 FOR
SET COUNT=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
if 'COUNT!(NOPREF=1)
QUIT
Begin DoDot:1
+4 SET PREFERENCE=""
+5 FOR
SET PREFERENCE=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))
if PREFERENCE=""!(NOPREF=1)
QUIT
Begin DoDot:2
+6 DO VALSETOFCODES^SDESCRTNEEDPREFS(.ERRORS,PREFERENCE,409.8451,.01,"Invalid special need or preference")
IF $DATA(ERRORS)
SET NOPREF=1
QUIT
+7 IF $GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))=""
IF '$LENGTH($GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS")))
DO ERRLOG^SDESJSON(.ERRORS,439)
SET NOPREF=1
QUIT
+8 IF $GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE))'="@"
IF '$LENGTH($GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,PREFERENCE,"REMARKS")))
DO ERRLOG^SDESJSON(.ERRORS,440)
SET NOPREF=1
QUIT
+9 SET INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)
+10 IF '$DATA(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF))
DO ERRLOG^SDESJSON(.ERRORS,437)
SET NOPREF=1
QUIT
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
BUILDJSON(JSONRETURN,RETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN")
+3 QUIT
+4 ;
