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  Sep 23, 2025@20:30:20                                                                                                                                                                                              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       ;