SDECAR4 ;ALB/TAW,BLB,LAB - VISTA SCHEDULING RPCS ;Feb 3,2023
;;5.3;Scheduling;**784,785,788,805,813,826,833,835,836**;Aug 13, 1993;Build 20
;;Per VHA Directive 6402, this routine should not be modified
; Reference to ^DPT(DFN,0) in ICR #10035
;
Q
;
; Get SDEC APPOINTMENT REQUEST for all entries in the user's Institution
; where the Current Status is not C(losed).
;
; This RPC differs from SDEC ARGET in that only appointment specific data is returned.
;
; The ARGETPAT and ARGETPATJSON entry points must be kept in sync when passing in
; new parameters
;
GETREQBYTYPEVET(RET) ; SDES GET APPT REQ BY TYPE VET
N ERRORS,APPT,CNT,ARIEN,ARDATA,FNUM
;
S ARIEN=0,COUNT=0,FNUM=409.85,JSONFLG=1
F S ARIEN=$O(^SDEC(409.85,"TYPE","VETERAN",ARIEN)) Q:'ARIEN!(COUNT=200) D
.I $$GET1^DIQ(409.85,ARIEN,23,"I")="C" Q
.D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
.D BUILDREC
I '$D(APPT) S APPT("Appt",1)=""
;
D BUILDJSON
Q
;
ARGETPATJSON(RET,DFN) ;Entry point to return JSON
; SDEC GET PATIENT APPT REQ JSON
; ARGETPATJSON^SDEC1
N FILT,APPT,ERR,JSONFLG,JSONERR,COPUNT
S JSONFLG=1,JSONERR=""
D JSONEP
I '$D(APPT("Error")),'$D(APPT("ApptReq")) S APPT("ApptReq")="" ;No appt req for this patient
D BUILDJSON
Q
;
ARGETIEN(RET,ARIEN) ;Appt Req GET for speific appt IEN
; SDEC GET PAT APPT REQ BY IEN
; ARGETIEN^SDEC1
N FILT,APPT,COUNT,FNUM,DFN,ARDATA,JSONFLG,JSONERR
S JSONFLG=1,JSONERR=""
D INIT
S ARIEN=$G(ARIEN)
I ARIEN="" D ERRLOG^SDESJSON(.APPT,3)
S FNUM=$$FNUM^SDECAR
I ARIEN'="",('$D(^SDEC(409.85,ARIEN))) S ARIEN="" D ERRLOG^SDESJSON(.APPT,4)
I ARIEN D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG") ;Get data for all field for this appt req
I $D(ARDATA)>1 D BUILDREC
D BUILDJSON
Q
;
ARGETPAT(RET,DFN) ;Appt Req GET.
; SDEC PATIENT APP REQ GET
; ARGETPAT^SDEC1
;
; RPC Description:
; Get appointment request details. This is similar to SDEC ARGET but it
; only returns Appt request specific data.
;
; INPUT
; DFN : [R] Patient ID pointer to PATIENT File (#2)
;
; OUTPUT
; See RPC file
N FILT,APPT,COUNT
;
JSONEP ;
D INIT
D:'$G(JSONFLG) HDR
I $$VALIDATE()=0 D:'$G(JSONFLG) EXIT Q
D PROCESS
D:'$G(JSONFLG) EXIT
Q
;
INIT ; Initalize any process specific variables
S COUNT=0
I '$G(JSONFLG) S RET="^TMP(""SDECAR4"","_$J_")" K ^TMP("SDECAR4",$J)
S FILT("SKIP STAT","C")="" ;Exclude closed requests
S FILT("INDEX")="DFN^"_$G(DFN)
Q
;
VALIDATE() ;Validata input params
N VALID,DFN,COUNT
S VALID=1 ;Assume all is good
;
S DFN=$P(FILT("INDEX"),"^",2)
I +DFN<1 S VALID=0 D ERRLOG^SDESJSON(.APPT,1)
I +DFN>0,'$D(^DPT(DFN,0)) S VALID=0 D ERRLOG^SDESJSON(.APPT,2) ;This is a valid DFN
I 'VALID,'$G(JSONFLG) D ERR1^SDECERR(-1,"Invalid Patient ID.",.COUNT,.RET)
;
Q VALID
;
PROCESS ; Loop over primary index
N ARIEN,FNUM,COUNT
S FNUM=$$FNUM^SDECAR,COUNT=0
;
S ARIEN=0
F S ARIEN=$O(^SDEC(409.85,"B",+DFN,ARIEN)) Q:ARIEN'>0 D ONEPAT
Q
;
ONEPAT ; Process one patient
N ARDATA,ARMSG
I $$VALIDIEN()=0 Q ;Is this appt request one that we are looking for
D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG") ;Get data for all field for this appt req
D:$D(ARDATA)>1 BUILDREC
Q
;
VALIDIEN() ;Validate the appointment request
N VALID,ARSTAT
S VALID=1 ;Assume this is a good record
; Is status for this request on the skip list
I $D(FILT("SKIP STAT")) D
.S ARSTAT=$$GET1^DIQ(409.85,ARIEN_",",23,"I")
.I ARSTAT'="",$D(FILT("SKIP STAT",ARSTAT)) S VALID=0
I VALID,$$GET1^DIQ(409.85,ARIEN_",",.01,"I")="" S VALID=0 ;Missing DFN
Q VALID
;
BUILDREC ; Build an output record
N ARSTAT,DFN,SDPS,SDCLY,ARORIGDT,SDI,STR,SDCL,CALLLETTER,I,X,VAR,SUBCNT,SDECLET,SDECALL
N ARINST,ARINSTNM,ARTYPE,VAOSGUID,ARSTOP,ARSTOPN,ARCLIEN,ARCLNAME,APPTYPE,ARUSER,ARUSRNM
N AREDT,ARPRIO,ARENPRI,ARREQBY,ARPROV,ARPROVNM,ARSDOA,ARSDOA,ARDAM,ARCLERK,ARCLERKN,ARASD,ARSDOA
N ARCLERK,ARCLERKN,ARDAM,ARSVCCON,ARDAPTDT,ARCOMM,ARMAR,ARMAI,ARMAN,ARPC,ARDISPD,ARDISPU,ARDISPUN
N APPTPTRS,CHILDREN,ARMRTC,SDPARENT,SDMTRC,CANCHANGEPID,MRTCSEQUENCENUM
S ARORIGDT=ARDATA(FNUM,ARIEN_",",1,"I")
S ARSTAT=ARDATA(FNUM,ARIEN_",",23,"I")
S DFN=ARDATA(FNUM,ARIEN_",",.01,"I")
S SDPS=ARDATA(FNUM,ARIEN_",",.02,"E")
S SDCL=ARDATA(FNUM,ARIEN_",",8,"I")
S ARINST=ARDATA(FNUM,ARIEN_",",2,"I")
S ARINSTNM=ARDATA(FNUM,ARIEN_",",2,"E")
S ARTYPE=ARDATA(FNUM,ARIEN_",",4,"I")
S ARCLIEN=ARDATA(FNUM,ARIEN_",",8,"I")
S ARSTOP=ARDATA(FNUM,ARIEN_",",8.5,"I")
S ARSTOPN=ARDATA(FNUM,ARIEN_",",8.5,"E")
S ARCLNAME=ARDATA(FNUM,ARIEN_",",8,"E")
S APPTYPE=ARDATA(FNUM,ARIEN_",",8.7,"I")
S ARUSER=ARDATA(FNUM,ARIEN_",",9,"I")
S ARUSRNM=ARDATA(FNUM,ARIEN_",",9,"E")
S AREDT=$G(ARDATA(FNUM,ARIEN_",",9.5,"E")) ;53
S ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
S ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E") ;msc/sat
S ARREQBY=ARDATA(FNUM,ARIEN_",",11,"I")
S ARPROV=ARDATA(FNUM,ARIEN_",",12,"I")
S ARPROVNM=ARDATA(FNUM,ARIEN_",",12,"E")
S ARSDOA=ARDATA(FNUM,ARIEN_",",13,"I") ;scheduled date of appt
; Change date/time conversion so midnight is handled properly. wtc/pwc 694 1/7/2020
;
S ARSDOA=$$FMTONET^SDECDATE(ARSDOA,"N") ;
S ARDAM=ARDATA(FNUM,ARIEN_",",13.1,"E") ;date appt. made
S ARCLERK=ARDATA(FNUM,ARIEN_",",13.7,"I") ;appt clerk ien
S ARCLERKN=ARDATA(FNUM,ARIEN_",",13.7,"E") ;appt clerk name
S ARASD=""
S:ARSDOA'="" $P(ARASD,"~~",1)=ARSDOA
S:ARCLERK'="" $P(ARASD,"~~",12)=ARCLERK
S:ARCLERKN'="" $P(ARASD,"~~",13)=ARCLERKN
S:ARDAM'="" $P(ARASD,"~~",17)=ARDAM
S ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
S ARDAPTDT=ARDATA(FNUM,ARIEN_",",22,"I")
S ARCOMM=ARDATA(FNUM,ARIEN_",",25,"E")
S ARMAR=ARDATA(409.85,ARIEN_",",41,"E")
S ARMAI=ARDATA(409.85,ARIEN_",",42,"E")
S ARMAN=ARDATA(409.85,ARIEN_",",43,"E")
S ARPC=$$WLPC^SDECAR1A(.ARDATA,ARIEN)
S ARDISPD=ARDATA(FNUM,ARIEN_",",19,"E")
S ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
S ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
S APPTPTRS=$$GETAPPTS^SDECAR1A(ARIEN)
S CHILDREN=$$CHILDREN^SDECAR1A(ARIEN)
S ARMRTC=$$MRTC^SDECAR(ARIEN)
S SDPARENT=ARDATA(FNUM,ARIEN_",",43.8,"I")
S MRTCSEQUENCENUM=ARDATA(FNUM,ARIEN_",",43.1,"I")
S CANCHANGEPID=ARDATA(409.85,ARIEN_",",49,"I")
;Build string of RTC dates
S (SDI,SDMTRC)=""
F S SDI=$O(ARDATA(409.851,SDI)) Q:SDI="" S SDMTRC=$S(SDMTRC'="":SDMTRC_"|",1:"")_ARDATA(409.851,SDI,.01,"E")
; 1 2 3 4 5 6
S STR=DFN_U_ARIEN_U_ARORIGDT_U_ARINST_U_ARINSTNM_U_ARTYPE
; 7 8 9 10 11 12 13
S STR=STR_U_ARCLIEN_U_ARCLNAME_U_ARUSER_U_ARUSRNM_U_ARPRIO_U_ARREQBY_U_ARPROV
; 14 15 16 17 18 19 20
S STR=STR_U_ARPROVNM_U_ARDAPTDT_U_ARCOMM_U_ARENPRI_U_ARMAR_U_ARMAI_U_ARMAN
; 21 22 23 24 25
S STR=STR_U_ARPC_U_ARDISPD_U_ARDISPU_U_ARDISPUN_U_ARSVCCON
; 26 27 28 29 30
S STR=STR_U_AREDT_U_SDMTRC_U_ARSTOP_U_ARSTOPN_U_ARASD
; 31 32 33 34 35 36
S STR=STR_U_ARMRTC_U_APPTYPE_U_SDPS_U_APPTPTRS_U_CHILDREN_U_SDPARENT
;# OF CALLS MADE AND DATE LAST LETTER SENT
S CALLLETTER=$$CALLET^SDECAR1A(DFN,ARIEN)
S STR=STR_U_CALLLETTER
;
S COUNT=$G(COUNT)+1
I '$G(JSONFLG) S ^TMP("SDECAR4",$J,COUNT)=STR_$C(30) Q
;
S APPT("ApptReq",COUNT,"PatientIEN")=DFN
S APPT("ApptReq",COUNT,"ApptReqIEN")=ARIEN
S APPT("ApptReq",COUNT,"CreateDateI")=ARORIGDT
S APPT("ApptReq",COUNT,"InstitutionI")=ARINST
S APPT("ApptReq",COUNT,"InstitutionE")=ARINSTNM
S APPT("ApptReq",COUNT,"RequestTypeI")=ARTYPE
S APPT("ApptReq",COUNT,"ReqSpecificClinicI")=ARCLIEN
S APPT("ApptReq",COUNT,"ReqSpecificClinicE")=ARCLNAME
S APPT("ApptReq",COUNT,"OriginatingUserI")=ARUSER
S APPT("ApptReq",COUNT,"OriginatingUserE")=ARUSRNM
S APPT("ApptReq",COUNT,"PriorityI")=ARPRIO
S APPT("ApptReq",COUNT,"RequestedByI")=ARREQBY
S APPT("ApptReq",COUNT,"ProviderI")=ARPROV
S APPT("ApptReq",COUNT,"ProviderE")=ARPROVNM
S APPT("ApptReq",COUNT,"CidPreferredDateOfApptI")=ARDAPTDT
S APPT("ApptReq",COUNT,"CommentsE")=ARCOMM
D BUILDPATCOMMENTS(.APPT,ARIEN,COUNT)
S APPT("ApptReq",COUNT,"EnrollmentPriorityE")=ARENPRI
S APPT("ApptReq",COUNT,"MultipleAppointmentRtcE")=ARMAR
S APPT("ApptReq",COUNT,"MultApptRtcIntervalE")=ARMAI
S APPT("ApptReq",COUNT,"MultApptNumberE")=ARMAN
S SUBCNT=0
F I=1:1:$L(ARPC,"::") D
.S VAR=$P(ARPC,"::",I)
.Q:VAR=""
.S SUBCNT=SUBCNT+1
.S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"DateEnteredI")=$P(VAR,"~~",1)
.S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserI")=$P(VAR,"~~",2)
.S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserE")=$P(VAR,"~~",3)
.S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"ActionE")=$P(VAR,"~~",4)
.S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"PatientPhoneE")=$P(VAR,"~~",5)
.Q
I '$D(APPT("ApptReq",COUNT,"PatientContact")) S APPT("ApptReq",COUNT,"PatientContact")=""
;
S APPT("ApptReq",COUNT,"DateDispositionedE")=ARDISPD
S APPT("ApptReq",COUNT,"DispositionedByI")=ARDISPU
S APPT("ApptReq",COUNT,"DispositionedByE")=ARDISPUN
S APPT("ApptReq",COUNT,"ServiceConnectedPriorityE")=ARSVCCON
S APPT("ApptReq",COUNT,"DateTimeEnteredE")=AREDT
S SUBCNT=0
F I=1:1:$L(SDMTRC,"|") D
.S SUBCNT=SUBCNT+1
.S:$P(SDMTRC,"|",I)'="" APPT("ApptReq",COUNT,"MRTCCalcPrefDates",SUBCNT,"Date")=$P(SDMTRC,"|",I)
I '$D(APPT("ApptReq",COUNT,"MRTCCalcPrefDates")) S APPT("ApptReq",COUNT,"MRTCCalcPrefDates")=""
;
S APPT("ApptReq",COUNT,"ReqServiceSpecialtyI")=ARSTOP
S APPT("ApptReq",COUNT,"ReqServiceSpecialtyE")=ARSTOPN
S APPT("ApptReq",COUNT,"ScheduledDateOfApptI")=ARSDOA
S APPT("ApptReq",COUNT,"ApptClerkI")=ARCLERK
S APPT("ApptReq",COUNT,"ApptClerkE")=ARCLERKN
S APPT("ApptReq",COUNT,"DateApptMadeE")=ARDAM
S APPT("ApptReq",COUNT,"CountOfRTCs")=ARMRTC ;Count of nodes in 43.3 sub file
S APPT("ApptReq",COUNT,"MrtcSequenceNumber")=$G(MRTCSEQUENCENUM)
S APPT("ApptReq",COUNT,"ReqAppointmentTypeI")=APPTYPE
S APPT("ApptReq",COUNT,"PatientStatusE")=SDPS
S APPT("ApptReq",COUNT,"CanEditPid")=CANCHANGEPID
S SUBCNT=0
F I=1:1:$L(APPTPTRS,"|") D
.S VAR=$P(APPTPTRS,"|",I)
.S SUBCNT=SUBCNT+1
.S:VAR'="" APPT("ApptReq",COUNT,"MultiAppointmentsI",SUBCNT,"IEN")=VAR
I '$D(APPT("ApptReq",COUNT,"MultiAppointmentsI")) S APPT("ApptReq",COUNT,"MultiAppointmentsI")=""
;
S SUBCNT=0
F I=1:1:$L(CHILDREN,"|") D
.S VAR=$P(CHILDREN,"|",I)
.S SUBCNT=SUBCNT+1
.S:VAR'="" APPT("ApptReq",COUNT,"MultiApptRequestsChildI",SUBCNT,"ARIEN")=VAR
I '$D(APPT("ApptReq",COUNT,"MultiApptRequestsChildI")) S APPT("ApptReq",COUNT,"MultiApptRequestsChildI")=""
;
S APPT("ApptReq",COUNT,"ParentRequestI")=SDPARENT
S APPT("ApptReq",COUNT,"NumberOfCalls")=$P(CALLLETTER,"^",1)
S APPT("ApptReq",COUNT,"NumberOfEmailContact")=$P(CALLLETTER,U,3)
S APPT("ApptReq",COUNT,"NumberOfTextContact")=$P(CALLLETTER,U,4)
S APPT("ApptReq",COUNT,"NumberOfSecureMessage")=$P(CALLLETTER,U,5)
S APPT("ApptReq",COUNT,"DateOfLastLetterSent")=$P(CALLLETTER,"^",2)
Q
;
HDR ;
N SDRTMP
S SDRTMP="T00030DFN^I00010IEN^D00030ORIGDT"
; 4 5 6 7 8
S SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030CLINIEN^T00030CLINNAME"
; 9 10 11 12 13 14
S SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
; 15 16 17
S SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030ENROLLMENT_PRIORITY"
; 18 19 20
S SDRTMP=SDRTMP_"^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL^T00010MULT APPT NUMBER"
; 21 22 23 24 25
S SDRTMP=SDRTMP_"^T00100PCONTACT^T00030ARDISPD^T00030ARDISPU^T00030ARDISPUN^T00030WLSVCCON"
; 26 27 28 29 30
S SDRTMP=SDRTMP_"^T00030DATE^T00030MTRCDATES^T00030STOPIEN^T00030STOPNAME^T00250APPT_SCHED_DATE"
; 31 32 33 34 35 36
S SDRTMP=SDRTMP_"^T00030MRTCCOUNT^T00030APPTYPE^T00030EESTAT^T00030APPTPTRS^T00250CHILDREN^T00030SDPARENT"
S SDRTMP=SDRTMP_"^T00030CPHONE^T00030CLET"
S @RET@(0)=SDRTMP_$C(30)
Q
;
N SUBIEN,NUM,PATCMT
S SUBIEN=0
S PATCMT=""
F S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN)) Q:'SUBIEN D
.S PATCMT=PATCMT_$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")_" "
S REQUEST("ApptReq",COUNT,"PatientComment")=PATCMT
Q
;
BUILDJSON ;Convert to JSON
S RET=$G(RET,"RET")
D ENCODE^SDESJSON(.APPT,.RET,.JSONERR)
K ^TMP("SDECAR4",$J)
Q
;
EXIT ; Any special logic needed for a successful completion
N SDTMP,COUNT
S COUNT=$O(^TMP("SDECAR4",$J,""),-1)
I COUNT="" S ^TMP("SDECAR4",$J,1)=0,COUNT=1 ;No records to return
S SDTMP=^TMP("SDECAR4",$J,COUNT)
S SDTMP=$P(SDTMP,$C(30),1)
S ^TMP("SDECAR4",$J,COUNT)=SDTMP_$C(30,31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECAR4 13303 printed Dec 13, 2024@02:51:47 Page 2
SDECAR4 ;ALB/TAW,BLB,LAB - VISTA SCHEDULING RPCS ;Feb 3,2023
+1 ;;5.3;Scheduling;**784,785,788,805,813,826,833,835,836**;Aug 13, 1993;Build 20
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ; Reference to ^DPT(DFN,0) in ICR #10035
+4 ;
+5 QUIT
+6 ;
+7 ; Get SDEC APPOINTMENT REQUEST for all entries in the user's Institution
+8 ; where the Current Status is not C(losed).
+9 ;
+10 ; This RPC differs from SDEC ARGET in that only appointment specific data is returned.
+11 ;
+12 ; The ARGETPAT and ARGETPATJSON entry points must be kept in sync when passing in
+13 ; new parameters
+14 ;
GETREQBYTYPEVET(RET) ; SDES GET APPT REQ BY TYPE VET
+1 NEW ERRORS,APPT,CNT,ARIEN,ARDATA,FNUM
+2 ;
+3 SET ARIEN=0
SET COUNT=0
SET FNUM=409.85
SET JSONFLG=1
+4 FOR
SET ARIEN=$ORDER(^SDEC(409.85,"TYPE","VETERAN",ARIEN))
if 'ARIEN!(COUNT=200)
QUIT
Begin DoDot:1
+5 IF $$GET1^DIQ(409.85,ARIEN,23,"I")="C"
QUIT
+6 DO GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
+7 DO BUILDREC
End DoDot:1
+8 IF '$DATA(APPT)
SET APPT("Appt",1)=""
+9 ;
+10 DO BUILDJSON
+11 QUIT
+12 ;
ARGETPATJSON(RET,DFN) ;Entry point to return JSON
+1 ; SDEC GET PATIENT APPT REQ JSON
+2 ; ARGETPATJSON^SDEC1
+3 NEW FILT,APPT,ERR,JSONFLG,JSONERR,COPUNT
+4 SET JSONFLG=1
SET JSONERR=""
+5 DO JSONEP
+6 ;No appt req for this patient
IF '$DATA(APPT("Error"))
IF '$DATA(APPT("ApptReq"))
SET APPT("ApptReq")=""
+7 DO BUILDJSON
+8 QUIT
+9 ;
ARGETIEN(RET,ARIEN) ;Appt Req GET for speific appt IEN
+1 ; SDEC GET PAT APPT REQ BY IEN
+2 ; ARGETIEN^SDEC1
+3 NEW FILT,APPT,COUNT,FNUM,DFN,ARDATA,JSONFLG,JSONERR
+4 SET JSONFLG=1
SET JSONERR=""
+5 DO INIT
+6 SET ARIEN=$GET(ARIEN)
+7 IF ARIEN=""
DO ERRLOG^SDESJSON(.APPT,3)
+8 SET FNUM=$$FNUM^SDECAR
+9 IF ARIEN'=""
IF ('$DATA(^SDEC(409.85,ARIEN)))
SET ARIEN=""
DO ERRLOG^SDESJSON(.APPT,4)
+10 ;Get data for all field for this appt req
IF ARIEN
DO GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
+11 IF $DATA(ARDATA)>1
DO BUILDREC
+12 DO BUILDJSON
+13 QUIT
+14 ;
ARGETPAT(RET,DFN) ;Appt Req GET.
+1 ; SDEC PATIENT APP REQ GET
+2 ; ARGETPAT^SDEC1
+3 ;
+4 ; RPC Description:
+5 ; Get appointment request details. This is similar to SDEC ARGET but it
+6 ; only returns Appt request specific data.
+7 ;
+8 ; INPUT
+9 ; DFN : [R] Patient ID pointer to PATIENT File (#2)
+10 ;
+11 ; OUTPUT
+12 ; See RPC file
+13 NEW FILT,APPT,COUNT
+14 ;
JSONEP ;
+1 DO INIT
+2 if '$GET(JSONFLG)
DO HDR
+3 IF $$VALIDATE()=0
if '$GET(JSONFLG)
DO EXIT
QUIT
+4 DO PROCESS
+5 if '$GET(JSONFLG)
DO EXIT
+6 QUIT
+7 ;
INIT ; Initalize any process specific variables
+1 SET COUNT=0
+2 IF '$GET(JSONFLG)
SET RET="^TMP(""SDECAR4"","_$JOB_")"
KILL ^TMP("SDECAR4",$JOB)
+3 ;Exclude closed requests
SET FILT("SKIP STAT","C")=""
+4 SET FILT("INDEX")="DFN^"_$GET(DFN)
+5 QUIT
+6 ;
VALIDATE() ;Validata input params
+1 NEW VALID,DFN,COUNT
+2 ;Assume all is good
SET VALID=1
+3 ;
+4 SET DFN=$PIECE(FILT("INDEX"),"^",2)
+5 IF +DFN<1
SET VALID=0
DO ERRLOG^SDESJSON(.APPT,1)
+6 ;This is a valid DFN
IF +DFN>0
IF '$DATA(^DPT(DFN,0))
SET VALID=0
DO ERRLOG^SDESJSON(.APPT,2)
+7 IF 'VALID
IF '$GET(JSONFLG)
DO ERR1^SDECERR(-1,"Invalid Patient ID.",.COUNT,.RET)
+8 ;
+9 QUIT VALID
+10 ;
PROCESS ; Loop over primary index
+1 NEW ARIEN,FNUM,COUNT
+2 SET FNUM=$$FNUM^SDECAR
SET COUNT=0
+3 ;
+4 SET ARIEN=0
+5 FOR
SET ARIEN=$ORDER(^SDEC(409.85,"B",+DFN,ARIEN))
if ARIEN'>0
QUIT
DO ONEPAT
+6 QUIT
+7 ;
ONEPAT ; Process one patient
+1 NEW ARDATA,ARMSG
+2 ;Is this appt request one that we are looking for
IF $$VALIDIEN()=0
QUIT
+3 ;Get data for all field for this appt req
DO GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
+4 if $DATA(ARDATA)>1
DO BUILDREC
+5 QUIT
+6 ;
VALIDIEN() ;Validate the appointment request
+1 NEW VALID,ARSTAT
+2 ;Assume this is a good record
SET VALID=1
+3 ; Is status for this request on the skip list
+4 IF $DATA(FILT("SKIP STAT"))
Begin DoDot:1
+5 SET ARSTAT=$$GET1^DIQ(409.85,ARIEN_",",23,"I")
+6 IF ARSTAT'=""
IF $DATA(FILT("SKIP STAT",ARSTAT))
SET VALID=0
End DoDot:1
+7 ;Missing DFN
IF VALID
IF $$GET1^DIQ(409.85,ARIEN_",",.01,"I")=""
SET VALID=0
+8 QUIT VALID
+9 ;
BUILDREC ; Build an output record
+1 NEW ARSTAT,DFN,SDPS,SDCLY,ARORIGDT,SDI,STR,SDCL,CALLLETTER,I,X,VAR,SUBCNT,SDECLET,SDECALL
+2 NEW ARINST,ARINSTNM,ARTYPE,VAOSGUID,ARSTOP,ARSTOPN,ARCLIEN,ARCLNAME,APPTYPE,ARUSER,ARUSRNM
+3 NEW AREDT,ARPRIO,ARENPRI,ARREQBY,ARPROV,ARPROVNM,ARSDOA,ARSDOA,ARDAM,ARCLERK,ARCLERKN,ARASD,ARSDOA
+4 NEW ARCLERK,ARCLERKN,ARDAM,ARSVCCON,ARDAPTDT,ARCOMM,ARMAR,ARMAI,ARMAN,ARPC,ARDISPD,ARDISPU,ARDISPUN
+5 NEW APPTPTRS,CHILDREN,ARMRTC,SDPARENT,SDMTRC,CANCHANGEPID,MRTCSEQUENCENUM
+6 SET ARORIGDT=ARDATA(FNUM,ARIEN_",",1,"I")
+7 SET ARSTAT=ARDATA(FNUM,ARIEN_",",23,"I")
+8 SET DFN=ARDATA(FNUM,ARIEN_",",.01,"I")
+9 SET SDPS=ARDATA(FNUM,ARIEN_",",.02,"E")
+10 SET SDCL=ARDATA(FNUM,ARIEN_",",8,"I")
+11 SET ARINST=ARDATA(FNUM,ARIEN_",",2,"I")
+12 SET ARINSTNM=ARDATA(FNUM,ARIEN_",",2,"E")
+13 SET ARTYPE=ARDATA(FNUM,ARIEN_",",4,"I")
+14 SET ARCLIEN=ARDATA(FNUM,ARIEN_",",8,"I")
+15 SET ARSTOP=ARDATA(FNUM,ARIEN_",",8.5,"I")
+16 SET ARSTOPN=ARDATA(FNUM,ARIEN_",",8.5,"E")
+17 SET ARCLNAME=ARDATA(FNUM,ARIEN_",",8,"E")
+18 SET APPTYPE=ARDATA(FNUM,ARIEN_",",8.7,"I")
+19 SET ARUSER=ARDATA(FNUM,ARIEN_",",9,"I")
+20 SET ARUSRNM=ARDATA(FNUM,ARIEN_",",9,"E")
+21 ;53
SET AREDT=$GET(ARDATA(FNUM,ARIEN_",",9.5,"E"))
+22 SET ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
+23 ;msc/sat
SET ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E")
+24 SET ARREQBY=ARDATA(FNUM,ARIEN_",",11,"I")
+25 SET ARPROV=ARDATA(FNUM,ARIEN_",",12,"I")
+26 SET ARPROVNM=ARDATA(FNUM,ARIEN_",",12,"E")
+27 ;scheduled date of appt
SET ARSDOA=ARDATA(FNUM,ARIEN_",",13,"I")
+28 ; Change date/time conversion so midnight is handled properly. wtc/pwc 694 1/7/2020
+29 ;
+30 ;
SET ARSDOA=$$FMTONET^SDECDATE(ARSDOA,"N")
+31 ;date appt. made
SET ARDAM=ARDATA(FNUM,ARIEN_",",13.1,"E")
+32 ;appt clerk ien
SET ARCLERK=ARDATA(FNUM,ARIEN_",",13.7,"I")
+33 ;appt clerk name
SET ARCLERKN=ARDATA(FNUM,ARIEN_",",13.7,"E")
+34 SET ARASD=""
+35 if ARSDOA'=""
SET $PIECE(ARASD,"~~",1)=ARSDOA
+36 if ARCLERK'=""
SET $PIECE(ARASD,"~~",12)=ARCLERK
+37 if ARCLERKN'=""
SET $PIECE(ARASD,"~~",13)=ARCLERKN
+38 if ARDAM'=""
SET $PIECE(ARASD,"~~",17)=ARDAM
+39 SET ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
+40 SET ARDAPTDT=ARDATA(FNUM,ARIEN_",",22,"I")
+41 SET ARCOMM=ARDATA(FNUM,ARIEN_",",25,"E")
+42 SET ARMAR=ARDATA(409.85,ARIEN_",",41,"E")
+43 SET ARMAI=ARDATA(409.85,ARIEN_",",42,"E")
+44 SET ARMAN=ARDATA(409.85,ARIEN_",",43,"E")
+45 SET ARPC=$$WLPC^SDECAR1A(.ARDATA,ARIEN)
+46 SET ARDISPD=ARDATA(FNUM,ARIEN_",",19,"E")
+47 SET ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
+48 SET ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
+49 SET APPTPTRS=$$GETAPPTS^SDECAR1A(ARIEN)
+50 SET CHILDREN=$$CHILDREN^SDECAR1A(ARIEN)
+51 SET ARMRTC=$$MRTC^SDECAR(ARIEN)
+52 SET SDPARENT=ARDATA(FNUM,ARIEN_",",43.8,"I")
+53 SET MRTCSEQUENCENUM=ARDATA(FNUM,ARIEN_",",43.1,"I")
+54 SET CANCHANGEPID=ARDATA(409.85,ARIEN_",",49,"I")
+55 ;Build string of RTC dates
+56 SET (SDI,SDMTRC)=""
+57 FOR
SET SDI=$ORDER(ARDATA(409.851,SDI))
if SDI=""
QUIT
SET SDMTRC=$SELECT(SDMTRC'="":SDMTRC_"|",1:"")_ARDATA(409.851,SDI,.01,"E")
+58 ; 1 2 3 4 5 6
+59 SET STR=DFN_U_ARIEN_U_ARORIGDT_U_ARINST_U_ARINSTNM_U_ARTYPE
+60 ; 7 8 9 10 11 12 13
+61 SET STR=STR_U_ARCLIEN_U_ARCLNAME_U_ARUSER_U_ARUSRNM_U_ARPRIO_U_ARREQBY_U_ARPROV
+62 ; 14 15 16 17 18 19 20
+63 SET STR=STR_U_ARPROVNM_U_ARDAPTDT_U_ARCOMM_U_ARENPRI_U_ARMAR_U_ARMAI_U_ARMAN
+64 ; 21 22 23 24 25
+65 SET STR=STR_U_ARPC_U_ARDISPD_U_ARDISPU_U_ARDISPUN_U_ARSVCCON
+66 ; 26 27 28 29 30
+67 SET STR=STR_U_AREDT_U_SDMTRC_U_ARSTOP_U_ARSTOPN_U_ARASD
+68 ; 31 32 33 34 35 36
+69 SET STR=STR_U_ARMRTC_U_APPTYPE_U_SDPS_U_APPTPTRS_U_CHILDREN_U_SDPARENT
+70 ;# OF CALLS MADE AND DATE LAST LETTER SENT
+71 SET CALLLETTER=$$CALLET^SDECAR1A(DFN,ARIEN)
+72 SET STR=STR_U_CALLLETTER
+73 ;
+74 SET COUNT=$GET(COUNT)+1
+75 IF '$GET(JSONFLG)
SET ^TMP("SDECAR4",$JOB,COUNT)=STR_$CHAR(30)
QUIT
+76 ;
+77 SET APPT("ApptReq",COUNT,"PatientIEN")=DFN
+78 SET APPT("ApptReq",COUNT,"ApptReqIEN")=ARIEN
+79 SET APPT("ApptReq",COUNT,"CreateDateI")=ARORIGDT
+80 SET APPT("ApptReq",COUNT,"InstitutionI")=ARINST
+81 SET APPT("ApptReq",COUNT,"InstitutionE")=ARINSTNM
+82 SET APPT("ApptReq",COUNT,"RequestTypeI")=ARTYPE
+83 SET APPT("ApptReq",COUNT,"ReqSpecificClinicI")=ARCLIEN
+84 SET APPT("ApptReq",COUNT,"ReqSpecificClinicE")=ARCLNAME
+85 SET APPT("ApptReq",COUNT,"OriginatingUserI")=ARUSER
+86 SET APPT("ApptReq",COUNT,"OriginatingUserE")=ARUSRNM
+87 SET APPT("ApptReq",COUNT,"PriorityI")=ARPRIO
+88 SET APPT("ApptReq",COUNT,"RequestedByI")=ARREQBY
+89 SET APPT("ApptReq",COUNT,"ProviderI")=ARPROV
+90 SET APPT("ApptReq",COUNT,"ProviderE")=ARPROVNM
+91 SET APPT("ApptReq",COUNT,"CidPreferredDateOfApptI")=ARDAPTDT
+92 SET APPT("ApptReq",COUNT,"CommentsE")=ARCOMM
+93 DO BUILDPATCOMMENTS(.APPT,ARIEN,COUNT)
+94 SET APPT("ApptReq",COUNT,"EnrollmentPriorityE")=ARENPRI
+95 SET APPT("ApptReq",COUNT,"MultipleAppointmentRtcE")=ARMAR
+96 SET APPT("ApptReq",COUNT,"MultApptRtcIntervalE")=ARMAI
+97 SET APPT("ApptReq",COUNT,"MultApptNumberE")=ARMAN
+98 SET SUBCNT=0
+99 FOR I=1:1:$LENGTH(ARPC,"::")
Begin DoDot:1
+100 SET VAR=$PIECE(ARPC,"::",I)
+101 if VAR=""
QUIT
+102 SET SUBCNT=SUBCNT+1
+103 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"DateEnteredI")=$PIECE(VAR,"~~",1)
+104 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserI")=$PIECE(VAR,"~~",2)
+105 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserE")=$PIECE(VAR,"~~",3)
+106 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"ActionE")=$PIECE(VAR,"~~",4)
+107 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"PatientPhoneE")=$PIECE(VAR,"~~",5)
+108 QUIT
End DoDot:1
+109 IF '$DATA(APPT("ApptReq",COUNT,"PatientContact"))
SET APPT("ApptReq",COUNT,"PatientContact")=""
+110 ;
+111 SET APPT("ApptReq",COUNT,"DateDispositionedE")=ARDISPD
+112 SET APPT("ApptReq",COUNT,"DispositionedByI")=ARDISPU
+113 SET APPT("ApptReq",COUNT,"DispositionedByE")=ARDISPUN
+114 SET APPT("ApptReq",COUNT,"ServiceConnectedPriorityE")=ARSVCCON
+115 SET APPT("ApptReq",COUNT,"DateTimeEnteredE")=AREDT
+116 SET SUBCNT=0
+117 FOR I=1:1:$LENGTH(SDMTRC,"|")
Begin DoDot:1
+118 SET SUBCNT=SUBCNT+1
+119 if $PIECE(SDMTRC,"|",I)'=""
SET APPT("ApptReq",COUNT,"MRTCCalcPrefDates",SUBCNT,"Date")=$PIECE(SDMTRC,"|",I)
End DoDot:1
+120 IF '$DATA(APPT("ApptReq",COUNT,"MRTCCalcPrefDates"))
SET APPT("ApptReq",COUNT,"MRTCCalcPrefDates")=""
+121 ;
+122 SET APPT("ApptReq",COUNT,"ReqServiceSpecialtyI")=ARSTOP
+123 SET APPT("ApptReq",COUNT,"ReqServiceSpecialtyE")=ARSTOPN
+124 SET APPT("ApptReq",COUNT,"ScheduledDateOfApptI")=ARSDOA
+125 SET APPT("ApptReq",COUNT,"ApptClerkI")=ARCLERK
+126 SET APPT("ApptReq",COUNT,"ApptClerkE")=ARCLERKN
+127 SET APPT("ApptReq",COUNT,"DateApptMadeE")=ARDAM
+128 ;Count of nodes in 43.3 sub file
SET APPT("ApptReq",COUNT,"CountOfRTCs")=ARMRTC
+129 SET APPT("ApptReq",COUNT,"MrtcSequenceNumber")=$GET(MRTCSEQUENCENUM)
+130 SET APPT("ApptReq",COUNT,"ReqAppointmentTypeI")=APPTYPE
+131 SET APPT("ApptReq",COUNT,"PatientStatusE")=SDPS
+132 SET APPT("ApptReq",COUNT,"CanEditPid")=CANCHANGEPID
+133 SET SUBCNT=0
+134 FOR I=1:1:$LENGTH(APPTPTRS,"|")
Begin DoDot:1
+135 SET VAR=$PIECE(APPTPTRS,"|",I)
+136 SET SUBCNT=SUBCNT+1
+137 if VAR'=""
SET APPT("ApptReq",COUNT,"MultiAppointmentsI",SUBCNT,"IEN")=VAR
End DoDot:1
+138 IF '$DATA(APPT("ApptReq",COUNT,"MultiAppointmentsI"))
SET APPT("ApptReq",COUNT,"MultiAppointmentsI")=""
+139 ;
+140 SET SUBCNT=0
+141 FOR I=1:1:$LENGTH(CHILDREN,"|")
Begin DoDot:1
+142 SET VAR=$PIECE(CHILDREN,"|",I)
+143 SET SUBCNT=SUBCNT+1
+144 if VAR'=""
SET APPT("ApptReq",COUNT,"MultiApptRequestsChildI",SUBCNT,"ARIEN")=VAR
End DoDot:1
+145 IF '$DATA(APPT("ApptReq",COUNT,"MultiApptRequestsChildI"))
SET APPT("ApptReq",COUNT,"MultiApptRequestsChildI")=""
+146 ;
+147 SET APPT("ApptReq",COUNT,"ParentRequestI")=SDPARENT
+148 SET APPT("ApptReq",COUNT,"NumberOfCalls")=$PIECE(CALLLETTER,"^",1)
+149 SET APPT("ApptReq",COUNT,"NumberOfEmailContact")=$PIECE(CALLLETTER,U,3)
+150 SET APPT("ApptReq",COUNT,"NumberOfTextContact")=$PIECE(CALLLETTER,U,4)
+151 SET APPT("ApptReq",COUNT,"NumberOfSecureMessage")=$PIECE(CALLLETTER,U,5)
+152 SET APPT("ApptReq",COUNT,"DateOfLastLetterSent")=$PIECE(CALLLETTER,"^",2)
+153 QUIT
+154 ;
HDR ;
+1 NEW SDRTMP
+2 SET SDRTMP="T00030DFN^I00010IEN^D00030ORIGDT"
+3 ; 4 5 6 7 8
+4 SET SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030CLINIEN^T00030CLINNAME"
+5 ; 9 10 11 12 13 14
+6 SET SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
+7 ; 15 16 17
+8 SET SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030ENROLLMENT_PRIORITY"
+9 ; 18 19 20
+10 SET SDRTMP=SDRTMP_"^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL^T00010MULT APPT NUMBER"
+11 ; 21 22 23 24 25
+12 SET SDRTMP=SDRTMP_"^T00100PCONTACT^T00030ARDISPD^T00030ARDISPU^T00030ARDISPUN^T00030WLSVCCON"
+13 ; 26 27 28 29 30
+14 SET SDRTMP=SDRTMP_"^T00030DATE^T00030MTRCDATES^T00030STOPIEN^T00030STOPNAME^T00250APPT_SCHED_DATE"
+15 ; 31 32 33 34 35 36
+16 SET SDRTMP=SDRTMP_"^T00030MRTCCOUNT^T00030APPTYPE^T00030EESTAT^T00030APPTPTRS^T00250CHILDREN^T00030SDPARENT"
+17 SET SDRTMP=SDRTMP_"^T00030CPHONE^T00030CLET"
+18 SET @RET@(0)=SDRTMP_$CHAR(30)
+19 QUIT
+20 ;
+1 NEW SUBIEN,NUM,PATCMT
+2 SET SUBIEN=0
+3 SET PATCMT=""
+4 FOR
SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:1
+5 SET PATCMT=PATCMT_$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")_" "
End DoDot:1
+6 SET REQUEST("ApptReq",COUNT,"PatientComment")=PATCMT
+7 QUIT
+8 ;
BUILDJSON ;Convert to JSON
+1 SET RET=$GET(RET,"RET")
+2 DO ENCODE^SDESJSON(.APPT,.RET,.JSONERR)
+3 KILL ^TMP("SDECAR4",$JOB)
+4 QUIT
+5 ;
EXIT ; Any special logic needed for a successful completion
+1 NEW SDTMP,COUNT
+2 SET COUNT=$ORDER(^TMP("SDECAR4",$JOB,""),-1)
+3 ;No records to return
IF COUNT=""
SET ^TMP("SDECAR4",$JOB,1)=0
SET COUNT=1
+4 SET SDTMP=^TMP("SDECAR4",$JOB,COUNT)
+5 SET SDTMP=$PIECE(SDTMP,$CHAR(30),1)
+6 SET ^TMP("SDECAR4",$JOB,COUNT)=SDTMP_$CHAR(30,31)
+7 QUIT
