Routine: SDES2EDITAPREQ

SDES2EDITAPREQ ;ALB/BWF,JAS,JAS,TJB/JAS - EDIT APPOINTMENT REQUEST; APR 2, 2024

 ;;5.3;Scheduling;**869,871,873,875**;Aug 13, 1993;Build 25

 ;;Per VHA Directive 6402, this routine should not be modified

 ; RPC: SDES2 EDIT APPT REQ

 ; SDCONTEXT INPUT

 ;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37

 ;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.

 ;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.

 ;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.

 ;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.

 ; REQUEST INPUT FORMAT

 ;S REQUEST("REQUEST IEN")=""                               REQ

 ;S REQUEST("DFN")=""                                       REQ

 ;S REQUEST("APPOINTMENT TYPE")=""                          OPT - APPOINTMENT TYPE - can be the Name or IEN

 ;S REQUEST("PATIENT INDICATED DATE")=""                    REQ - when editing a child, this is the new pid date for the child

 ;S REQUEST("PRIORITY")=""                                  REQ

 ;S REQUEST("REQUESTED BY")=""                              REQ

 ;S REQUEST("CLINIC IEN")=""                                OPT/REQ  \

 ;S REQUEST("PRIMARY AMIS")=""                              OPT/REQ---> Either CLINIC IEN or PRIMARY AMIS/CREDIT PRIMARY AMIS must be defined

 ;S REQUEST("CREDIT AMIS")=""                               OPT/REQ  /

 ;S REQUEST("STATION NUMBER")=""                            OPT/REQ -- > Either STATION NUMBER or INSTITUTION NAME is REQUIRED

 ;S REQUEST("INSTITUTION NAME")=""                          OPT/REQ --/

 ;S REQUEST("PROVIDER IEN")=""                              OPT (Required if 'REQUESTED BY' is 'PROVIDER')

 ;S REQUEST("PRIORITY GROUP")=""                            OPT

 ;S REQUEST("SERVICE CONNECTED")=""                         OPT (This is for PRIORITY; 1 OR 0, if passed)

 ;S REQUEST("SERVICE CONNECTED PERCENTAGE")=""              OPT

 ;S REQUEST("MODALITY")=""                                  OPT

 ;S REQUEST("PATIENT STATUS")=""                            OPT

 ;S REQUEST("VAOS GUID")=""                                 OPT

 ;S REQUEST("TIME SENSITIVE")=""                            OPT

 ;S REQUEST("REQUEST COMMENT")=""                           OPT

 ;S REQUEST("PATIENT COMMENT")=""                           OPT

 ;S REQUEST("PATIENT PREFERRED START DATE",1)=""            OPT

 ;S REQUEST("PATIENT PREFERRED END DATE",1)=""              OPT

 ;S REQUEST("PATIENT PREFERRED START DATE",2)=""            OPT

 ;S REQUEST("PATIENT PREFERRED END DATE",2)=""              OPT

 ;S REQUEST("PATIENT PREFERRED START DATE",3)=""            OPT

 ;S REQUEST("PATIENT PREFERRED END DATE",3)=""              OPT

 ;S REQUEST("MRTC","PARENT REQUEST")=""                     OPT

EDITREQUEST(JSONRETURN,SDCONTEXT,REQUEST) ;

 N REQIEN,ERRORS,RETURN,INSTITUTIONIEN,EDITUSER,FILEDATA

 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q

 S EDITUSER=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)

 M FILEDATA=REQUEST

 D VALIDATE(.REQUEST,.FILEDATA,.INSTITUTIONIEN,.ERRORS)

 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q

 S RETURN("Request","IEN")=$$BUILDER(.FILEDATA,.INSTITUTIONIEN,$G(SDCONTEXT("ACHERON AUDIT ID")),EDITUSER)

 D BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)

VALIDATE(REQUEST,FILEDATA,INSTITUTIONIEN,ERRORS) ;

 N VALRETURN,VALREQUESTIEN,CLINICIEN,CURPID,CHILDIEN

 ; Validate required fields

 ; request ien

 S VALREQUESTIEN=""

 D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$G(REQUEST("REQUEST IEN")),1,,3,4)

 I VALRETURN S VALREQUESTIEN=$G(REQUEST("REQUEST IEN"))

 ; DFN

 D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$G(REQUEST("DFN")),1,,1,2,229,"DFN")

 I VALRETURN,VALREQUESTIEN,$$GET1^DIQ(409.85,$G(REQUEST("REQUEST IEN")),.01,"I")'=$G(REQUEST("DFN")) D ERRLOG^SDES2JSON(.ERRORS,534)

 ; if this is a parent request - no editing

 I VALREQUESTIEN D

 .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.")

 I $D(REQUEST("APPOINTMENT TYPE")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,8.7,$G(REQUEST("APPOINTMENT TYPE")),0,,,180)

 .S FILEDATA("APPOINTMENT TYPE")=$G(VALRETURN(409.85,8.7,"I"))

 ; validate clinic

 I $D(REQUEST("CLINIC IEN")) D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,44,$G(REQUEST("CLINIC IEN")),1,,,19)

 I $D(REQUEST("CLINIC IEN"))!($D(REQUEST("PRIMARY AMIS"))) D

 .I $D(REQUEST("CLINIC IEN")),$G(REQUEST("CLINIC IEN"))="",$D(REQUEST("PRIMARY AMIS")),$G(REQUEST("PRIMARY AMIS"))="" D ERRLOG^SDES2JSON(.ERRORS,530)

 .; CLINIC IEN or PRIMARY AMIS is allowed, NOT both

 .I $G(REQUEST("CLINIC IEN"))'="",($G(REQUEST("PRIMARY AMIS"))'=""!($G(REQUEST("CREDIT AMIS"))'="")) D ERRLOG^SDES2JSON(.ERRORS,202)

 .; cannot have credit amis with no primary amis

 .I $G(REQUEST("CREDIT AMIS"))'="",$D(REQUEST("PRIMARY AMIS")),$G(REQUEST("PRIMARY AMIS"))="" D ERRLOG^SDES2JSON(.ERRORS,234)

 .I $G(REQUEST("PRIMARY AMIS"))'="" D VALPRIMAMIS^SDES2CRTAPREQ(.ERRORS,.REQUEST,.FILEDATA)

 .I $G(REQUEST("CREDIT AMIS"))'="" D VALCREDITAMIS^SDES2CRTAPREQ(.ERRORS,.REQUEST,.FILEDATA)

 .I $G(REQUEST("PRIMARY AMIS"))'="",$G(REQUEST("CREDIT AMIS"))'="" D CONDAMISCHECK^SDES2VAL44(.ERRORS,$G(REQUEST("PRIMARY AMIS")),$G(REQUEST("CREDIT AMIS")))

 I $D(REQUEST("PATIENT INDICATED DATE")) D

 .S FILEDATA("PATIENT INDICATED DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$G(REQUEST("PATIENT INDICATED DATE")),$G(REQUEST("CLINIC IEN")),1,159,160,229,,,"PATIENT INDICATED DATE")

 .I VALREQUESTIEN,$$DUPPIDCHK^SDES2CANCELAPPT(VALREQUESTIEN,$G(FILEDATA("PATIENT INDICATED DATE"))) D ERRLOG^SDES2JSON(.ERRORS,545)

 I $D(REQUEST("PRIORITY")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10,$G(REQUEST("PRIORITY")),1,,457,211,229,,,"PRIORITY")

 .I VALRETURN S FILEDATA("PRIORITY")=$G(VALRETURN(409.85,10,"I"))

 I $D(REQUEST("REQUESTED BY")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,11,$G(REQUEST("REQUESTED BY")),1,,62,198)

 .I VALRETURN D

 ..S FILEDATA("REQUESTED BY")=$G(VALRETURN(409.85,11,"I"))

 ..I $G(FILEDATA("REQUESTED BY"))=1 D  Q

 ...D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,200,$G(REQUEST("PROVIDER IEN")),1,,53,54,229,,,"PROVIDER IEN")

 I $D(REQUEST("STATION NUMBER"))!($D(REQUEST("INSTITUTION NAME"))) D

 .S INSTITUTIONIEN=$$STATIONTOINST(.ERRORS,$G(REQUEST("STATION NUMBER")),$G(REQUEST("INSTITUTION NAME")))

 ; Validate optional fields

 I $D(REQUEST("VAOS GUID")) D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,5)

 I $D(REQUEST("MODALITY")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,6,$G(REQUEST("MODALITY")),,,,224) Q:'VALRETURN

 .S FILEDATA("MODALITY")=$G(VALRETURN(409.85,6,"I"))

 I $D(REQUEST("PRIORITY GROUP")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10.5,$G(REQUEST("PRIORITY GROUP")),,,,199) Q:'VALRETURN

 .S FILEDATA("PRIORITY GROUP")=$G(VALRETURN(409.85,10.5,"I"))

 I $D(REQUEST("SERVICE CONNECTED")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,15,$G(REQUEST("SERVICE CONNECTED")),,,,200)

 .S FILEDATA("SERVICE CONNECTED")=$G(VALRETURN(409.85,15,"I"))

 I $D(REQUEST("SERVICE CONNECTED PERCENTAGE")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,14,$G(REQUEST("SERVICE CONNECTED PERCENTAGE")),,,,201) Q:'VALRETURN

 .;I $G(FILEDATA("SERVICE CONNECTED"))=0,+$G(REQUEST("SERVICE CONNECTED PERCENTAGE")) D ERRLOG^SDES2JSON(.ERRORS,232)

 I $D(REQUEST("PATIENT STATUS")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,.02,$G(REQUEST("PATIENT STATUS")),,,,203) Q:'VALRETURN

 .S FILEDATA("PATIENT STATUS")=$G(VALRETURN(409.85,.02,"I"))

 I $D(REQUEST("PATIENT PREFERRED START DATE"))!$D(REQUEST("PATIENT PREFERRED END DATE")) D VALIDATEDATEPREF^SDES2CRTAPREQ(.ERRORS,.REQUEST)

 I $D(REQUEST("REQUEST COMMENT")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$G(REQUEST("REQUEST COMMENT")),,,,443)

 I $D(REQUEST("TIME SENSITIVE")) D

 .D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,47,$G(REQUEST("TIME SENSITIVE")))

 .I VALRETURN S FILEDATA("TIME SENSITIVE")=$G(VALRETURN(409.85,47,"I"))

 I $G(REQUEST("REQUEST COMMENT"))]"" D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$G(REQUEST("REQUEST COMMENT")),,,,443)

 ; if this is a child request validate child/parent linkage and PID date uniqueness

 I VALREQUESTIEN,$G(REQUEST("MRTC","PARENT REQUEST"))'="" D

 .D VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$G(REQUEST("MRTC","PARENT REQUEST")),1) Q:'VALRETURN

 .I VALRETURN D

 ..I $$GET1^DIQ(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),.01,"I")'=$G(REQUEST("DFN")) D ERRLOG^SDES2JSON(.ERRORS,533)

 .; Make sure this child is linked to this parent record

 .I '$D(^SDEC(409.85,$G(REQUEST("MRTC","PARENT REQUEST")),2,"B",VALREQUESTIEN)) D ERRLOG^SDES2JSON(.ERRORS,546)

 .S CHILDIEN=0

 .F  S CHILDIEN=$O(^SDEC(409.85,REQUEST("MRTC","PARENT REQUEST"),2,"B",CHILDIEN)) Q:'CHILDIEN  D

 ..Q:CHILDIEN=VALREQUESTIEN

 ..I $G(FILEDATA("PATIENT INDICATED DATE"))>0,$$GET1^DIQ(409.85,CHILDIEN,22,"I")=$G(FILEDATA("PATIENT INDICATED DATE")) D

 ...D ERRLOG^SDES2JSON(.ERRORS,545)

BUILDER(REQUEST,INSTITUTIONIEN,EAS,EDITUSER) ;

 N FDA,FDAERR,RETURNIEN,REQIEN,ORIGPID

 S REQIEN=$G(REQUEST("REQUEST IEN"))_","

 S ORIGPID=$$GET1^DIQ(409.85,REQIEN,22,"I")

 I $D(REQUEST("PATIENT STATUS")) S FDA(409.85,REQIEN,.02)=$G(REQUEST("PATIENT STATUS"))

 I $D(INSTITUTIONIEN) S FDA(409.85,REQIEN,2)=$G(INSTITUTIONIEN)

 I $D(REQUEST("REQUEST SUB TYPE")) S FDA(409.85,REQIEN,4)=$G(REQUEST("REQUEST SUB TYPE"))

 I $D(REQUEST("VAOS GUID")) S FDA(409.85,REQIEN,5)=$G(REQUEST("VAOS GUID"))

 I $D(REQUEST("MODALITY")) S FDA(409.85,REQIEN,6)=$G(REQUEST("MODALITY"))

 I $D(REQUEST("CLINIC IEN"))!($D(REQUEST("PRIMARY AMIS"))) D

 .S FDA(409.85,REQIEN,8)=$G(REQUEST("CLINIC IEN"))

 .S FDA(409.85,REQIEN,8.5)=$G(REQUEST("PRIMARY AMIS"))

 .S FDA(409.85,REQIEN,8.6)=$G(REQUEST("CREDIT AMIS"))

 I $D(REQUEST("APPOINTMENT TYPE")) S FDA(409.85,REQIEN,8.7)=$G(REQUEST("APPOINTMENT TYPE"))

 I $D(REQUEST("PRIORITY")) S FDA(409.85,REQIEN,10)=$G(REQUEST("PRIORITY"))

 I $D(REQUEST("PRIORITY GROUP")) S FDA(409.85,REQIEN,10.5)=$G(REQUEST("PRIORITY GROUP"))

 I $D(REQUEST("REQUESTED BY")) S FDA(409.85,REQIEN,11)=$G(REQUEST("REQUESTED BY"))

 I $D(REQUEST("PROVIDER IEN")) S FDA(409.85,REQIEN,12)=$G(REQUEST("PROVIDER IEN"))

 I $D(REQUEST("SERVICE CONNECTED PERCENTAGE")) S FDA(409.85,REQIEN,14)=$G(REQUEST("SERVICE CONNECTED PERCENTAGE"))

 I $D(REQUEST("SERVICE CONNECTED")) S FDA(409.85,REQIEN,15)=$G(REQUEST("SERVICE CONNECTED"))

 ; Removed the update to PID since it occurs in ADDPIDHISTORY as well and the Original PID is needed for ADDPIDHISTORY

 ;I $D(REQUEST("PATIENT INDICATED DATE")) S FDA(409.85,REQIEN,22)=$G(REQUEST("PATIENT INDICATED DATE"))

 I $D(REQUEST("REQUEST COMMENT")) S FDA(409.85,REQIEN,25)=$TR($G(REQUEST("REQUEST COMMENT")),"^"," ")

 I $D(REQUEST("TIME SENSITIVE")) S FDA(409.85,REQIEN,47)=$G(REQUEST("TIME SENSITIVE"))

 S FDA(409.85,REQIEN,100)=$G(EAS)

 D FILE^DIE(,"FDA","FDAERR") K FDA

 D ADDPIDHISTORY^SDES2CRTAPREQ($G(REQUEST("REQUEST IEN")),$G(REQUEST("PATIENT INDICATED DATE")),EDITUSER)

 I $D(REQUEST("PATIENT COMMENT"))!($D(REQUEST("PATIENT PREFERRED START DATE"))) D BUILDCOMMENTS(.REQUEST,$G(REQUEST("REQUEST IEN")))

 ; if PATIENT INDICATED DATE is passed in, and PARENT REQUEST is defined, update the MRTC CALC PREF DATES on the parent request

 I $D(REQUEST("PATIENT INDICATED DATE")),$G(REQUEST("MRTC","PARENT REQUEST")) D

 .;D EDITMRTCPID(.REQUEST,$G(REQUEST("REQUEST IEN")))

 .D EDITPRNTPIDMULT(.REQUEST,$G(REQUEST("MRTC","PARENT REQUEST")),ORIGPID)

 ;I $D(REQUEST("MRTC","CHILD REQUEST"))!($D(REQUEST("MRTC","MRTC APPOINTMENT"))) D EDITMRTCLINKS(.REQUEST,$G(REQUEST("REQUEST IEN")))

 D AUDIT($G(REQUEST("REQUEST IEN")),$G(REQUEST("CLINIC IEN")),$G(REQUEST("PRIMARY AMIS")),EDITUSER)

 Q $G(REQUEST("REQUEST IEN"))

BUILDAPPTDATA(REQIEN,APPTDATETIME,CLINICIEN,SERVCONNPERC,SERVCONN,APPTTYPE,EAS,USER) ;

 N FDA,FDAERR

 S REQIEN=$G(REQIEN)_","

 S FDA(409.85,REQIEN,8.7)=$G(APPTTYPE)

 S FDA(409.85,REQIEN,13)=$G(APPTDATETIME)

 S FDA(409.85,REQIEN,13.1)=$P($$NOW^XLFDT,".",1)

 S FDA(409.85,REQIEN,13.2)=$G(CLINICIEN)

 S FDA(409.85,REQIEN,13.3)=$$GET1^DIQ(44,$G(CLINICIEN),3,"I") ; appt institution ;

 S FDA(409.85,REQIEN,13.4)=$$GET1^DIQ(44,$G(CLINICIEN),8,"I") ; appt stop code

 S FDA(409.85,REQIEN,13.6)=$$GET1^DIQ(40.8,$$GET1^DIQ(44,$G(CLINICIEN),3.5,"I"),1,"I") ; appt station number

 S FDA(409.85,REQIEN,13.7)=$G(USER)

 S FDA(409.85,REQIEN,13.8)="R" ; 'R' FOR Scheduled/Kept;

 S FDA(409.85,REQIEN,14)=$G(SERVCONNPERC)

 S FDA(409.85,REQIEN,15)=$G(SERVCONN)

 S FDA(409.85,REQIEN,100)=$G(EAS)

 S FDA(409.85,REQIEN,19)=$P($$NOW^XLFDT,".",1)

 S FDA(409.85,REQIEN,20)=$G(USER)

 S FDA(409.85,REQIEN,21)=$$FIND1^DIC(409.853,,"B","REMOVED/SCHEDULED-ASSIGNED")

 S FDA(409.85,REQIEN,23)="C"

 D FILE^DIE(,"FDA","FDAERR") K FDA

 N PARENTIEN

 S PARENTIEN=$$GET1^DIQ(409.85,REQIEN_",",43.8,"I")

 I PARENTIEN D

 . N CHILDIEN,FOUND

 . S CHILDIEN="",FOUND=0

 . F  S CHILDIEN=$O(^SDEC(409.85,PARENTIEN,2,"B",CHILDIEN)) Q:(CHILDIEN="")!(FOUND)  D

 . . S FOUND=($$GET1^DIQ(409.85,CHILDIEN_",",23,"E")="OPEN")

 . I 'FOUND D

 . . S FDA(409.85,PARENTIEN_",",23)="C"

 . . D FILE^DIE(,"FDA","ERROR") K FDA

EDITMRTCLINKS(REQUEST,REQIEN) ;

 N NUM,FDA,FDAERR,SUBIEN

 S SUBIEN=0,NUM=0

 F  S SUBIEN=$O(^SDEC(409.85,REQIEN,2,SUBIEN)) Q:'SUBIEN  D

 .S NUM=NUM+1

 .S FDA(409.852,SUBIEN_","_REQIEN_",",.01)=$G(REQUEST("MRTC","CHILD REQUEST",NUM))

 .S FDA(409.852,SUBIEN_","_REQIEN_",",.02)=$G(REQUEST("MRTC","MRTC APPOINTMENT",NUM))

 .D FILE^DIE(,"FDA","FDAERR") K FDA

EDITMRTCPID(REQUEST,REQIEN) ;

 N NUM,FDA,FDAERR,SUBIEN

 S SUBIEN=0,NUM=0

 F  S SUBIEN=$O(^SDEC(409.85,REQIEN,5,SUBIEN)) Q:'SUBIEN  D

 .S NUM=NUM+1

 .S FDA(409.851,SUBIEN_","_REQIEN_",",.01)=$G(REQUEST("MRTC","PATIENT INDICATED DATE",NUM))

 .D FILE^DIE(,"FDA","FDAERR") K FDA

 ; Update the parent MRTC CAL PREF DATE for the child being edited.

EDITPRNTPIDMULT(REQUEST,PARENTIEN,ORIGPID) ;

 N NUM,FDA,FDAERR,SUBIEN,OLDPIDIEN

 S SUBIEN=0,NUM=0

 S OLDPIDIEN=$O(^SDEC(409.85,PARENTIEN,5,"B",ORIGPID,0)) Q:'OLDPIDIEN

 S FDA(409.851,OLDPIDIEN_","_PARENTIEN_",",.01)=$G(REQUEST("PATIENT INDICATED DATE"))

 D FILE^DIE(,"FDA","FDAERR") K FDA

BUILDMRTCLINKS(REQUEST,REQIEN) ; called from SDESCREATEAPPT after appt is made from mrtc child

 N FDA,FDAERR,SUBIEN

 S SUBIEN=$O(^SDEC(409.85,REQIEN,2,"B",REQUEST("MRTC","CHILD REQUEST"),0))

 S FDA(409.852,SUBIEN_","_REQIEN_",",.02)=$G(REQUEST("MRTC","MRTC APPOINTMENT"))

 D UPDATE^DIE(,"FDA",,"FDAERR") K FDA

BUILDMRTCPID(REQUEST,REQIEN) ; called from SDESCREATEAPPT after appt is made from mrtc child

 N FDA,FDAERR,SDPID

 S SDPID=$G(REQUEST("MRTC","PATIENT INDICATED DATE"))

 S:SDPID="" SDPID=$$GET1^DIQ(409.85,REQIEN,22,"I")

 Q:$O(^SDEC(409.85,REQIEN,5,"B",SDPID,0))

 S FDA(409.851,"+1,"_REQIEN_",",.01)=SDPID

 D UPDATE^DIE(,"FDA",,"FDAERR") K FDA

BUILDCOMMENTS(REQUEST,REQIEN) ;

 N REQCOMMS,NUM,NUM2,DONE,PREFDATES,PATCOMMS,RANGE,DATERANGE1,DATERANGE2,DATERANGE3,EDITPATCOM

 S NUM=0

 I $D(REQUEST("PATIENT COMMENT")) D

 .N PC S PC="PATIENT COMMENT"

 .I $G(REQUEST(PC))'["Patient preferred date range" S EDITPATCOM(1)=$G(REQUEST(PC)) D WP^DIE(409.85,REQIEN_",",60,"","EDITPATCOM") Q

 .S EDITPATCOM(1)=$P($G(REQUEST(PC)),"Patient preferred date range",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)

 .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)

 .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)

 .D WP^DIE(409.85,REQIEN_",",60,"","EDITPATCOM")

AUDIT(REQIEN,CLINICIEN,STOPCODE,USER) ;

 N FDA,FDAERR

 S FDA(409.8545,"+1,"_REQIEN_",",.01)=$$NOW^XLFDT

 S FDA(409.8545,"+1,"_REQIEN_",",1)=$G(USER)

 S FDA(409.8545,"+1,"_REQIEN_",",2)=$G(CLINICIEN)

 S FDA(409.8545,"+1,"_REQIEN_",",3)=$G(STOPCODE)

 D UPDATE^DIE("","FDA",,"FDAERR") K FDA

STATIONTOINST(ERRORS,STATIONNUM,INSTNAME) ; station number has precedence over institution name

 N INSTITUTIONIEN

 I STATIONNUM="",INSTNAME="" D ERRLOG^SDES2JSON(.ERRORS,204) Q 0

 I STATIONNUM="",INSTNAME'="" D

 .S INSTITUTIONIEN=$$FIND1^DIC(4,"","X",INSTNAME,"B") I 'INSTITUTIONIEN D ERRLOG^SDES2JSON(.ERRORS,205)

 I STATIONNUM'="" S INSTITUTIONIEN=$$FIND1^DIC(4,"","X",STATIONNUM,"D") I 'INSTITUTIONIEN D ERRLOG^SDES2JSON(.ERRORS,197) Q 0

 Q INSTITUTIONIEN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2EDITAPREQ   17223     printed  Nov 22, 2024@18:03:42                                                                                                                                                                                             Page 2

SDES2EDITAPREQ ;ALB/BWF,JAS,JAS,TJB/JAS - EDIT APPOINTMENT REQUEST; APR 2, 2024

 +1       ;;5.3;Scheduling;**869,871,873,875**;Aug 13, 1993;Build 25

 +2       ;;Per VHA Directive 6402, this routine should not be modified

 +3       ;

 +4        QUIT

 +5       ; RPC: SDES2 EDIT APPT REQ

 +6       ;

 +7       ; SDCONTEXT INPUT

 +8       ;

 +9       ;S SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37

 +10      ;S SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.

 +11      ;S SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.

 +12      ;S SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.

 +13      ;S SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.

 +14      ;

 +15      ; REQUEST INPUT FORMAT

 +16      ;

 +17      ;S REQUEST("REQUEST IEN")=""                               REQ

 +18      ;S REQUEST("DFN")=""                                       REQ

 +19      ;S REQUEST("APPOINTMENT TYPE")=""                          OPT - APPOINTMENT TYPE - can be the Name or IEN

 +20      ;S REQUEST("PATIENT INDICATED DATE")=""                    REQ - when editing a child, this is the new pid date for the child

 +21      ;S REQUEST("PRIORITY")=""                                  REQ

 +22      ;S REQUEST("REQUESTED BY")=""                              REQ

 +23      ;S REQUEST("CLINIC IEN")=""                                OPT/REQ  \

 +24      ;S REQUEST("PRIMARY AMIS")=""                              OPT/REQ---> Either CLINIC IEN or PRIMARY AMIS/CREDIT PRIMARY AMIS must be defined

 +25      ;S REQUEST("CREDIT AMIS")=""                               OPT/REQ  /

 +26      ;S REQUEST("STATION NUMBER")=""                            OPT/REQ -- > Either STATION NUMBER or INSTITUTION NAME is REQUIRED

 +27      ;S REQUEST("INSTITUTION NAME")=""                          OPT/REQ --/

 +28      ;S REQUEST("PROVIDER IEN")=""                              OPT (Required if 'REQUESTED BY' is 'PROVIDER')

 +29      ;S REQUEST("PRIORITY GROUP")=""                            OPT

 +30      ;S REQUEST("SERVICE CONNECTED")=""                         OPT (This is for PRIORITY; 1 OR 0, if passed)

 +31      ;S REQUEST("SERVICE CONNECTED PERCENTAGE")=""              OPT

 +32      ;S REQUEST("MODALITY")=""                                  OPT

 +33      ;S REQUEST("PATIENT STATUS")=""                            OPT

 +34      ;S REQUEST("VAOS GUID")=""                                 OPT

 +35      ;S REQUEST("TIME SENSITIVE")=""                            OPT

 +36      ;S REQUEST("REQUEST COMMENT")=""                           OPT

 +37      ;S REQUEST("PATIENT COMMENT")=""                           OPT

 +38      ;S REQUEST("PATIENT PREFERRED START DATE",1)=""            OPT

 +39      ;S REQUEST("PATIENT PREFERRED END DATE",1)=""              OPT

 +40      ;S REQUEST("PATIENT PREFERRED START DATE",2)=""            OPT

 +41      ;S REQUEST("PATIENT PREFERRED END DATE",2)=""              OPT

 +42      ;S REQUEST("PATIENT PREFERRED START DATE",3)=""            OPT

 +43      ;S REQUEST("PATIENT PREFERRED END DATE",3)=""              OPT

 +44      ;S REQUEST("MRTC","PARENT REQUEST")=""                     OPT

 +45      ;

EDITREQUEST(JSONRETURN,SDCONTEXT,REQUEST) ;

 +1        NEW REQIEN,ERRORS,RETURN,INSTITUTIONIEN,EDITUSER,FILEDATA

 +2       ;

 +3        DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 +4        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT

 +5        SET EDITUSER=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)

 +6       ;

 +7        MERGE FILEDATA=REQUEST

 +8        DO VALIDATE(.REQUEST,.FILEDATA,.INSTITUTIONIEN,.ERRORS)

 +9        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT

 +10      ;

 +11       SET RETURN("Request","IEN")=$$BUILDER(.FILEDATA,.INSTITUTIONIEN,$GET(SDCONTEXT("ACHERON AUDIT ID")),EDITUSER)

 +12      ;

 +13       DO BUILDJSON^SDES2JSON(.JSONRETURN,.RETURN)

 +14       QUIT

 +15      ;

VALIDATE(REQUEST,FILEDATA,INSTITUTIONIEN,ERRORS) ;

 +1        NEW VALRETURN,VALREQUESTIEN,CLINICIEN,CURPID,CHILDIEN

 +2       ;

 +3       ; Validate required fields

 +4       ; request ien

 +5        SET VALREQUESTIEN=""

 +6        DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$GET(REQUEST("REQUEST IEN")),1,,3,4)

 +7        IF VALRETURN

               SET VALREQUESTIEN=$GET(REQUEST("REQUEST IEN"))

 +8       ; DFN

 +9        DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,2,$GET(REQUEST("DFN")),1,,1,2,229,"DFN")

 +10       IF VALRETURN

               IF VALREQUESTIEN

                   IF $$GET1^DIQ(409.85,$GET(REQUEST("REQUEST IEN")),.01,"I")'=$GET(REQUEST("DFN"))

                       DO ERRLOG^SDES2JSON(.ERRORS,534)

 +11      ;

 +12      ; if this is a parent request - no editing

 +13       IF VALREQUESTIEN

               Begin DoDot:1

 +14               IF $$GET1^DIQ(409.85,VALREQUESTIEN,41,"I")

                       IF '$$GET1^DIQ(409.85,VALREQUESTIEN,43.8,"I")

                           DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot edit a parent MRTC request.")

               End DoDot:1

 +15      ;

 +16       IF $DATA(REQUEST("APPOINTMENT TYPE"))

               Begin DoDot:1

 +17               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,8.7,$GET(REQUEST("APPOINTMENT TYPE")),0,,,180)

 +18               SET FILEDATA("APPOINTMENT TYPE")=$GET(VALRETURN(409.85,8.7,"I"))

               End DoDot:1

 +19      ;

 +20      ; validate clinic

 +21       IF $DATA(REQUEST("CLINIC IEN"))

               DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,44,$GET(REQUEST("CLINIC IEN")),1,,,19)

 +22       IF $DATA(REQUEST("CLINIC IEN"))!($DATA(REQUEST("PRIMARY AMIS")))

               Begin DoDot:1

 +23               IF $DATA(REQUEST("CLINIC IEN"))

                       IF $GET(REQUEST("CLINIC IEN"))=""

                           IF $DATA(REQUEST("PRIMARY AMIS"))

                               IF $GET(REQUEST("PRIMARY AMIS"))=""

                                   DO ERRLOG^SDES2JSON(.ERRORS,530)

 +24      ; CLINIC IEN or PRIMARY AMIS is allowed, NOT both

 +25               IF $GET(REQUEST("CLINIC IEN"))'=""

                       IF ($GET(REQUEST("PRIMARY AMIS"))'=""!($GET(REQUEST("CREDIT AMIS"))'=""))

                           DO ERRLOG^SDES2JSON(.ERRORS,202)

 +26      ; cannot have credit amis with no primary amis

 +27               IF $GET(REQUEST("CREDIT AMIS"))'=""

                       IF $DATA(REQUEST("PRIMARY AMIS"))

                           IF $GET(REQUEST("PRIMARY AMIS"))=""

                               DO ERRLOG^SDES2JSON(.ERRORS,234)

 +28               IF $GET(REQUEST("PRIMARY AMIS"))'=""

                       DO VALPRIMAMIS^SDES2CRTAPREQ(.ERRORS,.REQUEST,.FILEDATA)

 +29               IF $GET(REQUEST("CREDIT AMIS"))'=""

                       DO VALCREDITAMIS^SDES2CRTAPREQ(.ERRORS,.REQUEST,.FILEDATA)

 +30               IF $GET(REQUEST("PRIMARY AMIS"))'=""

                       IF $GET(REQUEST("CREDIT AMIS"))'=""

                           DO CONDAMISCHECK^SDES2VAL44(.ERRORS,$GET(REQUEST("PRIMARY AMIS")),$GET(REQUEST("CREDIT AMIS")))

               End DoDot:1

 +31      ;

 +32       IF $DATA(REQUEST("PATIENT INDICATED DATE"))

               Begin DoDot:1

 +33               SET FILEDATA("PATIENT INDICATED DATE")=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,$GET(REQUEST("PATIENT INDICATED DATE")),$GET(REQUEST("CLINIC IEN")),1,159,160,229,,,"PATIENT INDICATED DATE")

 +34               IF VALREQUESTIEN

                       IF $$DUPPIDCHK^SDES2CANCELAPPT(VALREQUESTIEN,$GET(FILEDATA("PATIENT INDICATED DATE")))

                           DO ERRLOG^SDES2JSON(.ERRORS,545)

               End DoDot:1

 +35      ;

 +36       IF $DATA(REQUEST("PRIORITY"))

               Begin DoDot:1

 +37               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10,$GET(REQUEST("PRIORITY")),1,,457,211,229,,,"PRIORITY")

 +38               IF VALRETURN

                       SET FILEDATA("PRIORITY")=$GET(VALRETURN(409.85,10,"I"))

               End DoDot:1

 +39      ;

 +40       IF $DATA(REQUEST("REQUESTED BY"))

               Begin DoDot:1

 +41               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,11,$GET(REQUEST("REQUESTED BY")),1,,62,198)

 +42               IF VALRETURN

                       Begin DoDot:2

 +43                       SET FILEDATA("REQUESTED BY")=$GET(VALRETURN(409.85,11,"I"))

 +44                       IF $GET(FILEDATA("REQUESTED BY"))=1

                               Begin DoDot:3

 +45                               DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,200,$GET(REQUEST("PROVIDER IEN")),1,,53,54,229,,,"PROVIDER IEN")

                               End DoDot:3

                               QUIT

                       End DoDot:2

               End DoDot:1

 +46      ;

 +47       IF $DATA(REQUEST("STATION NUMBER"))!($DATA(REQUEST("INSTITUTION NAME")))

               Begin DoDot:1

 +48               SET INSTITUTIONIEN=$$STATIONTOINST(.ERRORS,$GET(REQUEST("STATION NUMBER")),$GET(REQUEST("INSTITUTION NAME")))

               End DoDot:1

 +49      ;

 +50      ; Validate optional fields

 +51       IF $DATA(REQUEST("VAOS GUID"))

               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,5)

 +52       IF $DATA(REQUEST("MODALITY"))

               Begin DoDot:1

 +53               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,6,$GET(REQUEST("MODALITY")),,,,224)

                   if 'VALRETURN

                       QUIT

 +54               SET FILEDATA("MODALITY")=$GET(VALRETURN(409.85,6,"I"))

               End DoDot:1

 +55      ;

 +56       IF $DATA(REQUEST("PRIORITY GROUP"))

               Begin DoDot:1

 +57               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,10.5,$GET(REQUEST("PRIORITY GROUP")),,,,199)

                   if 'VALRETURN

                       QUIT

 +58               SET FILEDATA("PRIORITY GROUP")=$GET(VALRETURN(409.85,10.5,"I"))

               End DoDot:1

 +59      ;

 +60       IF $DATA(REQUEST("SERVICE CONNECTED"))

               Begin DoDot:1

 +61               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,15,$GET(REQUEST("SERVICE CONNECTED")),,,,200)

 +62               SET FILEDATA("SERVICE CONNECTED")=$GET(VALRETURN(409.85,15,"I"))

               End DoDot:1

 +63      ;

 +64       IF $DATA(REQUEST("SERVICE CONNECTED PERCENTAGE"))

               Begin DoDot:1

 +65               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,14,$GET(REQUEST("SERVICE CONNECTED PERCENTAGE")),,,,201)

                   if 'VALRETURN

                       QUIT

 +66      ;I $G(FILEDATA("SERVICE CONNECTED"))=0,+$G(REQUEST("SERVICE CONNECTED PERCENTAGE")) D ERRLOG^SDES2JSON(.ERRORS,232)

               End DoDot:1

 +67      ;

 +68       IF $DATA(REQUEST("PATIENT STATUS"))

               Begin DoDot:1

 +69               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,.02,$GET(REQUEST("PATIENT STATUS")),,,,203)

                   if 'VALRETURN

                       QUIT

 +70               SET FILEDATA("PATIENT STATUS")=$GET(VALRETURN(409.85,.02,"I"))

               End DoDot:1

 +71      ;

 +72       IF $DATA(REQUEST("PATIENT PREFERRED START DATE"))!$DATA(REQUEST("PATIENT PREFERRED END DATE"))

               DO VALIDATEDATEPREF^SDES2CRTAPREQ(.ERRORS,.REQUEST)

 +73      ;

 +74       IF $DATA(REQUEST("REQUEST COMMENT"))

               Begin DoDot:1

 +75               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$GET(REQUEST("REQUEST COMMENT")),,,,443)

               End DoDot:1

 +76      ;

 +77       IF $DATA(REQUEST("TIME SENSITIVE"))

               Begin DoDot:1

 +78               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,47,$GET(REQUEST("TIME SENSITIVE")))

 +79               IF VALRETURN

                       SET FILEDATA("TIME SENSITIVE")=$GET(VALRETURN(409.85,47,"I"))

               End DoDot:1

 +80      ;

 +81       IF $GET(REQUEST("REQUEST COMMENT"))]""

               DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,25,$GET(REQUEST("REQUEST COMMENT")),,,,443)

 +82      ;

 +83      ; if this is a child request validate child/parent linkage and PID date uniqueness

 +84       IF VALREQUESTIEN

               IF $GET(REQUEST("MRTC","PARENT REQUEST"))'=""

                   Begin DoDot:1

 +85                   DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),1)

                       if 'VALRETURN

                           QUIT

 +86                   IF VALRETURN

                           Begin DoDot:2

 +87                           IF $$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),.01,"I")'=$GET(REQUEST("DFN"))

                                   DO ERRLOG^SDES2JSON(.ERRORS,533)

                           End DoDot:2

 +88      ; Make sure this child is linked to this parent record

 +89                   IF '$DATA(^SDEC(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),2,"B",VALREQUESTIEN))

                           DO ERRLOG^SDES2JSON(.ERRORS,546)

 +90                   SET CHILDIEN=0

 +91                   FOR

                           SET CHILDIEN=$ORDER(^SDEC(409.85,REQUEST("MRTC","PARENT REQUEST"),2,"B",CHILDIEN))

                           if 'CHILDIEN

                               QUIT

                           Begin DoDot:2

 +92                           if CHILDIEN=VALREQUESTIEN

                                   QUIT

 +93                           IF $GET(FILEDATA("PATIENT INDICATED DATE"))>0

                                   IF $$GET1^DIQ(409.85,CHILDIEN,22,"I")=$GET(FILEDATA("PATIENT INDICATED DATE"))

                                       Begin DoDot:3

 +94                                       DO ERRLOG^SDES2JSON(.ERRORS,545)

                                       End DoDot:3

                           End DoDot:2

                   End DoDot:1

 +95       QUIT

 +96      ;

BUILDER(REQUEST,INSTITUTIONIEN,EAS,EDITUSER) ;

 +1        NEW FDA,FDAERR,RETURNIEN,REQIEN,ORIGPID

 +2        SET REQIEN=$GET(REQUEST("REQUEST IEN"))_","

 +3        SET ORIGPID=$$GET1^DIQ(409.85,REQIEN,22,"I")

 +4        IF $DATA(REQUEST("PATIENT STATUS"))

               SET FDA(409.85,REQIEN,.02)=$GET(REQUEST("PATIENT STATUS"))

 +5        IF $DATA(INSTITUTIONIEN)

               SET FDA(409.85,REQIEN,2)=$GET(INSTITUTIONIEN)

 +6        IF $DATA(REQUEST("REQUEST SUB TYPE"))

               SET FDA(409.85,REQIEN,4)=$GET(REQUEST("REQUEST SUB TYPE"))

 +7        IF $DATA(REQUEST("VAOS GUID"))

               SET FDA(409.85,REQIEN,5)=$GET(REQUEST("VAOS GUID"))

 +8        IF $DATA(REQUEST("MODALITY"))

               SET FDA(409.85,REQIEN,6)=$GET(REQUEST("MODALITY"))

 +9        IF $DATA(REQUEST("CLINIC IEN"))!($DATA(REQUEST("PRIMARY AMIS")))

               Begin DoDot:1

 +10               SET FDA(409.85,REQIEN,8)=$GET(REQUEST("CLINIC IEN"))

 +11               SET FDA(409.85,REQIEN,8.5)=$GET(REQUEST("PRIMARY AMIS"))

 +12               SET FDA(409.85,REQIEN,8.6)=$GET(REQUEST("CREDIT AMIS"))

               End DoDot:1

 +13       IF $DATA(REQUEST("APPOINTMENT TYPE"))

               SET FDA(409.85,REQIEN,8.7)=$GET(REQUEST("APPOINTMENT TYPE"))

 +14       IF $DATA(REQUEST("PRIORITY"))

               SET FDA(409.85,REQIEN,10)=$GET(REQUEST("PRIORITY"))

 +15       IF $DATA(REQUEST("PRIORITY GROUP"))

               SET FDA(409.85,REQIEN,10.5)=$GET(REQUEST("PRIORITY GROUP"))

 +16       IF $DATA(REQUEST("REQUESTED BY"))

               SET FDA(409.85,REQIEN,11)=$GET(REQUEST("REQUESTED BY"))

 +17       IF $DATA(REQUEST("PROVIDER IEN"))

               SET FDA(409.85,REQIEN,12)=$GET(REQUEST("PROVIDER IEN"))

 +18       IF $DATA(REQUEST("SERVICE CONNECTED PERCENTAGE"))

               SET FDA(409.85,REQIEN,14)=$GET(REQUEST("SERVICE CONNECTED PERCENTAGE"))

 +19       IF $DATA(REQUEST("SERVICE CONNECTED"))

               SET FDA(409.85,REQIEN,15)=$GET(REQUEST("SERVICE CONNECTED"))

 +20      ; Removed the update to PID since it occurs in ADDPIDHISTORY as well and the Original PID is needed for ADDPIDHISTORY

 +21      ;I $D(REQUEST("PATIENT INDICATED DATE")) S FDA(409.85,REQIEN,22)=$G(REQUEST("PATIENT INDICATED DATE"))

 +22       IF $DATA(REQUEST("REQUEST COMMENT"))

               SET FDA(409.85,REQIEN,25)=$TRANSLATE($GET(REQUEST("REQUEST COMMENT")),"^"," ")

 +23       IF $DATA(REQUEST("TIME SENSITIVE"))

               SET FDA(409.85,REQIEN,47)=$GET(REQUEST("TIME SENSITIVE"))

 +24       SET FDA(409.85,REQIEN,100)=$GET(EAS)

 +25       DO FILE^DIE(,"FDA","FDAERR")

           KILL FDA

 +26      ;

 +27       DO ADDPIDHISTORY^SDES2CRTAPREQ($GET(REQUEST("REQUEST IEN")),$GET(REQUEST("PATIENT INDICATED DATE")),EDITUSER)

 +28      ;

 +29       IF $DATA(REQUEST("PATIENT COMMENT"))!($DATA(REQUEST("PATIENT PREFERRED START DATE")))

               DO BUILDCOMMENTS(.REQUEST,$GET(REQUEST("REQUEST IEN")))

 +30      ;

 +31      ; if PATIENT INDICATED DATE is passed in, and PARENT REQUEST is defined, update the MRTC CALC PREF DATES on the parent request

 +32       IF $DATA(REQUEST("PATIENT INDICATED DATE"))

               IF $GET(REQUEST("MRTC","PARENT REQUEST"))

                   Begin DoDot:1

 +33      ;D EDITMRTCPID(.REQUEST,$G(REQUEST("REQUEST IEN")))

 +34                   DO EDITPRNTPIDMULT(.REQUEST,$GET(REQUEST("MRTC","PARENT REQUEST")),ORIGPID)

                   End DoDot:1

 +35      ;

 +36      ;I $D(REQUEST("MRTC","CHILD REQUEST"))!($D(REQUEST("MRTC","MRTC APPOINTMENT"))) D EDITMRTCLINKS(.REQUEST,$G(REQUEST("REQUEST IEN")))

 +37      ;

 +38       DO AUDIT($GET(REQUEST("REQUEST IEN")),$GET(REQUEST("CLINIC IEN")),$GET(REQUEST("PRIMARY AMIS")),EDITUSER)

 +39      ;

 +40       QUIT $GET(REQUEST("REQUEST IEN"))

 +41      ;

BUILDAPPTDATA(REQIEN,APPTDATETIME,CLINICIEN,SERVCONNPERC,SERVCONN,APPTTYPE,EAS,USER) ;

 +1        NEW FDA,FDAERR

 +2        SET REQIEN=$GET(REQIEN)_","

 +3        SET FDA(409.85,REQIEN,8.7)=$GET(APPTTYPE)

 +4        SET FDA(409.85,REQIEN,13)=$GET(APPTDATETIME)

 +5        SET FDA(409.85,REQIEN,13.1)=$PIECE($$NOW^XLFDT,".",1)

 +6        SET FDA(409.85,REQIEN,13.2)=$GET(CLINICIEN)

 +7       ; appt institution ;

           SET FDA(409.85,REQIEN,13.3)=$$GET1^DIQ(44,$GET(CLINICIEN),3,"I")

 +8       ; appt stop code

           SET FDA(409.85,REQIEN,13.4)=$$GET1^DIQ(44,$GET(CLINICIEN),8,"I")

 +9       ; appt station number

           SET FDA(409.85,REQIEN,13.6)=$$GET1^DIQ(40.8,$$GET1^DIQ(44,$GET(CLINICIEN),3.5,"I"),1,"I")

 +10       SET FDA(409.85,REQIEN,13.7)=$GET(USER)

 +11      ; 'R' FOR Scheduled/Kept;

           SET FDA(409.85,REQIEN,13.8)="R"

 +12       SET FDA(409.85,REQIEN,14)=$GET(SERVCONNPERC)

 +13       SET FDA(409.85,REQIEN,15)=$GET(SERVCONN)

 +14       SET FDA(409.85,REQIEN,100)=$GET(EAS)

 +15       SET FDA(409.85,REQIEN,19)=$PIECE($$NOW^XLFDT,".",1)

 +16       SET FDA(409.85,REQIEN,20)=$GET(USER)

 +17       SET FDA(409.85,REQIEN,21)=$$FIND1^DIC(409.853,,"B","REMOVED/SCHEDULED-ASSIGNED")

 +18       SET FDA(409.85,REQIEN,23)="C"

 +19       DO FILE^DIE(,"FDA","FDAERR")

           KILL FDA

 +20      ;

 +21       NEW PARENTIEN

 +22       SET PARENTIEN=$$GET1^DIQ(409.85,REQIEN_",",43.8,"I")

 +23       IF PARENTIEN

               Begin DoDot:1

 +24               NEW CHILDIEN,FOUND

 +25               SET CHILDIEN=""

                   SET FOUND=0

 +26               FOR

                       SET CHILDIEN=$ORDER(^SDEC(409.85,PARENTIEN,2,"B",CHILDIEN))

                       if (CHILDIEN="")!(FOUND)

                           QUIT

                       Begin DoDot:2

 +27                       SET FOUND=($$GET1^DIQ(409.85,CHILDIEN_",",23,"E")="OPEN")

                       End DoDot:2

 +28               IF 'FOUND

                       Begin DoDot:2

 +29                       SET FDA(409.85,PARENTIEN_",",23)="C"

 +30                       DO FILE^DIE(,"FDA","ERROR")

                           KILL FDA

                       End DoDot:2

               End DoDot:1

 +31       QUIT

 +32      ;

EDITMRTCLINKS(REQUEST,REQIEN) ;

 +1        NEW NUM,FDA,FDAERR,SUBIEN

 +2        SET SUBIEN=0

           SET NUM=0

 +3        FOR

               SET SUBIEN=$ORDER(^SDEC(409.85,REQIEN,2,SUBIEN))

               if 'SUBIEN

                   QUIT

               Begin DoDot:1

 +4                SET NUM=NUM+1

 +5                SET FDA(409.852,SUBIEN_","_REQIEN_",",.01)=$GET(REQUEST("MRTC","CHILD REQUEST",NUM))

 +6                SET FDA(409.852,SUBIEN_","_REQIEN_",",.02)=$GET(REQUEST("MRTC","MRTC APPOINTMENT",NUM))

 +7                DO FILE^DIE(,"FDA","FDAERR")

                   KILL FDA

               End DoDot:1

 +8        QUIT

 +9       ;

EDITMRTCPID(REQUEST,REQIEN) ;

 +1        NEW NUM,FDA,FDAERR,SUBIEN

 +2        SET SUBIEN=0

           SET NUM=0

 +3        FOR

               SET SUBIEN=$ORDER(^SDEC(409.85,REQIEN,5,SUBIEN))

               if 'SUBIEN

                   QUIT

               Begin DoDot:1

 +4                SET NUM=NUM+1

 +5                SET FDA(409.851,SUBIEN_","_REQIEN_",",.01)=$GET(REQUEST("MRTC","PATIENT INDICATED DATE",NUM))

 +6                DO FILE^DIE(,"FDA","FDAERR")

                   KILL FDA

               End DoDot:1

 +7        QUIT

 +8       ; Update the parent MRTC CAL PREF DATE for the child being edited.

EDITPRNTPIDMULT(REQUEST,PARENTIEN,ORIGPID) ;

 +1        NEW NUM,FDA,FDAERR,SUBIEN,OLDPIDIEN

 +2        SET SUBIEN=0

           SET NUM=0

 +3        SET OLDPIDIEN=$ORDER(^SDEC(409.85,PARENTIEN,5,"B",ORIGPID,0))

           if 'OLDPIDIEN

               QUIT

 +4        SET FDA(409.851,OLDPIDIEN_","_PARENTIEN_",",.01)=$GET(REQUEST("PATIENT INDICATED DATE"))

 +5        DO FILE^DIE(,"FDA","FDAERR")

           KILL FDA

 +6        QUIT

 +7       ;

BUILDMRTCLINKS(REQUEST,REQIEN) ; called from SDESCREATEAPPT after appt is made from mrtc child

 +1        NEW FDA,FDAERR,SUBIEN

 +2        SET SUBIEN=$ORDER(^SDEC(409.85,REQIEN,2,"B",REQUEST("MRTC","CHILD REQUEST"),0))

 +3        SET FDA(409.852,SUBIEN_","_REQIEN_",",.02)=$GET(REQUEST("MRTC","MRTC APPOINTMENT"))

 +4        DO UPDATE^DIE(,"FDA",,"FDAERR")

           KILL FDA

 +5        QUIT

 +6       ;

BUILDMRTCPID(REQUEST,REQIEN) ; called from SDESCREATEAPPT after appt is made from mrtc child

 +1        NEW FDA,FDAERR,SDPID

 +2        SET SDPID=$GET(REQUEST("MRTC","PATIENT INDICATED DATE"))

 +3        if SDPID=""

               SET SDPID=$$GET1^DIQ(409.85,REQIEN,22,"I")

 +4        if $ORDER(^SDEC(409.85,REQIEN,5,"B",SDPID,0))

               QUIT

 +5        SET FDA(409.851,"+1,"_REQIEN_",",.01)=SDPID

 +6        DO UPDATE^DIE(,"FDA",,"FDAERR")

           KILL FDA

 +7        QUIT

 +8       ;

BUILDCOMMENTS(REQUEST,REQIEN) ;

 +1        NEW REQCOMMS,NUM,NUM2,DONE,PREFDATES,PATCOMMS,RANGE,DATERANGE1,DATERANGE2,DATERANGE3,EDITPATCOM

 +2        SET NUM=0

 +3        IF $DATA(REQUEST("PATIENT COMMENT"))

               Begin DoDot:1

 +4                NEW PC

                   SET PC="PATIENT COMMENT"

 +5                IF $GET(REQUEST(PC))'["Patient preferred date range"

                       SET EDITPATCOM(1)=$GET(REQUEST(PC))

                       DO WP^DIE(409.85,REQIEN_",",60,"","EDITPATCOM")

                       QUIT

 +6                SET EDITPATCOM(1)=$PIECE($GET(REQUEST(PC)),"Patient preferred date range",1)

 +7                SET DATERANGE1=$PIECE($GET(REQUEST(PC)),"Patient preferred date range",2)

                   IF $LENGTH($GET(DATERANGE1))

                       SET EDITPATCOM(2)="Patient preferred date range"_$PIECE($GET(REQUEST(PC)),"Patient preferred date range",2)

 +8                SET DATERANGE2=$PIECE($GET(REQUEST(PC)),"Patient preferred date range",3)

                   IF $LENGTH($GET(DATERANGE2))

                       SET EDITPATCOM(3)="Patient preferred date range"_$PIECE($GET(REQUEST(PC)),"Patient preferred date range",3)

 +9                SET DATERANGE3=$PIECE($GET(REQUEST(PC)),"Patient preferred date range",4)

                   IF $LENGTH($GET(DATERANGE3))

                       SET EDITPATCOM(4)="Patient preferred date range"_$PIECE($GET(REQUEST(PC)),"Patient preferred date range",4)

 +10               DO WP^DIE(409.85,REQIEN_",",60,"","EDITPATCOM")

               End DoDot:1

 +11       QUIT

 +12      ;

AUDIT(REQIEN,CLINICIEN,STOPCODE,USER) ;

 +1        NEW FDA,FDAERR

 +2        SET FDA(409.8545,"+1,"_REQIEN_",",.01)=$$NOW^XLFDT

 +3        SET FDA(409.8545,"+1,"_REQIEN_",",1)=$GET(USER)

 +4        SET FDA(409.8545,"+1,"_REQIEN_",",2)=$GET(CLINICIEN)

 +5        SET FDA(409.8545,"+1,"_REQIEN_",",3)=$GET(STOPCODE)

 +6        DO UPDATE^DIE("","FDA",,"FDAERR")

           KILL FDA

 +7        QUIT

 +8       ;

STATIONTOINST(ERRORS,STATIONNUM,INSTNAME) ; station number has precedence over institution name

 +1        NEW INSTITUTIONIEN

 +2        IF STATIONNUM=""

               IF INSTNAME=""

                   DO ERRLOG^SDES2JSON(.ERRORS,204)

                   QUIT 0

 +3        IF STATIONNUM=""

               IF INSTNAME'=""

                   Begin DoDot:1

 +4                    SET INSTITUTIONIEN=$$FIND1^DIC(4,"","X",INSTNAME,"B")

                       IF 'INSTITUTIONIEN

                           DO ERRLOG^SDES2JSON(.ERRORS,205)

                   End DoDot:1

 +5        IF STATIONNUM'=""

               SET INSTITUTIONIEN=$$FIND1^DIC(4,"","X",STATIONNUM,"D")

               IF 'INSTITUTIONIEN

                   DO ERRLOG^SDES2JSON(.ERRORS,197)

                   QUIT 0

 +6        QUIT INSTITUTIONIEN

 +7       ;

SDES2EDITAPREQ.m