SDES2EDITAPPT ;ALB/JAS,LAB/JAS,JAS - SDES2 EDIT APPOINTMENT ; MAY 8, 2025
;;5.3;Scheduling;**893,895,907**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EDIT(JSON,SDCONTEXT,SDINPUT) ;
N APPTIEN,ERRORS,NOTE,RETURN,SDDUZ
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Appointment",1)="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
S NOTE=$$CLEANCMMTS^SDES2APPTUTIL($G(SDINPUT("NOTE")))
I NOTE="" D ERRLOG^SDES2JSON(.ERRORS,444)
S APPTIEN=$G(SDINPUT("APPTIEN"))
D VALIDATEAPPTIEN(.ERRORS,APPTIEN)
I $D(ERRORS) S ERRORS("Appointment",1)="" M RETURN=ERRORS D BUILDJSON^SDES2JSON(.JSON,.RETURN) Q
;
S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
;
D EDITNOTE(APPTIEN,$E(NOTE,1,150),$$GET1^DIQ(409.84,APPTIEN,.01,"I"),$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,APPTIEN,.07,"I"),.04,"I"),$$GET1^DIQ(409.84,APPTIEN,.05,"I"),SDDUZ)
;
S RETURN("Appointment","IEN")=APPTIEN
D BUILDJSON^SDES2JSON(.JSON,.RETURN)
Q
;
EDITNOTE(APPTIEN,NOTE,STARTDATETIME,CLINICIEN,DFN,SDDUZ) ;
N FDA,SUBIEN,EDITED,EDITEDNOTE,APPTREF
N NOTEINFO,ERR,INDEX,LASTLENGTH,NEWLENGTH,NEWNOTE
D GETS^DIQ(409.84,APPTIEN_",","1","E","NOTEINFO","ERR")
S (INDEX,LASTLENGTH)=0
S APPTREF=$O(NOTEINFO(409.84,""),-1)
F S INDEX=$O(NOTEINFO(409.84,APPTREF,1,INDEX)) Q:'INDEX D
. S LASTLENGTH=LASTLENGTH+$L(NOTEINFO(409.84,APPTREF,1,INDEX))
S NEWNOTE=$E(NOTE,(LASTLENGTH+1),($L(NOTE)))
;
; 409.84 WP field
S EDITEDNOTE(1)=NOTE
D WP^DIE(409.84,APPTIEN_",",1,"","EDITEDNOTE")
;
; 409.84 NOTE AUDIT multiple
I $L(NEWNOTE) D
. S FDA(409.847,"+1,"_APPTIEN_",",.01)=$$NOW^XLFDT
. S FDA(409.847,"+1,"_APPTIEN_",",1)=SDDUZ
. S FDA(409.847,"+1,"_APPTIEN_",",2)=NEWNOTE
. D UPDATE^DIE("","FDA") K FDA
;
; 44 free text field
S SUBIEN=0,EDITED=0
F S SUBIEN=$O(^SC(CLINICIEN,"S",STARTDATETIME,1,SUBIEN)) Q:'SUBIEN!(EDITED=1) D
.I DFN=$$GET1^DIQ(44.003,SUBIEN_","_STARTDATETIME_","_CLINICIEN_",",.01,"I") D
..S FDA(44.003,SUBIEN_","_STARTDATETIME_","_CLINICIEN_",",3)=NOTE
..D FILE^DIE(,"FDA") K FDA
..S EDITED=1
Q
;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
I APPTIEN="" D ERRLOG^SDES2JSON(.ERRORS,14) Q
I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDES2JSON(.ERRORS,15) Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2EDITAPPT 2317 printed Aug 26, 2025@23:09:57 Page 2
SDES2EDITAPPT ;ALB/JAS,LAB/JAS,JAS - SDES2 EDIT APPOINTMENT ; MAY 8, 2025
+1 ;;5.3;Scheduling;**893,895,907**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
EDIT(JSON,SDCONTEXT,SDINPUT) ;
+1 NEW APPTIEN,ERRORS,NOTE,RETURN,SDDUZ
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("Appointment",1)=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+5 ;
+6 SET NOTE=$$CLEANCMMTS^SDES2APPTUTIL($GET(SDINPUT("NOTE")))
+7 IF NOTE=""
DO ERRLOG^SDES2JSON(.ERRORS,444)
+8 SET APPTIEN=$GET(SDINPUT("APPTIEN"))
+9 DO VALIDATEAPPTIEN(.ERRORS,APPTIEN)
+10 IF $DATA(ERRORS)
SET ERRORS("Appointment",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
QUIT
+11 ;
+12 SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
+13 ;
+14 DO EDITNOTE(APPTIEN,$EXTRACT(NOTE,1,150),$$GET1^DIQ(409.84,APPTIEN,.01,"I"),$$GET1^DIQ(409.831,$$GET1^DIQ(409.84,APPTIEN,.07,"I"),.04,"I"),$$GET1^DIQ(409.84,APPTIEN,.05,"I"),SDDUZ)
+15 ;
+16 SET RETURN("Appointment","IEN")=APPTIEN
+17 DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
+18 QUIT
+19 ;
EDITNOTE(APPTIEN,NOTE,STARTDATETIME,CLINICIEN,DFN,SDDUZ) ;
+1 NEW FDA,SUBIEN,EDITED,EDITEDNOTE,APPTREF
+2 NEW NOTEINFO,ERR,INDEX,LASTLENGTH,NEWLENGTH,NEWNOTE
+3 DO GETS^DIQ(409.84,APPTIEN_",","1","E","NOTEINFO","ERR")
+4 SET (INDEX,LASTLENGTH)=0
+5 SET APPTREF=$ORDER(NOTEINFO(409.84,""),-1)
+6 FOR
SET INDEX=$ORDER(NOTEINFO(409.84,APPTREF,1,INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+7 SET LASTLENGTH=LASTLENGTH+$LENGTH(NOTEINFO(409.84,APPTREF,1,INDEX))
End DoDot:1
+8 SET NEWNOTE=$EXTRACT(NOTE,(LASTLENGTH+1),($LENGTH(NOTE)))
+9 ;
+10 ; 409.84 WP field
+11 SET EDITEDNOTE(1)=NOTE
+12 DO WP^DIE(409.84,APPTIEN_",",1,"","EDITEDNOTE")
+13 ;
+14 ; 409.84 NOTE AUDIT multiple
+15 IF $LENGTH(NEWNOTE)
Begin DoDot:1
+16 SET FDA(409.847,"+1,"_APPTIEN_",",.01)=$$NOW^XLFDT
+17 SET FDA(409.847,"+1,"_APPTIEN_",",1)=SDDUZ
+18 SET FDA(409.847,"+1,"_APPTIEN_",",2)=NEWNOTE
+19 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:1
+20 ;
+21 ; 44 free text field
+22 SET SUBIEN=0
SET EDITED=0
+23 FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",STARTDATETIME,1,SUBIEN))
if 'SUBIEN!(EDITED=1)
QUIT
Begin DoDot:1
+24 IF DFN=$$GET1^DIQ(44.003,SUBIEN_","_STARTDATETIME_","_CLINICIEN_",",.01,"I")
Begin DoDot:2
+25 SET FDA(44.003,SUBIEN_","_STARTDATETIME_","_CLINICIEN_",",3)=NOTE
+26 DO FILE^DIE(,"FDA")
KILL FDA
+27 SET EDITED=1
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
+1 IF APPTIEN=""
DO ERRLOG^SDES2JSON(.ERRORS,14)
QUIT
+2 IF APPTIEN'=""
IF '$DATA(^SDEC(409.84,APPTIEN,0))
DO ERRLOG^SDES2JSON(.ERRORS,15)
QUIT
+3 QUIT
+4 ;