SDESARGET.m

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 ---SDESARGET   10904     printed  Apr 09, 2024@22:01:33                                                                                                                                                                                                  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)'=""