SDES2EDITAPREQ ;ALB/BWF,JAS,JAS,TJB/JAS,BWF,JAS - EDIT APPOINTMENT REQUEST ; OCT 7, 2024
;;5.3;Scheduling;**869,871,873,875,890,893**;Aug 13, 1993;Build 6
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; 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
;S REQUEST("DUPLICATE REASON")="" OPT - The reason a duplicate appointment request is being made
;
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)
Q
;
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)
;
I $G(REQUEST("DUPLICATE REASON"))]"" D VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,51,$G(REQUEST("DUPLICATE REASON")),,,,593)
;
; 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)
Q
;
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"))
I $D(REQUEST("DUPLICATE REASON")) S FDA(409.85,REQIEN,51)=$G(REQUEST("DUPLICATE REASON"))
S FDA(409.85,REQIEN,100)=$G(EAS)
D FILE^DIE(,"FDA","FDAERR") K FDA
;
; 409.85 COMMENTS AUDIT multiple
I $G(REQUEST("REQUEST COMMENT"))'="" D
. S FDA(409.8527,"+1,"_REQIEN,.01)=$$NOW^XLFDT
. S FDA(409.8527,"+1,"_REQIEN,1)=EDITUSER
. S FDA(409.8527,"+1,"_REQIEN,2)=$TR($G(REQUEST("REQUEST COMMENT")),"^"," ")
. D UPDATE^DIE("","FDA") 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
Q
;
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
Q
;
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
Q
; 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
Q
;
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
Q
;
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
Q
;
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")
Q
;
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
Q
;
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 17876 printed Dec 13, 2024@02:53:45 Page 2
SDES2EDITAPREQ ;ALB/BWF,JAS,JAS,TJB/JAS,BWF,JAS - EDIT APPOINTMENT REQUEST ; OCT 7, 2024
+1 ;;5.3;Scheduling;**869,871,873,875,890,893**;Aug 13, 1993;Build 6
+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 ;S REQUEST("DUPLICATE REASON")="" OPT - The reason a duplicate appointment request is being made
+46 ;
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 $GET(REQUEST("DUPLICATE REASON"))]""
DO VALFIELD^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,51,$GET(REQUEST("DUPLICATE REASON")),,,,593)
+84 ;
+85 ; if this is a child request validate child/parent linkage and PID date uniqueness
+86 IF VALREQUESTIEN
IF $GET(REQUEST("MRTC","PARENT REQUEST"))'=""
Begin DoDot:1
+87 DO VALFILEIEN^SDES2VALUTIL(.VALRETURN,.ERRORS,409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),1)
if 'VALRETURN
QUIT
+88 IF VALRETURN
Begin DoDot:2
+89 IF $$GET1^DIQ(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),.01,"I")'=$GET(REQUEST("DFN"))
DO ERRLOG^SDES2JSON(.ERRORS,533)
End DoDot:2
+90 ; Make sure this child is linked to this parent record
+91 IF '$DATA(^SDEC(409.85,$GET(REQUEST("MRTC","PARENT REQUEST")),2,"B",VALREQUESTIEN))
DO ERRLOG^SDES2JSON(.ERRORS,546)
+92 SET CHILDIEN=0
+93 FOR
SET CHILDIEN=$ORDER(^SDEC(409.85,REQUEST("MRTC","PARENT REQUEST"),2,"B",CHILDIEN))
if 'CHILDIEN
QUIT
Begin DoDot:2
+94 if CHILDIEN=VALREQUESTIEN
QUIT
+95 IF $GET(FILEDATA("PATIENT INDICATED DATE"))>0
IF $$GET1^DIQ(409.85,CHILDIEN,22,"I")=$GET(FILEDATA("PATIENT INDICATED DATE"))
Begin DoDot:3
+96 DO ERRLOG^SDES2JSON(.ERRORS,545)
End DoDot:3
End DoDot:2
End DoDot:1
+97 QUIT
+98 ;
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 IF $DATA(REQUEST("DUPLICATE REASON"))
SET FDA(409.85,REQIEN,51)=$GET(REQUEST("DUPLICATE REASON"))
+25 SET FDA(409.85,REQIEN,100)=$GET(EAS)
+26 DO FILE^DIE(,"FDA","FDAERR")
KILL FDA
+27 ;
+28 ; 409.85 COMMENTS AUDIT multiple
+29 IF $GET(REQUEST("REQUEST COMMENT"))'=""
Begin DoDot:1
+30 SET FDA(409.8527,"+1,"_REQIEN,.01)=$$NOW^XLFDT
+31 SET FDA(409.8527,"+1,"_REQIEN,1)=EDITUSER
+32 SET FDA(409.8527,"+1,"_REQIEN,2)=$TRANSLATE($GET(REQUEST("REQUEST COMMENT")),"^"," ")
+33 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:1
+34 ;
+35 DO ADDPIDHISTORY^SDES2CRTAPREQ($GET(REQUEST("REQUEST IEN")),$GET(REQUEST("PATIENT INDICATED DATE")),EDITUSER)
+36 ;
+37 IF $DATA(REQUEST("PATIENT COMMENT"))!($DATA(REQUEST("PATIENT PREFERRED START DATE")))
DO BUILDCOMMENTS(.REQUEST,$GET(REQUEST("REQUEST IEN")))
+38 ;
+39 ; if PATIENT INDICATED DATE is passed in, and PARENT REQUEST is defined, update the MRTC CALC PREF DATES on the parent request
+40 IF $DATA(REQUEST("PATIENT INDICATED DATE"))
IF $GET(REQUEST("MRTC","PARENT REQUEST"))
Begin DoDot:1
+41 ;D EDITMRTCPID(.REQUEST,$G(REQUEST("REQUEST IEN")))
+42 DO EDITPRNTPIDMULT(.REQUEST,$GET(REQUEST("MRTC","PARENT REQUEST")),ORIGPID)
End DoDot:1
+43 ;
+44 ;I $D(REQUEST("MRTC","CHILD REQUEST"))!($D(REQUEST("MRTC","MRTC APPOINTMENT"))) D EDITMRTCLINKS(.REQUEST,$G(REQUEST("REQUEST IEN")))
+45 ;
+46 DO AUDIT($GET(REQUEST("REQUEST IEN")),$GET(REQUEST("CLINIC IEN")),$GET(REQUEST("PRIMARY AMIS")),EDITUSER)
+47 ;
+48 QUIT $GET(REQUEST("REQUEST IEN"))
+49 ;
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 ;
+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 ;