- 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 Feb 19, 2025@00:18:13 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