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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCRTNEEDPREFS 3573 printed Nov 22, 2024@18:06:19 Page 2
SDESCRTNEEDPREFS ;ALB/BLB - SDES CREATE 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 ;
CREATENEEDSPREFS(JSON,NEEDSPREFS) ;
+1 NEW ERRORS,RETURN
+2 ;
+3 DO VALIDATEDFN(.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 DO VALIDATENEEDPREF(.ERRORS,.NEEDSPREFS)
+8 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSON,.RETURN)
QUIT
+9 ;
+10 DO BUILD(.NEEDSPREFS,.RETURN)
+11 DO BUILDJSON(.JSON,.RETURN)
QUIT
+12 QUIT
+13 ;
BUILD(NEEDSPREFS,RETURN) ;
+1 NEW PATIENTFDA,PATIENTFDAERR,NEEDSPREFSFDAERR,RETURNIEN,COUNT,IENS
+2 ;
+3 ; create top level patient record
+4 IF '$GET(NEEDSPREFS("IEN"))
Begin DoDot:1
+5 SET PATIENTFDA(409.845,"+1,",.01)=NEEDSPREFS("PATIENT DFN")
+6 DO UPDATE^DIE("","PATIENTFDA","RETURNIEN","PATIENTFDAERR")
KILL PATIENTFDA
+7 SET NEEDSPREFS("IEN")=$GET(RETURNIEN(1))
End DoDot:1
+8 ;
+9 ; create sub level pref record
+10 SET COUNT=0
+11 FOR
SET COUNT=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+12 ;
+13 NEW NEEDSPREFSFDA,REMARK,RETURNPREFIEN
+14 SET IENS="+1,"_NEEDSPREFS("IEN")_","
+15 SET NEEDSPREFSFDA(409.8451,IENS,.01)=$GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
+16 SET NEEDSPREFSFDA(409.8451,IENS,2)=$$NOW^XLFDT
+17 SET NEEDSPREFSFDA(409.8451,IENS,3)=$GET(DUZ)
+18 DO UPDATE^DIE(,"NEEDSPREFSFDA","RETURNPREFIEN","NEEDSPREFSFDAERR")
KILL NEEDSPREFSFDA
+19 SET RETURN("SPECIAL NEEDS AND PREFERENCES",COUNT,"NAME")=$$SOCINT2EXT^SDESUTIL(409.8451,.01,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
+20 ;
+21 ; create sub level word processing entry
+22 IF $DATA(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,"REMARK"))
Begin DoDot:2
+23 SET REMARK(COUNT)=NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT,"REMARK")
+24 DO WP^DIE(409.8451,RETURNPREFIEN(1)_","_NEEDSPREFS("IEN")_",",6,,"REMARK")
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
VALIDATENEEDPREF(ERRORS,NEEDSPREFS) ;
+1 NEW COUNT,DUP,INTERNALPREF
+2 IF '$LENGTH($GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",1)))
DO ERRLOG^SDESJSON(.ERRORS,438)
QUIT
+3 SET COUNT=0
SET DUP=0
+4 FOR
SET COUNT=$ORDER(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
if 'COUNT!(DUP=1)
QUIT
Begin DoDot:1
+5 DO VALSETOFCODES(.ERRORS,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT),409.8451,.01,"Invalid special need or preference")
IF $DATA(ERRORS)
SET DUP=1
QUIT
+6 IF $GET(NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))=""
DO ERRLOG^SDESJSON(.ERRORS,438)
SET DUP=1
QUIT
+7 IF $GET(NEEDSPREFS("IEN"))
Begin DoDot:2
+8 SET INTERNALPREF=$$SOCEXT2INT^SDESUTIL(409.8451,.01,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
+9 IF $DATA(^SDEC(409.845,NEEDSPREFS("IEN"),1,"B",INTERNALPREF))
DO ERRLOG^SDESJSON(.ERRORS,435)
SET DUP=1
QUIT
End DoDot:2
+10 SET NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT)=$$SOCEXT2INT^SDESUTIL(409.8451,.01,NEEDSPREFS("SPECIAL NEEDS AND PREFERENCES",COUNT))
End DoDot:1
+11 QUIT
+12 ;
VALSETOFCODES(ERRORS,VALUE,FILE,FLD,TEXT) ;
+1 NEW RESULTS,CONT,CODE,INTCODE,FOUND,RESULTS,ITEM,EXTCODE
+2 IF VALUE=""
DO ERRLOG^SDESJSON(.ERRORS,52,"Missing set of codes value: "_TEXT_".")
QUIT
+3 DO FIELD^DID(FILE,FLD,"","SET OF CODES","RESULTS")
+4 SET FOUND=0
+5 FOR ITEM=1:1:$LENGTH(RESULTS("SET OF CODES"),";")
Begin DoDot:1
+6 SET CODE=$PIECE(RESULTS("SET OF CODES"),";",ITEM)
if '$LENGTH(CODE)
QUIT
+7 SET INTCODE=$PIECE(CODE,":")
SET EXTCODE=$PIECE(CODE,":",2)
+8 IF VALUE=EXTCODE
SET FOUND=1
QUIT
End DoDot:1
if FOUND
QUIT
+9 IF 'FOUND
DO ERRLOG^SDESJSON(.ERRORS,52,"Invalid set of codes value: "_TEXT_": '"_VALUE_"'.")
+10 QUIT
VALIDATEDFN(ERRORS,DFN) ;
+1 IF DFN=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT 0
+2 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT 0
+3 QUIT 1
+4 ;
BUILDJSON(JSON,RETURN) ;
+1 DO ENCODE^XLFJSON("RETURN","JSON")
+2 QUIT
+3 ;
