SDESCRTAPPTWRAP ;ALB/BLB,MGD,BLB,TJB,LAB - VISTA SCHEDULING RPCS ; Apr 22,2024
;;5.3;Scheduling;**814,816,823,826,827,828,843,847,864,877**;Aug 13, 1993;Build 14
;;Per VHA Directive 6402, this routine should not be modified
;----------------- ----------------- ----------
; ^TMP($J SACC 2.3.2.5.1
;
;(APPTARRAY(1)= APPT START TIME - (REQUIRED) - ISO FORMAT
;(APPTARRAY(2)= APPT END TIME - (REQUIRED) - ISO FORMAT
;(APPTARRAY(3)= DFN - (REQUIRED) - PATIENT IEN
;(APPTARRAY(4)= SDEC RESOURCE IEN (REQUIRED)
;(APPTARRAY(5)= WALKIN - (Y/N)
;(APPTARRAY(6)= DESIRED DATE/TIME - ISO FORMAT
;(APPTARRAY(7)= EXTERNAL ID - (FREE TEXT 1-50)
;(APPTARRAY(8)= SD REQUEST TYPE (REQUIRED) - REQTYPE|REQIEN
;(APPTARRAY(9)= PROVIDER IEN
;(APPTARRAY(10)= CLINIC IEN (REQUIRED)
;(APPTARRAY(11)= NOTE - FREE TEXT 1-150
;(APPTARRAY(12)= APPT TYPE IEN - POINTER TO ^SD(409.1)
;(APPTARRAY(12.5)= APPT TYPE NAME - Name from ^SD(409.1)
; Either APPT TYPE IEN or APPT TYPE NAME is Required
;(APPTARRAY(13)= PATIENT STATUS - (N/E) N:NEW E:ESTABLISHED
;(APPTARRAY(14)= APPT LENGTH (REQUIRED) - IN MINUTES (5-120)
;(APPTARRAY(15)= SERVICE CONNECTED - YES/NO
;(APPTARRAY(16)= SERVICE CONNECTED PERCENTAGE - 0-100
;(APPTARRAY(17)= MRTC (TRUE/FALSE)
;(APPTARRAY(18)= PARENT REQUEST (APPT REQUEST IEN)
;(APPTARRAY(19)= EAS TRACKING NUMBER
;(APPTARRAY(20)= RESERVED FOR FUTURE USE
;(APPTARRAY(21)= PATIENT ELIGIBILITY IEN - POINTER TO ^DIC(8
;(APPTARRAY(22)= OVERBOOK (0 for no, 1 for yes)
;(APPTARRAY(23)= LAB DATE/TIME - ISO FORMAT
;(APPTARRAY(24)= XRAY DATE/TIME - ISO FORMAT
;(APPTARRAY(25)= EKG DATE/TIME - ISO FORMAT
;(APPTARRAY(26)= PURPOSE (REQUIRED)- '1' FOR C&P; '2' FOR 10-10; '3' FOR SCHEDULED VISIT; '4' FOR UNSCHED. VISIT;
;(APPTARRAY(27)= COLLATERAL - 1 FOR YES
;(APPTARRAY(28)= SCHEDULE REQUEST TYPE (REQUIRED) -
; 'N' FOR 'NEXT AVAILABLE' APPT.;
; 'C' FOR OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
; 'P' FOR OTHER THAN 'NEXT AVA.' (PATIENT REQ.);
; 'W' FOR WALKIN APPT.;
; 'M' FOR MULTIPLE APPT. BOOKING;
; 'A' FOR AUTO REBOOK;
; 'O' FOR OTHER THAN 'NEXT AVA.' APPT.;
;(APPTARRAY(29)= NEXT AVAILABLE APPT (REQUIRED) -
; '0' FOR NOT INDICATED TO BE A 'NEXT AVA.' APPT.
; 1' FOR 'NEXT AVA.' APPT. INDICATED BY USER;
; '2' FOR 'NEXT AVA.' APPT. INDICATED BY CALCULATION;
; '3' FOR 'NEXT AVA.' APPT. INDICATED BY USER & C
;(APPTARRAY(30)= FOLLOWUP - 1 FOR YES 0 FOR NO
Q
CREATEAPPTS(JSONRETURN,APPTARRAY) ;
N RETURN,ERRORS,HAS40984ERRORS,HAS44ERRORS,HAS2ERRORS,FILENUMBER,ARY84,ARY44,ARY2,IS40984CREATED,IS44CREATED,IS2CREATED,ARRAYDELETE
N RETURNIEN40984,RETURNIEN44,ORDERLOCK,APPTMSG
;
D POPULATEARRAYS(.APPTARRAY,.ARY84,.ARY44,.ARY2)
;
S ORDERLOCK=$$ORDERCHECKLOCK(.ERRORS,ARY84("SDREQTYPE"),ARY84("DFN"))
I ORDERLOCK M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
; validate parameters
S HAS40984ERRORS=$$VALIDATE40984(.ERRORS,.ARY84,.ARY44)
I HAS40984ERRORS M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q ;has errors, quit
;
S HAS44ERRORS=$$VALIDATE44(.ERRORS,.ARY44)
I HAS44ERRORS M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
S HAS2ERRORS=$$VALIDATE2(.ERRORS,.ARY2)
I HAS2ERRORS M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
; create entries in 409.84, 44, and 2
;
S IS40984CREATED=$$CREATE40984(.ARY84,.ERRORS,.ARRAYDELETE,.RETURNIEN40984)
I 'IS40984CREATED M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
D SETMISSIONELIG^SDESMISSIONELG($G(RETURNIEN40984))
;
S IS44CREATED=$$CREATE44(.ARY44,.ERRORS,.ARRAYDELETE,.RETURNIEN44)
I 'IS44CREATED M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
S IS2CREATED=$$CREATE2(.ARY2,.ERRORS,$G(ARY84("SDESIREDTTM")),.ARRAYDELETE)
I 'IS2CREATED M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
I '$D(RETURN) D
.D CLEANUP40984^SDESCREATEAPPT(.ARY84,RETURNIEN40984,.APPTMSG)
.D CLEANUP44^SDESCREATEAPPT44(.ARY44,.RETURNIEN44,ARY84("SDREQTYPE"))
.I $P(ARY84("SDREQTYPE"),"|",2)'="C" D
..D ADDPIDHISTORY^SDESCREATEAPPREQ($P(ARY84("SDREQTYPE"),"|",2),$G(ARY84("SDESIREDTTM")))
.S RETURN("Appointment","IEN")=RETURNIEN40984
.S:$G(APPTMSG)'="" RETURN("Appointment","Message")=APPTMSG
;
D BUILDJSON(.JSONRETURN,.RETURN)
;
Q
;
VALIDATE40984(ERRORS,ARY84,ARY44) ;
N ERRORFLAG
I '$D(ARY84) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,169) Q $D(ERRORFLAG)
D VALIDATE^SDESCREATEAPPT(.ERRORS,.ARY84,.ARY44)
I $D(ERRORS) S ERRORFLAG=1
Q $D(ERRORFLAG)
;
VALIDATE44(ERRORS,ARY44) ;
N ERRORFLAG
I '$D(ARY44) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,170) Q $D(ERRORFLAG)
D VALIDATE^SDESCREATEAPPT44(.ERRORS,.ARY44)
I $D(ERRORS) S ERRORFLAG=1
Q $D(ERRORFLAG)
;
VALIDATE2(ERRORS,ARY2) ;
N ERRORFLAG
I '$D(ARY2) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,171) Q $D(ERRORFLAG)
D VALIDATE^SDESCREATEAPPT2(.ERRORS,.ARY2)
I $D(ERRORS) S ERRORFLAG=1
Q $D(ERRORFLAG)
;
CREATE40984(ARY84,ERRORS,ARRAYDELETE,RETURNIEN40984) ;
N ARY84FDA,SDERROR,NEWIEN40984,SDERROR,REQUESTIEN,PATIENTCOMMENTS,SUBIEN
D CREATE^SDESCREATEAPPT(.ARY84FDA,.ARY84)
D UPDATE^DIE(,"ARY84FDA","NEWIEN40984","SDERROR") K ARY84FDA
I $D(SDERROR) D ERRLOG^SDESJSON(.ERRORS,173) Q 0 ;no records to delete
S ARRAYDELETE(409.84)=$G(NEWIEN40984(1))_",",RETURNIEN40984=$G(NEWIEN40984(1))
;
; copy patient comments from cooresponding appointment request into appointment patient comments
S REQUESTIEN=$P($G(ARY84("SDREQTYPE")),"|",2)
I $D(^SDEC(409.85,REQUESTIEN,"PATCOM",0)) D
.S SUBIEN=0
.F S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN)) Q:'SUBIEN D
..S PATIENTCOMMENTS(SUBIEN)=$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")
D WP^DIE(409.84,RETURNIEN40984_",",4,"","PATIENTCOMMENTS")
Q 1
;
CREATE44(ARY44,ERRORS,ARRAYDELETE,RETURNIEN44) ;
N ARRAY44001FDA,ARRAY44003FDA,NEWIEN44001,NEWIEN44003,SDERR1,SDERR2,IENS44
D CREATE^SDESCREATEAPPT44(.ARRAY44001FDA,.ARRAY44003FDA,.NEWIEN44001,.IENS44,.ARY44)
I $D(ARRAY44001FDA) D
.D UPDATE^DIE(,"ARRAY44001FDA","NEWIEN44001","SDERR1") K FDA44001FDA
I $D(ERRORS) Q 0
I $D(SDERR1) D DELETERECORD(.ARRAYDELETE),ERRLOG^SDESJSON(.ERRORS,173) Q 0 ;delete all records in arraydelete
;
D UPDATE^DIE(,"ARRAY44003FDA","NEWIEN44003","SDERR2") K FDA44003FDA
I $D(SDERR2) D DELETERECORD(.ARRAYDELETE),ERRLOG^SDESJSON(.ERRORS,173) Q 0 ;delete all records in arraydelete
;if filed, set arraydelete for potential deletion
S ARRAYDELETE(44.003)=$G(NEWIEN44003(1))_","_ARY44("SDAPPTSTARTDTTM")_","_ARY44("CLINICIEN")_",",RETURNIEN44=$G(NEWIEN44003(1))
Q 1
;
CREATE2(ARY2,ERRORS,PID,ARRAYDELETE) ;
N ARRAY2FDA,NEWIEN2,SDERR
D CREATE^SDESCREATEAPPT2(.ARRAY2FDA,.NEWIEN2,.ARY2,$G(PID))
L +^DPT(ARY2("DFN")):3
I '$T D ERRLOG^SDESJSON(.ERRORS,187),DELETERECORD(.ARRAYDELETE) Q 0
D UPDATE^DIE("","ARRAY2FDA","NEWIEN2","SDERR") K ARRAY2FDA
L -^DPT(ARY2("DFN"))
I $D(SDERR) D DELETERECORD(.ARRAYDELETE),ERRLOG^SDESJSON(.ERRORS,173) Q 0 ;delete all records in arraydelete
Q 1
;
DELETERECORD(ARRAYDELETE) ;
N DELETEFDA,FILENUMBER,IENS,ERR
S FILENUMBER=0
F S FILENUMBER=$O(ARRAYDELETE(FILENUMBER)) Q:'FILENUMBER D
.S IENS=ARRAYDELETE(FILENUMBER)
.S DELETEFDA(FILENUMBER,IENS,.01)="@"
.D FILE^DIE(,"DELETEFDA","ERR") K DELETEFDA
Q
;
ORDERCHECKLOCK(ERRORS,REQTYPE,DFN) ;
N FOUND,REQUESTIEN,ORDERID
S FOUND=0
S REQUESTIEN=$P($G(REQTYPE),"|",2)
S REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
I REQTYPE="RTC" D
.S ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
.I '+$G(ORDERID) Q
.I $D(^XTMP("ORLK-"_ORDERID)) D ERRLOG^SDESJSON(.ERRORS,188) S FOUND=1
Q FOUND
;
BUILDJSON(JSONRETURN,RETURN) ;
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
Q
;
POPULATEARRAYS(APPTARRAY,ARY84,ARY44,ARY2) ;
S ARY84("SDAPPTSTARTDTTM")=$G(APPTARRAY(1))
S ARY84("SDAPPTENDDTTM")=$G(APPTARRAY(2))
S ARY84("DFN")=$G(APPTARRAY(3))
S ARY84("SDRESOURCE")=$G(APPTARRAY(4))
S ARY84("WALKIN")=$G(APPTARRAY(5))
S ARY84("SDESIREDTTM")=$$GETDESIREDT(.APPTARRAY)
S ARY84("SDEXTERNALID")=$G(APPTARRAY(7))
S ARY84("SDREQTYPE")=$G(APPTARRAY(8))
S ARY84("SDPROVIEN")=$G(APPTARRAY(9))
S ARY84("CLINICIEN")=$G(APPTARRAY(10))
S ARY84("SDNOTE")=$G(APPTARRAY(11))
S ARY84("SDAPPTYPE")=$G(APPTARRAY(12))
S ARY84("SDAPPTNAME")=$G(APPTARRAY(12.5))
S ARY84("SDPATIENTSTATUS")=$G(APPTARRAY(13))
S ARY84("SDAPPTLENGTH")=$G(APPTARRAY(14))
S ARY84("SDSERVCONN")=$G(APPTARRAY(15))
S ARY84("SDSERVCONNPERC")=$G(APPTARRAY(16))
S ARY84("SDMRTC")=$G(APPTARRAY(17))
S ARY84("SDPARENT")=$G(APPTARRAY(18))
S ARY84("SDEAS")=$G(APPTARRAY(19))
;
S ARY44("CLINICIEN")=$G(APPTARRAY(10))
S ARY44("DFN")=$G(APPTARRAY(3))
S ARY44("SDAPPTSTARTDTTM")=$G(APPTARRAY(1))
S ARY44("SDAPPTLENGTH")=$G(APPTARRAY(14))
S ARY44("SDAPPTREASON")=$G(APPTARRAY(11))
S ARY44("SDPATELIG")=$G(APPTARRAY(21))
S ARY44("SDOVERBOOK")=$G(APPTARRAY(22))
S ARY44("SDREQTYPE")=$G(APPTARRAY(8))
;
S ARY2("DFN")=$G(APPTARRAY(3))
S ARY2("CLINICIEN")=$G(APPTARRAY(10))
S ARY2("SDAPPTSTARTDTTM")=$G(APPTARRAY(1))
S ARY2("SDLABDTTM")=$G(APPTARRAY(23))
S ARY2("SDXRAYDTTM")=$G(APPTARRAY(24))
S ARY2("SDEKGDTTM")=$G(APPTARRAY(25))
S ARY2("SDPURPOSE")=$G(APPTARRAY(26))
S ARY2("SDAPPTYPE")=$G(APPTARRAY(12))
S ARY2("SDAPPTNAME")=$G(APPTARRAY(12.5))
S ARY2("SDCOLLATERAL")=$G(APPTARRAY(27))
S ARY2("SDSCHREQTYPE")=$G(APPTARRAY(28))
S ARY2("SDNXTAVAAPPT")=$G(APPTARRAY(29))
S ARY2("SDFOLLOWUP")=$G(APPTARRAY(30))
Q
;
GETDESIREDT(APPTARRAY) ;
N APTYP,PID,REQIEN
S PID=$G(APPTARRAY(6))
Q:PID'="" APPTARRAY(6)
S APTYP=$P($G(APPTARRAY(8)),"|",1)
S REQIEN=$P($G(APPTARRAY(8)),"|",2)
S:APTYP="A" PID=$$GET1^DIQ(409.85,REQIEN,22,"I")
S:APTYP="R" PID=$$GET1^DIQ(403.5,REQIEN,5,"I")
S:(APTYP="C"&($$GET1^DIQ(123,REQIEN,17,"I")'="")) PID=$$GET1^DIQ(123,REQIEN,17,"I")
S:(APTYP="C"&PID="") PID=$$GET1^DIQ(123,REQIEN,.01,"I")
S PID=$$FMTISO^SDAMUTDT(PID)
Q PID
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCRTAPPTWRAP 10515 printed Dec 13, 2024@02:56:26 Page 2
SDESCRTAPPTWRAP ;ALB/BLB,MGD,BLB,TJB,LAB - VISTA SCHEDULING RPCS ; Apr 22,2024
+1 ;;5.3;Scheduling;**814,816,823,826,827,828,843,847,864,877**;Aug 13, 1993;Build 14
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;----------------- ----------------- ----------
+4 ; ^TMP($J SACC 2.3.2.5.1
+5 ;
+6 ;(APPTARRAY(1)= APPT START TIME - (REQUIRED) - ISO FORMAT
+7 ;(APPTARRAY(2)= APPT END TIME - (REQUIRED) - ISO FORMAT
+8 ;(APPTARRAY(3)= DFN - (REQUIRED) - PATIENT IEN
+9 ;(APPTARRAY(4)= SDEC RESOURCE IEN (REQUIRED)
+10 ;(APPTARRAY(5)= WALKIN - (Y/N)
+11 ;(APPTARRAY(6)= DESIRED DATE/TIME - ISO FORMAT
+12 ;(APPTARRAY(7)= EXTERNAL ID - (FREE TEXT 1-50)
+13 ;(APPTARRAY(8)= SD REQUEST TYPE (REQUIRED) - REQTYPE|REQIEN
+14 ;(APPTARRAY(9)= PROVIDER IEN
+15 ;(APPTARRAY(10)= CLINIC IEN (REQUIRED)
+16 ;(APPTARRAY(11)= NOTE - FREE TEXT 1-150
+17 ;(APPTARRAY(12)= APPT TYPE IEN - POINTER TO ^SD(409.1)
+18 ;(APPTARRAY(12.5)= APPT TYPE NAME - Name from ^SD(409.1)
+19 ; Either APPT TYPE IEN or APPT TYPE NAME is Required
+20 ;(APPTARRAY(13)= PATIENT STATUS - (N/E) N:NEW E:ESTABLISHED
+21 ;(APPTARRAY(14)= APPT LENGTH (REQUIRED) - IN MINUTES (5-120)
+22 ;(APPTARRAY(15)= SERVICE CONNECTED - YES/NO
+23 ;(APPTARRAY(16)= SERVICE CONNECTED PERCENTAGE - 0-100
+24 ;(APPTARRAY(17)= MRTC (TRUE/FALSE)
+25 ;(APPTARRAY(18)= PARENT REQUEST (APPT REQUEST IEN)
+26 ;(APPTARRAY(19)= EAS TRACKING NUMBER
+27 ;(APPTARRAY(20)= RESERVED FOR FUTURE USE
+28 ;(APPTARRAY(21)= PATIENT ELIGIBILITY IEN - POINTER TO ^DIC(8
+29 ;(APPTARRAY(22)= OVERBOOK (0 for no, 1 for yes)
+30 ;(APPTARRAY(23)= LAB DATE/TIME - ISO FORMAT
+31 ;(APPTARRAY(24)= XRAY DATE/TIME - ISO FORMAT
+32 ;(APPTARRAY(25)= EKG DATE/TIME - ISO FORMAT
+33 ;(APPTARRAY(26)= PURPOSE (REQUIRED)- '1' FOR C&P; '2' FOR 10-10; '3' FOR SCHEDULED VISIT; '4' FOR UNSCHED. VISIT;
+34 ;(APPTARRAY(27)= COLLATERAL - 1 FOR YES
+35 ;(APPTARRAY(28)= SCHEDULE REQUEST TYPE (REQUIRED) -
+36 ; 'N' FOR 'NEXT AVAILABLE' APPT.;
+37 ; 'C' FOR OTHER THAN 'NEXT AVA.' (CLINICIAN REQ.)
+38 ; 'P' FOR OTHER THAN 'NEXT AVA.' (PATIENT REQ.);
+39 ; 'W' FOR WALKIN APPT.;
+40 ; 'M' FOR MULTIPLE APPT. BOOKING;
+41 ; 'A' FOR AUTO REBOOK;
+42 ; 'O' FOR OTHER THAN 'NEXT AVA.' APPT.;
+43 ;(APPTARRAY(29)= NEXT AVAILABLE APPT (REQUIRED) -
+44 ; '0' FOR NOT INDICATED TO BE A 'NEXT AVA.' APPT.
+45 ; 1' FOR 'NEXT AVA.' APPT. INDICATED BY USER;
+46 ; '2' FOR 'NEXT AVA.' APPT. INDICATED BY CALCULATION;
+47 ; '3' FOR 'NEXT AVA.' APPT. INDICATED BY USER & C
+48 ;(APPTARRAY(30)= FOLLOWUP - 1 FOR YES 0 FOR NO
+49 QUIT
CREATEAPPTS(JSONRETURN,APPTARRAY) ;
+1 NEW RETURN,ERRORS,HAS40984ERRORS,HAS44ERRORS,HAS2ERRORS,FILENUMBER,ARY84,ARY44,ARY2,IS40984CREATED,IS44CREATED,IS2CREATED,ARRAYDELETE
+2 NEW RETURNIEN40984,RETURNIEN44,ORDERLOCK,APPTMSG
+3 ;
+4 DO POPULATEARRAYS(.APPTARRAY,.ARY84,.ARY44,.ARY2)
+5 ;
+6 SET ORDERLOCK=$$ORDERCHECKLOCK(.ERRORS,ARY84("SDREQTYPE"),ARY84("DFN"))
+7 IF ORDERLOCK
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+8 ; validate parameters
+9 SET HAS40984ERRORS=$$VALIDATE40984(.ERRORS,.ARY84,.ARY44)
+10 ;has errors, quit
IF HAS40984ERRORS
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+11 ;
+12 SET HAS44ERRORS=$$VALIDATE44(.ERRORS,.ARY44)
+13 IF HAS44ERRORS
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+14 ;
+15 SET HAS2ERRORS=$$VALIDATE2(.ERRORS,.ARY2)
+16 IF HAS2ERRORS
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+17 ;
+18 ; create entries in 409.84, 44, and 2
+19 ;
+20 SET IS40984CREATED=$$CREATE40984(.ARY84,.ERRORS,.ARRAYDELETE,.RETURNIEN40984)
+21 IF 'IS40984CREATED
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+22 DO SETMISSIONELIG^SDESMISSIONELG($GET(RETURNIEN40984))
+23 ;
+24 SET IS44CREATED=$$CREATE44(.ARY44,.ERRORS,.ARRAYDELETE,.RETURNIEN44)
+25 IF 'IS44CREATED
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+26 ;
+27 SET IS2CREATED=$$CREATE2(.ARY2,.ERRORS,$GET(ARY84("SDESIREDTTM")),.ARRAYDELETE)
+28 IF 'IS2CREATED
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+29 IF '$DATA(RETURN)
Begin DoDot:1
+30 DO CLEANUP40984^SDESCREATEAPPT(.ARY84,RETURNIEN40984,.APPTMSG)
+31 DO CLEANUP44^SDESCREATEAPPT44(.ARY44,.RETURNIEN44,ARY84("SDREQTYPE"))
+32 IF $PIECE(ARY84("SDREQTYPE"),"|",2)'="C"
Begin DoDot:2
+33 DO ADDPIDHISTORY^SDESCREATEAPPREQ($PIECE(ARY84("SDREQTYPE"),"|",2),$GET(ARY84("SDESIREDTTM")))
End DoDot:2
+34 SET RETURN("Appointment","IEN")=RETURNIEN40984
+35 if $GET(APPTMSG)'=""
SET RETURN("Appointment","Message")=APPTMSG
End DoDot:1
+36 ;
+37 DO BUILDJSON(.JSONRETURN,.RETURN)
+38 ;
+39 QUIT
+40 ;
VALIDATE40984(ERRORS,ARY84,ARY44) ;
+1 NEW ERRORFLAG
+2 IF '$DATA(ARY84)
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,169)
QUIT $DATA(ERRORFLAG)
+3 DO VALIDATE^SDESCREATEAPPT(.ERRORS,.ARY84,.ARY44)
+4 IF $DATA(ERRORS)
SET ERRORFLAG=1
+5 QUIT $DATA(ERRORFLAG)
+6 ;
VALIDATE44(ERRORS,ARY44) ;
+1 NEW ERRORFLAG
+2 IF '$DATA(ARY44)
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,170)
QUIT $DATA(ERRORFLAG)
+3 DO VALIDATE^SDESCREATEAPPT44(.ERRORS,.ARY44)
+4 IF $DATA(ERRORS)
SET ERRORFLAG=1
+5 QUIT $DATA(ERRORFLAG)
+6 ;
VALIDATE2(ERRORS,ARY2) ;
+1 NEW ERRORFLAG
+2 IF '$DATA(ARY2)
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,171)
QUIT $DATA(ERRORFLAG)
+3 DO VALIDATE^SDESCREATEAPPT2(.ERRORS,.ARY2)
+4 IF $DATA(ERRORS)
SET ERRORFLAG=1
+5 QUIT $DATA(ERRORFLAG)
+6 ;
CREATE40984(ARY84,ERRORS,ARRAYDELETE,RETURNIEN40984) ;
+1 NEW ARY84FDA,SDERROR,NEWIEN40984,SDERROR,REQUESTIEN,PATIENTCOMMENTS,SUBIEN
+2 DO CREATE^SDESCREATEAPPT(.ARY84FDA,.ARY84)
+3 DO UPDATE^DIE(,"ARY84FDA","NEWIEN40984","SDERROR")
KILL ARY84FDA
+4 ;no records to delete
IF $DATA(SDERROR)
DO ERRLOG^SDESJSON(.ERRORS,173)
QUIT 0
+5 SET ARRAYDELETE(409.84)=$GET(NEWIEN40984(1))_","
SET RETURNIEN40984=$GET(NEWIEN40984(1))
+6 ;
+7 ; copy patient comments from cooresponding appointment request into appointment patient comments
+8 SET REQUESTIEN=$PIECE($GET(ARY84("SDREQTYPE")),"|",2)
+9 IF $DATA(^SDEC(409.85,REQUESTIEN,"PATCOM",0))
Begin DoDot:1
+10 SET SUBIEN=0
+11 FOR
SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:2
+12 SET PATIENTCOMMENTS(SUBIEN)=$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")
End DoDot:2
End DoDot:1
+13 DO WP^DIE(409.84,RETURNIEN40984_",",4,"","PATIENTCOMMENTS")
+14 QUIT 1
+15 ;
CREATE44(ARY44,ERRORS,ARRAYDELETE,RETURNIEN44) ;
+1 NEW ARRAY44001FDA,ARRAY44003FDA,NEWIEN44001,NEWIEN44003,SDERR1,SDERR2,IENS44
+2 DO CREATE^SDESCREATEAPPT44(.ARRAY44001FDA,.ARRAY44003FDA,.NEWIEN44001,.IENS44,.ARY44)
+3 IF $DATA(ARRAY44001FDA)
Begin DoDot:1
+4 DO UPDATE^DIE(,"ARRAY44001FDA","NEWIEN44001","SDERR1")
KILL FDA44001FDA
End DoDot:1
+5 IF $DATA(ERRORS)
QUIT 0
+6 ;delete all records in arraydelete
IF $DATA(SDERR1)
DO DELETERECORD(.ARRAYDELETE)
DO ERRLOG^SDESJSON(.ERRORS,173)
QUIT 0
+7 ;
+8 DO UPDATE^DIE(,"ARRAY44003FDA","NEWIEN44003","SDERR2")
KILL FDA44003FDA
+9 ;delete all records in arraydelete
IF $DATA(SDERR2)
DO DELETERECORD(.ARRAYDELETE)
DO ERRLOG^SDESJSON(.ERRORS,173)
QUIT 0
+10 ;if filed, set arraydelete for potential deletion
+11 SET ARRAYDELETE(44.003)=$GET(NEWIEN44003(1))_","_ARY44("SDAPPTSTARTDTTM")_","_ARY44("CLINICIEN")_","
SET RETURNIEN44=$GET(NEWIEN44003(1))
+12 QUIT 1
+13 ;
CREATE2(ARY2,ERRORS,PID,ARRAYDELETE) ;
+1 NEW ARRAY2FDA,NEWIEN2,SDERR
+2 DO CREATE^SDESCREATEAPPT2(.ARRAY2FDA,.NEWIEN2,.ARY2,$GET(PID))
+3 LOCK +^DPT(ARY2("DFN")):3
+4 IF '$TEST
DO ERRLOG^SDESJSON(.ERRORS,187)
DO DELETERECORD(.ARRAYDELETE)
QUIT 0
+5 DO UPDATE^DIE("","ARRAY2FDA","NEWIEN2","SDERR")
KILL ARRAY2FDA
+6 LOCK -^DPT(ARY2("DFN"))
+7 ;delete all records in arraydelete
IF $DATA(SDERR)
DO DELETERECORD(.ARRAYDELETE)
DO ERRLOG^SDESJSON(.ERRORS,173)
QUIT 0
+8 QUIT 1
+9 ;
DELETERECORD(ARRAYDELETE) ;
+1 NEW DELETEFDA,FILENUMBER,IENS,ERR
+2 SET FILENUMBER=0
+3 FOR
SET FILENUMBER=$ORDER(ARRAYDELETE(FILENUMBER))
if 'FILENUMBER
QUIT
Begin DoDot:1
+4 SET IENS=ARRAYDELETE(FILENUMBER)
+5 SET DELETEFDA(FILENUMBER,IENS,.01)="@"
+6 DO FILE^DIE(,"DELETEFDA","ERR")
KILL DELETEFDA
End DoDot:1
+7 QUIT
+8 ;
ORDERCHECKLOCK(ERRORS,REQTYPE,DFN) ;
+1 NEW FOUND,REQUESTIEN,ORDERID
+2 SET FOUND=0
+3 SET REQUESTIEN=$PIECE($GET(REQTYPE),"|",2)
+4 SET REQTYPE=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
+5 IF REQTYPE="RTC"
Begin DoDot:1
+6 SET ORDERID=$$GET1^DIQ(409.85,REQUESTIEN,46,"I")
+7 IF '+$GET(ORDERID)
QUIT
+8 IF $DATA(^XTMP("ORLK-"_ORDERID))
DO ERRLOG^SDESJSON(.ERRORS,188)
SET FOUND=1
End DoDot:1
+9 QUIT FOUND
+10 ;
BUILDJSON(JSONRETURN,RETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
+3 QUIT
+4 ;
POPULATEARRAYS(APPTARRAY,ARY84,ARY44,ARY2) ;
+1 SET ARY84("SDAPPTSTARTDTTM")=$GET(APPTARRAY(1))
+2 SET ARY84("SDAPPTENDDTTM")=$GET(APPTARRAY(2))
+3 SET ARY84("DFN")=$GET(APPTARRAY(3))
+4 SET ARY84("SDRESOURCE")=$GET(APPTARRAY(4))
+5 SET ARY84("WALKIN")=$GET(APPTARRAY(5))
+6 SET ARY84("SDESIREDTTM")=$$GETDESIREDT(.APPTARRAY)
+7 SET ARY84("SDEXTERNALID")=$GET(APPTARRAY(7))
+8 SET ARY84("SDREQTYPE")=$GET(APPTARRAY(8))
+9 SET ARY84("SDPROVIEN")=$GET(APPTARRAY(9))
+10 SET ARY84("CLINICIEN")=$GET(APPTARRAY(10))
+11 SET ARY84("SDNOTE")=$GET(APPTARRAY(11))
+12 SET ARY84("SDAPPTYPE")=$GET(APPTARRAY(12))
+13 SET ARY84("SDAPPTNAME")=$GET(APPTARRAY(12.5))
+14 SET ARY84("SDPATIENTSTATUS")=$GET(APPTARRAY(13))
+15 SET ARY84("SDAPPTLENGTH")=$GET(APPTARRAY(14))
+16 SET ARY84("SDSERVCONN")=$GET(APPTARRAY(15))
+17 SET ARY84("SDSERVCONNPERC")=$GET(APPTARRAY(16))
+18 SET ARY84("SDMRTC")=$GET(APPTARRAY(17))
+19 SET ARY84("SDPARENT")=$GET(APPTARRAY(18))
+20 SET ARY84("SDEAS")=$GET(APPTARRAY(19))
+21 ;
+22 SET ARY44("CLINICIEN")=$GET(APPTARRAY(10))
+23 SET ARY44("DFN")=$GET(APPTARRAY(3))
+24 SET ARY44("SDAPPTSTARTDTTM")=$GET(APPTARRAY(1))
+25 SET ARY44("SDAPPTLENGTH")=$GET(APPTARRAY(14))
+26 SET ARY44("SDAPPTREASON")=$GET(APPTARRAY(11))
+27 SET ARY44("SDPATELIG")=$GET(APPTARRAY(21))
+28 SET ARY44("SDOVERBOOK")=$GET(APPTARRAY(22))
+29 SET ARY44("SDREQTYPE")=$GET(APPTARRAY(8))
+30 ;
+31 SET ARY2("DFN")=$GET(APPTARRAY(3))
+32 SET ARY2("CLINICIEN")=$GET(APPTARRAY(10))
+33 SET ARY2("SDAPPTSTARTDTTM")=$GET(APPTARRAY(1))
+34 SET ARY2("SDLABDTTM")=$GET(APPTARRAY(23))
+35 SET ARY2("SDXRAYDTTM")=$GET(APPTARRAY(24))
+36 SET ARY2("SDEKGDTTM")=$GET(APPTARRAY(25))
+37 SET ARY2("SDPURPOSE")=$GET(APPTARRAY(26))
+38 SET ARY2("SDAPPTYPE")=$GET(APPTARRAY(12))
+39 SET ARY2("SDAPPTNAME")=$GET(APPTARRAY(12.5))
+40 SET ARY2("SDCOLLATERAL")=$GET(APPTARRAY(27))
+41 SET ARY2("SDSCHREQTYPE")=$GET(APPTARRAY(28))
+42 SET ARY2("SDNXTAVAAPPT")=$GET(APPTARRAY(29))
+43 SET ARY2("SDFOLLOWUP")=$GET(APPTARRAY(30))
+44 QUIT
+45 ;
GETDESIREDT(APPTARRAY) ;
+1 NEW APTYP,PID,REQIEN
+2 SET PID=$GET(APPTARRAY(6))
+3 if PID'=""
QUIT APPTARRAY(6)
+4 SET APTYP=$PIECE($GET(APPTARRAY(8)),"|",1)
+5 SET REQIEN=$PIECE($GET(APPTARRAY(8)),"|",2)
+6 if APTYP="A"
SET PID=$$GET1^DIQ(409.85,REQIEN,22,"I")
+7 if APTYP="R"
SET PID=$$GET1^DIQ(403.5,REQIEN,5,"I")
+8 if (APTYP="C"&($$GET1^DIQ(123,REQIEN,17,"I")'=""))
SET PID=$$GET1^DIQ(123,REQIEN,17,"I")
+9 if (APTYP="C"&PID="")
SET PID=$$GET1^DIQ(123,REQIEN,.01,"I")
+10 SET PID=$$FMTISO^SDAMUTDT(PID)
+11 QUIT PID
+12 ;
