SDES2EDITSNAPS ;ALB/BLB - EDIT SPECIAL NEEDS PREFS; OCT 28, 2023@6:10pm
;;5.3;Scheduling;**864,877**;Aug 13, 1993;Build 14
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EDITNEEDSPREFS(JSON,SDCONTEXT,NEEDSPREFS) ;
N ERRORS,RETURN,VALRETURN
;
D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$G(NEEDSPREFS("PATIENT DFN")),1,,1,2)
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("SpecialNeedsAndPreferences",1)="" M RETURN=ERRORS D BUILDJSON^SDES2JSON(.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) S ERRORS("SpecialNeedsAndPreferences",1)="" M RETURN=ERRORS D BUILDJSON^SDES2JSON(.JSON,.RETURN) Q
;
D VALIDATENEEDPREF(.ERRORS,.NEEDSPREFS)
I $D(ERRORS) S ERRORS("SpecialNeedsAndPreferences",1)="" M RETURN=ERRORS D BUILDJSON^SDES2JSON(.JSON,.RETURN) Q
;
D BUILD(.NEEDSPREFS)
S RETURN("SpecialNeedsAndPreferences")=1 D BUILDJSON^SDES2JSON(.JSON,.RETURN) Q
Q
;
BUILD(NEEDSPREFS) ;
N PATIENTFDA,PREFERENCE,PATIENTFDAERR,NEEDSPREFSFDAERR,RETURNIEN,COUNT,IENS,PREFNAME,NOPREF,INTERNALPREF,EDITREMARK,REMARKIEN
;
; delete any preference that is passed in
; if remarks subscript is null, delete
; if remarks are defined, they will be the new remarks
;
; edit preferences
S COUNT=0,NOPREF=0
F S COUNT=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)) Q:'COUNT D
.S PREFERENCE=$G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
.N NEEDSPREFSFDA,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 $L($G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))) D
..S NEEDSPREFSFDA(409.8451,IENS,.01)="@"
..D FILE^DIE(,"NEEDSPREFSFDA","NEEDSPREFSFDAERR") K NEEDSPREFSFDA
;
; edit preference remarks
S PREFERENCE="",COUNT=0
F S PREFERENCE=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",PREFERENCE)) Q:PREFERENCE="" D
.I $L($$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)) D
..N EDITREMARK
..S COUNT=COUNT+1
..S SUBIEN=0,SUBIEN=$O(^SDEC(409.845,$G(NEEDSPREFS("IEN")),1,"B",$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE),SUBIEN))
..S EDITREMARK(COUNT)=$G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",PREFERENCE,"REMARK"))
..D WP^DIE(409.8451,SUBIEN_","_NEEDSPREFS("IEN")_",",6,"","EDITREMARK") Q
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=$G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
.D VALSETOFCODES^SDES2CREATESNAPS(.ERRORS,PREFERENCE,409.8451,.01,"Invalid special need or preference") I $D(ERRORS) 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2EDITSNAPS 3134 printed Nov 22, 2024@18:03:47 Page 2
SDES2EDITSNAPS ;ALB/BLB - EDIT SPECIAL NEEDS PREFS; OCT 28, 2023@6:10pm
+1 ;;5.3;Scheduling;**864,877**;Aug 13, 1993;Build 14
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
EDITNEEDSPREFS(JSON,SDCONTEXT,NEEDSPREFS) ;
+1 NEW ERRORS,RETURN,VALRETURN
+2 ;
+3 DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$GET(NEEDSPREFS("PATIENT DFN")),1,,1,2)
+4 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+5 IF $DATA(ERRORS)
SET ERRORS("SpecialNeedsAndPreferences",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
QUIT
+6 ;
+7 SET NEEDSPREFS("IEN")=0
SET NEEDSPREFS("IEN")=$ORDER(^SDEC(409.845,"B",NEEDSPREFS("PATIENT DFN"),NEEDSPREFS("IEN")))
+8 IF '$GET(NEEDSPREFS("IEN"))
DO ERRLOG^SDESJSON(.ERRORS,436)
+9 IF $DATA(ERRORS)
SET ERRORS("SpecialNeedsAndPreferences",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
QUIT
+10 ;
+11 DO VALIDATENEEDPREF(.ERRORS,.NEEDSPREFS)
+12 IF $DATA(ERRORS)
SET ERRORS("SpecialNeedsAndPreferences",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
QUIT
+13 ;
+14 DO BUILD(.NEEDSPREFS)
+15 SET RETURN("SpecialNeedsAndPreferences")=1
DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
QUIT
+16 QUIT
+17 ;
BUILD(NEEDSPREFS) ;
+1 NEW PATIENTFDA,PREFERENCE,PATIENTFDAERR,NEEDSPREFSFDAERR,RETURNIEN,COUNT,IENS,PREFNAME,NOPREF,INTERNALPREF,EDITREMARK,REMARKIEN
+2 ;
+3 ; delete any preference that is passed in
+4 ; if remarks subscript is null, delete
+5 ; if remarks are defined, they will be the new remarks
+6 ;
+7 ; edit preferences
+8 SET COUNT=0
SET NOPREF=0
+9 FOR
SET COUNT=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+10 SET PREFERENCE=$GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
+11 NEW NEEDSPREFSFDA,REMARK,SUBIEN
+12 ;
+13 SET INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)
+14 SET SUBIEN=0
SET SUBIEN=$ORDER(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF,SUBIEN))
+15 SET IENS=SUBIEN_","_$GET(NEEDSPREFS("IEN"))_","
+16 ;
+17 IF $LENGTH($GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)))
Begin DoDot:2
+18 SET NEEDSPREFSFDA(409.8451,IENS,.01)="@"
+19 DO FILE^DIE(,"NEEDSPREFSFDA","NEEDSPREFSFDAERR")
KILL NEEDSPREFSFDA
End DoDot:2
End DoDot:1
+20 ;
+21 ; edit preference remarks
+22 SET PREFERENCE=""
SET COUNT=0
+23 FOR
SET PREFERENCE=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",PREFERENCE))
if PREFERENCE=""
QUIT
Begin DoDot:1
+24 IF $LENGTH($$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE))
Begin DoDot:2
+25 NEW EDITREMARK
+26 SET COUNT=COUNT+1
+27 SET SUBIEN=0
SET SUBIEN=$ORDER(^SDEC(409.845,$GET(NEEDSPREFS("IEN")),1,"B",$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE),SUBIEN))
+28 SET EDITREMARK(COUNT)=$GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",PREFERENCE,"REMARK"))
+29 DO WP^DIE(409.8451,SUBIEN_","_NEEDSPREFS("IEN")_",",6,"","EDITREMARK")
QUIT
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
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=$GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
+5 DO VALSETOFCODES^SDES2CREATESNAPS(.ERRORS,PREFERENCE,409.8451,.01,"Invalid special need or preference")
IF $DATA(ERRORS)
SET NOPREF=1
QUIT
+6 SET INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,PREFERENCE)
+7 IF '$DATA(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF))
DO ERRLOG^SDESJSON(.ERRORS,437)
SET NOPREF=1
QUIT
End DoDot:1
+8 QUIT
+9 ;
