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

SDES2EDITAPREQ.m

Go to the documentation of this file. 
  1. SDES2EDITAPREQ ;ALB/BWF,JAS,JAS,TJB/JAS,BWF,JAS,LAB/JAS - EDIT APPOINTMENT REQUEST ; NOV 21, 2024
  1.  ;;5.3;Scheduling;**869,871,873,875,890,893,895**;Aug 13, 1993;Build 11
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ; RPC: SDES2 EDIT APPT REQ
  1.  ;
  1.  ; SDCONTEXT INPUT
  1.  ;
  1.  ;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
  1.  ;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
  1.  ;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
  1.  ;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
  1.  ;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
  1.  ;
  1.  ; REQUEST INPUT FORMAT
  1.  ;
  1.  ;S REQUEST("REQUEST IEN")=""                               REQ
  1.  ;S REQUEST("DFN")=""                                       REQ
  1.  ;S REQUEST("APPOINTMENT TYPE")=""                          OPT - APPOINTMENT TYPE - can be the Name or IEN
  1.  ;S REQUEST("PATIENT INDICATED DATE")=""                    REQ - when editing a child, this is the new pid date for the child
  1.  ;S REQUEST("PRIORITY")=""                                  REQ
  1.  ;S REQUEST("REQUESTED BY")=""                              REQ
  1.  ;S REQUEST("CLINIC IEN")=""                                OPT/REQ  \
  1.  ;S REQUEST("PRIMARY AMIS")=""                              OPT/REQ---> Either CLINIC IEN or PRIMARY AMIS/CREDIT PRIMARY AMIS must be defined
  1.  ;S REQUEST("CREDIT AMIS")=""                               OPT/REQ  /
  1.  ;S REQUEST("STATION NUMBER")=""                            OPT/REQ -- > Either STATION NUMBER or INSTITUTION NAME is REQUIRED
  1.  ;S REQUEST("INSTITUTION NAME")=""                          OPT/REQ --/
  1.  ;S REQUEST("PROVIDER IEN")=""                              OPT (Required if 'REQUESTED BY' is 'PROVIDER')
  1.  ;S REQUEST("PRIORITY GROUP")=""                            OPT
  1.  ;S REQUEST("SERVICE CONNECTED")=""                         OPT (This is for PRIORITY; 1 OR 0, if passed)
  1.  ;S REQUEST("SERVICE CONNECTED PERCENTAGE")=""              OPT
  1.  ;S REQUEST("MODALITY")=""                                  OPT
  1.  ;S REQUEST("PATIENT STATUS")=""                            OPT
  1.  ;S REQUEST("VAOS GUID")=""                                 OPT
  1.  ;S REQUEST("TIME SENSITIVE")=""                            OPT
  1.  ;S REQUEST("REQUEST COMMENT")=""                           OPT
  1.  ;S REQUEST("PATIENT COMMENT")=""                           OPT
  1.  ;S REQUEST("PATIENT PREFERRED START DATE",1)=""            OPT
  1.  ;S REQUEST("PATIENT PREFERRED END DATE",1)=""              OPT
  1.  ;S REQUEST("PATIENT PREFERRED START DATE",2)=""            OPT
  1.  ;S REQUEST("PATIENT PREFERRED END DATE",2)=""              OPT
  1.  ;S REQUEST("PATIENT PREFERRED START DATE",3)=""            OPT
  1.  ;S REQUEST("PATIENT PREFERRED END DATE",3)=""              OPT
  1.  ;S REQUEST("MRTC","PARENT REQUEST")=""                     OPT
  1.  ;S REQUEST("DUPLICATE REASON")=""                          OPT - The reason a duplicate appointment request is being made
  1.  ;
  1. EDITREQUEST(JSONRETURN,SDCONTEXT,REQUEST) ;
  1.  N REQIEN,ERRORS,RETURN,INSTITUTIONIEN,EDITUSER,FILEDATA
  1.  ;
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
  1.  ;
  1.  S EDITUSER=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
  1.  ;
  1.  M FILEDATA=REQUEST
  1.  D VALIDATE(.REQUEST,.FILEDATA,.INSTITUTIONIEN,.ERRORS)
  1.  I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
  1.  ;
  1.  S RETURN("Request","IEN")=$$BUILDER(.FILEDATA,.INSTITUTIONIEN,$G(SDCONTEXT("ACHERON AUDIT ID")),EDITUSER)
  1.  ;
  1.  D BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)
  1.  Q
  1.  ;
  1. VALIDATE(REQUEST,FILEDATA,INSTITUTIONIEN,ERRORS) ;
  1.  N VALRETURN,VALREQUESTIEN,CLINICIEN,CURPID,CHILDIEN
  1.  ;
  1.  ; Validate required fields
  1.  ; request ien
  1.  S VALREQUESTIEN=""
  1.  D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$G(REQUEST("REQUEST IEN")),1,,3,4)
  1.  I VALRETURN S VALREQUESTIEN=$G(REQUEST("REQUEST IEN"))
  1.  ; DFN
  1.  D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$G(REQUEST("DFN")),1,,1,2,229,"DFN")
  1.  I VALRETURN,VALREQUESTIEN,$$GET1^DIQ(409.85,$G(REQUEST("REQUEST IEN")),.01,"I")'=$G(REQUEST("DFN")) D ERRLOG^SDES2JSON(.ERRORS,534)
  1.  ;
  1.  ; if this is a parent request - no editing
  1.  I VALREQUESTIEN D
  1.  .I $$GET1^DIQ(409.85,VALREQUESTIEN,41,"I"),'$$GET1^DIQ(409.85,VALREQUESTIEN,43.8,"I") D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot edit a parent MRTC request.")
  1.  ;
  1.  I $D(REQUEST("APPOINTMENT TYPE")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,8.7,$G(REQUEST("APPOINTMENT TYPE")),0,,,180)
  1.  .S FILEDATA("APPOINTMENT TYPE")=$G(VALRETURN(409.85,8.7,"I"))
  1.  ;
  1.  ; validate clinic
  1.  I $D(REQUEST("CLINIC IEN")) D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,44,$G(REQUEST("CLINIC IEN")),1,,,19)
  1.  I $D(REQUEST("CLINIC IEN"))!($D(REQUEST("PRIMARY AMIS"))) D
  1.  .I $D(REQUEST("CLINIC IEN")),$G(REQUEST("CLINIC IEN"))="",$D(REQUEST("PRIMARY AMIS")),$G(REQUEST("PRIMARY AMIS"))="" D ERRLOG^SDES2JSON(.ERRORS,530)
  1.  .; CLINIC IEN or PRIMARY AMIS is allowed, NOT both
  1.  .I $G(REQUEST("CLINIC IEN"))'="",($G(REQUEST("PRIMARY AMIS"))'=""!($G(REQUEST("CREDIT AMIS"))'="")) D ERRLOG^SDES2JSON(.ERRORS,202)
  1.  .; cannot have credit amis with no primary amis
  1.  .I $G(REQUEST("CREDIT AMIS"))'="",$D(REQUEST("PRIMARY AMIS")),$G(REQUEST("PRIMARY AMIS"))="" D ERRLOG^SDES2JSON(.ERRORS,234)
  1.  .I $G(REQUEST("PRIMARY AMIS"))'="" D VALPRIMAMIS^SDES2CRTAPREQ(.ERRORS,.REQUEST,.FILEDATA)
  1.  .I $G(REQUEST("CREDIT AMIS"))'="" D VALCREDITAMIS^SDES2CRTAPREQ(.ERRORS,.REQUEST,.FILEDATA)
  1.  .I $G(REQUEST("PRIMARY AMIS"))'="",$G(REQUEST("CREDIT AMIS"))'="" D CONDAMISCHECK^SDES2VAL44(.ERRORS,$G(REQUEST("PRIMARY AMIS")),$G(REQUEST("CREDIT AMIS")))
  1.  ;
  1.  I $D(REQUEST("PATIENT INDICATED DATE")) D
  1.  .S FILEDATA("PATIENT INDICATED DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(REQUEST("PATIENT INDICATED DATE")),$G(REQUEST("CLINIC IEN")),1,159,160,229,,,"PATIENT INDICATED DATE")
  1.  .I VALREQUESTIEN,$$DUPPIDCHK^SDES2CANCELAPPT(VALREQUESTIEN,$G(FILEDATA("PATIENT INDICATED DATE"))) D ERRLOG^SDES2JSON(.ERRORS,545)
  1.  ;
  1.  I $D(REQUEST("PRIORITY")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10,$G(REQUEST("PRIORITY")),1,,457,211,229,,,"PRIORITY")
  1.  .I VALRETURN S FILEDATA("PRIORITY")=$G(VALRETURN(409.85,10,"I"))
  1.  ;
  1.  I $D(REQUEST("REQUESTED BY")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,11,$G(REQUEST("REQUESTED BY")),1,,62,198)
  1.  .I VALRETURN D
  1.  ..S FILEDATA("REQUESTED BY")=$G(VALRETURN(409.85,11,"I"))
  1.  ..I $G(FILEDATA("REQUESTED BY"))=1 D  Q
  1.  ...D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,200,$G(REQUEST("PROVIDER IEN")),1,,53,54,229,,,"PROVIDER IEN")
  1.  ;
  1.  I $D(REQUEST("STATION NUMBER"))!($D(REQUEST("INSTITUTION NAME"))) D
  1.  .S INSTITUTIONIEN=$$STATIONTOINST(.ERRORS,$G(REQUEST("STATION NUMBER")),$G(REQUEST("INSTITUTION NAME")))
  1.  ;
  1.  ; Validate optional fields
  1.  I $D(REQUEST("VAOS GUID")) D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,5)
  1.  I $D(REQUEST("MODALITY")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,6,$G(REQUEST("MODALITY")),,,,224) Q:'VALRETURN
  1.  .S FILEDATA("MODALITY")=$G(VALRETURN(409.85,6,"I"))
  1.  ;
  1.  I $D(REQUEST("PRIORITY GROUP")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10.5,$G(REQUEST("PRIORITY GROUP")),,,,199) Q:'VALRETURN
  1.  .S FILEDATA("PRIORITY GROUP")=$G(VALRETURN(409.85,10.5,"I"))
  1.  ;
  1.  I $D(REQUEST("SERVICE CONNECTED")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,15,$G(REQUEST("SERVICE CONNECTED")),,,,200)
  1.  .S FILEDATA("SERVICE CONNECTED")=$G(VALRETURN(409.85,15,"I"))
  1.  ;
  1.  I $D(REQUEST("SERVICE CONNECTED PERCENTAGE")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,14,$G(REQUEST("SERVICE CONNECTED PERCENTAGE")),,,,201) Q:'VALRETURN
  1.  .;I $G(FILEDATA("SERVICE CONNECTED"))=0,+$G(REQUEST("SERVICE CONNECTED PERCENTAGE")) D ERRLOG^SDES2JSON(.ERRORS,232)
  1.  ;
  1.  I $D(REQUEST("PATIENT STATUS")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,.02,$G(REQUEST("PATIENT STATUS")),,,,203) Q:'VALRETURN
  1.  .S FILEDATA("PATIENT STATUS")=$G(VALRETURN(409.85,.02,"I"))
  1.  ;
  1.  I $D(REQUEST("PATIENT PREFERRED START DATE"))!$D(REQUEST("PATIENT PREFERRED END DATE")) D VALIDATEDATEPREF^SDES2CRTAPREQ(.ERRORS,.REQUEST)
  1.  ;
  1.  I $D(REQUEST("REQUEST COMMENT")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$G(REQUEST("REQUEST COMMENT")),,,,443)
  1.  ;
  1.  I $D(REQUEST("TIME SENSITIVE")) D
  1.  .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,47,$G(REQUEST("TIME SENSITIVE")))
  1.  .I VALRETURN S FILEDATA("TIME SENSITIVE")=$G(VALRETURN(409.85,47,"I"))
  1.  ;
  1.  I $G(REQUEST("REQUEST COMMENT"))]"" D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$G(REQUEST("REQUEST COMMENT")),,,,443)
  1.  ;
  1.  I $G(REQUEST("DUPLICATE REASON"))]"" D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,51,$G(REQUEST("DUPLICATE REASON")),,,,593)
  1.  ;
  1.  ; if this is a child request validate child/parent linkage and PID date uniqueness
  1.  I VALREQUESTIEN,$G(REQUEST("MRTC","PARENT REQUEST"))'="" D
  1.  .D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$G(REQUEST("MRTC","PARENT REQUEST")),1) Q:'VALRETURN
  1.  .I VALRETURN D
  1.  ..I $$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),.01,"I")'=$G(REQUEST("DFN")) D ERRLOG^SDES2JSON(.ERRORS,533)
  1.  .; Make sure this child is linked to this parent record
  1.  .I '$D(^SDEC(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),2,"B",VALREQUESTIEN)) D ERRLOG^SDES2JSON(.ERRORS,546)
  1.  .S CHILDIEN=0
  1.  .F  S CHILDIEN=$O(^SDEC(409.85,REQUEST("MRTC","PARENT REQUEST"),2,"B",CHILDIEN)) Q:'CHILDIEN  D
  1.  ..Q:CHILDIEN=VALREQUESTIEN
  1.  ..I $G(FILEDATA("PATIENT INDICATED DATE"))>0,$$GET1^DIQ(409.85,CHILDIEN,22,"I")=$G(FILEDATA("PATIENT INDICATED DATE")) D
  1.  ...D ERRLOG^SDES2JSON(.ERRORS,545)
  1.  Q
  1.  ;
  1. BUILDER(REQUEST,INSTITUTIONIEN,EAS,EDITUSER) ;
  1.  N FDA,FDAERR,RETURNIEN,REQIEN,ORIGPID,LASTNOTE
  1.  S REQIEN=$G(REQUEST("REQUEST IEN"))_","
  1.  S ORIGPID=$$GET1^DIQ(409.85,REQIEN,22,"I")
  1.  S LASTNOTE=$$GET1^DIQ(409.85,REQIEN_",",25)
  1.  I $D(REQUEST("PATIENT STATUS")) S FDA(409.85,REQIEN,.02)=$G(REQUEST("PATIENT STATUS"))
  1.  I $D(INSTITUTIONIEN) S FDA(409.85,REQIEN,2)=$G(INSTITUTIONIEN)
  1.  I $D(REQUEST("REQUEST SUB TYPE")) S FDA(409.85,REQIEN,4)=$G(REQUEST("REQUEST SUB TYPE"))
  1.  I $D(REQUEST("VAOS GUID")) S FDA(409.85,REQIEN,5)=$G(REQUEST("VAOS GUID"))
  1.  I $D(REQUEST("MODALITY")) S FDA(409.85,REQIEN,6)=$G(REQUEST("MODALITY"))
  1.  I $D(REQUEST("CLINIC IEN"))!($D(REQUEST("PRIMARY AMIS"))) D
  1.  .S FDA(409.85,REQIEN,8)=$G(REQUEST("CLINIC IEN"))
  1.  .S FDA(409.85,REQIEN,8.5)=$G(REQUEST("PRIMARY AMIS"))
  1.  .S FDA(409.85,REQIEN,8.6)=$G(REQUEST("CREDIT AMIS"))
  1.  I $D(REQUEST("APPOINTMENT TYPE")) S FDA(409.85,REQIEN,8.7)=$G(REQUEST("APPOINTMENT TYPE"))
  1.  I $D(REQUEST("PRIORITY")) S FDA(409.85,REQIEN,10)=$G(REQUEST("PRIORITY"))
  1.  I $D(REQUEST("PRIORITY GROUP")) S FDA(409.85,REQIEN,10.5)=$G(REQUEST("PRIORITY GROUP"))
  1.  I $D(REQUEST("REQUESTED BY")) S FDA(409.85,REQIEN,11)=$G(REQUEST("REQUESTED BY"))
  1.  I $D(REQUEST("PROVIDER IEN")) S FDA(409.85,REQIEN,12)=$G(REQUEST("PROVIDER IEN"))
  1.  I $D(REQUEST("SERVICE CONNECTED PERCENTAGE")) S FDA(409.85,REQIEN,14)=$G(REQUEST("SERVICE CONNECTED PERCENTAGE"))
  1.  I $D(REQUEST("SERVICE CONNECTED")) S FDA(409.85,REQIEN,15)=$G(REQUEST("SERVICE CONNECTED"))
  1.  ; Removed the update to PID since it occurs in ADDPIDHISTORY as well and the Original PID is needed for ADDPIDHISTORY
  1.  ;I $D(REQUEST("PATIENT INDICATED DATE")) S FDA(409.85,REQIEN,22)=$G(REQUEST("PATIENT INDICATED DATE"))
  1.  I $D(REQUEST("REQUEST COMMENT")) D
  1.  . N REQCOM S REQCOM=$$CTRL^XMXUTIL1($G(REQUEST("REQUEST COMMENT")))
  1.  . S FDA(409.85,REQIEN,25)=$TR(REQCOM,"^"," ")
  1.  I $D(REQUEST("TIME SENSITIVE")) S FDA(409.85,REQIEN,47)=$G(REQUEST("TIME SENSITIVE"))
  1.  I $D(REQUEST("DUPLICATE REASON")) S FDA(409.85,REQIEN,51)=$G(REQUEST("DUPLICATE REASON"))
  1.  S FDA(409.85,REQIEN,100)=$G(EAS)
  1.  D FILE^DIE(,"FDA","FDAERR") K FDA
  1.  ;
  1.  N LASTLENGTH,NEWLENGTH,NEWNOTE
  1.  ; 409.85 COMMENTS AUDIT multiple
  1.  I $G(REQUEST("REQUEST COMMENT"))'="" D
  1.  . S LASTLENGTH=$L(LASTNOTE),NEWLENGTH=$L(REQUEST("REQUEST COMMENT"))
  1.  . S NEWNOTE=$E(REQUEST("REQUEST COMMENT"),(LASTLENGTH+1),NEWLENGTH)
  1.  . S:$E(NEWNOTE,1,1)=" " NEWNOTE=$E(NEWNOTE,2,$L(NEWNOTE))
  1.  . S NEWNOTE=$$CTRL^XMXUTIL1(NEWNOTE)
  1.  . S FDA(409.8527,"+1,"_REQIEN,.01)=$$NOW^XLFDT
  1.  . S FDA(409.8527,"+1,"_REQIEN,1)=EDITUSER
  1.  . S FDA(409.8527,"+1,"_REQIEN,2)=$TR(NEWNOTE,"^"," ")
  1.  . D UPDATE^DIE("","FDA") K FDA
  1.  ;
  1.  D ADDPIDHISTORY^SDES2CRTAPREQ($G(REQUEST("REQUEST IEN")),$G(REQUEST("PATIENT INDICATED DATE")),EDITUSER)
  1.  ;
  1.  I $D(REQUEST("PATIENT COMMENT"))!($D(REQUEST("PATIENT PREFERRED START DATE"))) D BUILDCOMMENTS(.REQUEST,$G(REQUEST("REQUEST IEN")))
  1.  ;
  1.  ; if PATIENT INDICATED DATE is passed in, and PARENT REQUEST is defined, update the MRTC CALC PREF DATES on the parent request
  1.  I $D(REQUEST("PATIENT INDICATED DATE")),$G(REQUEST("MRTC","PARENT REQUEST")) D
  1.  .;D EDITMRTCPID(.REQUEST,$G(REQUEST("REQUEST IEN")))
  1.  .D EDITPRNTPIDMULT(.REQUEST,$G(REQUEST("MRTC","PARENT REQUEST")),ORIGPID)
  1.  ;
  1.  ;I $D(REQUEST("MRTC","CHILD REQUEST"))!($D(REQUEST("MRTC","MRTC APPOINTMENT"))) D EDITMRTCLINKS(.REQUEST,$G(REQUEST("REQUEST IEN")))
  1.  ;
  1.  D AUDIT($G(REQUEST("REQUEST IEN")),$G(REQUEST("CLINIC IEN")),$G(REQUEST("PRIMARY AMIS")),EDITUSER)
  1.  ;
  1.  Q $G(REQUEST("REQUEST IEN"))
  1.  ;
  1. BUILDAPPTDATA(REQIEN,APPTDATETIME,CLINICIEN,SERVCONNPERC,SERVCONN,APPTTYPE,EAS,USER) ;
  1.  N FDA,FDAERR
  1.  S REQIEN=$G(REQIEN)_","
  1.  S FDA(409.85,REQIEN,8.7)=$G(APPTTYPE)
  1.  S FDA(409.85,REQIEN,13)=$G(APPTDATETIME)
  1.  S FDA(409.85,REQIEN,13.1)=$P($$NOW^XLFDT,".",1)
  1.  S FDA(409.85,REQIEN,13.2)=$G(CLINICIEN)
  1.  S FDA(409.85,REQIEN,13.3)=$$GET1^DIQ(44,$G(CLINICIEN),3,"I") ; appt institution ;
  1.  S FDA(409.85,REQIEN,13.4)=$$GET1^DIQ(44,$G(CLINICIEN),8,"I") ; appt stop code
  1.  S FDA(409.85,REQIEN,13.6)=$$GET1^DIQ(40.8,$$GET1^DIQ(44,$G(CLINICIEN),3.5,"I"),1,"I") ; appt station number
  1.  S FDA(409.85,REQIEN,13.7)=$G(USER)
  1.  S FDA(409.85,REQIEN,13.8)="R" ; 'R' FOR Scheduled/Kept;
  1.  S FDA(409.85,REQIEN,14)=$G(SERVCONNPERC)
  1.  S FDA(409.85,REQIEN,15)=$G(SERVCONN)
  1.  S FDA(409.85,REQIEN,100)=$G(EAS)
  1.  S FDA(409.85,REQIEN,19)=$P($$NOW^XLFDT,".",1)
  1.  S FDA(409.85,REQIEN,20)=$G(USER)
  1.  S FDA(409.85,REQIEN,21)=$$FIND1^DIC(409.853,,"B","REMOVED/SCHEDULED-ASSIGNED")
  1.  S FDA(409.85,REQIEN,23)="C"
  1.  D FILE^DIE(,"FDA","FDAERR") K FDA
  1.  ;
  1.  N PARENTIEN
  1.  S PARENTIEN=$$GET1^DIQ(409.85,REQIEN_",",43.8,"I")
  1.  I PARENTIEN D
  1.  . N CHILDIEN,FOUND
  1.  . S CHILDIEN="",FOUND=0
  1.  . F  S CHILDIEN=$O(^SDEC(409.85,PARENTIEN,2,"B",CHILDIEN)) Q:(CHILDIEN="")!(FOUND)  D
  1.  . . S FOUND=($$GET1^DIQ(409.85,CHILDIEN_",",23,"E")="OPEN")
  1.  . I 'FOUND D
  1.  . . S FDA(409.85,PARENTIEN_",",23)="C"
  1.  . . D FILE^DIE(,"FDA","ERROR") K FDA
  1.  Q
  1.  ;
  1.  N NUM,FDA,FDAERR,SUBIEN
  1.  S SUBIEN=0,NUM=0
  1.  F  S SUBIEN=$O(^SDEC(409.85,REQIEN,2,SUBIEN)) Q:'SUBIEN  D
  1.  .S NUM=NUM+1
  1.  .S FDA(409.852,SUBIEN_","_REQIEN_",",.01)=$G(REQUEST("MRTC","CHILD REQUEST",NUM))
  1.  .S FDA(409.852,SUBIEN_","_REQIEN_",",.02)=$G(REQUEST("MRTC","MRTC APPOINTMENT",NUM))
  1.  .D FILE^DIE(,"FDA","FDAERR") K FDA
  1.  Q
  1.  ;
  1. EDITMRTCPID(REQUEST,REQIEN) ;
  1.  N NUM,FDA,FDAERR,SUBIEN
  1.  S SUBIEN=0,NUM=0
  1.  F  S SUBIEN=$O(^SDEC(409.85,REQIEN,5,SUBIEN)) Q:'SUBIEN  D
  1.  .S NUM=NUM+1
  1.  .S FDA(409.851,SUBIEN_","_REQIEN_",",.01)=$G(REQUEST("MRTC","PATIENT INDICATED DATE",NUM))
  1.  .D FILE^DIE(,"FDA","FDAERR") K FDA
  1.  Q
  1.  ; Update the parent MRTC CAL PREF DATE for the child being edited.
  1. EDITPRNTPIDMULT(REQUEST,PARENTIEN,ORIGPID) ;
  1.  N NUM,FDA,FDAERR,SUBIEN,OLDPIDIEN
  1.  S SUBIEN=0,NUM=0
  1.  S OLDPIDIEN=$O(^SDEC(409.85,PARENTIEN,5,"B",ORIGPID,0)) Q:'OLDPIDIEN
  1.  S FDA(409.851,OLDPIDIEN_","_PARENTIEN_",",.01)=$G(REQUEST("PATIENT INDICATED DATE"))
  1.  D FILE^DIE(,"FDA","FDAERR") K FDA
  1.  Q
  1.  ;
  1.  N FDA,FDAERR,SUBIEN
  1.  S SUBIEN=$O(^SDEC(409.85,REQIEN,2,"B",REQUEST("MRTC","CHILD REQUEST"),0))
  1.  S FDA(409.852,SUBIEN_","_REQIEN_",",.02)=$G(REQUEST("MRTC","MRTC APPOINTMENT"))
  1.  D UPDATE^DIE(,"FDA",,"FDAERR") K FDA
  1.  Q
  1.  ;
  1. BUILDMRTCPID(REQUEST,REQIEN) ; called from SDESCREATEAPPT after appt is made from mrtc child
  1.  N FDA,FDAERR,SDPID
  1.  S SDPID=$G(REQUEST("MRTC","PATIENT INDICATED DATE"))
  1.  S:SDPID="" SDPID=$$GET1^DIQ(409.85,REQIEN,22,"I")
  1.  Q:$O(^SDEC(409.85,REQIEN,5,"B",SDPID,0))
  1.  S FDA(409.851,"+1,"_REQIEN_",",.01)=SDPID
  1.  D UPDATE^DIE(,"FDA",,"FDAERR") K FDA
  1.  Q
  1.  ;
  1. BUILDCOMMENTS(REQUEST,REQIEN) ;
  1.  N REQCOMMS,NUM,NUM2,DONE,PREFDATES,PATCOMMS,RANGE,DATERANGE1,DATERANGE2,DATERANGE3,EDITPATCOM
  1.  S NUM=0
  1.  I $D(REQUEST("PATIENT COMMENT")) D
  1.  .N PC S PC="PATIENT COMMENT"
  1.  .I $G(REQUEST(PC))'["Patient preferred date range" S EDITPATCOM(1)=$G(REQUEST(PC)) D WP^DIE(409.85,REQIEN_",",60,"","EDITPATCOM") Q
  1.  .S EDITPATCOM(1)=$P($G(REQUEST(PC)),"Patient preferred date range",1)
  1.  .S DATERANGE1=$P($G(REQUEST(PC)),"Patient preferred date range",2) I $L($G(DATERANGE1)) S EDITPATCOM(2)="Patient preferred date range"_$P($G(REQUEST(PC)),"Patient preferred date range",2)
  1.  .S DATERANGE2=$P($G(REQUEST(PC)),"Patient preferred date range",3) I $L($G(DATERANGE2)) S EDITPATCOM(3)="Patient preferred date range"_$P($G(REQUEST(PC)),"Patient preferred date range",3)
  1.  .S DATERANGE3=$P($G(REQUEST(PC)),"Patient preferred date range",4) I $L($G(DATERANGE3)) S EDITPATCOM(4)="Patient preferred date range"_$P($G(REQUEST(PC)),"Patient preferred date range",4)
  1.  .D WP^DIE(409.85,REQIEN_",",60,"","EDITPATCOM")
  1.  Q
  1.  ;
  1. AUDIT(REQIEN,CLINICIEN,STOPCODE,USER) ;
  1.  N FDA,FDAERR
  1.  S FDA(409.8545,"+1,"_REQIEN_",",.01)=$$NOW^XLFDT
  1.  S FDA(409.8545,"+1,"_REQIEN_",",1)=$G(USER)
  1.  S FDA(409.8545,"+1,"_REQIEN_",",2)=$G(CLINICIEN)
  1.  S FDA(409.8545,"+1,"_REQIEN_",",3)=$G(STOPCODE)
  1.  D UPDATE^DIE("","FDA",,"FDAERR") K FDA
  1.  Q
  1.  ;
  1. STATIONTOINST(ERRORS,STATIONNUM,INSTNAME) ; station number has precedence over institution name
  1.  N INSTITUTIONIEN
  1.  I STATIONNUM="",INSTNAME="" D ERRLOG^SDES2JSON(.ERRORS,204) Q 0
  1.  I STATIONNUM="",INSTNAME'="" D
  1.  .S INSTITUTIONIEN=$$FIND1^DIC(4,"","X",INSTNAME,"B") I 'INSTITUTIONIEN D ERRLOG^SDES2JSON(.ERRORS,205)
  1.  I STATIONNUM'="" S INSTITUTIONIEN=$$FIND1^DIC(4,"","X",STATIONNUM,"D") I 'INSTITUTIONIEN D ERRLOG^SDES2JSON(.ERRORS,197) Q 0
  1.  Q INSTITUTIONIEN
  1.  ;