SDES2MRTCUTIL ;ALB/LAB - SDES2 UTILITIES Continued ;JAN 23,2026
;;5.3;Scheduling;**929**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
REMOVEMRTCINFO(PARENTIEN,ARIEN,SDERRORS) ;Remove the child info of an MRTC
N MULTAPPTNUMB,MRTCFDA,FDAERR,DFN,ERRMSG
D REMOVEMRTCCHILD(PARENTIEN,ARIEN,.SDERRORS) Q:$D(SDERRORS)
D REMRTCHILDCID(PARENTIEN,ARIEN,.SDERRORS) Q:$D(SDERRORS)
S MULTAPPTNUMB=$$GET1^DIQ(409.85,ARIEN,43,"I")
S MULTAPPTNUMB=$S(MULTAPPTNUMB>0:MULTAPPTNUMB-1,1:0)
S MRTCFDA(409.85,PARENTIEN_",",43)=MULTAPPTNUMB
D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
I $D(FDAERR("DIERR")) D
. S ERRMSG="Error while updating Mult appt number on parent. "
. F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
S DFN=$$GET1^DIQ(409.85,PARENTIEN,.01,"I")
D UPDATEMRTCSEQNUM(PARENTIEN,DFN,.SDERRORS) ;Resequence Children
Q
;
REMOVEMRTCCHILD(PARENTIEN,ARIEN,SDERRORS) ;Remove CHILD REQUEST
N SUBIEN,MRTCFDA,FDAERR,ERRIDX,ERRMSG
S SUBIEN=0
S SUBIEN=$O(^SDEC(409.85,PARENTIEN,2,"B",ARIEN,SUBIEN))
I 'SUBIEN D ERRLOG^SDES2JSON(.SDERRORS,52,"Child reference not found in parent record")
S MRTCFDA(409.852,SUBIEN_","_PARENTIEN_",",.01)="@"
D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
I $D(FDAERR("DIERR")) D
. S ERRMSG="Error while removing request from parent. "
. F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
REMRTCHILDCID(PARENTIEN,ARIEN,SDERRORS) ;Remove MRTC CALC PREF DATES
N SUBIEN,MRTCFDA,CIDDATE,FDAERR,ERRMSG
S CIDDATE=$$GET1^DIQ(409.85,ARIEN,22,"I")
I $G(CIDDATE)="" D ERRLOG^SDES2JSON(.SDERRORS,408)
S SUBIEN=0
S SUBIEN=$O(^SDEC(409.85,PARENTIEN,5,"B",CIDDATE,SUBIEN)) Q:'SUBIEN
S MRTCFDA(409.851,SUBIEN_","_PARENTIEN_",",.01)="@"
D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
I $D(FDAERR("DIERR")) D
. S ERRMSG="Error while removing child request's MRTC CALC PREF DATES from parent. "
. F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
UPDATEMRTCSEQNUM(PARENTREQUEST,DFN,SDERRORS) ;Resequence the MRTC child sequence #
N COUNT,REQUESTIEN,CHILD,MRTCFDA,FDAERR,ERRMSG
S REQUESTIEN=0,COUNT=0
F S REQUESTIEN=$O(^SDEC(409.85,"B",DFN,REQUESTIEN)) Q:'REQUESTIEN D
. I $$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")=PARENTREQUEST D
. . I $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C",'$$GET1^DIQ(409.85,REQUESTIEN,13,"I") Q
. . S COUNT=COUNT+1
. . S CHILD(REQUESTIEN)=COUNT
S REQUESTIEN=0
F S REQUESTIEN=$O(CHILD(REQUESTIEN)) Q:'REQUESTIEN D
. S MRTCFDA(409.85,REQUESTIEN_",",43.1)=$G(CHILD(REQUESTIEN))
. S MRTCFDA(409.85,REQUESTIEN_",",43)=$$GET1^DIQ(409.85,PARENTREQUEST,43,"I")
. D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
. I $D(FDAERR("DIERR")) D
. . S ERRMSG="Error while resequencing the MRTC children request. "
. . F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
UPDATEPARENT(PARENTREQUEST,DISP,DISPDT,AUDITID,SDERRORS) ;update status of parent if open and all children removed
N MRTCFDA,FDAERR,ERRMSG
Q:$$GET1^DIQ(409.85,PARENTREQUEST,23,"I")="C"
;if all children are removed from parent disposition parent with same disposition
I $O(^SDEC(409.85,PARENTREQUEST,2,"B",""))="" D
. S MRTCFDA(409.85,PARENTREQUEST_",",20)=DUZ
. S MRTCFDA(409.85,PARENTREQUEST_",",23)="C"
. S MRTCFDA(409.85,PARENTREQUEST_",",21)=DISP
. S MRTCFDA(409.85,PARENTREQUEST_",",19)=DISPDT
. S MRTCFDA(409.85,PARENTREQUEST_",",100)=AUDITID
. D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
. I $D(FDAERR("DIERR")) D
. . S ERRMSG="Error while updating status of parent. "
. . F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
;if all children are closed, but there are still children close parent with MRTC PARENT CLOSED
I $O(^SDEC(409.85,PARENTREQUEST,2,"B",""))'="" D
. N CHILDIEN,FOUND
. S CHILDIEN="",FOUND=0
. F S CHILDIEN=$O(^SDEC(409.85,PARENTREQUEST,2,"B",CHILDIEN)) Q:(CHILDIEN="")!(FOUND) D
. . S FOUND=($$GET1^DIQ(409.85,CHILDIEN_",",23,"E")="OPEN")
. I 'FOUND D
. . S MRTCFDA(409.85,PARENTREQUEST_",",19)=DISPDT
. . S MRTCFDA(409.85,PARENTREQUEST_",",20)=DUZ
. . S MRTCFDA(409.85,PARENTREQUEST_",",21)=$O(^SDEC(409.853,"B","MRTC PARENT CLOSED",""))
. . S MRTCFDA(409.85,PARENTREQUEST_",",23)="C"
. . S MRTCFDA(409.85,PARENTREQUEST_",",100)=AUDITID
. . D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
. . I $D(FDAERR("DIERR")) D
. . . S ERRMSG="Error while updating status of parent. "
. . . F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
REMOVEMRTCAPTIEN(REQUESTIEN,APPTIEN,PARENTIEN,SDERRORS) ;
N SUBIEN,MRTCFDA,FDAERR,ERRMSG
S SUBIEN=0
S SUBIEN=$O(^SDEC(409.85,PARENTIEN,2,"B",REQUESTIEN,SUBIEN)) Q:'SUBIEN
S MRTCFDA(409.852,SUBIEN_","_PARENTIEN_",",.02)="@"
D FILE^DIE(,"MRTCFDA","FDAERR") K MRTCFDA
I $D(FDAERR("DIERR")) D
. S ERRMSG="Error while removing appointment IEN from the parent request. "
. F ERRIDX=1:1:$G(FDAERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(FDAERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
REOPENREQUEST(REQUESTIEN,SDERRORS) ;reopen parent request
N REQFDA,REQUESTERR
S REQFDA(409.85,REQUESTIEN_",",19)=""
S REQFDA(409.85,REQUESTIEN_",",20)=""
S REQFDA(409.85,REQUESTIEN_",",21)=""
S REQFDA(409.85,REQUESTIEN_",",23)="O"
D FILE^DIE("","REQFDA","REQUESTERR") K REQFDA
I $D(REQUESTERR("DIERR")) D
. S ERRMSG="Error while reopening the parent request. "
. F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
ADDMRTCLINKS(CHILD,PARENT,SDERRORS) ;
N REQFDA,REQUESTERR
Q:$O(^SDEC(409.85,PARENT,2,"B",CHILD,0))
S REQFDA(409.852,"+1,"_PARENT_",",.01)=CHILD
D UPDATE^DIE(,"REQFDA",,"REQUESTERR") K REQFDA
I $D(REQUESTERR("DIERR")) D
. S ERRMSG="Error while reopening the parent request. "
. F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
ADDMRTCPIDLINKS(PARENT,PATIENTINDDATE,SDERRORS) ;
N REQFDA,REQUESTERR
Q:$O(^SDEC(409.85,PARENT,5,"B",PATIENTINDDATE,0))
S REQFDA(409.851,"+1,"_PARENT_",",.01)=PATIENTINDDATE
D UPDATE^DIE(,"REQFDA",,"REQUESTERR") K REQFDA
I $D(REQUESTERR("DIERR")) D
. S ERRMSG="Error while reopening the parent request. "
. F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
UPDATEAPPTNUM(PARENTREQUEST,SDERRORS) ;
N CHILDIEN,CHILDCNT,CHILDARRAY
S CHILDIEN=0,CHILDCNT=0
F S CHILDIEN=$O(^SDEC(409.85,PARENTREQUEST,2,"B",CHILDIEN)) Q:CHILDIEN="" D
. S CHILDARRAY(CHILDIEN)=1
. S CHILDCNT=CHILDCNT+1
S REQFDA(409.85,PARENTREQUEST_",",43)=CHILDCNT
D FILE^DIE("","REQFDA","REQUESTERR")
I $D(REQUESTERR("DIERR")) D
. S ERRMSG="Error while renumbering the parent request. "
. F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
S CHILDIEN=0
F S CHILDIEN=$O(CHILDARRAY(CHILDIEN)) Q:CHILDIEN="" D
. S REQFDA(409.85,CHILDIEN_",",43)=CHILDCNT
. D FILE^DIE("","REQFDA","REQUESTERR")
. I $D(REQUESTERR("DIERR")) D
. . S ERRMSG="Error while renumbering the parent request. "
. . F ERRIDX=1:1:$G(REQUESTERR("DIERR")) D ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$G(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$G(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2MRTCUTIL 8152 printed Apr 22, 2026@14:52:07 Page 2
SDES2MRTCUTIL ;ALB/LAB - SDES2 UTILITIES Continued ;JAN 23,2026
+1 ;;5.3;Scheduling;**929**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
REMOVEMRTCINFO(PARENTIEN,ARIEN,SDERRORS) ;Remove the child info of an MRTC
+1 NEW MULTAPPTNUMB,MRTCFDA,FDAERR,DFN,ERRMSG
+2 DO REMOVEMRTCCHILD(PARENTIEN,ARIEN,.SDERRORS)
if $DATA(SDERRORS)
QUIT
+3 DO REMRTCHILDCID(PARENTIEN,ARIEN,.SDERRORS)
if $DATA(SDERRORS)
QUIT
+4 SET MULTAPPTNUMB=$$GET1^DIQ(409.85,ARIEN,43,"I")
+5 SET MULTAPPTNUMB=$SELECT(MULTAPPTNUMB>0:MULTAPPTNUMB-1,1:0)
+6 SET MRTCFDA(409.85,PARENTIEN_",",43)=MULTAPPTNUMB
+7 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+8 IF $DATA(FDAERR("DIERR"))
Begin DoDot:1
+9 SET ERRMSG="Error while updating Mult appt number on parent. "
+10 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+11 SET DFN=$$GET1^DIQ(409.85,PARENTIEN,.01,"I")
+12 ;Resequence Children
DO UPDATEMRTCSEQNUM(PARENTIEN,DFN,.SDERRORS)
+13 QUIT
+14 ;
REMOVEMRTCCHILD(PARENTIEN,ARIEN,SDERRORS) ;Remove CHILD REQUEST
+1 NEW SUBIEN,MRTCFDA,FDAERR,ERRIDX,ERRMSG
+2 SET SUBIEN=0
+3 SET SUBIEN=$ORDER(^SDEC(409.85,PARENTIEN,2,"B",ARIEN,SUBIEN))
+4 IF 'SUBIEN
DO ERRLOG^SDES2JSON(.SDERRORS,52,"Child reference not found in parent record")
+5 SET MRTCFDA(409.852,SUBIEN_","_PARENTIEN_",",.01)="@"
+6 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+7 IF $DATA(FDAERR("DIERR"))
Begin DoDot:1
+8 SET ERRMSG="Error while removing request from parent. "
+9 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+10 QUIT
+11 ;
REMRTCHILDCID(PARENTIEN,ARIEN,SDERRORS) ;Remove MRTC CALC PREF DATES
+1 NEW SUBIEN,MRTCFDA,CIDDATE,FDAERR,ERRMSG
+2 SET CIDDATE=$$GET1^DIQ(409.85,ARIEN,22,"I")
+3 IF $GET(CIDDATE)=""
DO ERRLOG^SDES2JSON(.SDERRORS,408)
+4 SET SUBIEN=0
+5 SET SUBIEN=$ORDER(^SDEC(409.85,PARENTIEN,5,"B",CIDDATE,SUBIEN))
if 'SUBIEN
QUIT
+6 SET MRTCFDA(409.851,SUBIEN_","_PARENTIEN_",",.01)="@"
+7 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+8 IF $DATA(FDAERR("DIERR"))
Begin DoDot:1
+9 SET ERRMSG="Error while removing child request's MRTC CALC PREF DATES from parent. "
+10 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+11 QUIT
+12 ;
UPDATEMRTCSEQNUM(PARENTREQUEST,DFN,SDERRORS) ;Resequence the MRTC child sequence #
+1 NEW COUNT,REQUESTIEN,CHILD,MRTCFDA,FDAERR,ERRMSG
+2 SET REQUESTIEN=0
SET COUNT=0
+3 FOR
SET REQUESTIEN=$ORDER(^SDEC(409.85,"B",DFN,REQUESTIEN))
if 'REQUESTIEN
QUIT
Begin DoDot:1
+4 IF $$GET1^DIQ(409.85,REQUESTIEN,43.8,"I")=PARENTREQUEST
Begin DoDot:2
+5 IF $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C"
IF '$$GET1^DIQ(409.85,REQUESTIEN,13,"I")
QUIT
+6 SET COUNT=COUNT+1
+7 SET CHILD(REQUESTIEN)=COUNT
End DoDot:2
End DoDot:1
+8 SET REQUESTIEN=0
+9 FOR
SET REQUESTIEN=$ORDER(CHILD(REQUESTIEN))
if 'REQUESTIEN
QUIT
Begin DoDot:1
+10 SET MRTCFDA(409.85,REQUESTIEN_",",43.1)=$GET(CHILD(REQUESTIEN))
+11 SET MRTCFDA(409.85,REQUESTIEN_",",43)=$$GET1^DIQ(409.85,PARENTREQUEST,43,"I")
+12 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+13 IF $DATA(FDAERR("DIERR"))
Begin DoDot:2
+14 SET ERRMSG="Error while resequencing the MRTC children request. "
+15 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
UPDATEPARENT(PARENTREQUEST,DISP,DISPDT,AUDITID,SDERRORS) ;update status of parent if open and all children removed
+1 NEW MRTCFDA,FDAERR,ERRMSG
+2 if $$GET1^DIQ(409.85,PARENTREQUEST,23,"I")="C"
QUIT
+3 ;if all children are removed from parent disposition parent with same disposition
+4 IF $ORDER(^SDEC(409.85,PARENTREQUEST,2,"B",""))=""
Begin DoDot:1
+5 SET MRTCFDA(409.85,PARENTREQUEST_",",20)=DUZ
+6 SET MRTCFDA(409.85,PARENTREQUEST_",",23)="C"
+7 SET MRTCFDA(409.85,PARENTREQUEST_",",21)=DISP
+8 SET MRTCFDA(409.85,PARENTREQUEST_",",19)=DISPDT
+9 SET MRTCFDA(409.85,PARENTREQUEST_",",100)=AUDITID
+10 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+11 IF $DATA(FDAERR("DIERR"))
Begin DoDot:2
+12 SET ERRMSG="Error while updating status of parent. "
+13 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:2
End DoDot:1
+14 ;if all children are closed, but there are still children close parent with MRTC PARENT CLOSED
+15 IF $ORDER(^SDEC(409.85,PARENTREQUEST,2,"B",""))'=""
Begin DoDot:1
+16 NEW CHILDIEN,FOUND
+17 SET CHILDIEN=""
SET FOUND=0
+18 FOR
SET CHILDIEN=$ORDER(^SDEC(409.85,PARENTREQUEST,2,"B",CHILDIEN))
if (CHILDIEN="")!(FOUND)
QUIT
Begin DoDot:2
+19 SET FOUND=($$GET1^DIQ(409.85,CHILDIEN_",",23,"E")="OPEN")
End DoDot:2
+20 IF 'FOUND
Begin DoDot:2
+21 SET MRTCFDA(409.85,PARENTREQUEST_",",19)=DISPDT
+22 SET MRTCFDA(409.85,PARENTREQUEST_",",20)=DUZ
+23 SET MRTCFDA(409.85,PARENTREQUEST_",",21)=$ORDER(^SDEC(409.853,"B","MRTC PARENT CLOSED",""))
+24 SET MRTCFDA(409.85,PARENTREQUEST_",",23)="C"
+25 SET MRTCFDA(409.85,PARENTREQUEST_",",100)=AUDITID
+26 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+27 IF $DATA(FDAERR("DIERR"))
Begin DoDot:3
+28 SET ERRMSG="Error while updating status of parent. "
+29 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
REMOVEMRTCAPTIEN(REQUESTIEN,APPTIEN,PARENTIEN,SDERRORS) ;
+1 NEW SUBIEN,MRTCFDA,FDAERR,ERRMSG
+2 SET SUBIEN=0
+3 SET SUBIEN=$ORDER(^SDEC(409.85,PARENTIEN,2,"B",REQUESTIEN,SUBIEN))
if 'SUBIEN
QUIT
+4 SET MRTCFDA(409.852,SUBIEN_","_PARENTIEN_",",.02)="@"
+5 DO FILE^DIE(,"MRTCFDA","FDAERR")
KILL MRTCFDA
+6 IF $DATA(FDAERR("DIERR"))
Begin DoDot:1
+7 SET ERRMSG="Error while removing appointment IEN from the parent request. "
+8 FOR ERRIDX=1:1:$GET(FDAERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(FDAERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(FDAERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+9 QUIT
+10 ;
REOPENREQUEST(REQUESTIEN,SDERRORS) ;reopen parent request
+1 NEW REQFDA,REQUESTERR
+2 SET REQFDA(409.85,REQUESTIEN_",",19)=""
+3 SET REQFDA(409.85,REQUESTIEN_",",20)=""
+4 SET REQFDA(409.85,REQUESTIEN_",",21)=""
+5 SET REQFDA(409.85,REQUESTIEN_",",23)="O"
+6 DO FILE^DIE("","REQFDA","REQUESTERR")
KILL REQFDA
+7 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:1
+8 SET ERRMSG="Error while reopening the parent request. "
+9 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+10 QUIT
+11 ;
ADDMRTCLINKS(CHILD,PARENT,SDERRORS) ;
+1 NEW REQFDA,REQUESTERR
+2 if $ORDER(^SDEC(409.85,PARENT,2,"B",CHILD,0))
QUIT
+3 SET REQFDA(409.852,"+1,"_PARENT_",",.01)=CHILD
+4 DO UPDATE^DIE(,"REQFDA",,"REQUESTERR")
KILL REQFDA
+5 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:1
+6 SET ERRMSG="Error while reopening the parent request. "
+7 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+8 QUIT
+9 ;
ADDMRTCPIDLINKS(PARENT,PATIENTINDDATE,SDERRORS) ;
+1 NEW REQFDA,REQUESTERR
+2 if $ORDER(^SDEC(409.85,PARENT,5,"B",PATIENTINDDATE,0))
QUIT
+3 SET REQFDA(409.851,"+1,"_PARENT_",",.01)=PATIENTINDDATE
+4 DO UPDATE^DIE(,"REQFDA",,"REQUESTERR")
KILL REQFDA
+5 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:1
+6 SET ERRMSG="Error while reopening the parent request. "
+7 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+8 QUIT
+9 ;
UPDATEAPPTNUM(PARENTREQUEST,SDERRORS) ;
+1 NEW CHILDIEN,CHILDCNT,CHILDARRAY
+2 SET CHILDIEN=0
SET CHILDCNT=0
+3 FOR
SET CHILDIEN=$ORDER(^SDEC(409.85,PARENTREQUEST,2,"B",CHILDIEN))
if CHILDIEN=""
QUIT
Begin DoDot:1
+4 SET CHILDARRAY(CHILDIEN)=1
+5 SET CHILDCNT=CHILDCNT+1
End DoDot:1
+6 SET REQFDA(409.85,PARENTREQUEST_",",43)=CHILDCNT
+7 DO FILE^DIE("","REQFDA","REQUESTERR")
+8 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:1
+9 SET ERRMSG="Error while renumbering the parent request. "
+10 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:1
+11 SET CHILDIEN=0
+12 FOR
SET CHILDIEN=$ORDER(CHILDARRAY(CHILDIEN))
if CHILDIEN=""
QUIT
Begin DoDot:1
+13 SET REQFDA(409.85,CHILDIEN_",",43)=CHILDCNT
+14 DO FILE^DIE("","REQFDA","REQUESTERR")
+15 IF $DATA(REQUESTERR("DIERR"))
Begin DoDot:2
+16 SET ERRMSG="Error while renumbering the parent request. "
+17 FOR ERRIDX=1:1:$GET(REQUESTERR("DIERR"))
DO ERRLOG^SDESJSON(.SDERRORS,52,ERRMSG_$GET(REQUESTERR("DIERR",ERRIDX,"PARAM","IENS"))_" "_$GET(REQUESTERR("DIERR",ERRIDX,"TEXT",1)))
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
