SDES897P ;ALB/MGD,JAS - SD*5.3*897 Post Init Routine ; DEC 06, 2024
;;5.3;SCHEDULING;**897**;AUG 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
;;
Q
;
EN ; Update the VS GUI version in #409.98
D FIND
D TASK
D TASK2
D TASK3
D TASK4
Q
;
;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
N SDECDA,SDECDA1
D MES^XPDUTL("")
D MES^XPDUTL(" Updating SDEC SETTINGS file (#409.98)")
S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
D VERSION ;update GUI version number and date
Q
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.63
S DA=SDECDA,DIE=409.98,DR="2///1.7.63;3///"_DT D ^DIE ;update VS GUI NATIONAL
K DIE,DR,DA
S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)="" ;get DA for the VS GUI LOCAL
S DA=SDECDA1,DIE=409.98,DR="2///1.7.63;3///"_DT D ^DIE ;update VS GUI LOCAL
K DIE,DR,DA
Q
;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
D MES^XPDUTL(" VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
Q
;
TASK ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the CANCELLATION REMARKS")
D MES^XPDUTL(" (#17) field from the APPOINTMENT (#2.98) sub-file of the PATIENT (#2) file")
D MES^XPDUTL(" is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*897 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNREMRKS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNREMRKS ;
N APPTIEN,FDA,REM,SDDFN
S SDDFN=0
F S SDDFN=$O(^DPT(SDDFN)) Q:'SDDFN I $D(^DPT(SDDFN,"S")) D
. S APPTIEN=0
. F S APPTIEN=$O(^DPT(SDDFN,"S",APPTIEN)) Q:'APPTIEN D
. . S REM=$$GET1^DIQ(2.98,APPTIEN_","_SDDFN_",",17,"I")
. . I REM?.E1C.E D
. . . S REM=$$CTRL^XMXUTIL1(REM)
. . . S FDA(2.98,APPTIEN_","_SDDFN_",",17)=REM
. . . D FILE^DIE("","FDA") K FDA
Q
;
TASK2 ; tasks off process to remove control characters from Recall Reminders file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the COMMENT")
D MES^XPDUTL(" (#2.5) field from the RECALL REMINDERS (#403.5) file and its COMMENT")
D MES^XPDUTL(" AUDIT (#403.57) sub-file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*897 Post Install Routine Task 2"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNRECREMS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNRECREMS ;
;
N RECREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
S RECREQIEN=0
F S RECREQIEN=$O(^SD(403.5,RECREQIEN)) Q:'RECREQIEN I $D(^SD(403.5,RECREQIEN,0)) D
. S COMMENTS=$$GET1^DIQ(403.5,RECREQIEN,2.5,"E") I COMMENTS?.E1C.E D
. . S COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
. . S FDA(403.5,RECREQIEN_",",2.5)=COMMENTS
. . D FILE^DIE("","FDA") K FDA
. . ;
. . S COMAUDIEN=0
. . F S COMAUDIEN=$O(^SD(403.5,RECREQIEN,2,COMAUDIEN)) Q:'COMAUDIEN D
. . . Q:'$D(^SD(403.5,RECREQIEN,2,COMAUDIEN,0))
. . . S COMMENT=$$GET1^DIQ(403.57,COMAUDIEN_","_RECREQIEN_",",2)
. . . I COMMENT?.E1C.E D
. . . . S FDA(403.57,COMAUDIEN_","_RECREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
. . . . D FILE^DIE("","FDA") K FDA
Q
;
TASK3 ; tasks off process to remove control characters from SDEC Appt Request file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the COMMENTS")
D MES^XPDUTL(" (#25) field from the SDEC APPT REQUEST (#409.85) file and its COMMENTS")
D MES^XPDUTL(" AUDIT (#409.8527) sub-file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*897 Post Install Routine Task 3"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNAPREQS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNAPREQS ;
;
N APREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
S APREQIEN=0
F S APREQIEN=$O(^SDEC(409.85,APREQIEN)) Q:'APREQIEN I $D(^SDEC(409.85,APREQIEN,0)) D
. Q:$$GET1^DIQ(409.85,APREQIEN,23,"I")="C"
. S COMMENTS=$$GET1^DIQ(409.85,APREQIEN,25,"E") I COMMENTS?.E1C.E D
. . S COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
. . S FDA(409.85,APREQIEN_",",25)=COMMENTS
. . D FILE^DIE("","FDA") K FDA
. . ;
. . S COMAUDIEN=0
. . F S COMAUDIEN=$O(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN)) Q:'COMAUDIEN D
. . . S COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
. . . I COMMENT?.E1C.E D
. . . . S FDA(409.8527,COMAUDIEN_","_APREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
. . . . D FILE^DIE("","FDA") K FDA
Q
;
TASK4 ; tasks off process to remove control characters from SDEC Appointment file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the NOTE")
D MES^XPDUTL(" (#1) field from the SDEC APPOINTMENT (#409.84) file and its NOTE")
D MES^XPDUTL(" AUDIT (#409.847) sub-file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*897 Post Install Routine Task 4"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNAPPTS^SDES897P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNAPPTS ;
;
N APPTIEN,APREQIEN,COMAUDIEN,COMMARRAY,COMMENT,COMMENTS,COMMIEN,DATEIEN,EDITEDNOTE,FDA,REQREC
S DATEIEN=3231130.999999
F S DATEIEN=$O(^SDEC(409.84,"B",DATEIEN)) Q:'DATEIEN D
. S APPTIEN=0
. F S APPTIEN=$O(^SDEC(409.84,"B",DATEIEN,APPTIEN)) Q:'APPTIEN I $D(^SDEC(409.84,APPTIEN,1)) D
. . S REQREC=$$GET1^DIQ(409.84,APPTIEN_",",.22,"I")
. . Q:REQREC'[409.85
. . S APREQIEN=$P(REQREC,";")
. . S COMMENTS=$$GET1^DIQ(409.85,APREQIEN,25,"E") I COMMENTS?.E1C.E D
. . . ; Clean associated appt req record
. . . S COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
. . . S FDA(409.85,APREQIEN_",",25)=COMMENTS
. . . D FILE^DIE("","FDA") K FDA
. . . ;
. . . S COMAUDIEN=0
. . . F S COMAUDIEN=$O(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN)) Q:'COMAUDIEN D
. . . . S COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
. . . . I COMMENT?.E1C.E D
. . . . . S FDA(409.8527,COMAUDIEN_","_APREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
. . . . . D FILE^DIE("","FDA") K FDA
. . ;
. . ; Now clean appt record
. . S COMMIEN=0
. . K COMMARRAY
. . F S COMMIEN=$O(^SDEC(409.84,APPTIEN,1,COMMIEN)) Q:'COMMIEN S COMMARRAY(COMMIEN)=^SDEC(409.84,APPTIEN,1,COMMIEN,0)
. . I $D(COMMARRAY) D
. . . S COMMENTS=$$WPSTR^SDECUTL(.COMMARRAY)
. . . I COMMENTS?.E1C.E D
. . . . S EDITEDNOTE(1)=$$CTRL^XMXUTIL1(COMMENTS)
. . . . D WP^DIE(409.84,APPTIEN_",",1,"","EDITEDNOTE")
. . . . ;
. . . . S COMAUDIEN=0
. . . . F S COMAUDIEN=$O(^SDEC(409.84,APPTIEN,"NOTEAUD",COMAUDIEN)) Q:'COMAUDIEN D
. . . . . S COMMENT=$$GET1^DIQ(409.847,COMAUDIEN_","_APPTIEN_",",2)
. . . . . I COMMENT?.E1C.E D
. . . . . . S FDA(409.847,COMAUDIEN_","_APPTIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
. . . . . . D UPDATE^DIE("","FDA") K FDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES897P 7874 printed Aug 26, 2025@23:11:58 Page 2
SDES897P ;ALB/MGD,JAS - SD*5.3*897 Post Init Routine ; DEC 06, 2024
+1 ;;5.3;SCHEDULING;**897**;AUG 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;;
+4 QUIT
+5 ;
EN ; Update the VS GUI version in #409.98
+1 DO FIND
+2 DO TASK
+3 DO TASK2
+4 DO TASK3
+5 DO TASK4
+6 QUIT
+7 ;
+8 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
+1 NEW SDECDA,SDECDA1
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL(" Updating SDEC SETTINGS file (#409.98)")
+4 SET SDECDA=0
SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
if $GET(SDECDA)=""
GOTO NOFIND
+5 ;update GUI version number and date
DO VERSION
+6 QUIT
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.63
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.63;3///"_DT
DO ^DIE
+2 KILL DIE,DR,DA
+3 ;get DA for the VS GUI LOCAL
SET SDECDA1=0
SET SDECDA1=$ORDER(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1))
if $GET(SDECDA1)=""
QUIT
+4 ;update VS GUI LOCAL
SET DA=SDECDA1
SET DIE=409.98
SET DR="2///1.7.63;3///"_DT
DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
+1 DO MES^XPDUTL(" VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
+2 QUIT
+3 ;
TASK ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the CANCELLATION REMARKS")
+3 DO MES^XPDUTL(" (#17) field from the APPOINTMENT (#2.98) sub-file of the PATIENT (#2) file")
+4 DO MES^XPDUTL(" is being queued to run in the background.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+7 SET ZTDESC="SD*5.3*897 Post Install Routine"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNREMRKS^SDES897P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
CLNREMRKS ;
+1 NEW APPTIEN,FDA,REM,SDDFN
+2 SET SDDFN=0
+3 FOR
SET SDDFN=$ORDER(^DPT(SDDFN))
if 'SDDFN
QUIT
IF $DATA(^DPT(SDDFN,"S"))
Begin DoDot:1
+4 SET APPTIEN=0
+5 FOR
SET APPTIEN=$ORDER(^DPT(SDDFN,"S",APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+6 SET REM=$$GET1^DIQ(2.98,APPTIEN_","_SDDFN_",",17,"I")
+7 IF REM?.E1C.E
Begin DoDot:3
+8 SET REM=$$CTRL^XMXUTIL1(REM)
+9 SET FDA(2.98,APPTIEN_","_SDDFN_",",17)=REM
+10 DO FILE^DIE("","FDA")
KILL FDA
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
TASK2 ; tasks off process to remove control characters from Recall Reminders file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the COMMENT")
+3 DO MES^XPDUTL(" (#2.5) field from the RECALL REMINDERS (#403.5) file and its COMMENT")
+4 DO MES^XPDUTL(" AUDIT (#403.57) sub-file is being queued to run in the background.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+7 SET ZTDESC="SD*5.3*897 Post Install Routine Task 2"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNRECREMS^SDES897P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
CLNRECREMS ;
+1 ;
+2 NEW RECREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
+3 SET RECREQIEN=0
+4 FOR
SET RECREQIEN=$ORDER(^SD(403.5,RECREQIEN))
if 'RECREQIEN
QUIT
IF $DATA(^SD(403.5,RECREQIEN,0))
Begin DoDot:1
+5 SET COMMENTS=$$GET1^DIQ(403.5,RECREQIEN,2.5,"E")
IF COMMENTS?.E1C.E
Begin DoDot:2
+6 SET COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
+7 SET FDA(403.5,RECREQIEN_",",2.5)=COMMENTS
+8 DO FILE^DIE("","FDA")
KILL FDA
+9 ;
+10 SET COMAUDIEN=0
+11 FOR
SET COMAUDIEN=$ORDER(^SD(403.5,RECREQIEN,2,COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:3
+12 if '$DATA(^SD(403.5,RECREQIEN,2,COMAUDIEN,0))
QUIT
+13 SET COMMENT=$$GET1^DIQ(403.57,COMAUDIEN_","_RECREQIEN_",",2)
+14 IF COMMENT?.E1C.E
Begin DoDot:4
+15 SET FDA(403.57,COMAUDIEN_","_RECREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
+16 DO FILE^DIE("","FDA")
KILL FDA
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
TASK3 ; tasks off process to remove control characters from SDEC Appt Request file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the COMMENTS")
+3 DO MES^XPDUTL(" (#25) field from the SDEC APPT REQUEST (#409.85) file and its COMMENTS")
+4 DO MES^XPDUTL(" AUDIT (#409.8527) sub-file is being queued to run in the background.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+7 SET ZTDESC="SD*5.3*897 Post Install Routine Task 3"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNAPREQS^SDES897P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
CLNAPREQS ;
+1 ;
+2 NEW APREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
+3 SET APREQIEN=0
+4 FOR
SET APREQIEN=$ORDER(^SDEC(409.85,APREQIEN))
if 'APREQIEN
QUIT
IF $DATA(^SDEC(409.85,APREQIEN,0))
Begin DoDot:1
+5 if $$GET1^DIQ(409.85,APREQIEN,23,"I")="C"
QUIT
+6 SET COMMENTS=$$GET1^DIQ(409.85,APREQIEN,25,"E")
IF COMMENTS?.E1C.E
Begin DoDot:2
+7 SET COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
+8 SET FDA(409.85,APREQIEN_",",25)=COMMENTS
+9 DO FILE^DIE("","FDA")
KILL FDA
+10 ;
+11 SET COMAUDIEN=0
+12 FOR
SET COMAUDIEN=$ORDER(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:3
+13 SET COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
+14 IF COMMENT?.E1C.E
Begin DoDot:4
+15 SET FDA(409.8527,COMAUDIEN_","_APREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
+16 DO FILE^DIE("","FDA")
KILL FDA
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
TASK4 ; tasks off process to remove control characters from SDEC Appointment file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*897 Post-Install to clear control characters from the NOTE")
+3 DO MES^XPDUTL(" (#1) field from the SDEC APPOINTMENT (#409.84) file and its NOTE")
+4 DO MES^XPDUTL(" AUDIT (#409.847) sub-file is being queued to run in the background.")
+5 DO MES^XPDUTL("")
+6 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+7 SET ZTDESC="SD*5.3*897 Post Install Routine Task 4"
+8 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNAPPTS^SDES897P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
CLNAPPTS ;
+1 ;
+2 NEW APPTIEN,APREQIEN,COMAUDIEN,COMMARRAY,COMMENT,COMMENTS,COMMIEN,DATEIEN,EDITEDNOTE,FDA,REQREC
+3 SET DATEIEN=3231130.999999
+4 FOR
SET DATEIEN=$ORDER(^SDEC(409.84,"B",DATEIEN))
if 'DATEIEN
QUIT
Begin DoDot:1
+5 SET APPTIEN=0
+6 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"B",DATEIEN,APPTIEN))
if 'APPTIEN
QUIT
IF $DATA(^SDEC(409.84,APPTIEN,1))
Begin DoDot:2
+7 SET REQREC=$$GET1^DIQ(409.84,APPTIEN_",",.22,"I")
+8 if REQREC'[409.85
QUIT
+9 SET APREQIEN=$PIECE(REQREC,";")
+10 SET COMMENTS=$$GET1^DIQ(409.85,APREQIEN,25,"E")
IF COMMENTS?.E1C.E
Begin DoDot:3
+11 ; Clean associated appt req record
+12 SET COMMENTS=$$CTRL^XMXUTIL1(COMMENTS)
+13 SET FDA(409.85,APREQIEN_",",25)=COMMENTS
+14 DO FILE^DIE("","FDA")
KILL FDA
+15 ;
+16 SET COMAUDIEN=0
+17 FOR
SET COMAUDIEN=$ORDER(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:4
+18 SET COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
+19 IF COMMENT?.E1C.E
Begin DoDot:5
+20 SET FDA(409.8527,COMAUDIEN_","_APREQIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
+21 DO FILE^DIE("","FDA")
KILL FDA
End DoDot:5
End DoDot:4
End DoDot:3
+22 ;
+23 ; Now clean appt record
+24 SET COMMIEN=0
+25 KILL COMMARRAY
+26 FOR
SET COMMIEN=$ORDER(^SDEC(409.84,APPTIEN,1,COMMIEN))
if 'COMMIEN
QUIT
SET COMMARRAY(COMMIEN)=^SDEC(409.84,APPTIEN,1,COMMIEN,0)
+27 IF $DATA(COMMARRAY)
Begin DoDot:3
+28 SET COMMENTS=$$WPSTR^SDECUTL(.COMMARRAY)
+29 IF COMMENTS?.E1C.E
Begin DoDot:4
+30 SET EDITEDNOTE(1)=$$CTRL^XMXUTIL1(COMMENTS)
+31 DO WP^DIE(409.84,APPTIEN_",",1,"","EDITEDNOTE")
+32 ;
+33 SET COMAUDIEN=0
+34 FOR
SET COMAUDIEN=$ORDER(^SDEC(409.84,APPTIEN,"NOTEAUD",COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:5
+35 SET COMMENT=$$GET1^DIQ(409.847,COMAUDIEN_","_APPTIEN_",",2)
+36 IF COMMENT?.E1C.E
Begin DoDot:6
+37 SET FDA(409.847,COMAUDIEN_","_APPTIEN_",",2)=$$CTRL^XMXUTIL1(COMMENT)
+38 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
