- 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 Mar 13, 2025@22:01:40 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 ;
