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

SDESCRTAPPTWRAP.m

Go to the documentation of this file.
SDESCRTAPPTWRAP  ;ALB/BLB,MGD,BLB,TJB,LAB - VISTA SCHEDULING RPCS ; Oct 26,2023
 ;;5.3;Scheduling;**814,816,823,826,827,828,843,847,864**;Aug 13, 1993;Build 15
 ;;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
 ;
 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)
 .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
 ;
 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
 ;