Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESCRTNEEDPREFS

SDESCRTNEEDPREFS.m

Go to the documentation of this file.
SDESCRTNEEDPREFS ;ALB/BLB - SDES CREATE 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
 ;
CREATENEEDSPREFS(JSON,NEEDSPREFS) ;
 N ERRORS,RETURN
 ;
 D VALIDATEDFN(.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")))
 D VALIDATENEEDPREF(.ERRORS,.NEEDSPREFS)
 I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSON,.RETURN) Q
 ;
 D BUILD(.NEEDSPREFS,.RETURN)
 D BUILDJSON(.JSON,.RETURN) Q
 Q
 ;
BUILD(NEEDSPREFS,RETURN) ;
 N PATIENTFDA,PATIENTFDAERR,NEEDSPREFSFDAERR,RETURNIEN,COUNT,IENS
 ;
 ; create top level patient record
 I '$G(NEEDSPREFS("IEN")) D
 .S PATIENTFDA(409.845,"+1,",.01)=NEEDSPREFS("PATIENT DFN")
 .D UPDATE^DIE("","PATIENTFDA","RETURNIEN","PATIENTFDAERR") K PATIENTFDA
 .S NEEDSPREFS("IEN")=$G(RETURNIEN(1))
 ;
 ; create sub level pref record
 S COUNT=0
 F  S COUNT=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)) Q:'COUNT  D
 .;
 .N NEEDSPREFSFDA,REMARK,RETURNPREFIEN
 .S IENS="+1,"_NEEDSPREFS("IEN")_","
 .S NEEDSPREFSFDA(409.8451,IENS,.01)=$G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
 .S NEEDSPREFSFDA(409.8451,IENS,2)=$$NOW^XLFDT
 .S NEEDSPREFSFDA(409.8451,IENS,3)=$G(DUZ)
 .D UPDATE^DIE(,"NEEDSPREFSFDA","RETURNPREFIEN","NEEDSPREFSFDAERR") K NEEDSPREFSFDA
 .S RETURN("SPECIAL NEEDS AND PREFERENCES",COUNT,"NAME")=$$SOCINT2EXT^SDESUTIL(409.8451,.01,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
 .;
 .; create sub level word processing entry
 .I $D(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,"REMARK")) D
 ..S REMARK(COUNT)=NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,"REMARK")
 ..D WP^DIE(409.8451,RETURNPREFIEN(1)_","_NEEDSPREFS("IEN")_",",6,,"REMARK")
 Q
 ;
VALIDATENEEDPREF(ERRORS,NEEDSPREFS) ;
 N COUNT,DUP,INTERNALPREF
 I '$L($G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",1))) D ERRLOG^SDESJSON(.ERRORS,438) Q
 S COUNT=0,DUP=0
 F  S COUNT=$O(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)) Q:'COUNT!(DUP=1)  D
 .D VALSETOFCODES(.ERRORS,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT),409.8451,.01,"Invalid special need or preference") I $D(ERRORS) S DUP=1 Q
 .I $G(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))="" D ERRLOG^SDESJSON(.ERRORS,438) S DUP=1 Q
 .I $G(NEEDSPREFS("IEN")) D
 ..S INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
 ..I $D(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF)) D ERRLOG^SDESJSON(.ERRORS,435) S DUP=1 Q
 .S NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)=$$SOCEXT2INT^SDESUTIL(409.8451,.01,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
 Q
 ;
VALSETOFCODES(ERRORS,VALUE,FILE,FLD,TEXT) ;
 N RESULTS,CONT,CODE,INTCODE,FOUND,RESULTS,ITEM,EXTCODE
 I VALUE="" D ERRLOG^SDESJSON(.ERRORS,52,"Missing set of codes value: "_TEXT_".") Q
 D FIELD^DID(FILE,FLD,"","SET OF CODES","RESULTS")
 S FOUND=0
 F ITEM=1:1:$L(RESULTS("SET OF CODES"),";") D  Q:FOUND
 .S CODE=$P(RESULTS("SET OF CODES"),";",ITEM) Q:'$L(CODE)
 .S INTCODE=$P(CODE,":"),EXTCODE=$P(CODE,":",2)
 .I VALUE=EXTCODE S FOUND=1 Q
 I 'FOUND D ERRLOG^SDESJSON(.ERRORS,52,"Invalid set of codes value: "_TEXT_": '"_VALUE_"'.")
 Q
VALIDATEDFN(ERRORS,DFN) ;
 I DFN="" D ERRLOG^SDESJSON(.ERRORS,1) Q 0
 I DFN'="",'$D(^DPT(DFN,0)) D ERRLOG^SDESJSON(.ERRORS,2) Q 0
 Q 1
 ;
BUILDJSON(JSON,RETURN) ;
 D ENCODE^XLFJSON("RETURN","JSON")
 Q
 ;