- SDESEDITAPPTREQ ;ALB/BLB,MGD,TJB,BWF,TJB,BLB,LAB,JAS,JAS,JAS,ANU,LAB - SCHEDULING EDIT APPT REQUEST; MAY 10,2024@08:27PM
- ;;5.3;Scheduling;**823,826,837,845,846,847,864,871,873,875,877**;Aug 13, 1993;Build 14
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- ; SDES EDIT APPT REQ
- ;
- Q
- ;
- EDITREQUEST(JSONRETURN,REQUEST) ;
- N REQIEN,ERRORS,RETURN,ISAPPREQIENVALID,ISDFNVALID,ISDATETIMEVALID,ISEASVALID,INSTITUTIONIEN
- N ISCLINSTOPVALID,ISMODALINVALID,ISREQUESTBYVALID,ISPROVIDERVALID,ISPIDVALID,ISPRIGROUPVALID
- N ISREQTYPEVALID,ISPRIORITYVALID,ISSERVCONNVALID,ISAPPTTYPEVALID,ISPATSTATVALID
- N ISDATEPREFVALID,ISMTRCDATAVALID,ISCPRSDATAVALID
- ;
- D VALIDATE(.REQUEST,.ERRORS)
- I $D(ERRORS) M RETURN=ERRORS D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN) Q
- ;
- S RETURN("Request","IEN")=$$BUILDER(.REQUEST)
- ;
- D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
- Q
- ;
- VALIDATE(REQUEST,ERRORS) ;
- ;
- S ISAPPREQIENVALID=$$VALIDATEAPPTREQ^SDESEDITAPREQVAL(.ERRORS,$G(REQUEST("REQUEST IEN")))
- ;
- S ISDFNVALID=$$VALIDATEDFN^SDESEDITAPREQVAL(.ERRORS,$G(REQUEST("DFN")))
- ;
- S ISDATETIMEVALID=$$VALIDATEDATETIME^SDESEDITAPREQVAL(.ERRORS,.REQUEST)
- ;
- S ISREQTYPEVALID=$$VALIDATEREQTYPE^SDESEDITAPREQVAL(.ERRORS,$G(REQUEST("REQUEST SUB TYPE")))
- ;
- S INSTITUTIONIEN=$$STATIONTOINST^SDESEDITAPREQVAL(.ERRORS,$G(REQUEST("STATION NUMBER")),$G(REQUEST("INSTITUTION NAME")))
- ;
- S ISCLINSTOPVALID=$$VALIDATECLINSTOP^SDESEDITAPREQVAL(.ERRORS,.REQUEST,$G(REQUEST("CLINIC IEN")),$G(REQUEST("STOP CODE")),$G(REQUEST("SECONDARY STOP CODE")))
- ;
- S ISREQUESTBYVALID=$$VALIDATEREQBY^SDESEDITAPREQVAL(.ERRORS,$G(REQUEST("REQUESTED BY")))
- I ISREQUESTBYVALID S REQUEST("REQUESTED BY")=$$SOCEXT2INT^SDESUTIL(409.85,11,$G(REQUEST("REQUESTED BY")))
- ;
- I $G(REQUEST("REQUESTED BY"))="PROVIDER" S ISPROVIDERVALID=$$VALIDATEPROVIDER(.ERRORS,$G(REQUEST("PROVIDER IEN")))
- ;
- S ISPIDVALID=$$VALIDATEPID(.ERRORS,.REQUEST)
- ;
- S ISEASVALID=$$VALIDATEEAS(.ERRORS,$G(REQUEST("EAS")))
- ;
- I $L($G(REQUEST("MODALITY"))) S ISMODALINVALID=$$VALIDATEMODALITY^SDESINPUTVALUTL(.ERRORS,$G(REQUEST("MODALITY")))
- ;
- S ISPRIORITYVALID=$$VALIDATEPRIORITY(.ERRORS,$G(REQUEST("PRIORITY")))
- I ISPRIORITYVALID S REQUEST("PRIORITY")=$$SOCEXT2INT^SDESUTIL(409.85,10,$G(REQUEST("PRIORITY")))
- ;
- I $L($G(REQUEST("PRIORITY GROUP"))) S ISPRIGROUPVALID=$$VALIDATEPRIGROUP(.ERRORS,$G(REQUEST("PRIORITY GROUP")))
- ;
- S ISSERVCONNVALID=$$VALIDATESERVCONN^SDESCREATEAPPREQ(.ERRORS,$G(REQUEST("SERVICE CONNECTED")),$G(REQUEST("SERVICE CONNECTED PERCENTAGE")))
- ;
- ; Evaluate Appt Type IEN and Appt Type Name together
- N SDIEN,SDNAME
- S SDIEN=$G(REQUEST("APPOINTMENT TYPE IEN")),SDNAME=$G(REQUEST("APPOINTMENT TYPE NAME"))
- S ISAPPTTYPEVALID=$$VALIDATEAPPTTYPE^SDESCREATEAPPREQ(.ERRORS,.SDIEN,SDNAME)
- S REQUEST("APPOINTMENT TYPE IEN")=SDIEN
- ;
- I $L($G(REQUEST("PATIENT STATUS"))) S ISPATSTATVALID=$$VALIDATEPATSTAT(.ERRORS,$G(REQUEST("PATIENT STATUS")))
- ;
- I $D(REQUEST("PATIENT PREFERRED START DATE")),$D(REQUEST("PATIENT PREFERRED END DATE")) D VALIDATEDATEPREF^SDESEDITAPPTREQ2(.ERRORS,.REQUEST)
- ;
- I $D(REQUEST("MRTC")) D VALIDATEMRTCDATA(.ERRORS,.REQUEST,$G(REQUEST("MRTC","PARENT REQUEST")),$G(REQUEST("MRTC","NEEDED")),$G(REQUEST("MRTC","DAYS BETWEEN APPTS")),$G(REQUEST("MRTC","HOW MANY NEEDED")))
- I $G(REQUEST("REQUEST COMMENT"))]"" D VALREQCOM(.ERRORS,.REQUEST)
- Q
- ;
- BUILDER(REQUEST) ;
- N FDA,FDAERR,RETURNIEN
- S REQIEN=$G(REQUEST("REQUEST IEN"))_","
- S FDA(409.85,REQIEN,.01)=$G(REQUEST("DFN"))
- S FDA(409.85,REQIEN,.02)=$G(REQUEST("PATIENT STATUS"))
- S FDA(409.85,REQIEN,1)=$G(REQUEST("CREATE DATE"))
- S FDA(409.85,REQIEN,2)=$G(INSTITUTIONIEN)
- S FDA(409.85,REQIEN,4)=$G(REQUEST("REQUEST SUB TYPE"))
- S FDA(409.85,REQIEN,5)=$G(REQUEST("VAOS GUID"))
- S FDA(409.85,REQIEN,6)=$G(REQUEST("MODALITY"))
- S FDA(409.85,REQIEN,8)=$G(REQUEST("CLINIC IEN"))
- S FDA(409.85,REQIEN,8.5)=$G(REQUEST("STOP CODE"))
- S FDA(409.85,REQIEN,8.6)=$G(REQUEST("SECONDARY STOP CODE"))
- S FDA(409.85,REQIEN,8.7)=$G(REQUEST("APPOINTMENT TYPE IEN"))
- S FDA(409.85,REQIEN,9)=$G(DUZ)
- S FDA(409.85,REQIEN,9.5)=$$NOW^XLFDT
- S FDA(409.85,REQIEN,10)=$G(REQUEST("PRIORITY"))
- S FDA(409.85,REQIEN,10.5)=$G(REQUEST("PRIORITY GROUP"))
- S FDA(409.85,REQIEN,11)=$G(REQUEST("REQUESTED BY"))
- S FDA(409.85,REQIEN,12)=$G(REQUEST("PROVIDER IEN"))
- S FDA(409.85,REQIEN,14)=$G(REQUEST("SERVICE CONNECTED PERCENTAGE"))
- 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
- ;S FDA(409.85,REQIEN,22)=$G(REQUEST("PATIENT INDICATED DATE"))
- S FDA(409.85,REQIEN,25)=$TR($G(REQUEST("REQUEST COMMENT")),"^"," ")
- S FDA(409.85,REQIEN,41)=$G(REQUEST("MRTC","NEEDED"))
- S FDA(409.85,REQIEN,42)=$G(REQUEST("MRTC","DAYS BETWEEN APPTS"))
- S FDA(409.85,REQIEN,43)=$G(REQUEST("MRTC","HOW MANY NEEDED"))
- I $G(REQUEST("MRTC","PARENT REQUEST"))'="" S FDA(409.85,REQIEN,43.8)=$G(REQUEST("MRTC","PARENT REQUEST"))
- S FDA(409.85,REQIEN,46)=$G(REQUEST("CPRS ORDER NUMBER"))
- S FDA(409.85,REQIEN,47)=$G(REQUEST("CPRS TIME SENSITIVE"))
- S FDA(409.85,REQIEN,100)=$G(REQUEST("EAS"))
- D FILE^DIE(,"FDA","FDAERR") K FDA
- ;
- D ADDPIDHISTORY^SDESCREATEAPPREQ($G(REQUEST("REQUEST IEN")),$G(REQUEST("PATIENT INDICATED DATE")))
- ;
- I $D(REQUEST("CPRS PREREQUISITES")) D EDITCPRSPREREQS(.REQUEST,$G(REQUEST("REQUEST IEN")))
- ;
- I $D(REQUEST("PATIENT COMMENT"))!($D(REQUEST("PATIENT PREFERRED START DATE"))) D BUILDCOMMENTS(.REQUEST,$G(REQUEST("REQUEST IEN")))
- ;
- I $D(REQUEST("MRTC","PATIENT INDICATED DATE")) D EDITMRTCPID(.REQUEST,$G(REQUEST("REQUEST IEN")))
- ;
- 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("STOP CODE")))
- ;
- Q $G(REQUEST("REQUEST IEN"))
- ;
- ;877
- BUILDAPPTDATA(REQIEN,APPTDATETIME,CLINICIEN,SERVCONNPERC,SERVCONN,APPTTYPE,EAS,SDUSER,APPTMSG) ;
- N FDA,FDAERR,ERROR
- 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:$G(SDUSER)="" SDUSER=DUZ
- S FDA(409.85,REQIEN,13.7)=SDUSER
- 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)
- ;877
- S FDA(409.85,REQIEN,20)=SDUSER
- ;
- 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
- I $$GET1^DIQ(409.85,REQIEN,4,"I")="RTC" D UPDATEORDER(.APPTMSG,$P(REQIEN,",",1),SDUSER)
- ;
- 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_",",20)=SDUSER
- . . S FDA(409.85,PARENTIEN_",",21)=$$FIND1^DIC(409.853,,"B","MRTC PARENT CLOSED")
- . . S FDA(409.85,PARENTIEN_",",23)="C"
- . . S FDA(409.85,PARENTIEN_",",19)=$P($$NOW^XLFDT,".",1)
- . . D FILE^DIE(,"FDA","ERROR") K FDA
- . . I $$GET1^DIQ(409.85,PARENTIEN,4,"I")="RTC" D UPDATEORDER(.APPTMSG,PARENTIEN,SDUSER)
- Q
- ;
- UPDATEORDER(APPTMSG,REQUESTIEN,SDUSER) ;Send HL7 to CPRS if RTC request
- D ARDISP^SDECHL7(REQUESTIEN,"",SDUSER)
- I $D(^TMP($J,"REJECT",REQUESTIEN)) D
- . S APPTMSG="Appointment created; however, ORDER status not updated. Please submit ticket."
- 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
- ;
- 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
- ;
- EDITCPRSPREREQS(REQUEST,REQIEN) ;
- N NUM,FDA,FDAERR,SUBIEN
- I '$D(^SDEC(409.85,REQIEN,8)) D BUILDCPRSPREREQS^SDESCREATEAPPREQ(.REQUEST,REQIEN) Q
- S SUBIEN=0,NUM=0
- F S SUBIEN=$O(^SDEC(409.85,REQIEN,8,SUBIEN)) Q:'SUBIEN D
- .S NUM=NUM+1
- .S FDA(409.8548,SUBIEN_","_REQIEN_",",.01)=$G(REQUEST("CPRS PREREQUISITES",NUM))
- .D FILE^DIE(,"FDA","FDAERR") K FDA
- Q
- ;
- AUDIT(REQIEN,CLINICIEN,STOPCODE) ;
- N FDA,FDAERR
- S FDA(409.8545,"+1,"_REQIEN_",",.01)=$$NOW^XLFDT
- S FDA(409.8545,"+1,"_REQIEN_",",1)=$G(DUZ)
- 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
- ;
- VALIDATEPROVIDER(ERRORS,PROVIDERIEN) ;
- I PROVIDERIEN="@" D ERRLOG^SDESJSON(.ERRORS,229) Q 0
- I PROVIDERIEN="" D ERRLOG^SDESJSON(.ERRORS,53) Q 0
- I PROVIDERIEN'="",'$D(^VA(200,PROVIDERIEN,0)) D ERRLOG^SDESJSON(.ERRORS,54) Q 0
- Q 1
- ;
- VALIDATEPID(ERRORS,REQUEST) ;
- N REQUESTIEN,OLDPID
- S REQUESTIEN=$G(REQUEST("REQUEST IEN"))
- S OLDPID=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
- I $G(REQUEST("PATIENT INDICATED DATE"))="@" D ERRLOG^SDESJSON(.ERRORS,229) Q 0
- I $G(REQUEST("PATIENT INDICATED DATE"))="" D ERRLOG^SDESJSON(.ERRORS,159) Q 0
- I $G(REQUEST("PATIENT INDICATED DATE"))'="" S REQUEST("PATIENT INDICATED DATE")=$$ISOTFM^SDAMUTDT($G(REQUEST("PATIENT INDICATED DATE")))
- I $G(REQUEST("PATIENT INDICATED DATE"))=-1 D ERRLOG^SDESJSON(.ERRORS,160) Q 0
- I REQUESTIEN,$$DUPPIDCHK^SDES2CANCELAPPT(REQUESTIEN,$G(REQUEST("PATIENT INDICATED DATE"))) D ERRLOG^SDESJSON(.ERRORS,545) Q 0
- Q 1
- ;
- VALIDATEEAS(ERRORS,EAS) ;
- I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL($G(EAS))
- I $P($G(EAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q 0
- Q 1
- ;
- VALIDATEPRIORITY(ERRORS,PRIORITY) ;
- I PRIORITY="" D ERRLOG^SDESJSON(.ERRORS,457) Q 0
- I PRIORITY'="ASAP",PRIORITY'="FUTURE" D ERRLOG^SDESJSON(.ERRORS,211) Q 0
- Q 1
- ;
- VALIDATEPRIGROUP(ERRORS,GROUP) ;
- N NUM,FOUND,GCHECK
- S NUM=0,FOUND=0
- F NUM=1:1:8 D
- .S GCHECK="GROUP "_NUM
- .I GROUP=GCHECK S REQUEST("PRIORITY GROUP")=NUM S FOUND=1
- I FOUND=0 D ERRLOG^SDESJSON(.ERRORS,199) Q 0
- Q 1
- ;
- VALIDATEPATSTAT(ERRORS,PATIENTSTATUS) ;
- I PATIENTSTATUS'="NEW",PATIENTSTATUS'="ESTABLISHED" D ERRLOG^SDESJSON(.ERRORS,203) Q 0
- S REQUEST("PATIENT STATUS")=$S(PATIENTSTATUS="NEW":"N",PATIENTSTATUS="ESTABLISHED":"E",1:"")
- Q 1
- ;
- VALIDATEMRTCDATA(ERRORS,REQUEST,PARENTREQUEST,NEEDED,DAYSBETWEEN,HOWMANY) ;
- N NUM,DONE,CNT
- I NEEDED'="YES" D Q ""
- .I $G(PARENTREQUEST)!($G(DAYSBETWEEN))!($G(HOWMANY)) D ERRLOG^SDESJSON(.ERRORS,233)
- I NEEDED'="",NEEDED'="YES",NEEDED'="NO" D ERRLOG^SDESJSON(.ERRORS,208) Q
- ;
- I PARENTREQUEST'="",('$D(^SDEC(409.85,PARENTREQUEST)))!(PARENTREQUEST=0) D ERRLOG^SDESJSON(.ERRORS,207)
- ;
- I DAYSBETWEEN'="" D
- .I '+DAYSBETWEEN!(DAYSBETWEEN'<366) D ERRLOG^SDESJSON(.ERRORS,209)
- ;
- I HOWMANY'="" D
- .I '+HOWMANY!(HOWMANY'<101) D ERRLOG^SDESJSON(.ERRORS,210)
- ;
- I $D(REQUEST("MRTC","PATIENT INDICATED DATE")) D
- .S NUM=0,DONE=0
- .F S NUM=$O(REQUEST("MRTC","PATIENT INDICATED DATE",NUM)) Q:'NUM!(DONE=1) D
- ..S REQUEST("MRTC","PATIENT INDICATED DATE",NUM)=$$ISOTFM^SDAMUTDT($G(REQUEST("MRTC","PATIENT INDICATED DATE",NUM)))
- ..I $G(REQUEST("MRTC","PATIENT INDICATED DATE",NUM))=-1 D ERRLOG^SDESJSON(.ERRORS,215) S DONE=1 Q
- ;
- I $D(REQUEST("MRTC","CHILD REQUEST"))!($D(REQUEST("MRTC","MRTC APPOINTMENT"))) D
- .S CNT=0,DONE=0
- .F S CNT=$O(REQUEST("MRTC","CHILD REQUEST",CNT)) Q:'CNT!(DONE=1) D
- ..I '$D(^SDEC(409.85,$G(REQUEST("MRTC","CHILD REQUEST",CNT)),0)) D ERRLOG^SDESJSON(.ERRORS,216) S DONE=1 Q
- ..I '$D(^SDEC(409.84,$G(REQUEST("MRTC","MRTC APPOINTMENT",CNT)),0)) D ERRLOG^SDESJSON(.ERRORS,217) S DONE=1 Q
- Q
- VALREQCOM(ERRORS,REQUEST) ;
- S REQUEST("REQUEST COMMENT")=$TR(REQUEST("REQUEST COMMENT"),"^"," ")
- I $L($G(REQUEST("REQUEST COMMENT")))>80 D ERRLOG^SDESJSON(.ERRORS,443)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESEDITAPPTREQ 14301 printed Feb 19, 2025@00:23:01 Page 2
- SDESEDITAPPTREQ ;ALB/BLB,MGD,TJB,BWF,TJB,BLB,LAB,JAS,JAS,JAS,ANU,LAB - SCHEDULING EDIT APPT REQUEST; MAY 10,2024@08:27PM
- +1 ;;5.3;Scheduling;**823,826,837,845,846,847,864,871,873,875,877**;Aug 13, 1993;Build 14
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 ; SDES EDIT APPT REQ
- +5 ;
- +6 QUIT
- +7 ;
- EDITREQUEST(JSONRETURN,REQUEST) ;
- +1 NEW REQIEN,ERRORS,RETURN,ISAPPREQIENVALID,ISDFNVALID,ISDATETIMEVALID,ISEASVALID,INSTITUTIONIEN
- +2 NEW ISCLINSTOPVALID,ISMODALINVALID,ISREQUESTBYVALID,ISPROVIDERVALID,ISPIDVALID,ISPRIGROUPVALID
- +3 NEW ISREQTYPEVALID,ISPRIORITYVALID,ISSERVCONNVALID,ISAPPTTYPEVALID,ISPATSTATVALID
- +4 NEW ISDATEPREFVALID,ISMTRCDATAVALID,ISCPRSDATAVALID
- +5 ;
- +6 DO VALIDATE(.REQUEST,.ERRORS)
- +7 IF $DATA(ERRORS)
- MERGE RETURN=ERRORS
- DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
- QUIT
- +8 ;
- +9 SET RETURN("Request","IEN")=$$BUILDER(.REQUEST)
- +10 ;
- +11 DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
- +12 QUIT
- +13 ;
- VALIDATE(REQUEST,ERRORS) ;
- +1 ;
- +2 SET ISAPPREQIENVALID=$$VALIDATEAPPTREQ^SDESEDITAPREQVAL(.ERRORS,$GET(REQUEST("REQUEST IEN")))
- +3 ;
- +4 SET ISDFNVALID=$$VALIDATEDFN^SDESEDITAPREQVAL(.ERRORS,$GET(REQUEST("DFN")))
- +5 ;
- +6 SET ISDATETIMEVALID=$$VALIDATEDATETIME^SDESEDITAPREQVAL(.ERRORS,.REQUEST)
- +7 ;
- +8 SET ISREQTYPEVALID=$$VALIDATEREQTYPE^SDESEDITAPREQVAL(.ERRORS,$GET(REQUEST("REQUEST SUB TYPE")))
- +9 ;
- +10 SET INSTITUTIONIEN=$$STATIONTOINST^SDESEDITAPREQVAL(.ERRORS,$GET(REQUEST("STATION NUMBER")),$GET(REQUEST("INSTITUTION NAME")))
- +11 ;
- +12 SET ISCLINSTOPVALID=$$VALIDATECLINSTOP^SDESEDITAPREQVAL(.ERRORS,.REQUEST,$GET(REQUEST("CLINIC IEN")),$GET(REQUEST("STOP CODE")),$GET(REQUEST("SECONDARY STOP CODE")))
- +13 ;
- +14 SET ISREQUESTBYVALID=$$VALIDATEREQBY^SDESEDITAPREQVAL(.ERRORS,$GET(REQUEST("REQUESTED BY")))
- +15 IF ISREQUESTBYVALID
- SET REQUEST("REQUESTED BY")=$$SOCEXT2INT^SDESUTIL(409.85,11,$GET(REQUEST("REQUESTED BY")))
- +16 ;
- +17 IF $GET(REQUEST("REQUESTED BY"))="PROVIDER"
- SET ISPROVIDERVALID=$$VALIDATEPROVIDER(.ERRORS,$GET(REQUEST("PROVIDER IEN")))
- +18 ;
- +19 SET ISPIDVALID=$$VALIDATEPID(.ERRORS,.REQUEST)
- +20 ;
- +21 SET ISEASVALID=$$VALIDATEEAS(.ERRORS,$GET(REQUEST("EAS")))
- +22 ;
- +23 IF $LENGTH($GET(REQUEST("MODALITY")))
- SET ISMODALINVALID=$$VALIDATEMODALITY^SDESINPUTVALUTL(.ERRORS,$GET(REQUEST("MODALITY")))
- +24 ;
- +25 SET ISPRIORITYVALID=$$VALIDATEPRIORITY(.ERRORS,$GET(REQUEST("PRIORITY")))
- +26 IF ISPRIORITYVALID
- SET REQUEST("PRIORITY")=$$SOCEXT2INT^SDESUTIL(409.85,10,$GET(REQUEST("PRIORITY")))
- +27 ;
- +28 IF $LENGTH($GET(REQUEST("PRIORITY GROUP")))
- SET ISPRIGROUPVALID=$$VALIDATEPRIGROUP(.ERRORS,$GET(REQUEST("PRIORITY GROUP")))
- +29 ;
- +30 SET ISSERVCONNVALID=$$VALIDATESERVCONN^SDESCREATEAPPREQ(.ERRORS,$GET(REQUEST("SERVICE CONNECTED")),$GET(REQUEST("SERVICE CONNECTED PERCENTAGE")))
- +31 ;
- +32 ; Evaluate Appt Type IEN and Appt Type Name together
- +33 NEW SDIEN,SDNAME
- +34 SET SDIEN=$GET(REQUEST("APPOINTMENT TYPE IEN"))
- SET SDNAME=$GET(REQUEST("APPOINTMENT TYPE NAME"))
- +35 SET ISAPPTTYPEVALID=$$VALIDATEAPPTTYPE^SDESCREATEAPPREQ(.ERRORS,.SDIEN,SDNAME)
- +36 SET REQUEST("APPOINTMENT TYPE IEN")=SDIEN
- +37 ;
- +38 IF $LENGTH($GET(REQUEST("PATIENT STATUS")))
- SET ISPATSTATVALID=$$VALIDATEPATSTAT(.ERRORS,$GET(REQUEST("PATIENT STATUS")))
- +39 ;
- +40 IF $DATA(REQUEST("PATIENT PREFERRED START DATE"))
- IF $DATA(REQUEST("PATIENT PREFERRED END DATE"))
- DO VALIDATEDATEPREF^SDESEDITAPPTREQ2(.ERRORS,.REQUEST)
- +41 ;
- +42 IF $DATA(REQUEST("MRTC"))
- DO VALIDATEMRTCDATA(.ERRORS,.REQUEST,$GET(REQUEST("MRTC","PARENT REQUEST")),$GET(REQUEST("MRTC","NEEDED")),$GET(REQUEST("MRTC","DAYS BETWEEN APPTS")),$GET(REQUEST("MRTC","HOW MANY NEEDED")))
- +43 IF $GET(REQUEST("REQUEST COMMENT"))]""
- DO VALREQCOM(.ERRORS,.REQUEST)
- +44 QUIT
- +45 ;
- BUILDER(REQUEST) ;
- +1 NEW FDA,FDAERR,RETURNIEN
- +2 SET REQIEN=$GET(REQUEST("REQUEST IEN"))_","
- +3 SET FDA(409.85,REQIEN,.01)=$GET(REQUEST("DFN"))
- +4 SET FDA(409.85,REQIEN,.02)=$GET(REQUEST("PATIENT STATUS"))
- +5 SET FDA(409.85,REQIEN,1)=$GET(REQUEST("CREATE DATE"))
- +6 SET FDA(409.85,REQIEN,2)=$GET(INSTITUTIONIEN)
- +7 SET FDA(409.85,REQIEN,4)=$GET(REQUEST("REQUEST SUB TYPE"))
- +8 SET FDA(409.85,REQIEN,5)=$GET(REQUEST("VAOS GUID"))
- +9 SET FDA(409.85,REQIEN,6)=$GET(REQUEST("MODALITY"))
- +10 SET FDA(409.85,REQIEN,8)=$GET(REQUEST("CLINIC IEN"))
- +11 SET FDA(409.85,REQIEN,8.5)=$GET(REQUEST("STOP CODE"))
- +12 SET FDA(409.85,REQIEN,8.6)=$GET(REQUEST("SECONDARY STOP CODE"))
- +13 SET FDA(409.85,REQIEN,8.7)=$GET(REQUEST("APPOINTMENT TYPE IEN"))
- +14 SET FDA(409.85,REQIEN,9)=$GET(DUZ)
- +15 SET FDA(409.85,REQIEN,9.5)=$$NOW^XLFDT
- +16 SET FDA(409.85,REQIEN,10)=$GET(REQUEST("PRIORITY"))
- +17 SET FDA(409.85,REQIEN,10.5)=$GET(REQUEST("PRIORITY GROUP"))
- +18 SET FDA(409.85,REQIEN,11)=$GET(REQUEST("REQUESTED BY"))
- +19 SET FDA(409.85,REQIEN,12)=$GET(REQUEST("PROVIDER IEN"))
- +20 SET FDA(409.85,REQIEN,14)=$GET(REQUEST("SERVICE CONNECTED PERCENTAGE"))
- +21 SET FDA(409.85,REQIEN,15)=$GET(REQUEST("SERVICE CONNECTED"))
- +22 ; Removed the update to PID since it occurs in ADDPIDHISTORY as well and the Original PID is needed for ADDPIDHISTORY
- +23 ;S FDA(409.85,REQIEN,22)=$G(REQUEST("PATIENT INDICATED DATE"))
- +24 SET FDA(409.85,REQIEN,25)=$TRANSLATE($GET(REQUEST("REQUEST COMMENT")),"^"," ")
- +25 SET FDA(409.85,REQIEN,41)=$GET(REQUEST("MRTC","NEEDED"))
- +26 SET FDA(409.85,REQIEN,42)=$GET(REQUEST("MRTC","DAYS BETWEEN APPTS"))
- +27 SET FDA(409.85,REQIEN,43)=$GET(REQUEST("MRTC","HOW MANY NEEDED"))
- +28 IF $GET(REQUEST("MRTC","PARENT REQUEST"))'=""
- SET FDA(409.85,REQIEN,43.8)=$GET(REQUEST("MRTC","PARENT REQUEST"))
- +29 SET FDA(409.85,REQIEN,46)=$GET(REQUEST("CPRS ORDER NUMBER"))
- +30 SET FDA(409.85,REQIEN,47)=$GET(REQUEST("CPRS TIME SENSITIVE"))
- +31 SET FDA(409.85,REQIEN,100)=$GET(REQUEST("EAS"))
- +32 DO FILE^DIE(,"FDA","FDAERR")
- KILL FDA
- +33 ;
- +34 DO ADDPIDHISTORY^SDESCREATEAPPREQ($GET(REQUEST("REQUEST IEN")),$GET(REQUEST("PATIENT INDICATED DATE")))
- +35 ;
- +36 IF $DATA(REQUEST("CPRS PREREQUISITES"))
- DO EDITCPRSPREREQS(.REQUEST,$GET(REQUEST("REQUEST IEN")))
- +37 ;
- +38 IF $DATA(REQUEST("PATIENT COMMENT"))!($DATA(REQUEST("PATIENT PREFERRED START DATE")))
- DO BUILDCOMMENTS(.REQUEST,$GET(REQUEST("REQUEST IEN")))
- +39 ;
- +40 IF $DATA(REQUEST("MRTC","PATIENT INDICATED DATE"))
- DO EDITMRTCPID(.REQUEST,$GET(REQUEST("REQUEST IEN")))
- +41 ;
- +42 IF $DATA(REQUEST("MRTC","CHILD REQUEST"))!($DATA(REQUEST("MRTC","MRTC APPOINTMENT")))
- DO EDITMRTCLINKS(.REQUEST,$GET(REQUEST("REQUEST IEN")))
- +43 ;
- +44 DO AUDIT($GET(REQUEST("REQUEST IEN")),$GET(REQUEST("CLINIC IEN")),$GET(REQUEST("STOP CODE")))
- +45 ;
- +46 QUIT $GET(REQUEST("REQUEST IEN"))
- +47 ;
- +48 ;877
- BUILDAPPTDATA(REQIEN,APPTDATETIME,CLINICIEN,SERVCONNPERC,SERVCONN,APPTTYPE,EAS,SDUSER,APPTMSG) ;
- +1 NEW FDA,FDAERR,ERROR
- +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 ;
- +11 if $GET(SDUSER)=""
- SET SDUSER=DUZ
- +12 SET FDA(409.85,REQIEN,13.7)=SDUSER
- +13 ; 'R' FOR Scheduled/Kept;
- SET FDA(409.85,REQIEN,13.8)="R"
- +14 SET FDA(409.85,REQIEN,14)=$GET(SERVCONNPERC)
- +15 SET FDA(409.85,REQIEN,15)=$GET(SERVCONN)
- +16 SET FDA(409.85,REQIEN,100)=$GET(EAS)
- +17 SET FDA(409.85,REQIEN,19)=$PIECE($$NOW^XLFDT,".",1)
- +18 ;877
- +19 SET FDA(409.85,REQIEN,20)=SDUSER
- +20 ;
- +21 SET FDA(409.85,REQIEN,21)=$$FIND1^DIC(409.853,,"B","REMOVED/SCHEDULED-ASSIGNED")
- +22 SET FDA(409.85,REQIEN,23)="C"
- +23 DO FILE^DIE(,"FDA","FDAERR")
- KILL FDA
- +24 IF $$GET1^DIQ(409.85,REQIEN,4,"I")="RTC"
- DO UPDATEORDER(.APPTMSG,$PIECE(REQIEN,",",1),SDUSER)
- +25 ;
- +26 NEW PARENTIEN
- +27 SET PARENTIEN=$$GET1^DIQ(409.85,REQIEN_",",43.8,"I")
- +28 IF PARENTIEN
- Begin DoDot:1
- +29 NEW CHILDIEN,FOUND
- +30 SET CHILDIEN=""
- SET FOUND=0
- +31 FOR
- SET CHILDIEN=$ORDER(^SDEC(409.85,PARENTIEN,2,"B",CHILDIEN))
- if (CHILDIEN="")!(FOUND)
- QUIT
- Begin DoDot:2
- +32 SET FOUND=($$GET1^DIQ(409.85,CHILDIEN_",",23,"E")="OPEN")
- End DoDot:2
- +33 IF 'FOUND
- Begin DoDot:2
- +34 SET FDA(409.85,PARENTIEN_",",20)=SDUSER
- +35 SET FDA(409.85,PARENTIEN_",",21)=$$FIND1^DIC(409.853,,"B","MRTC PARENT CLOSED")
- +36 SET FDA(409.85,PARENTIEN_",",23)="C"
- +37 SET FDA(409.85,PARENTIEN_",",19)=$PIECE($$NOW^XLFDT,".",1)
- +38 DO FILE^DIE(,"FDA","ERROR")
- KILL FDA
- +39 IF $$GET1^DIQ(409.85,PARENTIEN,4,"I")="RTC"
- DO UPDATEORDER(.APPTMSG,PARENTIEN,SDUSER)
- End DoDot:2
- End DoDot:1
- +40 QUIT
- +41 ;
- UPDATEORDER(APPTMSG,REQUESTIEN,SDUSER) ;Send HL7 to CPRS if RTC request
- +1 DO ARDISP^SDECHL7(REQUESTIEN,"",SDUSER)
- +2 IF $DATA(^TMP($JOB,"REJECT",REQUESTIEN))
- Begin DoDot:1
- +3 SET APPTMSG="Appointment created; however, ORDER status not updated. Please submit ticket."
- End DoDot:1
- +4 QUIT
- +5 ;
- 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 ;
- 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 ;
- EDITCPRSPREREQS(REQUEST,REQIEN) ;
- +1 NEW NUM,FDA,FDAERR,SUBIEN
- +2 IF '$DATA(^SDEC(409.85,REQIEN,8))
- DO BUILDCPRSPREREQS^SDESCREATEAPPREQ(.REQUEST,REQIEN)
- QUIT
- +3 SET SUBIEN=0
- SET NUM=0
- +4 FOR
- SET SUBIEN=$ORDER(^SDEC(409.85,REQIEN,8,SUBIEN))
- if 'SUBIEN
- QUIT
- Begin DoDot:1
- +5 SET NUM=NUM+1
- +6 SET FDA(409.8548,SUBIEN_","_REQIEN_",",.01)=$GET(REQUEST("CPRS PREREQUISITES",NUM))
- +7 DO FILE^DIE(,"FDA","FDAERR")
- KILL FDA
- End DoDot:1
- +8 QUIT
- +9 ;
- AUDIT(REQIEN,CLINICIEN,STOPCODE) ;
- +1 NEW FDA,FDAERR
- +2 SET FDA(409.8545,"+1,"_REQIEN_",",.01)=$$NOW^XLFDT
- +3 SET FDA(409.8545,"+1,"_REQIEN_",",1)=$GET(DUZ)
- +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 ;
- VALIDATEPROVIDER(ERRORS,PROVIDERIEN) ;
- +1 IF PROVIDERIEN="@"
- DO ERRLOG^SDESJSON(.ERRORS,229)
- QUIT 0
- +2 IF PROVIDERIEN=""
- DO ERRLOG^SDESJSON(.ERRORS,53)
- QUIT 0
- +3 IF PROVIDERIEN'=""
- IF '$DATA(^VA(200,PROVIDERIEN,0))
- DO ERRLOG^SDESJSON(.ERRORS,54)
- QUIT 0
- +4 QUIT 1
- +5 ;
- VALIDATEPID(ERRORS,REQUEST) ;
- +1 NEW REQUESTIEN,OLDPID
- +2 SET REQUESTIEN=$GET(REQUEST("REQUEST IEN"))
- +3 SET OLDPID=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
- +4 IF $GET(REQUEST("PATIENT INDICATED DATE"))="@"
- DO ERRLOG^SDESJSON(.ERRORS,229)
- QUIT 0
- +5 IF $GET(REQUEST("PATIENT INDICATED DATE"))=""
- DO ERRLOG^SDESJSON(.ERRORS,159)
- QUIT 0
- +6 IF $GET(REQUEST("PATIENT INDICATED DATE"))'=""
- SET REQUEST("PATIENT INDICATED DATE")=$$ISOTFM^SDAMUTDT($GET(REQUEST("PATIENT INDICATED DATE")))
- +7 IF $GET(REQUEST("PATIENT INDICATED DATE"))=-1
- DO ERRLOG^SDESJSON(.ERRORS,160)
- QUIT 0
- +8 IF REQUESTIEN
- IF $$DUPPIDCHK^SDES2CANCELAPPT(REQUESTIEN,$GET(REQUEST("PATIENT INDICATED DATE")))
- DO ERRLOG^SDESJSON(.ERRORS,545)
- QUIT 0
- +9 QUIT 1
- +10 ;
- VALIDATEEAS(ERRORS,EAS) ;
- +1 IF $LENGTH(EAS)
- SET EAS=$$EASVALIDATE^SDESUTIL($GET(EAS))
- +2 IF $PIECE($GET(EAS),U)=-1
- DO ERRLOG^SDESJSON(.ERRORS,142)
- QUIT 0
- +3 QUIT 1
- +4 ;
- VALIDATEPRIORITY(ERRORS,PRIORITY) ;
- +1 IF PRIORITY=""
- DO ERRLOG^SDESJSON(.ERRORS,457)
- QUIT 0
- +2 IF PRIORITY'="ASAP"
- IF PRIORITY'="FUTURE"
- DO ERRLOG^SDESJSON(.ERRORS,211)
- QUIT 0
- +3 QUIT 1
- +4 ;
- VALIDATEPRIGROUP(ERRORS,GROUP) ;
- +1 NEW NUM,FOUND,GCHECK
- +2 SET NUM=0
- SET FOUND=0
- +3 FOR NUM=1:1:8
- Begin DoDot:1
- +4 SET GCHECK="GROUP "_NUM
- +5 IF GROUP=GCHECK
- SET REQUEST("PRIORITY GROUP")=NUM
- SET FOUND=1
- End DoDot:1
- +6 IF FOUND=0
- DO ERRLOG^SDESJSON(.ERRORS,199)
- QUIT 0
- +7 QUIT 1
- +8 ;
- VALIDATEPATSTAT(ERRORS,PATIENTSTATUS) ;
- +1 IF PATIENTSTATUS'="NEW"
- IF PATIENTSTATUS'="ESTABLISHED"
- DO ERRLOG^SDESJSON(.ERRORS,203)
- QUIT 0
- +2 SET REQUEST("PATIENT STATUS")=$SELECT(PATIENTSTATUS="NEW":"N",PATIENTSTATUS="ESTABLISHED":"E",1:"")
- +3 QUIT 1
- +4 ;
- VALIDATEMRTCDATA(ERRORS,REQUEST,PARENTREQUEST,NEEDED,DAYSBETWEEN,HOWMANY) ;
- +1 NEW NUM,DONE,CNT
- +2 IF NEEDED'="YES"
- Begin DoDot:1
- +3 IF $GET(PARENTREQUEST)!($GET(DAYSBETWEEN))!($GET(HOWMANY))
- DO ERRLOG^SDESJSON(.ERRORS,233)
- End DoDot:1
- QUIT ""
- +4 IF NEEDED'=""
- IF NEEDED'="YES"
- IF NEEDED'="NO"
- DO ERRLOG^SDESJSON(.ERRORS,208)
- QUIT
- +5 ;
- +6 IF PARENTREQUEST'=""
- IF ('$DATA(^SDEC(409.85,PARENTREQUEST)))!(PARENTREQUEST=0)
- DO ERRLOG^SDESJSON(.ERRORS,207)
- +7 ;
- +8 IF DAYSBETWEEN'=""
- Begin DoDot:1
- +9 IF '+DAYSBETWEEN!(DAYSBETWEEN'<366)
- DO ERRLOG^SDESJSON(.ERRORS,209)
- End DoDot:1
- +10 ;
- +11 IF HOWMANY'=""
- Begin DoDot:1
- +12 IF '+HOWMANY!(HOWMANY'<101)
- DO ERRLOG^SDESJSON(.ERRORS,210)
- End DoDot:1
- +13 ;
- +14 IF $DATA(REQUEST("MRTC","PATIENT INDICATED DATE"))
- Begin DoDot:1
- +15 SET NUM=0
- SET DONE=0
- +16 FOR
- SET NUM=$ORDER(REQUEST("MRTC","PATIENT INDICATED DATE",NUM))
- if 'NUM!(DONE=1)
- QUIT
- Begin DoDot:2
- +17 SET REQUEST("MRTC","PATIENT INDICATED DATE",NUM)=$$ISOTFM^SDAMUTDT($GET(REQUEST("MRTC","PATIENT INDICATED DATE",NUM)))
- +18 IF $GET(REQUEST("MRTC","PATIENT INDICATED DATE",NUM))=-1
- DO ERRLOG^SDESJSON(.ERRORS,215)
- SET DONE=1
- QUIT
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 IF $DATA(REQUEST("MRTC","CHILD REQUEST"))!($DATA(REQUEST("MRTC","MRTC APPOINTMENT")))
- Begin DoDot:1
- +21 SET CNT=0
- SET DONE=0
- +22 FOR
- SET CNT=$ORDER(REQUEST("MRTC","CHILD REQUEST",CNT))
- if 'CNT!(DONE=1)
- QUIT
- Begin DoDot:2
- +23 IF '$DATA(^SDEC(409.85,$GET(REQUEST("MRTC","CHILD REQUEST",CNT)),0))
- DO ERRLOG^SDESJSON(.ERRORS,216)
- SET DONE=1
- QUIT
- +24 IF '$DATA(^SDEC(409.84,$GET(REQUEST("MRTC","MRTC APPOINTMENT",CNT)),0))
- DO ERRLOG^SDESJSON(.ERRORS,217)
- SET DONE=1
- QUIT
- End DoDot:2
- End DoDot:1
- +25 QUIT
- VALREQCOM(ERRORS,REQUEST) ;
- +1 SET REQUEST("REQUEST COMMENT")=$TRANSLATE(REQUEST("REQUEST COMMENT"),"^"," ")
- +2 IF $LENGTH($GET(REQUEST("REQUEST COMMENT")))>80
- DO ERRLOG^SDESJSON(.ERRORS,443)
- +3 QUIT