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

SDECVVS.m

Go to the documentation of this file.
SDECVVS ;ALB/RJT,TAW,LAB,JAS - SDEC AND VIDEO VISIT SERVICE (VVS) INTEGRATION ;OCT 26,2023
 ;;5.3;Scheduling;**781,784,785,788,790,792,800,801,804,805,818,823,864**;Aug 13, 1993;Build 15
 ;;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(VVSPRORETURN) ;
 N PROVIDERIEN
 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)
 Q
 ;
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=""
 N SDFIELDS,PROVREC
 S (PROVIDERIEN,PROVREC)="",SDFIELDS="2600*"
 K SDDATA,SDMSG
 D GETS^DIQ(44,CLINICIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
 F  S PROVREC=$O(SDDATA(44.1,PROVREC)) Q:PROVREC=""  D  Q:$G(PROVIDERIEN)
 . I $G(SDDATA(44.1,PROVREC,.02,"E"))="YES" S PROVIDERIEN=$G(SDDATA(44.1,PROVREC,.01,"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(RETURN,DFN,CLINIC,APPT,VVSID) ;Save VVS ID in the SDEC APPOINTMENT file
 S RETURN=0
 Q:DFN=""
 Q:CLINIC=""
 Q:APPT=""
 Q:VVSID=""
 ;
 N IEN40984,REC40984,IEN44,RESOURCEIEN,APPTDATETIME,RESOURCE
 ;
 S APPTDATETIME=$$NETTOFM^SDECDATE(APPT,"Y","N")
 ;
 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
 ..S RESOURCE=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
 ..Q:CLINIC'=RESOURCE
 ..Q:APPTDATETIME'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
 ..D UPDATEVVS
 ..S RETURN=1
 ..Q
 Q
UPDATEVVS ;
 S DIE="^SDEC(409.84,",DA=IEN40984,DR="2///"_VVSID D ^DIE
 K DIE,DA,DR
 Q
 ;
GETVVSID(RETURN,DFN,RESOURCE,APPTDATETIME) ;Return the VVS ID from the SDEC APPOINTMENT file
 S RETURN=0
 Q:DFN=""
 Q:RESOURCE=""
 Q:APPTDATETIME=""
 ;
 N IEN40984,REC40984,IEN44,RESOURCEIEN,APPT
 ;
 S APPT=$$NETTOFM^SDECDATE(APPTDATETIME,"Y","N")
 ;
 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:APPT'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
 ..S RETURN=$$GET1^DIQ(409.84,IEN40984,2)
 ..Q
 Q
 ;
 ;
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(RETURN,DFN,RESOURCE,APPTDATETIME) ;Delete the VVS ID from the SDEC APPOINTMENT file
 S RETURN=0
 Q:'$G(DFN)
 Q:'$G(RESOURCE)
 Q:APPTDATETIME=""
 ;
 N IEN40984,IEN44,RESOURCEIEN,APPT
 ;
 S APPT=$$NETTOFM^SDECDATE(APPTDATETIME,"Y","N")
 ;
 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:APPT'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
 ..D DELVVSID
 ..S RETURN=1
 ..Q
 Q
DELVVSID ;
 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