SDESVVS ;ALB/RJT,TAW,LAB,DJS,ANU,MGD - SDEC AND VIDEO VISIT SERVICE (VVS) INTEGRATION ;FEB 21, 2023@17:00
;;5.3;Scheduling;**781,784,785,788,790,792,800,801,804,805,818,823,828,833,838**;;Build 7
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to ^XTV(8989.3.1,XUS in ICR #1518
Q
;
GETVVSMAKEINFO(VVSMAKEINFO,PATIENTIEN,CLINICIEN) ;GET INFO TO MAKE A VIDEO VISIT WEB SERVICE (VVS) CALL
;S BASERETURN="-1"
Q:PATIENTIEN=""
Q:CLINICIEN=""
S (VVSPATIENT,VVSPROVIDER,PROVIDERINFO,VVSSYSTEMINFO)=""
;
D GETVVSPATIENT(.VVSPATIENT,PATIENTIEN)
D GETDPROIEN(.VVSPROVIDER,CLINICIEN)
D GETPROINFO(.PROVIDERINFO,PROVIDERIEN)
D GETSYSTEMINFO(.VVSSYSTEMINFO,CLINICIEN)
D GETVVSINFO(.VVSMAKEINFO,VVSPATIENT,PROVIDERINFO,VVSSYSTEMINFO)
;
K PATINFO,PROVIDERIEN,PROVIDERINFO,VVSSYSTEMINFO
Q
;
GETSPACEBARPRO(JSONRETURN) ;return Video Visit Provider
;INPUT:
; None
;RETURN:
; Video Visit Provider
;
N RETURN,ERRORS,HASFIELDS,RETURN,ELGFIELDSARRARY
;
S HASFIELDS=$$GETSBPRO(.ELGFIELDSARRAY)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
D CLEANUP
Q
;
GETSBPRO(ELGARRAY) ; Get VVS Provider
N PROVIDERIEN,VVSPRORETURN
I $D(^DISV(DUZ,"^VA(200,")) D
.S PROVIDERIEN=^DISV(DUZ,"^VA(200,")
.D GETPROINFO(.VVSPRORETURN,PROVIDERIEN)
I '$D(^DISV(DUZ,"^VA(200,")),$D(^TMP(DUZ,"SDECPROIEN")) D
.S PROVIDERIEN=^TMP(DUZ,"SDECPROIEN")
.D GETPROINFO(.VVSPRORETURN,PROVIDERIEN)
S VVSPRORETURN=$G(VVSPRORETURN)
S ELGARRAY("VVSProvider","ProviderIEN")=$P(VVSPRORETURN,"^",1)
S ELGARRAY("VVSProvider","ProviderName")=$P(VVSPRORETURN,"^",2)
S ELGARRAY("VVSProvider","ProviderEmail")=$P(VVSPRORETURN,"^",3)
S ELGARRAY("VVSProvider","ProviderCell")=$P(VVSPRORETURN,"^",4)
S ELGARRAY("VVSProvider","ProviderTitle")=$P(VVSPRORETURN,"^",5)
S ELGARRAY("VVSProvider","ProviderClass")=$P(VVSPRORETURN,"^",6)
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
VVSPROSEARCH(VVSPROVIDERS,SEARCHSTRING) ;SEARCH PROVIDERS AND GET DATA NEEDED TO MAKE VIDEO VISIT SERVICE (VVS) APPOINTMENT
N PROVIDERCOUNT
S VVSPROVIDERS="-1"
S PROVIDERCOUNT=0
Q:$L(SEARCHSTRING)<2
N PROVIDERIEN,VVSPROVIDER,PROVIDERNAME,STRINGLENGTH,SDPOP,TERMDATE
S PROVIDERIEN=""
S STRINGLENGTH=$L(SEARCHSTRING)
S PROVIDERNAME=$O(^VA(200,"B",SEARCHSTRING),-1)
I $E(PROVIDERNAME,1,STRINGLENGTH)=SEARCHSTRING D
.S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME),-1)
F S PROVIDERNAME=$O(^VA(200,"B",PROVIDERNAME)) Q:PROVIDERNAME=""!($E(PROVIDERNAME,1,STRINGLENGTH)'=SEARCHSTRING) D
.I PROVIDERCOUNT>49 Q
.S (VVSPROVIDER,PROVIDERIEN)=""
.F S PROVIDERIEN=$O(^VA(200,"B",PROVIDERNAME,PROVIDERIEN)) Q:PROVIDERIEN="" D
..S TERMDATE=$$GET1^DIQ(200,PROVIDERIEN,9.2,"E")
..S SDPOP=0
..I TERMDATE'="" D
... S:TERMDATE<DT SDPOP=1
..I ($$GET1^DIQ(200,PROVIDERIEN,7,"I")'=1)&('SDPOP) D
...D GETPROINFO(.VVSPROVIDER,PROVIDERIEN)
...I VVSPROVIDER'="" D
....S PROVIDERCOUNT=PROVIDERCOUNT+1
....I VVSPROVIDERS="-1" S VVSPROVIDERS=""
....S VVSPROVIDERS=VVSPROVIDERS_"|"_VVSPROVIDER
Q
;
GETVVSPATIENT(RETURN,PATIENTIEN) ;GET VIDEO VISIT SERVICE (VVS) PATIENT
Q:PATIENTIEN=""
N NAME,LASTNAME,FIRSTNAME,DOB,SSN,EMAIL,HOMEPHONE,CELLPHONE,ICN,ZIPCODE
S NAME=$$GET1^DIQ(2,PATIENTIEN,.01)
S LASTNAME=$P(NAME,",",1)
S FIRSTNAME=$P($P(NAME,",",2)," ",1)
S DOB=$$GET1^DIQ(2,PATIENTIEN,.03)
S SSN=$$LAST4SSN^SDESINPUTVALUTL(PATIENTIEN) ;SSN
S EMAIL=$$GET1^DIQ(2,PATIENTIEN,.133)
S HOMEPHONE=$$GET1^DIQ(2,PATIENTIEN,.131)
S CELLPHONE=$$GET1^DIQ(2,PATIENTIEN,.134)
S ICN=$$GETICN^MPIF001(PATIENTIEN)
S ZIPCODE=$$GET1^DIQ(2,PATIENTIEN,.116)
S RETURN=PATIENTIEN_"^"_DOB_"^"_FIRSTNAME_"^"_LASTNAME_"^"_SSN_"^"_EMAIL_"^"_HOMEPHONE_"^"_CELLPHONE_"^"_ICN_"^"_ZIPCODE
Q
;
GETDPROIEN(RETURN,CLINICIEN) ;GET THE IEN FOR THE DEFAULT PROVIDER ASSIGNED TO A CLINIC
Q:CLINICIEN=""
S PROVIDERIEN=""
S PROVIDERIEN=$$GET1^DIQ(44,CLINICIEN,16,"I")
S RETURN=PROVIDERIEN
Q
;
GETPROINFO(RETURN,PROVIDERIEN) ;GET PROVIDER INFO REQUIRED TO MAKE VIDEO VISIT SERVICE (VVS) CALL
Q:PROVIDERIEN=""
N NAME,EMAIL,CELL,TITLE,PROVCLASS
S NAME=$$GET1^DIQ(200,PROVIDERIEN,.01)
S EMAIL=$$GET1^DIQ(200,PROVIDERIEN,.151)
S CELL=$$GET1^DIQ(200,PROVIDERIEN,.133)
S TITLE=$$GET1^DIQ(200,PROVIDERIEN,8,"E")
S PROVCLASS=$$GET1^DIQ(200,PROVIDERIEN,53.5,"E")
S RETURN=PROVIDERIEN_"^"_NAME_"^"_EMAIL_"^"_CELL_"^"_TITLE_"^"_PROVCLASS
S ^TMP(DUZ,"SDECPROIEN")=PROVIDERIEN
Q
;
GETSYSTEMINFO(RETURN,CLINICIEN) ;GET SYSTEM INFO NEED TO CALL MAKE VIDEO VISIT SERVICE (VVS) CALL
N FACILITYSITECODE,FACILITYNAME,SYSTEMTIMEZONEI,SDDIV,CLINICSITECODE,DFTINSTITUTION,OFFSET,TIMEZONEEXECPT
N OFFSETDST,SYSTEMTIMEZONEE,TIMEFRAMEIEN,TIMEFRAMEARY,POP,X,EXECPTFLG
S POP=0,(OFFSET,OFFSETDST,EXECPTFLG)=""
;Removed, want site from clinic not user S FACILITYSITECODE=DUZ(2)
S SDDIV=$$GET1^DIQ(44,CLINICIEN_",",3.5,"I")
S CLINICSITECODE=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
S SYSTEMTIMEZONEE=$$GET1^DIQ(4,CLINICSITECODE,800,"E")
S SYSTEMTIMEZONEI=$$GET1^DIQ(4,CLINICSITECODE,800,"I")
S EXECPTFLG=$$GET1^DIQ(4,CLINICSITECODE,802,"I")
S TIMEZONEEXECPT=$S(EXECPTFLG=0:1,1:0) ;there is a timezone exception if the value = 0
F X=1:1:3 D Q:POP
.S TIMEFRAMEIEN=X_","_SYSTEMTIMEZONEI_","
.D GETS^DIQ(1.711,TIMEFRAMEIEN,".01;.02","IE","TIMEFRAMEARY","SDMSG") ;Data from WORLD TIMEZONE file
.I '$D(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01)) S POP=1 Q
.I $G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="SST" S OFFSET=$G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E"))
.I $G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="DST" S OFFSETDST=$G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E"))
S DFTINSTITUTION=$$GET1^DIQ(8989.3,1,217,"I")
S FACILITYNAME=$$GET1^DIQ(4,DFTINSTITUTION,.01)
S FACILITYSITECODE=$$DEFAULTSTATION^SDECDUZ()
S RETURN=FACILITYSITECODE_"^"_FACILITYNAME_"^"_SYSTEMTIMEZONEE_"^"_TIMEZONEEXECPT_"^"_OFFSET_"^"_OFFSETDST
Q
;
GETVVSINFO(RETURN,VVSPATIENT,PROVIDERINFO,VVSSYSTEMINFO) ;GET RPC: "SDEC GETVVSBASE" RETURN
S RETURN=""
S RETURN=VVSPATIENT_"|"_PROVIDERINFO_"|"_VVSSYSTEMINFO
Q
SAVEVVSID(JSONRETURN,IEN40984,VVSID) ;Save VVS ID in the SDEC APPOINTMENT file
;INPUT:
; IEN40984 - Required: IEN of the appointment in the SDEC APPOINTMENT (#409.84) file
; VVSID - Required: The Video Visit Appointment ID
;
;RETURN: JSON Object
; 0 & VVSID is not Saved
; 1 & VVSID is Saved
;
N ISIENVALID,ISVVSIDVALID,RETURN,ERRORS
;
S ISIENVALID=$$VALIDATEAPPTIEN(.ERRORS,$G(IEN40984))
S ISVVSIDVALID=$$VALIDATEVVSID(.ERRORS,$G(VVSID))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN) Q
;
I '$D(ERRORS) S HASFIELDS=$$SVVSID(.ELGFIELDSARRAY,IEN40984,VVSID)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
D CLEANUP
Q
;
SVVSID(ELGARRAY,IEN40984,VVSID) ;Save VVS ID in the SDEC APPOINTMENT file
;
N HASDATA
;
S ELGARRAY("VVSID","VideoVisitServiceID","Status")=0
S ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is not Saved"
;
S DIE="^SDEC(409.84,",DA=IEN40984,DR="2///"_VVSID
D ^DIE
K DIE,DA,DR
;
S ELGARRAY("VVSID","VideoVisitServiceID","Status")=1
S ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is Saved"
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
UPDATEVVS ;
S DIE="^SDEC(409.84,",DA=IEN40984,DR="2///"_VVSID D ^DIE
K DIE,DA,DR
Q
;
GETVVSID(JSONRETURN,DFN,RESOURCE,APPTDATETIME) ;Return the VVS ID from the SDEC APPOINTMENT file
;INPUT:
;DFN - Required Patient ID Pointer to the PATIENT file 2
;RESOURCE - Required
;APPTDATETIME - Required Appointment Date of search in ISO8601 format
;RETURN:
; 0 or VVS Appointment
;
N ISDFNVALID,ISRSCVALID,ISAPPTDTVALID,RETURN,ERRORS,REQUESTIEN,REQUEST
;
S ISDFNVALID=$$VALIDATEDFN(.ERRORS,$G(DFN))
S ISRSCVALID=$$VALIDATERSC(.ERRORS,$G(RESOURCE))
S ISAPPTDTVALID=$$VALIDATEAPPTDT(.ERRORS,$G(APPTDATETIME))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN) Q
;
I '$D(ERRORS) S HASFIELDS=$$GETVVSIDTL(.ELGFIELDSARRAY,DFN,RESOURCE,APPTDATETIME)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
D CLEANUP
Q
;
VALIDATEDFN(ERRORS,DFN) ;
I DFN="" D ERRLOG^SDESJSON(.ERRORS,1) Q 0
I DFN'="",'$D(^DPT(DFN,0)) D ERRLOG^SDESJSON(.ERRORS,2) Q 0
Q 1
;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14) Q 0
I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15) Q 0
Q 1
;
VALIDATERSC(ERRORS,SDESRSIEN) ; Validate Resource IEN
I SDESRSIEN="" D ERRLOG^SDESJSON(.ERRORS,69) Q 0 ; Missing Resource Item IEN
I SDESRSIEN'="" I '$D(^SDEC(409.831,SDESRSIEN,0)) D ERRLOG^SDESJSON(.ERRORS,70) Q 0 ; Invalid Resource Item
Q 1
;
VALIDATECLN(ERRORS,SDCLNIEN) ; Validate Clinic IEN
N SDCLNAME,ERROR,SDCLRESIEN,SDERR,SDCLRESIEN
S ERROR=0
I SDCLNIEN="" D ERRLOG^SDESJSON(.ERRORS,67) S ERROR=1 Q 0 ;clinic cannot be blank
I +SDCLNIEN,'$D(^SC(SDCLNIEN)) D ERRLOG^SDESJSON(.ERRORS,19) S ERROR=1 Q 0 ; clinic not found
I +SDCLNIEN'>0 D ERRLOG^SDESJSON(.ERRORS,19) S ERROR=1 Q 0 ; invalid clinic
I +SDCLNIEN>0 D
. S SDCLNAME=$$GET1^DIQ(44,SDCLNIEN_",",.01,"I") ;retrieve the clinic name
. I SDCLNAME="" D ERRLOG^SDESJSON(.ERRORS,80) S ERROR=1 Q ;clinic IEN not found
. S SDCLRESIEN=$$FIND1^DIC(409.831,"","MX",SDCLNAME,"","","SDERR") ;retrieve the resource IEN for the clinic
. I $D(SDERR) D ERRLOG^SDESJSON(.ERRORS,70) S ERROR=1 Q ;invalid clinic resource id
I ERROR=1 Q 0
Q 1
;
VALIDATEAPPTDT(ERRORS,DATETIME) ;
I DATETIME="" D ERRLOG^SDESJSON(.ERRORS,25) Q 0
S APPTDATETIME=$$ISOTFM^SDAMUTDT(DATETIME)
I APPTDATETIME=-1!(APPTDATETIME="") D ERRLOG^SDESJSON(.ERRORS,27) Q 0
Q 1
;
VALIDATEVVSID(ERRORS,VVSID) ;
I VVSID="" D ERRLOG^SDESJSON(.ERRORS,384) Q 0
I $L(VVSID)>60 D ERRLOG^SDESJSON(.ERRORS,428) Q 0
Q 1
;
GETVVSIDTL(ELGARRAY,DFN,RESOURCE,APPTDATETIME) ;Return the VVS ID from the SDEC APPOINTMENT file
N IEN40984,REC40984,IEN44,RESOURCEIEN,APPT,HASDATA
;
S ELGARRAY("VVSID","VideoVisitServiceID")=0
S IEN40984="" F S IEN40984=$O(^SDEC(409.84,"CPAT",DFN,IEN40984)) Q:IEN40984="" D
.S RESOURCEIEN="" S RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I") D
..Q:RESOURCEIEN'=RESOURCE
..Q:APPTDATETIME'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
..S ELGARRAY("VVSID","VideoVisitServiceID")=$$GET1^DIQ(409.84,IEN40984,2)
..Q
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
GETVVSID1(RETURN,DFN,APPT,CLINIC) ;Return the VVS ID from the SDEC APPOINTMENT file
S RETURN=0
Q:DFN=""
Q:APPT=""
Q:CLINIC=""
;
N IEN40984,REC40984,IEN44,RESOURCEIEN
;
;S APPT=$$NETTOFM^SDECDATE(APPTDATETIME,"Y","N")
;
S IEN40984="" F S IEN40984=$O(^SDEC(409.84,"CPAT",DFN,IEN40984)) Q:IEN40984="" D
.Q:APPT'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
.S RESOURCEIEN="" S RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I") D
..Q:$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")'=CLINIC
..S RETURN=$$GET1^DIQ(409.84,IEN40984,2)
..Q
Q
;
DELETEVVSID(JSONRETURN,DFN,RESOURCE,APPTDATETIME) ;Delete the VVS ID from the SDEC APPOINTMENT file
;INPUT:
;DFN - Required Patient ID Pointer to the PATIENT file 2
;RESOURCE - Required
;APPTDATETIME - Required Appointment Date of search in ISO8601 format
;RETURN:
; 0 or VVS Appointment
;
N ISDFNVALID,ISCLNVALID,ISAPPTVALID,ISVVSIDVALID,RETURN,ERRORS,REQUEST
;
S ISDFNVALID=$$VALIDATEDFN(.ERRORS,$G(DFN))
S ISCLNVALID=$$VALIDATERSC(.ERRORS,$G(RESOURCE))
S ISAPPTVALID=$$VALIDATEAPPTDT(.ERRORS,$G(APPTDATETIME))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN) Q
;
I '$D(ERRORS) S HASFIELDS=$$DELVVSID(.ELGFIELDSARRAY,DFN,RESOURCE,APPTDATETIME)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
D CLEANUP
Q
;
DELVVSID(ELGARRAY,DFN,RESOURCE,APPTDATETIME) ;Delete the VVS ID from the SDEC APPOINTMENT file
N IEN40984,IEN44,RESOURCEIEN,APPT
S ELGARRAY("VVSID","VideoVisitServiceID","Status")=0
S ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is not Deleted"
;
S IEN40984="" F S IEN40984=$O(^SDEC(409.84,"CPAT",DFN,IEN40984)) Q:IEN40984="" D
.S RESOURCEIEN="" S RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I") D
..Q:RESOURCEIEN'=RESOURCE
..Q:APPTDATETIME'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
..D DVVSID
..S ELGARRAY("VVSID","VideoVisitServiceID","Status")=1
..S ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is Deleted"
..Q
S HASDATA=($D(ELGARRAY)>1)
Q HASDATA
;
DVVSID ;
S DIE=409.84,DA=IEN40984,DR="2///@"
D ^DIE
K DIE,DA,DR
Q
GETPATIENTICN(RETURN,PATIENTIEN) ;GET PATIENT ICN FROM PATIENT IEN (DFN)
Q:PATIENTIEN=""
S RETURN=$$GETICN^MPIF001(PATIENTIEN)
I RETURN["-1" D
.I $$GET1^DIQ(8989.3,1,.01,"E")["TEST" D
..S RETURN=$$GET1^DIQ(2,PATIENTIEN,991.1)
Q
CLEANUP ;
K ERRORS
K RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESVVS 12999 printed Apr 09, 2024@21:58:19 Page 2
SDESVVS ;ALB/RJT,TAW,LAB,DJS,ANU,MGD - SDEC AND VIDEO VISIT SERVICE (VVS) INTEGRATION ;FEB 21, 2023@17:00
+1 ;;5.3;Scheduling;**781,784,785,788,790,792,800,801,804,805,818,823,828,833,838**;;Build 7
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to ^XTV(8989.3.1,XUS in ICR #1518
+5 QUIT
+6 ;
GETVVSMAKEINFO(VVSMAKEINFO,PATIENTIEN,CLINICIEN) ;GET INFO TO MAKE A VIDEO VISIT WEB SERVICE (VVS) CALL
+1 ;S BASERETURN="-1"
+2 if PATIENTIEN=""
QUIT
+3 if CLINICIEN=""
QUIT
+4 SET (VVSPATIENT,VVSPROVIDER,PROVIDERINFO,VVSSYSTEMINFO)=""
+5 ;
+6 DO GETVVSPATIENT(.VVSPATIENT,PATIENTIEN)
+7 DO GETDPROIEN(.VVSPROVIDER,CLINICIEN)
+8 DO GETPROINFO(.PROVIDERINFO,PROVIDERIEN)
+9 DO GETSYSTEMINFO(.VVSSYSTEMINFO,CLINICIEN)
+10 DO GETVVSINFO(.VVSMAKEINFO,VVSPATIENT,PROVIDERINFO,VVSSYSTEMINFO)
+11 ;
+12 KILL PATINFO,PROVIDERIEN,PROVIDERINFO,VVSSYSTEMINFO
+13 QUIT
+14 ;
GETSPACEBARPRO(JSONRETURN) ;return Video Visit Provider
+1 ;INPUT:
+2 ; None
+3 ;RETURN:
+4 ; Video Visit Provider
+5 ;
+6 NEW RETURN,ERRORS,HASFIELDS,RETURN,ELGFIELDSARRARY
+7 ;
+8 SET HASFIELDS=$$GETSBPRO(.ELGFIELDSARRAY)
+9 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+10 ;
+11 DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
+12 DO CLEANUP
+13 QUIT
+14 ;
GETSBPRO(ELGARRAY) ; Get VVS Provider
+1 NEW PROVIDERIEN,VVSPRORETURN
+2 IF $DATA(^DISV(DUZ,"^VA(200,"))
Begin DoDot:1
+3 SET PROVIDERIEN=^DISV(DUZ,"^VA(200,")
+4 DO GETPROINFO(.VVSPRORETURN,PROVIDERIEN)
End DoDot:1
+5 IF '$DATA(^DISV(DUZ,"^VA(200,"))
IF $DATA(^TMP(DUZ,"SDECPROIEN"))
Begin DoDot:1
+6 SET PROVIDERIEN=^TMP(DUZ,"SDECPROIEN")
+7 DO GETPROINFO(.VVSPRORETURN,PROVIDERIEN)
End DoDot:1
+8 SET VVSPRORETURN=$GET(VVSPRORETURN)
+9 SET ELGARRAY("VVSProvider","ProviderIEN")=$PIECE(VVSPRORETURN,"^",1)
+10 SET ELGARRAY("VVSProvider","ProviderName")=$PIECE(VVSPRORETURN,"^",2)
+11 SET ELGARRAY("VVSProvider","ProviderEmail")=$PIECE(VVSPRORETURN,"^",3)
+12 SET ELGARRAY("VVSProvider","ProviderCell")=$PIECE(VVSPRORETURN,"^",4)
+13 SET ELGARRAY("VVSProvider","ProviderTitle")=$PIECE(VVSPRORETURN,"^",5)
+14 SET ELGARRAY("VVSProvider","ProviderClass")=$PIECE(VVSPRORETURN,"^",6)
+15 SET HASDATA=($DATA(ELGARRAY)>1)
+16 QUIT HASDATA
+17 ;
VVSPROSEARCH(VVSPROVIDERS,SEARCHSTRING) ;SEARCH PROVIDERS AND GET DATA NEEDED TO MAKE VIDEO VISIT SERVICE (VVS) APPOINTMENT
+1 NEW PROVIDERCOUNT
+2 SET VVSPROVIDERS="-1"
+3 SET PROVIDERCOUNT=0
+4 if $LENGTH(SEARCHSTRING)<2
QUIT
+5 NEW PROVIDERIEN,VVSPROVIDER,PROVIDERNAME,STRINGLENGTH,SDPOP,TERMDATE
+6 SET PROVIDERIEN=""
+7 SET STRINGLENGTH=$LENGTH(SEARCHSTRING)
+8 SET PROVIDERNAME=$ORDER(^VA(200,"B",SEARCHSTRING),-1)
+9 IF $EXTRACT(PROVIDERNAME,1,STRINGLENGTH)=SEARCHSTRING
Begin DoDot:1
+10 SET PROVIDERNAME=$ORDER(^VA(200,"B",PROVIDERNAME),-1)
End DoDot:1
+11 FOR
SET PROVIDERNAME=$ORDER(^VA(200,"B",PROVIDERNAME))
if PROVIDERNAME=""!($EXTRACT(PROVIDERNAME,1,STRINGLENGTH)'=SEARCHSTRING)
QUIT
Begin DoDot:1
+12 IF PROVIDERCOUNT>49
QUIT
+13 SET (VVSPROVIDER,PROVIDERIEN)=""
+14 FOR
SET PROVIDERIEN=$ORDER(^VA(200,"B",PROVIDERNAME,PROVIDERIEN))
if PROVIDERIEN=""
QUIT
Begin DoDot:2
+15 SET TERMDATE=$$GET1^DIQ(200,PROVIDERIEN,9.2,"E")
+16 SET SDPOP=0
+17 IF TERMDATE'=""
Begin DoDot:3
+18 if TERMDATE<DT
SET SDPOP=1
End DoDot:3
+19 IF ($$GET1^DIQ(200,PROVIDERIEN,7,"I")'=1)&('SDPOP)
Begin DoDot:3
+20 DO GETPROINFO(.VVSPROVIDER,PROVIDERIEN)
+21 IF VVSPROVIDER'=""
Begin DoDot:4
+22 SET PROVIDERCOUNT=PROVIDERCOUNT+1
+23 IF VVSPROVIDERS="-1"
SET VVSPROVIDERS=""
+24 SET VVSPROVIDERS=VVSPROVIDERS_"|"_VVSPROVIDER
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
GETVVSPATIENT(RETURN,PATIENTIEN) ;GET VIDEO VISIT SERVICE (VVS) PATIENT
+1 if PATIENTIEN=""
QUIT
+2 NEW NAME,LASTNAME,FIRSTNAME,DOB,SSN,EMAIL,HOMEPHONE,CELLPHONE,ICN,ZIPCODE
+3 SET NAME=$$GET1^DIQ(2,PATIENTIEN,.01)
+4 SET LASTNAME=$PIECE(NAME,",",1)
+5 SET FIRSTNAME=$PIECE($PIECE(NAME,",",2)," ",1)
+6 SET DOB=$$GET1^DIQ(2,PATIENTIEN,.03)
+7 ;SSN
SET SSN=$$LAST4SSN^SDESINPUTVALUTL(PATIENTIEN)
+8 SET EMAIL=$$GET1^DIQ(2,PATIENTIEN,.133)
+9 SET HOMEPHONE=$$GET1^DIQ(2,PATIENTIEN,.131)
+10 SET CELLPHONE=$$GET1^DIQ(2,PATIENTIEN,.134)
+11 SET ICN=$$GETICN^MPIF001(PATIENTIEN)
+12 SET ZIPCODE=$$GET1^DIQ(2,PATIENTIEN,.116)
+13 SET RETURN=PATIENTIEN_"^"_DOB_"^"_FIRSTNAME_"^"_LASTNAME_"^"_SSN_"^"_EMAIL_"^"_HOMEPHONE_"^"_CELLPHONE_"^"_ICN_"^"_ZIPCODE
+14 QUIT
+15 ;
GETDPROIEN(RETURN,CLINICIEN) ;GET THE IEN FOR THE DEFAULT PROVIDER ASSIGNED TO A CLINIC
+1 if CLINICIEN=""
QUIT
+2 SET PROVIDERIEN=""
+3 SET PROVIDERIEN=$$GET1^DIQ(44,CLINICIEN,16,"I")
+4 SET RETURN=PROVIDERIEN
+5 QUIT
+6 ;
GETPROINFO(RETURN,PROVIDERIEN) ;GET PROVIDER INFO REQUIRED TO MAKE VIDEO VISIT SERVICE (VVS) CALL
+1 if PROVIDERIEN=""
QUIT
+2 NEW NAME,EMAIL,CELL,TITLE,PROVCLASS
+3 SET NAME=$$GET1^DIQ(200,PROVIDERIEN,.01)
+4 SET EMAIL=$$GET1^DIQ(200,PROVIDERIEN,.151)
+5 SET CELL=$$GET1^DIQ(200,PROVIDERIEN,.133)
+6 SET TITLE=$$GET1^DIQ(200,PROVIDERIEN,8,"E")
+7 SET PROVCLASS=$$GET1^DIQ(200,PROVIDERIEN,53.5,"E")
+8 SET RETURN=PROVIDERIEN_"^"_NAME_"^"_EMAIL_"^"_CELL_"^"_TITLE_"^"_PROVCLASS
+9 SET ^TMP(DUZ,"SDECPROIEN")=PROVIDERIEN
+10 QUIT
+11 ;
GETSYSTEMINFO(RETURN,CLINICIEN) ;GET SYSTEM INFO NEED TO CALL MAKE VIDEO VISIT SERVICE (VVS) CALL
+1 NEW FACILITYSITECODE,FACILITYNAME,SYSTEMTIMEZONEI,SDDIV,CLINICSITECODE,DFTINSTITUTION,OFFSET,TIMEZONEEXECPT
+2 NEW OFFSETDST,SYSTEMTIMEZONEE,TIMEFRAMEIEN,TIMEFRAMEARY,POP,X,EXECPTFLG
+3 SET POP=0
SET (OFFSET,OFFSETDST,EXECPTFLG)=""
+4 ;Removed, want site from clinic not user S FACILITYSITECODE=DUZ(2)
+5 SET SDDIV=$$GET1^DIQ(44,CLINICIEN_",",3.5,"I")
+6 SET CLINICSITECODE=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
+7 SET SYSTEMTIMEZONEE=$$GET1^DIQ(4,CLINICSITECODE,800,"E")
+8 SET SYSTEMTIMEZONEI=$$GET1^DIQ(4,CLINICSITECODE,800,"I")
+9 SET EXECPTFLG=$$GET1^DIQ(4,CLINICSITECODE,802,"I")
+10 ;there is a timezone exception if the value = 0
SET TIMEZONEEXECPT=$SELECT(EXECPTFLG=0:1,1:0)
+11 FOR X=1:1:3
Begin DoDot:1
+12 SET TIMEFRAMEIEN=X_","_SYSTEMTIMEZONEI_","
+13 ;Data from WORLD TIMEZONE file
DO GETS^DIQ(1.711,TIMEFRAMEIEN,".01;.02","IE","TIMEFRAMEARY","SDMSG")
+14 IF '$DATA(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01))
SET POP=1
QUIT
+15 IF $GET(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="SST"
SET OFFSET=$GET(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E"))
+16 IF $GET(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="DST"
SET OFFSETDST=$GET(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E"))
End DoDot:1
if POP
QUIT
+17 SET DFTINSTITUTION=$$GET1^DIQ(8989.3,1,217,"I")
+18 SET FACILITYNAME=$$GET1^DIQ(4,DFTINSTITUTION,.01)
+19 SET FACILITYSITECODE=$$DEFAULTSTATION^SDECDUZ()
+20 SET RETURN=FACILITYSITECODE_"^"_FACILITYNAME_"^"_SYSTEMTIMEZONEE_"^"_TIMEZONEEXECPT_"^"_OFFSET_"^"_OFFSETDST
+21 QUIT
+22 ;
GETVVSINFO(RETURN,VVSPATIENT,PROVIDERINFO,VVSSYSTEMINFO) ;GET RPC: "SDEC GETVVSBASE" RETURN
+1 SET RETURN=""
+2 SET RETURN=VVSPATIENT_"|"_PROVIDERINFO_"|"_VVSSYSTEMINFO
+3 QUIT
SAVEVVSID(JSONRETURN,IEN40984,VVSID) ;Save VVS ID in the SDEC APPOINTMENT file
+1 ;INPUT:
+2 ; IEN40984 - Required: IEN of the appointment in the SDEC APPOINTMENT (#409.84) file
+3 ; VVSID - Required: The Video Visit Appointment ID
+4 ;
+5 ;RETURN: JSON Object
+6 ; 0 & VVSID is not Saved
+7 ; 1 & VVSID is Saved
+8 ;
+9 NEW ISIENVALID,ISVVSIDVALID,RETURN,ERRORS
+10 ;
+11 SET ISIENVALID=$$VALIDATEAPPTIEN(.ERRORS,$GET(IEN40984))
+12 SET ISVVSIDVALID=$$VALIDATEVVSID(.ERRORS,$GET(VVSID))
+13 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
QUIT
+14 ;
+15 IF '$DATA(ERRORS)
SET HASFIELDS=$$SVVSID(.ELGFIELDSARRAY,IEN40984,VVSID)
+16 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
+19 DO CLEANUP
+20 QUIT
+21 ;
SVVSID(ELGARRAY,IEN40984,VVSID) ;Save VVS ID in the SDEC APPOINTMENT file
+1 ;
+2 NEW HASDATA
+3 ;
+4 SET ELGARRAY("VVSID","VideoVisitServiceID","Status")=0
+5 SET ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is not Saved"
+6 ;
+7 SET DIE="^SDEC(409.84,"
SET DA=IEN40984
SET DR="2///"_VVSID
+8 DO ^DIE
+9 KILL DIE,DA,DR
+10 ;
+11 SET ELGARRAY("VVSID","VideoVisitServiceID","Status")=1
+12 SET ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is Saved"
+13 SET HASDATA=($DATA(ELGARRAY)>1)
+14 QUIT HASDATA
+15 ;
UPDATEVVS ;
+1 SET DIE="^SDEC(409.84,"
SET DA=IEN40984
SET DR="2///"_VVSID
DO ^DIE
+2 KILL DIE,DA,DR
+3 QUIT
+4 ;
GETVVSID(JSONRETURN,DFN,RESOURCE,APPTDATETIME) ;Return the VVS ID from the SDEC APPOINTMENT file
+1 ;INPUT:
+2 ;DFN - Required Patient ID Pointer to the PATIENT file 2
+3 ;RESOURCE - Required
+4 ;APPTDATETIME - Required Appointment Date of search in ISO8601 format
+5 ;RETURN:
+6 ; 0 or VVS Appointment
+7 ;
+8 NEW ISDFNVALID,ISRSCVALID,ISAPPTDTVALID,RETURN,ERRORS,REQUESTIEN,REQUEST
+9 ;
+10 SET ISDFNVALID=$$VALIDATEDFN(.ERRORS,$GET(DFN))
+11 SET ISRSCVALID=$$VALIDATERSC(.ERRORS,$GET(RESOURCE))
+12 SET ISAPPTDTVALID=$$VALIDATEAPPTDT(.ERRORS,$GET(APPTDATETIME))
+13 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
QUIT
+14 ;
+15 IF '$DATA(ERRORS)
SET HASFIELDS=$$GETVVSIDTL(.ELGFIELDSARRAY,DFN,RESOURCE,APPTDATETIME)
+16 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
+19 DO CLEANUP
+20 QUIT
+21 ;
VALIDATEDFN(ERRORS,DFN) ;
+1 IF DFN=""
DO ERRLOG^SDESJSON(.ERRORS,1)
QUIT 0
+2 IF DFN'=""
IF '$DATA(^DPT(DFN,0))
DO ERRLOG^SDESJSON(.ERRORS,2)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATEAPPTIEN(ERRORS,APPTIEN) ;
+1 IF APPTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,14)
QUIT 0
+2 IF APPTIEN'=""
IF '$DATA(^SDEC(409.84,APPTIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,15)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATERSC(ERRORS,SDESRSIEN) ; Validate Resource IEN
+1 ; Missing Resource Item IEN
IF SDESRSIEN=""
DO ERRLOG^SDESJSON(.ERRORS,69)
QUIT 0
+2 ; Invalid Resource Item
IF SDESRSIEN'=""
IF '$DATA(^SDEC(409.831,SDESRSIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,70)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATECLN(ERRORS,SDCLNIEN) ; Validate Clinic IEN
+1 NEW SDCLNAME,ERROR,SDCLRESIEN,SDERR,SDCLRESIEN
+2 SET ERROR=0
+3 ;clinic cannot be blank
IF SDCLNIEN=""
DO ERRLOG^SDESJSON(.ERRORS,67)
SET ERROR=1
QUIT 0
+4 ; clinic not found
IF +SDCLNIEN
IF '$DATA(^SC(SDCLNIEN))
DO ERRLOG^SDESJSON(.ERRORS,19)
SET ERROR=1
QUIT 0
+5 ; invalid clinic
IF +SDCLNIEN'>0
DO ERRLOG^SDESJSON(.ERRORS,19)
SET ERROR=1
QUIT 0
+6 IF +SDCLNIEN>0
Begin DoDot:1
+7 ;retrieve the clinic name
SET SDCLNAME=$$GET1^DIQ(44,SDCLNIEN_",",.01,"I")
+8 ;clinic IEN not found
IF SDCLNAME=""
DO ERRLOG^SDESJSON(.ERRORS,80)
SET ERROR=1
QUIT
+9 ;retrieve the resource IEN for the clinic
SET SDCLRESIEN=$$FIND1^DIC(409.831,"","MX",SDCLNAME,"","","SDERR")
+10 ;invalid clinic resource id
IF $DATA(SDERR)
DO ERRLOG^SDESJSON(.ERRORS,70)
SET ERROR=1
QUIT
End DoDot:1
+11 IF ERROR=1
QUIT 0
+12 QUIT 1
+13 ;
VALIDATEAPPTDT(ERRORS,DATETIME) ;
+1 IF DATETIME=""
DO ERRLOG^SDESJSON(.ERRORS,25)
QUIT 0
+2 SET APPTDATETIME=$$ISOTFM^SDAMUTDT(DATETIME)
+3 IF APPTDATETIME=-1!(APPTDATETIME="")
DO ERRLOG^SDESJSON(.ERRORS,27)
QUIT 0
+4 QUIT 1
+5 ;
VALIDATEVVSID(ERRORS,VVSID) ;
+1 IF VVSID=""
DO ERRLOG^SDESJSON(.ERRORS,384)
QUIT 0
+2 IF $LENGTH(VVSID)>60
DO ERRLOG^SDESJSON(.ERRORS,428)
QUIT 0
+3 QUIT 1
+4 ;
GETVVSIDTL(ELGARRAY,DFN,RESOURCE,APPTDATETIME) ;Return the VVS ID from the SDEC APPOINTMENT file
+1 NEW IEN40984,REC40984,IEN44,RESOURCEIEN,APPT,HASDATA
+2 ;
+3 SET ELGARRAY("VVSID","VideoVisitServiceID")=0
+4 SET IEN40984=""
FOR
SET IEN40984=$ORDER(^SDEC(409.84,"CPAT",DFN,IEN40984))
if IEN40984=""
QUIT
Begin DoDot:1
+5 SET RESOURCEIEN=""
SET RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I")
Begin DoDot:2
+6 if RESOURCEIEN'=RESOURCE
QUIT
+7 if APPTDATETIME'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
QUIT
+8 SET ELGARRAY("VVSID","VideoVisitServiceID")=$$GET1^DIQ(409.84,IEN40984,2)
+9 QUIT
End DoDot:2
End DoDot:1
+10 SET HASDATA=($DATA(ELGARRAY)>1)
+11 QUIT HASDATA
+12 ;
GETVVSID1(RETURN,DFN,APPT,CLINIC) ;Return the VVS ID from the SDEC APPOINTMENT file
+1 SET RETURN=0
+2 if DFN=""
QUIT
+3 if APPT=""
QUIT
+4 if CLINIC=""
QUIT
+5 ;
+6 NEW IEN40984,REC40984,IEN44,RESOURCEIEN
+7 ;
+8 ;S APPT=$$NETTOFM^SDECDATE(APPTDATETIME,"Y","N")
+9 ;
+10 SET IEN40984=""
FOR
SET IEN40984=$ORDER(^SDEC(409.84,"CPAT",DFN,IEN40984))
if IEN40984=""
QUIT
Begin DoDot:1
+11 if APPT'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
QUIT
+12 SET RESOURCEIEN=""
SET RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I")
Begin DoDot:2
+13 if $$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")'=CLINIC
QUIT
+14 SET RETURN=$$GET1^DIQ(409.84,IEN40984,2)
+15 QUIT
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
DELETEVVSID(JSONRETURN,DFN,RESOURCE,APPTDATETIME) ;Delete the VVS ID from the SDEC APPOINTMENT file
+1 ;INPUT:
+2 ;DFN - Required Patient ID Pointer to the PATIENT file 2
+3 ;RESOURCE - Required
+4 ;APPTDATETIME - Required Appointment Date of search in ISO8601 format
+5 ;RETURN:
+6 ; 0 or VVS Appointment
+7 ;
+8 NEW ISDFNVALID,ISCLNVALID,ISAPPTVALID,ISVVSIDVALID,RETURN,ERRORS,REQUEST
+9 ;
+10 SET ISDFNVALID=$$VALIDATEDFN(.ERRORS,$GET(DFN))
+11 SET ISCLNVALID=$$VALIDATERSC(.ERRORS,$GET(RESOURCE))
+12 SET ISAPPTVALID=$$VALIDATEAPPTDT(.ERRORS,$GET(APPTDATETIME))
+13 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
QUIT
+14 ;
+15 IF '$DATA(ERRORS)
SET HASFIELDS=$$DELVVSID(.ELGFIELDSARRAY,DFN,RESOURCE,APPTDATETIME)
+16 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
+19 DO CLEANUP
+20 QUIT
+21 ;
DELVVSID(ELGARRAY,DFN,RESOURCE,APPTDATETIME) ;Delete the VVS ID from the SDEC APPOINTMENT file
+1 NEW IEN40984,IEN44,RESOURCEIEN,APPT
+2 SET ELGARRAY("VVSID","VideoVisitServiceID","Status")=0
+3 SET ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is not Deleted"
+4 ;
+5 SET IEN40984=""
FOR
SET IEN40984=$ORDER(^SDEC(409.84,"CPAT",DFN,IEN40984))
if IEN40984=""
QUIT
Begin DoDot:1
+6 SET RESOURCEIEN=""
SET RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I")
Begin DoDot:2
+7 if RESOURCEIEN'=RESOURCE
QUIT
+8 if APPTDATETIME'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
QUIT
+9 DO DVVSID
+10 SET ELGARRAY("VVSID","VideoVisitServiceID","Status")=1
+11 SET ELGARRAY("VVSID","VideoVisitServiceID","Message")="VVSID is Deleted"
+12 QUIT
End DoDot:2
End DoDot:1
+13 SET HASDATA=($DATA(ELGARRAY)>1)
+14 QUIT HASDATA
+15 ;
DVVSID ;
+1 SET DIE=409.84
SET DA=IEN40984
SET DR="2///@"
+2 DO ^DIE
+3 KILL DIE,DA,DR
+4 QUIT
GETPATIENTICN(RETURN,PATIENTIEN) ;GET PATIENT ICN FROM PATIENT IEN (DFN)
+1 if PATIENTIEN=""
QUIT
+2 SET RETURN=$$GETICN^MPIF001(PATIENTIEN)
+3 IF RETURN["-1"
Begin DoDot:1
+4 IF $$GET1^DIQ(8989.3,1,.01,"E")["TEST"
Begin DoDot:2
+5 SET RETURN=$$GET1^DIQ(2,PATIENTIEN,991.1)
End DoDot:2
End DoDot:1
+6 QUIT
CLEANUP ;
+1 KILL ERRORS
+2 KILL RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
+3 QUIT
