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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECVVS 8190 printed Nov 22, 2024@18:02:57 Page 2
SDECVVS ;ALB/RJT,TAW,LAB,JAS - SDEC AND VIDEO VISIT SERVICE (VVS) INTEGRATION ;OCT 26,2023
+1 ;;5.3;Scheduling;**781,784,785,788,790,792,800,801,804,805,818,823,864**;Aug 13, 1993;Build 15
+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(VVSPRORETURN) ;
+1 NEW PROVIDERIEN
+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 QUIT
+9 ;
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 NEW SDFIELDS,PROVREC
+3 SET (PROVIDERIEN,PROVREC)=""
SET SDFIELDS="2600*"
+4 KILL SDDATA,SDMSG
+5 DO GETS^DIQ(44,CLINICIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+6 FOR
SET PROVREC=$ORDER(SDDATA(44.1,PROVREC))
if PROVREC=""
QUIT
Begin DoDot:1
+7 IF $GET(SDDATA(44.1,PROVREC,.02,"E"))="YES"
SET PROVIDERIEN=$GET(SDDATA(44.1,PROVREC,.01,"I"))
End DoDot:1
if $GET(PROVIDERIEN)
QUIT
+8 SET RETURN=PROVIDERIEN
+9 QUIT
+10 ;
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(RETURN,DFN,CLINIC,APPT,VVSID) ;Save VVS ID in the SDEC APPOINTMENT file
+1 SET RETURN=0
+2 if DFN=""
QUIT
+3 if CLINIC=""
QUIT
+4 if APPT=""
QUIT
+5 if VVSID=""
QUIT
+6 ;
+7 NEW IEN40984,REC40984,IEN44,RESOURCEIEN,APPTDATETIME,RESOURCE
+8 ;
+9 SET APPTDATETIME=$$NETTOFM^SDECDATE(APPT,"Y","N")
+10 ;
+11 SET IEN40984=""
FOR
SET IEN40984=$ORDER(^SDEC(409.84,"CPAT",DFN,IEN40984))
if IEN40984=""
QUIT
Begin DoDot:1
+12 SET RESOURCEIEN=""
SET RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I")
Begin DoDot:2
+13 SET RESOURCE=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
+14 if CLINIC'=RESOURCE
QUIT
+15 if APPTDATETIME'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
QUIT
+16 DO UPDATEVVS
+17 SET RETURN=1
+18 QUIT
End DoDot:2
End DoDot:1
+19 QUIT
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(RETURN,DFN,RESOURCE,APPTDATETIME) ;Return the VVS ID from the SDEC APPOINTMENT file
+1 SET RETURN=0
+2 if DFN=""
QUIT
+3 if RESOURCE=""
QUIT
+4 if APPTDATETIME=""
QUIT
+5 ;
+6 NEW IEN40984,REC40984,IEN44,RESOURCEIEN,APPT
+7 ;
+8 SET 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 SET RESOURCEIEN=""
SET RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I")
Begin DoDot:2
+12 if RESOURCEIEN'=RESOURCE
QUIT
+13 if APPT'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
QUIT
+14 SET RETURN=$$GET1^DIQ(409.84,IEN40984,2)
+15 QUIT
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ;
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(RETURN,DFN,RESOURCE,APPTDATETIME) ;Delete the VVS ID from the SDEC APPOINTMENT file
+1 SET RETURN=0
+2 if '$GET(DFN)
QUIT
+3 if '$GET(RESOURCE)
QUIT
+4 if APPTDATETIME=""
QUIT
+5 ;
+6 NEW IEN40984,IEN44,RESOURCEIEN,APPT
+7 ;
+8 SET 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 SET RESOURCEIEN=""
SET RESOURCEIEN=$$GET1^DIQ(409.84,IEN40984,.07,"I")
Begin DoDot:2
+12 if RESOURCEIEN'=RESOURCE
QUIT
+13 if APPT'=$$GET1^DIQ(409.84,IEN40984,.01,"I")
QUIT
+14 DO DELVVSID
+15 SET RETURN=1
+16 QUIT
End DoDot:2
End DoDot:1
+17 QUIT
DELVVSID ;
+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
