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

SDESARGET.m

Go to the documentation of this file.
  1. SDESARGET ;ALB/BLB,MGD,KML,LAB - VISTA SCHEDULING RPCS ;March 23, 2022
  1. ;;5.3;Scheduling;**794,799,805,809,813**;Aug 13, 1993;Build 6
  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. ; VSE-2500 - dates and date/times that get returned will be in ISO8601 format (e.g., CCYY-MM-DD, CCYY-MM-DDTHH:MM-timezone offset)
  1. ; since the data is retrieved from file 409.85, any date/times that are returned will be system time
  1. ;
  1. ARGETPATJSON(RET,DFN,SDEAS) ;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. S SDEAS=$G(SDEAS,"")
  1. I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
  1. I +SDEAS=-1 D ERRLOG^SDESJSON(.APPT,142),BUILDJSON Q
  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. ARGETIENJSON(RET,ARIEN,SDEAS) ;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 SDEAS=$G(SDEAS,"")
  1. I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
  1. I +SDEAS=-1 D ERRLOG^SDESJSON(.APPT,142),BUILDJSON Q
  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(.ARDATA)
  1. D BUILDJSON
  1. Q
  1. ;
  1. JSONEP ;
  1. D INIT
  1. I $$VALIDATE()=0 D:'$G(JSONFLG) EXIT Q
  1. D PROCESS
  1. Q
  1. ;
  1. INIT ; Initalize any process specific variables
  1. S COUNT=0
  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(.ARDATA)
  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(ARDATA) ; Build an output record
  1. ; Input - ARDATA = array containing data from SDEC APPT REQUEST file (#409.85)
  1. N 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,ARCLERK,ARCLERKN,ARSDOA
  1. N ARCLERK,ARCLERKN,ARDAM,ARSVCCON,ARDAPTDT,ARCOMM,ARMAR,ARMAI,ARMAN,ARPC,ARDISPD,ARDISPU,ARDISPUN
  1. N APPTPTRS,CHILDREN,ARMRTC,SDPARENT,SDMRTC,AREAS
  1. N I,L,ZZ
  1. S ARORIGDT=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",1,"I")) ;vse-2500 CREATE DATE
  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,"I")) ;DATE/TIME ENTERED
  1. S ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
  1. S ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E")
  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=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",13,"I")) ;vse-2500 SCHEDULED DATE OF APPT
  1. S ARDAM=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",13.1,"I")) ;vse-2500 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 ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
  1. S ARDAPTDT=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",22,"I")) ;vse-2500 CID/PREFERRED DATE OF APPT
  1. ;VSE-1218; start process mult lines of comments
  1. S ARCOMM=ARDATA(FNUM,ARIEN_",",25,"I")
  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(.ARDATA,ARIEN)
  1. S ARDISPD=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",19,"I")) ;vse-2500 DATE DISPOSITIONED
  1. S ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
  1. S ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
  1. S AREAS=ARDATA(FNUM,ARIEN_",",100,"E") ; EAS tracking number added with patch SD*5.3*799
  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. ;Build string of RTC dates
  1. S (SDI,SDMRTC)=""
  1. F S SDI=$O(ARDATA(409.851,SDI)) Q:SDI="" D
  1. .S SDMRTC=$S(SDMRTC'="":SDMRTC_"|",1:"")_$$FMTISO^SDAMUTDT(ARDATA(409.851,SDI,.01,"I")) ;vse-2500 MRTC CALC PREF DATES
  1. ;# OF CALLS MADE AND DATE LAST LETTER SENT
  1. S CALLLETTER=$$CALLET^SDECAR1A(DFN,ARIEN)
  1. ;
  1. S COUNT=$G(COUNT)+1
  1. ;
  1. S APPT("ApptReq",COUNT,"PatientIEN")=DFN
  1. S APPT("ApptReq",COUNT,"ApptReqIEN")=ARIEN
  1. S APPT("ApptReq",COUNT,"CreateDateE")=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,"CidPreferredDateOfApptE")=ARDAPTDT
  1. S APPT("ApptReq",COUNT,"CommentsE")=ARCOMM
  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 APPT("ApptReq",COUNT,"EASTrackingNumberE")=AREAS
  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,"DateEnteredE")=$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")=$$FMTISO^SDAMUTDT(AREDT) ;vse-2500
  1. S SUBCNT=0
  1. F I=1:1:$L(SDMRTC,"|") D
  1. .S:$P(SDMRTC,"|",I)'="" APPT("ApptReq",COUNT,"MRTCCalcPrefDates",$I(SUBCNT),"Date")=$P(SDMRTC,"|",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,"ScheduledDateOfApptE")=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,"ReqAppointmentTypeI")=APPTYPE
  1. S APPT("ApptReq",COUNT,"PatientStatusE")=SDPS
  1. S SUBCNT=0
  1. F I=1:1:$L(APPTPTRS,"|") D
  1. .S VAR=$P(APPTPTRS,"|",I)
  1. .S:VAR'="" APPT("ApptReq",COUNT,"MultiAppointmentsI",$I(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:VAR'="" APPT("ApptReq",COUNT,"MultiApptRequestsChildI",$I(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,"DateOfLastLetterSent")=$P(CALLLETTER,"^",2)
  1. S APPT("ApptReq",COUNT,"NumberOfEmailContact")=$P(CALLLETTER,"^",3)
  1. S APPT("ApptReq",COUNT,"NumberOfTextContact")=$P(CALLLETTER,"^",4)
  1. S APPT("ApptReq",COUNT,"NumberOfSecureMessage")=$P(CALLLETTER,"^",5)
  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. WLPC(ARDATA,ASDIEN) ;
  1. N PC,PC1,PCIEN
  1. S PC=""
  1. S PCIEN="" F S PCIEN=$O(ARDATA(409.8544,PCIEN)) Q:PCIEN="" D
  1. .Q:$P(PCIEN,",",2)'=ASDIEN
  1. .S PC1=""
  1. .S $P(PC1,"~~",1)=$$FMTISO^SDAMUTDT(ARDATA(409.8544,PCIEN,.01,"I")) ;vse-2500 DATE ENTERED
  1. .S $P(PC1,"~~",2)=ARDATA(409.8544,PCIEN,2,"I") ;PC ENTERED BY USER IEN
  1. .S $P(PC1,"~~",3)=ARDATA(409.8544,PCIEN,2,"E") ;PC ENTERED BY USER NAME
  1. .S $P(PC1,"~~",4)=ARDATA(409.8544,PCIEN,3,"E") ;ACTION
  1. .S $P(PC1,"~~",5)=ARDATA(409.8544,PCIEN,4,"E") ;PATIENT PHONE
  1. .S PC=$S(PC'="":PC_"::",1:"")_PC1
  1. Q PC
  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