SDESARGET ;ALB/BLB,MGD,KML,LAB - VISTA SCHEDULING RPCS ;March 23, 2022
;;5.3;Scheduling;**794,799,805,809,813**;Aug 13, 1993;Build 6
;;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
;
; 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)
; since the data is retrieved from file 409.85, any date/times that are returned will be system time
;
ARGETPATJSON(RET,DFN,SDEAS) ;Entry point to return JSON
; SDEC GET PATIENT APPT REQ JSON
; ARGETPATJSON^SDEC1
N FILT,APPT,ERR,JSONFLG,JSONERR,COPUNT
S JSONFLG=1,JSONERR=""
S SDEAS=$G(SDEAS,"")
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
I +SDEAS=-1 D ERRLOG^SDESJSON(.APPT,142),BUILDJSON Q
D JSONEP
I '$D(APPT("Error")),'$D(APPT("ApptReq")) S APPT("ApptReq")="" ;No appt req for this patient
D BUILDJSON
Q
;
ARGETIENJSON(RET,ARIEN,SDEAS) ;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 SDEAS=$G(SDEAS,"")
I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
I +SDEAS=-1 D ERRLOG^SDESJSON(.APPT,142),BUILDJSON Q
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(.ARDATA)
D BUILDJSON
Q
;
JSONEP ;
D INIT
I $$VALIDATE()=0 D:'$G(JSONFLG) EXIT Q
D PROCESS
Q
;
INIT ; Initalize any process specific variables
S COUNT=0
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(.ARDATA)
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(ARDATA) ; Build an output record
; Input - ARDATA = array containing data from SDEC APPT REQUEST file (#409.85)
N 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,ARCLERK,ARCLERKN,ARSDOA
N ARCLERK,ARCLERKN,ARDAM,ARSVCCON,ARDAPTDT,ARCOMM,ARMAR,ARMAI,ARMAN,ARPC,ARDISPD,ARDISPU,ARDISPUN
N APPTPTRS,CHILDREN,ARMRTC,SDPARENT,SDMRTC,AREAS
N I,L,ZZ
S ARORIGDT=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",1,"I")) ;vse-2500 CREATE DATE
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,"I")) ;DATE/TIME ENTERED
S ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
S ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E")
S ARREQBY=ARDATA(FNUM,ARIEN_",",11,"I")
S ARPROV=ARDATA(FNUM,ARIEN_",",12,"I")
S ARPROVNM=ARDATA(FNUM,ARIEN_",",12,"E")
S ARSDOA=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",13,"I")) ;vse-2500 SCHEDULED DATE OF APPT
S ARDAM=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",13.1,"I")) ;vse-2500 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 ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
S ARDAPTDT=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",22,"I")) ;vse-2500 CID/PREFERRED DATE OF APPT
;VSE-1218; start process mult lines of comments
S ARCOMM=ARDATA(FNUM,ARIEN_",",25,"I")
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(.ARDATA,ARIEN)
S ARDISPD=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",19,"I")) ;vse-2500 DATE DISPOSITIONED
S ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
S ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
S AREAS=ARDATA(FNUM,ARIEN_",",100,"E") ; EAS tracking number added with patch SD*5.3*799
S APPTPTRS=$$GETAPPTS^SDECAR1A(ARIEN)
S CHILDREN=$$CHILDREN^SDECAR1A(ARIEN)
S ARMRTC=$$MRTC^SDECAR(ARIEN)
S SDPARENT=ARDATA(FNUM,ARIEN_",",43.8,"I")
;Build string of RTC dates
S (SDI,SDMRTC)=""
F S SDI=$O(ARDATA(409.851,SDI)) Q:SDI="" D
.S SDMRTC=$S(SDMRTC'="":SDMRTC_"|",1:"")_$$FMTISO^SDAMUTDT(ARDATA(409.851,SDI,.01,"I")) ;vse-2500 MRTC CALC PREF DATES
;# OF CALLS MADE AND DATE LAST LETTER SENT
S CALLLETTER=$$CALLET^SDECAR1A(DFN,ARIEN)
;
S COUNT=$G(COUNT)+1
;
S APPT("ApptReq",COUNT,"PatientIEN")=DFN
S APPT("ApptReq",COUNT,"ApptReqIEN")=ARIEN
S APPT("ApptReq",COUNT,"CreateDateE")=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,"CidPreferredDateOfApptE")=ARDAPTDT
S APPT("ApptReq",COUNT,"CommentsE")=ARCOMM
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 APPT("ApptReq",COUNT,"EASTrackingNumberE")=AREAS
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,"DateEnteredE")=$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")=$$FMTISO^SDAMUTDT(AREDT) ;vse-2500
S SUBCNT=0
F I=1:1:$L(SDMRTC,"|") D
.S:$P(SDMRTC,"|",I)'="" APPT("ApptReq",COUNT,"MRTCCalcPrefDates",$I(SUBCNT),"Date")=$P(SDMRTC,"|",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,"ScheduledDateOfApptE")=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,"ReqAppointmentTypeI")=APPTYPE
S APPT("ApptReq",COUNT,"PatientStatusE")=SDPS
S SUBCNT=0
F I=1:1:$L(APPTPTRS,"|") D
.S VAR=$P(APPTPTRS,"|",I)
.S:VAR'="" APPT("ApptReq",COUNT,"MultiAppointmentsI",$I(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:VAR'="" APPT("ApptReq",COUNT,"MultiApptRequestsChildI",$I(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,"DateOfLastLetterSent")=$P(CALLLETTER,"^",2)
S APPT("ApptReq",COUNT,"NumberOfEmailContact")=$P(CALLLETTER,"^",3)
S APPT("ApptReq",COUNT,"NumberOfTextContact")=$P(CALLLETTER,"^",4)
S APPT("ApptReq",COUNT,"NumberOfSecureMessage")=$P(CALLLETTER,"^",5)
Q
;
BUILDJSON ;Convert to JSON
S RET=$G(RET,"RET")
D ENCODE^SDESJSON(.APPT,.RET,.JSONERR)
K ^TMP("SDECAR4",$J)
Q
;
WLPC(ARDATA,ASDIEN) ;
N PC,PC1,PCIEN
S PC=""
S PCIEN="" F S PCIEN=$O(ARDATA(409.8544,PCIEN)) Q:PCIEN="" D
.Q:$P(PCIEN,",",2)'=ASDIEN
.S PC1=""
.S $P(PC1,"~~",1)=$$FMTISO^SDAMUTDT(ARDATA(409.8544,PCIEN,.01,"I")) ;vse-2500 DATE ENTERED
.S $P(PC1,"~~",2)=ARDATA(409.8544,PCIEN,2,"I") ;PC ENTERED BY USER IEN
.S $P(PC1,"~~",3)=ARDATA(409.8544,PCIEN,2,"E") ;PC ENTERED BY USER NAME
.S $P(PC1,"~~",4)=ARDATA(409.8544,PCIEN,3,"E") ;ACTION
.S $P(PC1,"~~",5)=ARDATA(409.8544,PCIEN,4,"E") ;PATIENT PHONE
.S PC=$S(PC'="":PC_"::",1:"")_PC1
Q PC
;
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[HSDESARGET 10904 printed Dec 13, 2024@02:55:48 Page 2
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
+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 ;
+15 ; 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)
+16 ; since the data is retrieved from file 409.85, any date/times that are returned will be system time
+17 ;
ARGETPATJSON(RET,DFN,SDEAS) ;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 SET SDEAS=$GET(SDEAS,"")
+6 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+7 IF +SDEAS=-1
DO ERRLOG^SDESJSON(.APPT,142)
DO BUILDJSON
QUIT
+8 DO JSONEP
+9 ;No appt req for this patient
IF '$DATA(APPT("Error"))
IF '$DATA(APPT("ApptReq"))
SET APPT("ApptReq")=""
+10 DO BUILDJSON
+11 QUIT
+12 ;
ARGETIENJSON(RET,ARIEN,SDEAS) ;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 SDEAS=$GET(SDEAS,"")
+9 IF $LENGTH(SDEAS)
SET SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
+10 IF +SDEAS=-1
DO ERRLOG^SDESJSON(.APPT,142)
DO BUILDJSON
QUIT
+11 SET FNUM=$$FNUM^SDECAR
+12 IF ARIEN'=""
IF ('$DATA(^SDEC(409.85,ARIEN)))
SET ARIEN=""
DO ERRLOG^SDESJSON(.APPT,4)
+13 ;Get data for all field for this appt req
IF ARIEN
DO GETS^DIQ(FNUM,ARIEN,"**","IE","ARDATA","ARMSG")
+14 IF $DATA(ARDATA)>1
DO BUILDREC(.ARDATA)
+15 DO BUILDJSON
+16 QUIT
+17 ;
JSONEP ;
+1 DO INIT
+2 IF $$VALIDATE()=0
if '$GET(JSONFLG)
DO EXIT
QUIT
+3 DO PROCESS
+4 QUIT
+5 ;
INIT ; Initalize any process specific variables
+1 SET COUNT=0
+2 ;Exclude closed requests
SET FILT("SKIP STAT","C")=""
+3 SET FILT("INDEX")="DFN^"_$GET(DFN)
+4 QUIT
+5 ;
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(.ARDATA)
+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(ARDATA) ; Build an output record
+1 ; Input - ARDATA = array containing data from SDEC APPT REQUEST file (#409.85)
+2 NEW DFN,SDPS,SDCLY,ARORIGDT,SDI,STR,SDCL,CALLLETTER,I,X,VAR,SUBCNT,SDECLET,SDECALL
+3 NEW ARINST,ARINSTNM,ARTYPE,VAOSGUID,ARSTOP,ARSTOPN,ARCLIEN,ARCLNAME,APPTYPE,ARUSER,ARUSRNM
+4 NEW AREDT,ARPRIO,ARENPRI,ARREQBY,ARPROV,ARPROVNM,ARCLERK,ARCLERKN,ARSDOA
+5 NEW ARCLERK,ARCLERKN,ARDAM,ARSVCCON,ARDAPTDT,ARCOMM,ARMAR,ARMAI,ARMAN,ARPC,ARDISPD,ARDISPU,ARDISPUN
+6 NEW APPTPTRS,CHILDREN,ARMRTC,SDPARENT,SDMRTC,AREAS
+7 NEW I,L,ZZ
+8 ;vse-2500 CREATE DATE
SET ARORIGDT=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",1,"I"))
+9 SET ARSTAT=ARDATA(FNUM,ARIEN_",",23,"I")
+10 SET DFN=ARDATA(FNUM,ARIEN_",",.01,"I")
+11 SET SDPS=ARDATA(FNUM,ARIEN_",",.02,"E")
+12 SET SDCL=ARDATA(FNUM,ARIEN_",",8,"I")
+13 SET ARINST=ARDATA(FNUM,ARIEN_",",2,"I")
+14 SET ARINSTNM=ARDATA(FNUM,ARIEN_",",2,"E")
+15 SET ARTYPE=ARDATA(FNUM,ARIEN_",",4,"I")
+16 SET ARCLIEN=ARDATA(FNUM,ARIEN_",",8,"I")
+17 SET ARSTOP=ARDATA(FNUM,ARIEN_",",8.5,"I")
+18 SET ARSTOPN=ARDATA(FNUM,ARIEN_",",8.5,"E")
+19 SET ARCLNAME=ARDATA(FNUM,ARIEN_",",8,"E")
+20 SET APPTYPE=ARDATA(FNUM,ARIEN_",",8.7,"I")
+21 SET ARUSER=ARDATA(FNUM,ARIEN_",",9,"I")
+22 SET ARUSRNM=ARDATA(FNUM,ARIEN_",",9,"E")
+23 ;DATE/TIME ENTERED
SET AREDT=$GET(ARDATA(FNUM,ARIEN_",",9.5,"I"))
+24 SET ARPRIO=ARDATA(FNUM,ARIEN_",",10,"I")
+25 SET ARENPRI=ARDATA(FNUM,ARIEN_",",10.5,"E")
+26 SET ARREQBY=ARDATA(FNUM,ARIEN_",",11,"I")
+27 SET ARPROV=ARDATA(FNUM,ARIEN_",",12,"I")
+28 SET ARPROVNM=ARDATA(FNUM,ARIEN_",",12,"E")
+29 ;vse-2500 SCHEDULED DATE OF APPT
SET ARSDOA=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",13,"I"))
+30 ;vse-2500 DATE APPT. MADE
SET ARDAM=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",13.1,"I"))
+31 ;appt clerk ien
SET ARCLERK=ARDATA(FNUM,ARIEN_",",13.7,"I")
+32 ;appt clerk name
SET ARCLERKN=ARDATA(FNUM,ARIEN_",",13.7,"E")
+33 SET ARSVCCON=ARDATA(FNUM,ARIEN_",",15,"E")
+34 ;vse-2500 CID/PREFERRED DATE OF APPT
SET ARDAPTDT=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",22,"I"))
+35 ;VSE-1218; start process mult lines of comments
+36 SET ARCOMM=ARDATA(FNUM,ARIEN_",",25,"I")
+37 SET ARMAR=ARDATA(409.85,ARIEN_",",41,"E")
+38 SET ARMAI=ARDATA(409.85,ARIEN_",",42,"E")
+39 SET ARMAN=ARDATA(409.85,ARIEN_",",43,"E")
+40 SET ARPC=$$WLPC(.ARDATA,ARIEN)
+41 ;vse-2500 DATE DISPOSITIONED
SET ARDISPD=$$FMTISO^SDAMUTDT(ARDATA(FNUM,ARIEN_",",19,"I"))
+42 SET ARDISPU=ARDATA(FNUM,ARIEN_",",20,"I")
+43 SET ARDISPUN=ARDATA(FNUM,ARIEN_",",20,"E")
+44 ; EAS tracking number added with patch SD*5.3*799
SET AREAS=ARDATA(FNUM,ARIEN_",",100,"E")
+45 SET APPTPTRS=$$GETAPPTS^SDECAR1A(ARIEN)
+46 SET CHILDREN=$$CHILDREN^SDECAR1A(ARIEN)
+47 SET ARMRTC=$$MRTC^SDECAR(ARIEN)
+48 SET SDPARENT=ARDATA(FNUM,ARIEN_",",43.8,"I")
+49 ;Build string of RTC dates
+50 SET (SDI,SDMRTC)=""
+51 FOR
SET SDI=$ORDER(ARDATA(409.851,SDI))
if SDI=""
QUIT
Begin DoDot:1
+52 ;vse-2500 MRTC CALC PREF DATES
SET SDMRTC=$SELECT(SDMRTC'="":SDMRTC_"|",1:"")_$$FMTISO^SDAMUTDT(ARDATA(409.851,SDI,.01,"I"))
End DoDot:1
+53 ;# OF CALLS MADE AND DATE LAST LETTER SENT
+54 SET CALLLETTER=$$CALLET^SDECAR1A(DFN,ARIEN)
+55 ;
+56 SET COUNT=$GET(COUNT)+1
+57 ;
+58 SET APPT("ApptReq",COUNT,"PatientIEN")=DFN
+59 SET APPT("ApptReq",COUNT,"ApptReqIEN")=ARIEN
+60 SET APPT("ApptReq",COUNT,"CreateDateE")=ARORIGDT
+61 SET APPT("ApptReq",COUNT,"InstitutionI")=ARINST
+62 SET APPT("ApptReq",COUNT,"InstitutionE")=ARINSTNM
+63 SET APPT("ApptReq",COUNT,"RequestTypeI")=ARTYPE
+64 SET APPT("ApptReq",COUNT,"ReqSpecificClinicI")=ARCLIEN
+65 SET APPT("ApptReq",COUNT,"ReqSpecificClinicE")=ARCLNAME
+66 SET APPT("ApptReq",COUNT,"OriginatingUserI")=ARUSER
+67 SET APPT("ApptReq",COUNT,"OriginatingUserE")=ARUSRNM
+68 SET APPT("ApptReq",COUNT,"PriorityI")=ARPRIO
+69 SET APPT("ApptReq",COUNT,"RequestedByI")=ARREQBY
+70 SET APPT("ApptReq",COUNT,"ProviderI")=ARPROV
+71 SET APPT("ApptReq",COUNT,"ProviderE")=ARPROVNM
+72 SET APPT("ApptReq",COUNT,"CidPreferredDateOfApptE")=ARDAPTDT
+73 SET APPT("ApptReq",COUNT,"CommentsE")=ARCOMM
+74 SET APPT("ApptReq",COUNT,"EnrollmentPriorityE")=ARENPRI
+75 SET APPT("ApptReq",COUNT,"MultipleAppointmentRtcE")=ARMAR
+76 SET APPT("ApptReq",COUNT,"MultApptRtcIntervalE")=ARMAI
+77 SET APPT("ApptReq",COUNT,"MultApptNumberE")=ARMAN
+78 SET APPT("ApptReq",COUNT,"EASTrackingNumberE")=AREAS
+79 SET SUBCNT=0
+80 FOR I=1:1:$LENGTH(ARPC,"::")
Begin DoDot:1
+81 SET VAR=$PIECE(ARPC,"::",I)
+82 if VAR=""
QUIT
+83 SET SUBCNT=SUBCNT+1
+84 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"DateEnteredE")=$PIECE(VAR,"~~",1)
+85 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserI")=$PIECE(VAR,"~~",2)
+86 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"EnteredByUserE")=$PIECE(VAR,"~~",3)
+87 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"ActionE")=$PIECE(VAR,"~~",4)
+88 SET APPT("ApptReq",COUNT,"PatientContact",SUBCNT,"PatientPhoneE")=$PIECE(VAR,"~~",5)
+89 QUIT
End DoDot:1
+90 IF '$DATA(APPT("ApptReq",COUNT,"PatientContact"))
SET APPT("ApptReq",COUNT,"PatientContact")=""
+91 ;
+92 SET APPT("ApptReq",COUNT,"DateDispositionedE")=ARDISPD
+93 SET APPT("ApptReq",COUNT,"DispositionedByI")=ARDISPU
+94 SET APPT("ApptReq",COUNT,"DispositionedByE")=ARDISPUN
+95 SET APPT("ApptReq",COUNT,"ServiceConnectedPriorityE")=ARSVCCON
+96 ;vse-2500
SET APPT("ApptReq",COUNT,"DateTimeEnteredE")=$$FMTISO^SDAMUTDT(AREDT)
+97 SET SUBCNT=0
+98 FOR I=1:1:$LENGTH(SDMRTC,"|")
Begin DoDot:1
+99 if $PIECE(SDMRTC,"|",I)'=""
