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

SDECAR4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ; Reference to ^DPT(DFN,0) in ICR #10035
  1. ;
  1. Q
  1. ;
  1. ; Get SDEC APPOINTMENT REQUEST for all entries in the user's Institution
  1. ; where the Current Status is not C(losed).
  1. ;
  1. ; This RPC differs from SDEC ARGET in that only appointment specific data is returned.
  1. ;
  1. ; The ARGETPAT and ARGETPATJSON entry points must be kept in sync when passing in
  1. ; new parameters
  1. ;
  1. GETREQBYTYPEVET(RET) ; SDES GET APPT REQ BY TYPE VET
  1. N ERRORS,APPT,CNT,ARIEN,ARDATA,FNUM
  1. ;
  1. S ARIEN=0,COUNT=0,FNUM=409.85,JSONFLG=1
  1. F S ARIEN=$O(^SDEC(409.85,"TYPE","VETERAN",ARIEN)) Q:'ARIEN!(COUNT=200) D
  1. .I $$GET1^DIQ(409.85,ARIEN,23,"I")="C" Q
  1. .D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
  1. .D BUILDREC
  1. I '$D(APPT) S APPT("Appt",1)=""
  1. ;
  1. D BUILDJSON
  1. Q
  1. ;
  1. ARGETPATJSON(RET,DFN) ;Entry point to return JSON
  1. ; SDEC GET PATIENT APPT REQ JSON
  1. ; ARGETPATJSON^SDEC1
  1. N FILT,APPT,ERR,JSONFLG,JSONERR,COPUNT
  1. S JSONFLG=1,JSONERR=""
  1. D JSONEP
  1. I '$D(APPT("Error")),'$D(APPT("ApptReq")) S APPT("ApptReq")="" ;No appt req for this patient
  1. D BUILDJSON
  1. Q
  1. ;
  1. ARGETIEN(RET,ARIEN) ;Appt Req GET for speific appt IEN
  1. ; SDEC GET PAT APPT REQ BY IEN
  1. ; ARGETIEN^SDEC1
  1. N FILT,APPT,COUNT,FNUM,DFN,ARDATA,JSONFLG,JSONERR
  1. S JSONFLG=1,JSONERR=""
  1. D INIT
  1. S ARIEN=$G(ARIEN)
  1. I ARIEN="" D ERRLOG^SDESJSON(.APPT,3)
  1. S FNUM=$$FNUM^SDECAR
  1. I ARIEN'="",('$D(^SDEC(409.85,ARIEN))) S ARIEN="" D ERRLOG^SDESJSON(.APPT,4)
  1. I ARIEN D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG") ;Get data for all field for this appt req
  1. I $D(ARDATA)>1 D BUILDREC
  1. D BUILDJSON
  1. Q
  1. ;
  1. ARGETPAT(RET,DFN) ;Appt Req GET.
  1. ; SDEC PATIENT APP REQ GET
  1. ; ARGETPAT^SDEC1
  1. ;
  1. ; RPC Description:
  1. ; Get appointment request details. This is similar to SDEC ARGET but it
  1. ; only returns Appt request specific data.
  1. ;
  1. ; INPUT
  1. ; DFN : [R] Patient ID pointer to PATIENT File (#2)
  1. ;
  1. ; OUTPUT
  1. ; See RPC file
  1. N FILT,APPT,COUNT
  1. ;
  1. JSONEP ;
  1. D INIT
  1. D:'$G(JSONFLG) HDR
  1. I $$VALIDATE()=0 D:'$G(JSONFLG) EXIT Q
  1. D PROCESS
  1. D:'$G(JSONFLG) EXIT
  1. Q
  1. ;
  1. INIT ; Initalize any process specific variables
  1. S COUNT=0
  1. I '$G(JSONFLG) S RET="^TMP(""SDECAR4"","_$J_")" K ^TMP("SDECAR4",$J)
  1. S FILT("SKIP STAT","C")="" ;Exclude closed requests
  1. S FILT("INDEX")="DFN^"_$G(DFN)
  1. Q
  1. ;
  1. VALIDATE() ;Validata input params
  1. N VALID,DFN,COUNT
  1. S VALID=1 ;Assume all is good
  1. ;
  1. S DFN=$P(FILT("INDEX"),"^",2)
  1. I +DFN<1 S VALID=0 D ERRLOG^SDESJSON(.APPT,1)
  1. I +DFN>0,'$D(^DPT(DFN,0)) S VALID=0 D ERRLOG^SDESJSON(.APPT,2) ;This is a valid DFN
  1. I 'VALID,'$G(JSONFLG) D ERR1^SDECERR(-1,"Invalid Patient ID.",.COUNT,.RET)
  1. ;
  1. Q VALID
  1. ;
  1. PROCESS ; Loop over primary index
  1. N ARIEN,FNUM,COUNT
  1. S FNUM=$$FNUM^SDECAR,COUNT=0
  1. ;
  1. S ARIEN=0
  1. F S ARIEN=$O(^SDEC(409.85,"B",+DFN,ARIEN)) Q:ARIEN'>0 D ONEPAT
  1. Q
  1. ;
  1. ONEPAT ; Process one patient
  1. N ARDATA,ARMSG
  1. I $$VALIDIEN()=0 Q ;Is this appt request one that we are looking for
  1. D GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG") ;Get data for all field for this appt req
  1. D:$D(ARDATA)>1 BUILDREC
  1. Q
  1. ;
  1. VALIDIEN() ;Validate the appointment request
  1. N VALID,ARSTAT
  1. S VALID=1 ;Assume this is a good record
  1. ; Is status for this request on the skip list
  1. I $D(FILT("SKIP STAT")) D
  1. .S ARSTAT=$$GET1^DIQ(409.85,ARIEN_",",23,"I")
  1. .I ARSTAT'="",$D(FILT("SKIP STAT",ARSTAT)) S VALID=0
  1. I VALID,$$GET1^DIQ(409.85,ARIEN_",",.01,"I")="" S VALID=0 ;Missing DFN
  1. Q VALID
  1. ;
  1. BUILDREC ; Build an output record
  1. N ARSTAT,DFN,SDPS,SDCLY,ARORIGDT,SDI,STR,SDCL,CALLLETTER,I,X,VAR,SUBCNT,SDECLET,SDECALL
  1. N ARINST,ARINSTNM,ARTYPE,VAOSGUID,ARSTOP,ARSTOPN,ARCLIEN,ARCLNAME,APPTYPE,ARUSER,ARUSRNM
  1. N AREDT,ARPRIO,ARENPRI,ARREQBY,ARPROV,ARPROVNM,ARSDOA,ARSDOA,ARDAM,ARCLERK,ARCLERKN,ARASD,ARSDOA
  1. N ARCLERK,ARCLERKN,ARDAM,ARSVCCON,ARDAPTDT,ARCOMM,ARMAR,ARMAI,ARMAN,ARPC,ARDISPD,ARDISPU,ARDISPUN
  1. N APPTPTRS,CHILDREN,ARMRTC,SDPARENT,SDMTRC,CANCHANGEPID,MRTCSEQUENCENUM
  1. S ARORIGDT=ARDATA(FNUM,ARIEN_",",1,"I")
  1. S ARSTAT=ARDATA(FNUM,ARIEN_",",23,"I")
  1. S DFN=ARDATA(FNUM,ARIEN_",",.01,"I")
  1. S SDPS=ARDATA(FNUM,ARIEN_",",.02,"E")
  1. S SDCL=ARDATA(FNUM,ARIEN_",",8,"I")
  1. S ARINST=ARDATA(FNUM,ARIEN_",",2,"I")
  1. S ARINSTNM=ARDATA(FNUM,ARIEN_",",2,"E")
  1. S ARTYPE=ARDATA(FNUM,ARIEN_",",4,"I")
  1. S ARCLIEN=ARDATA(FNUM,ARIEN_",",8,"I")
  1. S ARSTOP=ARDATA(FNUM,ARIEN_",",8.5,"I")
  1. S ARSTOPN=ARDATA(FNUM,ARIEN_",",8.5,"E")
  1. S ARCLNAME=ARDATA(FNUM,ARIEN_",",8,"E")
  1. S APPTYPE=ARDATA(FNUM,ARIEN_",",8.7,"I")
  1. S ARUSER=ARDATA(FNUM,ARIEN_",",9,"I")
  1. S ARUSRNM=ARDATA(FNUM,ARIEN_",",9,"E")
  1. S AREDT=$G(ARDATA(FNUM,ARIEN_",",9.5,"E")) ;53
  1. S ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
  1. S ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E") ;msc/sat
  1. S ARREQBY=ARDATA(FNUM,ARIEN_",",11,"I")
  1. S ARPROV=ARDATA(FNUM,ARIEN_",",12,"I")
  1. S ARPROVNM=ARDATA(FNUM,ARIEN_",",12,"E")
  1. S ARSDOA=ARDATA(FNUM,ARIEN_",",13,"I") ;scheduled date of appt
  1. ; Change date/time conversion so midnight is handled properly. wtc/pwc 694 1/7/2020
  1. ;
  1. S ARSDOA=$$FMTONET^SDECDATE(ARSDOA,"N") ;
  1. S ARDAM=ARDATA(FNUM,ARIEN_",",13.1,"E") ;date appt. made
  1. S ARCLERK=ARDATA(FNUM,ARIEN_",",13.7,"I") ;appt clerk ien
  1. S ARCLERKN=ARDATA(FNUM,ARIEN_",",13.7,"E") ;appt clerk name
  1. S ARASD=""
  1. S:ARSDOA'="" $P(ARASD,"~~",1)=ARSDOA
  1. S:ARCLERK'="" $P(ARASD,"~~",12)=ARCLERK
  1. S:ARCLERKN'="" $P(ARASD,"~~",13)=ARCLERKN
  1. S:ARDAM'="" $P(ARASD,"~~",17)=ARDAM
  1. S ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
  1. S ARDAPTDT=ARDATA(FNUM,ARIEN_",",22,"I")
  1. S ARCOMM=ARDATA(FNUM,ARIEN_",",25,"E")
  1. S ARMAR=ARDATA(409.85,ARIEN_",",41,"E")
  1. S ARMAI=ARDATA(409.85,ARIEN_",",42,"E")
  1. S ARMAN=ARDATA(409.85,ARIEN_",",43,"E")
  1. S ARPC=$$WLPC^SDECAR1A(.ARDATA,ARIEN)
  1. S ARDISPD=ARDATA(FNUM,ARIEN_",",19,"E")
  1. S ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
  1. S ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
  1. S APPTPTRS=$$GETAPPTS^SDECAR1A(ARIEN)
  1. S CHILDREN=$$CHILDREN^SDECAR1A(ARIEN)
  1. S ARMRTC=$$MRTC^SDECAR(ARIEN)
  1. S SDPARENT=ARDATA(FNUM,ARIEN_",",43.8,"I")
  1. S MRTCSEQUENCENUM=ARDATA(FNUM,ARIEN_",",43.1,"I")
  1. S CANCHANGEPID=ARDATA(409.85,ARIEN_",",49,"I")
  1. ;Build string of RTC dates
  1. S (SDI,SDMTRC)=""
  1. F S SDI=$O(ARDATA(409.851,SDI)) Q:SDI="" S SDMTRC=$S(SDMTRC'="":SDMTRC_"|",1:"")_ARDATA(409.851,SDI,.01,"E")
  1. ; 1 2 3 4 5 6
  1. S STR=DFN_U_ARIEN_U_ARORIGDT_U_ARINST_U_ARINSTNM_U_ARTYPE
  1. ; 7 8 9 10 11 12 13
  1. S STR=STR_U_ARCLIEN_U_ARCLNAME_U_ARUSER_U_ARUSRNM_U_ARPRIO_U_ARREQBY_U_ARPROV
  1. ; 14 15 16 17 18 19 20
  1. S STR=STR_U_ARPROVNM_U_ARDAPTDT_U_ARCOMM_U_ARENPRI_U_ARMAR_U_ARMAI_U_ARMAN
  1. ; 21 22 23 24 25
  1. S STR=STR_U_ARPC_U_ARDISPD_U_ARDISPU_U_ARDISPUN_U_ARSVCCON
  1. ; 26 27 28 29 30
  1. S STR=STR_U_AREDT_U_SDMTRC_U_ARSTOP_U_ARSTOPN_U_ARASD
  1. ; 31 32 33 34 35 36
  1. S STR=STR_U_ARMRTC_U_APPTYPE_U_SDPS_U_APPTPTRS_U_CHILDREN_U_SDPARENT
  1. ;# OF CALLS MADE AND DATE LAST LETTER SENT
  1. S CALLLETTER=$$CALLET^SDECAR1A(DFN,ARIEN)
  1. S STR=STR_U_CALLLETTER
  1. ;
  1. S COUNT=$G(COUNT)+1
  1. I '$G(JSONFLG) S ^TMP("SDECAR4",$J,COUNT)=STR_$C(30) Q
  1. ;
  1. S APPT("ApptReq",COUNT,"PatientIEN")=DFN
  1. S APPT("ApptReq",COUNT,"ApptReqIEN")=ARIEN
  1. S APPT("ApptReq",COUNT,"CreateDateI")=ARORIGDT
  1. S APPT("ApptReq",COUNT,"InstitutionI")=ARINST
  1. S APPT("ApptReq",COUNT,"InstitutionE")=ARINSTNM
  1. S APPT("ApptReq",COUNT,"RequestTypeI")=ARTYPE
  1. S APPT("ApptReq",COUNT,"ReqSpecificClinicI")=ARCLIEN
  1. S APPT("ApptReq",COUNT,"ReqSpecificClinicE")=ARCLNAME
  1. S APPT("ApptReq",COUNT,"OriginatingUserI")=ARUSER
  1. S APPT("ApptReq",COUNT,"OriginatingUserE")=ARUSRNM
  1. S APPT("ApptReq",COUNT,"PriorityI")=ARPRIO
  1. S APPT("ApptReq",COUNT,"RequestedByI")=ARREQBY
  1. S APPT("ApptReq",COUNT,"ProviderI")=ARPROV
  1. S APPT("ApptReq",COUNT,"ProviderE")=ARPROVNM
  1. S APPT("ApptReq",COUNT,"CidPreferredDateOfApptI")=ARDAPTDT
  1. S APPT("ApptReq",COUNT,"CommentsE")=ARCOMM
  1. D BUILDPATCOMMENTS(.APPT,ARIEN,COUNT)
  1. S APPT("ApptReq",COUNT,"EnrollmentPriorityE")=ARENPRI
  1. S APPT("ApptReq",COUNT,"MultipleAppointmentRtcE")=ARMAR
  1. S APPT("ApptReq",COUNT,"MultApptRtcIntervalE")=ARMAI
  1. S APPT("ApptReq",COUNT,"MultApptNumberE")=ARMAN
  1. S SUBCNT=0
  1. F I=1:1:$L(ARPC,"::") D
  1. .S VAR=$P(ARPC,"::",I)
  1. .Q:VAR=""
  1. .S SUBCNT=SUBCNT+1
  1. .S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"DateEnteredI")=$P(VAR,"~~",1)
  1. .S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserI")=$P(VAR,"~~",2)
  1. .S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserE")=$P(VAR,"~~",3)
  1. .S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"ActionE")=$P(VAR,"~~",4)
  1. .S APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"PatientPhoneE")=$P(VAR,"~~",5)
  1. .Q
  1. I '$D(APPT("ApptReq",COUNT,"PatientContact")) S APPT("ApptReq",COUNT,"PatientContact")=""
  1. ;
  1. S APPT("ApptReq",COUNT,"DateDispositionedE")=ARDISPD
  1. S APPT("ApptReq",COUNT,"DispositionedByI")=ARDISPU
  1. S APPT("ApptReq",COUNT,"DispositionedByE")=ARDISPUN
  1. S APPT("ApptReq",COUNT,"ServiceConnectedPriorityE")=ARSVCCON
  1. S APPT("ApptReq",COUNT,"DateTimeEnteredE")=AREDT
  1. S SUBCNT=0
  1. F I=1:1:$L(SDMTRC,"|") D
  1. .S SUBCNT=SUBCNT+1
  1. .S:$P(SDMTRC,"|",I)'="" APPT("ApptReq",COUNT,"MRTCCalcPrefDates",SUBCNT,"Date")=$P(SDMTRC,"|",I)
  1. I '$D(APPT("ApptReq",COUNT,"MRTCCalcPrefDates")) S APPT("ApptReq",COUNT,"MRTCCalcPrefDates")=""
  1. ;
  1. S APPT("ApptReq",COUNT,"ReqServiceSpecialtyI")=ARSTOP
  1. S APPT("ApptReq",COUNT,"ReqServiceSpecialtyE")=ARSTOPN
  1. S APPT("ApptReq",COUNT,"ScheduledDateOfApptI")=ARSDOA
  1. S APPT("ApptReq",COUNT,"ApptClerkI")=ARCLERK
  1. S APPT("ApptReq",COUNT,"ApptClerkE")=ARCLERKN
  1. S APPT("ApptReq",COUNT,"DateApptMadeE")=ARDAM
  1. S APPT("ApptReq",COUNT,"CountOfRTCs")=ARMRTC ;Count of nodes in 43.3 sub file
  1. S APPT("ApptReq",COUNT,"MrtcSequenceNumber")=$G(MRTCSEQUENCENUM)
  1. S APPT("ApptReq",COUNT,"ReqAppointmentTypeI")=APPTYPE
  1. S APPT("ApptReq",COUNT,"PatientStatusE")=SDPS
  1. S APPT("ApptReq",COUNT,"CanEditPid")=CANCHANGEPID
  1. S SUBCNT=0
  1. F I=1:1:$L(APPTPTRS,"|") D
  1. .S VAR=$P(APPTPTRS,"|",I)
  1. .S SUBCNT=SUBCNT+1
  1. .S:VAR'="" APPT("ApptReq",COUNT,"MultiAppointmentsI",SUBCNT,"IEN")=VAR
  1. I '$D(APPT("ApptReq",COUNT,"MultiAppointmentsI")) S APPT("ApptReq",COUNT,"MultiAppointmentsI")=""
  1. ;
  1. S SUBCNT=0
  1. F I=1:1:$L(CHILDREN,"|") D
  1. .S VAR=$P(CHILDREN,"|",I)
  1. .S SUBCNT=SUBCNT+1
  1. .S:VAR'="" APPT("ApptReq",COUNT,"MultiApptRequestsChildI",SUBCNT,"ARIEN")=VAR
  1. I '$D(APPT("ApptReq",COUNT,"MultiApptRequestsChildI")) S APPT("ApptReq",COUNT,"MultiApptRequestsChildI")=""
  1. ;
  1. S APPT("ApptReq",COUNT,"ParentRequestI")=SDPARENT
  1. S APPT("ApptReq",COUNT,"NumberOfCalls")=$P(CALLLETTER,"^",1)
  1. S APPT("ApptReq",COUNT,"NumberOfEmailContact")=$P(CALLLETTER,U,3)
  1. S APPT("ApptReq",COUNT,"NumberOfTextContact")=$P(CALLLETTER,U,4)
  1. S APPT("ApptReq",COUNT,"NumberOfSecureMessage")=$P(CALLLETTER,U,5)
  1. S APPT("ApptReq",COUNT,"DateOfLastLetterSent")=$P(CALLLETTER,"^",2)
  1. Q
  1. ;
  1. HDR ;
  1. N SDRTMP
  1. S SDRTMP="T00030DFN^I00010IEN^D00030ORIGDT"
  1. ; 4 5 6 7 8
  1. S SDRTMP=SDRTMP_"^T00030INSTIEN^T00030INSTNAME^T00030TYPE^T00030CLINIEN^T00030CLINNAME"
  1. ; 9 10 11 12 13 14
  1. S SDRTMP=SDRTMP_"^T00030USERIEN^T00030USERNAME^T00030PRIO^T00030REQBY^T00030PROVIEN^T00030PROVNAME"
  1. ; 15 16 17
  1. S SDRTMP=SDRTMP_"^T00030DAPTDT^T00250COMM^T00030ENROLLMENT_PRIORITY"
  1. ; 18 19 20
  1. S SDRTMP=SDRTMP_"^T00010MULTIPLE APPOINTMENT RTC^T00010MULT APPT RTC INTERVAL^T00010MULT APPT NUMBER"
  1. ; 21 22 23 24 25
  1. S SDRTMP=SDRTMP_"^T00100PCONTACT^T00030ARDISPD^T00030ARDISPU^T00030ARDISPUN^T00030WLSVCCON"
  1. ; 26 27 28 29 30
  1. S SDRTMP=SDRTMP_"^T00030DATE^T00030MTRCDATES^T00030STOPIEN^T00030STOPNAME^T00250APPT_SCHED_DATE"
  1. ; 31 32 33 34 35 36
  1. S SDRTMP=SDRTMP_"^T00030MRTCCOUNT^T00030APPTYPE^T00030EESTAT^T00030APPTPTRS^T00250CHILDREN^T00030SDPARENT"
  1. S SDRTMP=SDRTMP_"^T00030CPHONE^T00030CLET"
  1. S @RET@(0)=SDRTMP_$C(30)
  1. Q
  1. ;
  1. BUILDPATCOMMENTS(REQUEST,REQUESTIEN,COUNT) ; patient comments
  1. N SUBIEN,NUM,PATCMT
  1. S SUBIEN=0
  1. S PATCMT=""
  1. F S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN)) Q:'SUBIEN D
  1. .S PATCMT=PATCMT_$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")_" "
  1. S REQUEST("ApptReq",COUNT,"PatientComment")=PATCMT
  1. Q
  1. ;
  1. BUILDJSON ;Convert to JSON
  1. S RET=$G(RET,"RET")
  1. D ENCODE^SDESJSON(.APPT,.RET,.JSONERR)
  1. K ^TMP("SDECAR4",$J)
  1. Q
  1. ;
  1. EXIT ; Any special logic needed for a successful completion
  1. N SDTMP,COUNT
  1. S COUNT=$O(^TMP("SDECAR4",$J,""),-1)
  1. I COUNT="" S ^TMP("SDECAR4",$J,1)=0,COUNT=1 ;No records to return
  1. S SDTMP=^TMP("SDECAR4",$J,COUNT)
  1. S SDTMP=$P(SDTMP,$C(30),1)
  1. S ^TMP("SDECAR4",$J,COUNT)=SDTMP_$C(30,31)
  1. Q