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

SDESVVS.m

Go to the documentation of this file.
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