SDAMUTDT ;BPOIFO/JFW,TAW,KML,LAB,TAW/JAS -Scheduling Encapsulation Utilities ;JAN 16,2026
;;5.3;Scheduling;**266,805,809,813,867,907,928**;13 Aug 1993;Build 5
;
;*****************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
;-------- ---------- -----------------------------------------
;1/24/06 SD*5.3*413 ROUTINE COMPLETED
;1/13/22 SD^5.3*805 Add FMTISO and ISOTFM to support clinic time zone different from system
;
;*****************************************************************
FMTISO(SDFMDT,SDCLINIC) ;convert internal fileman format to extended GMT
;initialize variables
;*****************************************************************
;INPUT SDFMDT - Fileman date/time
; SDCLINIC - OPT IEN from file 44
;OUTPUT -1 error occurred in translation
; GMT date/time in ISO 8601 extended format (No Errors)
;*****************************************************************
N SDDTM,SDGMT,SDTIME,SDOFFSET
I +$G(SDFMDT)=0 Q ""
S SDTIME=$P(SDFMDT,".",2)
I $E(SDTIME)>2 Q -1
I $E(SDTIME,1,2)>24 Q -1
I $E(SDTIME,1,2)=24,+$E(SDTIME,3,6)>0 Q -1
I $E(SDTIME,3,4)>59 Q -1
I $E(SDTIME,5,6)>59 Q -1
D FILEMANTOHL7^SDES2UTIL(.SDFMDT,.SDDTM)
Q:SDDTM<0 -1
S SDCLINIC=$G(SDCLINIC)
;If clinic offset is differnt from system, adjust SDFMDT
;I SDCLINIC D
;.S SDOFFSET=$$GETOFFSETDIFF(SDFMDT,SDCLINIC)
;.Q:SDOFFSET="" ;Clinic and system are the same
;.S HH=$EXTRACT(SDOFFSET,2,3)
;.S MM=$EXTRACT(SDOFFSET,4,5)
;.I $EXTRACT(SDOFFSET)="-" S HH=-HH,MM=-MM
;.S SDFMDT=$$FMADD^XLFDT(SDFMDT,,HH,MM)
;.S SDDTM=$$FMTHL7^XLFDT(SDFMDT)
;Gextract out date and convert to ISO 8601 extended format
S SDGMT=$E(SDDTM,1,4)_"-"_$E(SDDTM,5,6)_"-"_$E(SDDTM,7,8)
;if time is included, extract and convert to ISO 8601 external format
I $L(SDDTM)>8 D
.S SDTIME=$E(+SDDTM,9,99)
.S SDTIME=$$REMOVEOFFSET(SDTIME)
.;append hour and min
.S SDGMT=SDGMT_"T"_$E(SDTIME,1,2)_":"_$E(SDTIME,3,4)
.;include seconds
.I $L(SDTIME)>4 S SDGMT=SDGMT_":"_$E(SDTIME,5,6)
.S SDGMT=SDGMT_$$GETOFFSET(SDFMDT,SDCLINIC)
I SDGMT["-9999" S SDGMT=-1
Q SDGMT
;
ISOTFM(SDGMTDT,SDCLINIC) ;convert ISO 8601 extended GMT date/time to fileman format
;initialize variables
;*****************************************************************
;INPUT SDGMTDT - ISO 8601 extended GMT date/time
; SDCLINIC - OPT IEN from file 44
;OUTPUT -1 error occurred in translation
; FM date/time (No Errors)
;*****************************************************************
N SDFM,SDTIME,SDFMDTM,X,Y,%DT,SDFMTMP,POP,TMPFM,TMPDT,SDOFFSET,SDISOOFFSET
S (POP,SDOFFSET,TMPFM)=""
I $G(SDGMTDT)="" Q ""
;pattern match date(/time) for correctness
I '$$VALIDISO^SDECDATE(SDGMTDT) Q -1
;I $P(SDGMTDT,"T",2)="" Q -1
S SDCLINIC=$G(SDCLINIC)
;extract out date, removing punctuation
S SDFM=$TR($P(SDGMTDT,"T"),"-")
;set parameters to validate date/time
S %DT="TXS"
;extract out time if entered, removing all punctuation except for TZ offset
I $P(SDGMTDT,"T",2)'="" D
.S SDTIME=$P(SDGMTDT,"T",2)
.;Must have a time zone offset
.I SDTIME'["Z",SDTIME'["+",SDTIME'["-" S POP=1 Q
.;exclude time if 0's else FMTE returns previous date with .24
.S SDTIME=$$REMOVEOFFSET(SDTIME)
.S SDTIME=$P(SDTIME,".") ;No ractional seconds
.S SDTIME=$TR(SDTIME,":")
.I SDGMTDT'["00:00Z",+SDTIME=0 Q
.;Get the correct offset
.S TMPFM=$$CVTTOFM(SDGMTDT) ;Need a FM format of the ISO date that is passed in
.Q:TMPFM=-1 ;vse-2645 date is invalid so leave do dot logic and quit below
.S TMPFM=TMPFM_"."_SDTIME
.; IF ZULU reset SDGMTDT to match system time
.I SDGMTDT["Z"!(SDGMTDT["+0000") D
..S SDOFFSET=$$GETOFFSET(TMPFM,SDCLINIC)
..I SDOFFSET="BAD OFFSET" S SDOFFSET=-9999 Q
..D ADJUSTOFFSET(TMPFM,.SDOFFSET,SDCLINIC)
.E D
..S SDISOOFFSET=$$GETISOOFFSET(SDGMTDT)
..S SDOFFSET=$$GETOFFSETDIFF(TMPFM,SDCLINIC,SDISOOFFSET)
.;Build HLT formatted date with offset (Flip the sign on offset)
.S SDFM=SDFM_SDTIME_$$FLIPOFFSET(SDOFFSET)
I TMPFM=-1 Q -1
I SDFM["-9999"!(POP) Q -1
;
;convert date(/time) from HL7 format back to Fileman
I +SDOFFSET S SDFMDTM=$$HL7TFM^XLFDT(SDFM,"U")
I '(+SDOFFSET) S SDFMDTM=$$HL7TFM^XLFDT(SDFM)
Q:SDFMDTM<0 SDFMDTM ;error occurred in conversion
;check validity of date (including leap year check)
S X=$$FMTE^XLFDT(SDFMDTM)
D ^%DT
Q:Y<0 -1 ;date(/time) not valid
Q SDFMDTM
;
REMOVEOFFSET(TIME) ;
S TIME=$P(TIME,"-")
S TIME=$P(TIME,"+")
S TIME=$P(TIME,"Z")
Q TIME
GETISOOFFSET(DATE) ;
N ISOOFFSET
S ISOOFFSET=""
I $P(DATE,"+",2)'="" S ISOOFFSET="+"_$P(DATE,"+",2)
I ISOOFFSET="" S ISOOFFSET="-"_$P($P(DATE,"T",2),"-",2)
Q $TR(ISOOFFSET,":")
GETOFFSET(DATE,SDCLINIC) ;
N OFFSET
S OFFSET=""
;Clinc can be in a different time zone
I $G(SDCLINIC) S OFFSET=$$GETTZOFFSET^SDESUTIL(DATE,SDCLINIC)
;get offset for VistA Instance
I OFFSET="" S OFFSET=$$GETTZOFFSET^SDESUTIL(DATE)
I OFFSET=-1 S OFFSET="BAD OFFSET"
Q OFFSET
;
GETOFFSETDIFF(DATE,SDCLINIC,SDISOOFFSET) ;Compare offsets and return the difference
N SDCLNOFFSET,SDSYSOFFSET,OFFSET,TMPOFFSET
S (OFFSET,SDCLNOFFSET)=""
S (TMPOFFSET,SDSYSOFFSET)=$$GETOFFSET(DATE)
I $G(SDCLINIC) S (TMPOFFSET,SDCLNOFFSET)=$$GETOFFSET(DATE,SDCLINIC)
I TMPOFFSET=-1 Q "-9999"
I $E(SDISOOFFSET)?1N S SDISOOFFSET="+"_SDISOOFFSET
;If called from ISOTFM and ISO offset is different from the Clinic/System offset
I $G(SDISOOFFSET)'="",SDISOOFFSET'=TMPOFFSET D
.S OFFSET=TMPOFFSET-SDISOOFFSET
;
I $G(SDISOOFFSET)="",SDSYSOFFSET'=SDCLNOFFSET D
.S OFFSET=SDCLNOFFSET-SDSYSOFFSET
S:OFFSET=0 OFFSET=""
Q OFFSET
;
FLIPOFFSET(OFFSET) ;Need to flip the sign because HL7TFM will flip it back.
Q:+OFFSET=0 ""
I $E(OFFSET)="-" D
.S OFFSET=OFFSET*-1
.S OFFSET="+"_$E(10000+OFFSET,2,5)
E D
.S OFFSET="-"_$E(10000+OFFSET,2,5)
Q OFFSET
;
CVTTOFM(D) ;
N X,Y,%DT
S %DT=""
S X=$P(D,"T")
D ^%DT
Q Y
;
;
FMTGMT(SDFMDT) ;convert internal fileman format to extended GMT
;initialize variables
;*****************************************************************
;INPUT SDFMDT - Fileman date/time
;OUTPUT -1 error occurred in translation
; GMT date/time in ISO 8601 extended format (No Errors)
;*****************************************************************
N SDDTM,SDGMT,SDTIME,SDOFFSET
S SDDTM=$$FMTHL7^XLFDT(SDFMDT)
Q:SDDTM<0 -1
;extract out date and convert to ISO 8601 extended format
S SDGMT=$E(SDDTM,1,4)_"-"_$E(SDDTM,5,6)_"-"_$E(SDDTM,7,8)
;if time is included, extract and convert to ISO 8601 external format
I $L(SDDTM)>8 D
.S SDTIME=$E(+SDDTM,9,99),SDOFFSET=$$TZ^XLFDT()
.;determine if seconds are included in time
.I $L(SDTIME)<5 D
..;no seconds included in date/time
..S SDGMT=SDGMT_"T"_$E(SDDTM,9,10)_":"_$E(SDDTM,11,99)
.;seconds included in date/time
.E S SDGMT=SDGMT_"T"_$E(SDTIME,1,2)_":"_$E(SDTIME,3,4)_":"_$E(SDTIME,5,6)_SDOFFSET
Q SDGMT
;
GMTTFM(SDGMTDT) ;convert ISO 8601 extended GMT date/time to fileman format
;initialize variables
;*****************************************************************
;INPUT SDGMTDT - ISO 8601 extended GMT date/time
;OUTPUT -1 error occurred in translation
; FM date/time (No Errors)
;*****************************************************************
N SDFM,SDTIME,SDOFFSET,SDFMDTM,X,Y,%DT
;get offset for VistA Instance
S SDOFFSET=$$TZ^XLFDT()
;pattern match date(/time) for correctness
Q:((SDGMTDT["T")&'(SDGMTDT?4N1"-"2N1"-"2N1"T"2N1":"2N.E)) -1
Q:((SDGMTDT'["T")&'(SDGMTDT?4N1"-"2N1"-"2N)) -1
;extract out date, removing punctuation
S SDFM=$E(SDGMTDT,1,4)_$E(SDGMTDT,6,7)_$E(SDGMTDT,9,10)
;set parameters to validate date/time
S %DT="TXS"
;extract out time if entered, removing all punctuation except for TZ offset
I SDGMTDT>10 D
.S SDTIME=$P($E(SDGMTDT,12,99),$E(SDOFFSET,1,1))
.;exclude time if 0's else FMTE returns previous date with .24
.Q:((SDTIME["00:00")!(SDTIME["00:00:00"))
.;determine if seconds are included in time
.I $L(SDTIME)<6 D
..;no seconds include in date/time
..S SDFM=SDFM_$E(SDGMTDT,12,13)_$E(SDGMTDT,15,99)
.;seconds included in date/time
.E S SDFM=SDFM_$E(SDTIME,1,2)_$E(SDTIME,4,5)_$E(SDTIME,7,8)_"-"_SDOFFSET
;convert date(/time) from HL7 format back to Fileman
S SDFMDTM=$$HL7TFM^XLFDT(SDFM)
Q:SDFMDTM<0 SDFMDTM ;error occurred in conversion
;check validity of date (including leap year check)
S X=$$FMTE^XLFDT(SDFMDTM)
D ^%DT
Q:Y<0 -1 ;date(/time) not valid
Q SDFMDTM
;
SDAPIERR() ; SDAPI Error Messages.
;*****************************************************************
;INPUT N/A
;OUTPUT Extrinsic call returns error message
;*****************************************************************
N SDERR S SDERR=$O(^TMP($J,"SDAMA301",""))
I SDERR="" Q ""
I +SDERR=101 Q "Error 101: The Appointment Database is not currently available. Please try again later."
I +SDERR=115 Q "Error 115: Appointment request contains invalid values. Please contact National Help Desk."
Q "Error 117: An error has occurred, check the RSA Error Log."
ADJUSTOFFSET(FMDTTM,OFFSET,CLINIC) ;
N MONTH,TZDATA,YEAR,TIME,TIMEDIFF,DSTADJUST,DSTDATE
S MONTH=$E(FMDTTM,4,5)
I +MONTH'=3,MONTH'=11 Q
S CLINIC=$G(CLINIC)
S TZDATA=$$TIMEZONEDATA^SDES2UTIL(CLINIC)
I $P(TZDATA,"^",6)'="DST" Q
S YEAR=$E(FMDTTM,2,3)
I +MONTH=3 S DSTDATE=$$DSTSTART^SDES2UTIL(YEAR,"DST"),DSTADJUST=4
I +MONTH=11 S DSTDATE=$$DSTEND^SDES2UTIL(YEAR,"DST"),DSTADJUST=5
I $P(FMDTTM,".",1)'=DSTDATE Q
S TIME=$P(FMDTTM,".",2)
S TIME=$E(TIME_"0000",1,4)
S TIMEDIFF=TIME+OFFSET
; TIME=0600 OFFSET=-0500
I (DSTADJUST=5)&(TIMEDIFF>59) Q
I (DSTADJUST=4)&(TIMEDIFF>259) Q
S OFFSET=$P(TZDATA,"^",DSTADJUST)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMUTDT 9857 printed Mar 25, 2026@16:13:07 Page 2
SDAMUTDT ;BPOIFO/JFW,TAW,KML,LAB,TAW/JAS -Scheduling Encapsulation Utilities ;JAN 16,2026
+1 ;;5.3;Scheduling;**266,805,809,813,867,907,928**;13 Aug 1993;Build 5
+2 ;
+3 ;*****************************************************************
+4 ; CHANGE LOG
+5 ;
+6 ; DATE PATCH DESCRIPTION
+7 ;-------- ---------- -----------------------------------------
+8 ;1/24/06 SD*5.3*413 ROUTINE COMPLETED
+9 ;1/13/22 SD^5.3*805 Add FMTISO and ISOTFM to support clinic time zone different from system
+10 ;
+11 ;*****************************************************************
FMTISO(SDFMDT,SDCLINIC) ;convert internal fileman format to extended GMT
+1 ;initialize variables
+2 ;*****************************************************************
+3 ;INPUT SDFMDT - Fileman date/time
+4 ; SDCLINIC - OPT IEN from file 44
+5 ;OUTPUT -1 error occurred in translation
+6 ; GMT date/time in ISO 8601 extended format (No Errors)
+7 ;*****************************************************************
+8 NEW SDDTM,SDGMT,SDTIME,SDOFFSET
+9 IF +$GET(SDFMDT)=0
QUIT ""
+10 SET SDTIME=$PIECE(SDFMDT,".",2)
+11 IF $EXTRACT(SDTIME)>2
QUIT -1
+12 IF $EXTRACT(SDTIME,1,2)>24
QUIT -1
+13 IF $EXTRACT(SDTIME,1,2)=24
IF +$EXTRACT(SDTIME,3,6)>0
QUIT -1
+14 IF $EXTRACT(SDTIME,3,4)>59
QUIT -1
+15 IF $EXTRACT(SDTIME,5,6)>59
QUIT -1
+16 DO FILEMANTOHL7^SDES2UTIL(.SDFMDT,.SDDTM)
+17 if SDDTM<0
QUIT -1
+18 SET SDCLINIC=$GET(SDCLINIC)
+19 ;If clinic offset is differnt from system, adjust SDFMDT
+20 ;I SDCLINIC D
+21 ;.S SDOFFSET=$$GETOFFSETDIFF(SDFMDT,SDCLINIC)
+22 ;.Q:SDOFFSET="" ;Clinic and system are the same
+23 ;.S HH=$EXTRACT(SDOFFSET,2,3)
+24 ;.S MM=$EXTRACT(SDOFFSET,4,5)
+25 ;.I $EXTRACT(SDOFFSET)="-" S HH=-HH,MM=-MM
+26 ;.S SDFMDT=$$FMADD^XLFDT(SDFMDT,,HH,MM)
+27 ;.S SDDTM=$$FMTHL7^XLFDT(SDFMDT)
+28 ;Gextract out date and convert to ISO 8601 extended format
+29 SET SDGMT=$EXTRACT(SDDTM,1,4)_"-"_$EXTRACT(SDDTM,5,6)_"-"_$EXTRACT(SDDTM,7,8)
+30 ;if time is included, extract and convert to ISO 8601 external format
+31 IF $LENGTH(SDDTM)>8
Begin DoDot:1
+32 SET SDTIME=$EXTRACT(+SDDTM,9,99)
+33 SET SDTIME=$$REMOVEOFFSET(SDTIME)
+34 ;append hour and min
+35 SET SDGMT=SDGMT_"T"_$EXTRACT(SDTIME,1,2)_":"_$EXTRACT(SDTIME,3,4)
+36 ;include seconds
+37 IF $LENGTH(SDTIME)>4
SET SDGMT=SDGMT_":"_$EXTRACT(SDTIME,5,6)
+38 SET SDGMT=SDGMT_$$GETOFFSET(SDFMDT,SDCLINIC)
End DoDot:1
+39 IF SDGMT["-9999"
SET SDGMT=-1
+40 QUIT SDGMT
+41 ;
ISOTFM(SDGMTDT,SDCLINIC) ;convert ISO 8601 extended GMT date/time to fileman format
+1 ;initialize variables
+2 ;*****************************************************************
+3 ;INPUT SDGMTDT - ISO 8601 extended GMT date/time
+4 ; SDCLINIC - OPT IEN from file 44
+5 ;OUTPUT -1 error occurred in translation
+6 ; FM date/time (No Errors)
+7 ;*****************************************************************
+8 NEW SDFM,SDTIME,SDFMDTM,X,Y,%DT,SDFMTMP,POP,TMPFM,TMPDT,SDOFFSET,SDISOOFFSET
+9 SET (POP,SDOFFSET,TMPFM)=""
+10 IF $GET(SDGMTDT)=""
QUIT ""
+11 ;pattern match date(/time) for correctness
+12 IF '$$VALIDISO^SDECDATE(SDGMTDT)
QUIT -1
+13 ;I $P(SDGMTDT,"T",2)="" Q -1
+14 SET SDCLINIC=$GET(SDCLINIC)
+15 ;extract out date, removing punctuation
+16 SET SDFM=$TRANSLATE($PIECE(SDGMTDT,"T"),"-")
+17 ;set parameters to validate date/time
+18 SET %DT="TXS"
+19 ;extract out time if entered, removing all punctuation except for TZ offset
+20 IF $PIECE(SDGMTDT,"T",2)'=""
Begin DoDot:1
+21 SET SDTIME=$PIECE(SDGMTDT,"T",2)
+22 ;Must have a time zone offset
+23 IF SDTIME'["Z"
IF SDTIME'["+"
IF SDTIME'["-"
SET POP=1
QUIT
+24 ;exclude time if 0's else FMTE returns previous date with .24
+25 SET SDTIME=$$REMOVEOFFSET(SDTIME)
+26 ;No ractional seconds
SET SDTIME=$PIECE(SDTIME,".")
+27 SET SDTIME=$TRANSLATE(SDTIME,":")
+28 IF SDGMTDT'["00:00Z"
IF +SDTIME=0
QUIT
+29 ;Get the correct offset
+30 ;Need a FM format of the ISO date that is passed in
SET TMPFM=$$CVTTOFM(SDGMTDT)
+31 ;vse-2645 date is invalid so leave do dot logic and quit below
if TMPFM=-1
QUIT
+32 SET TMPFM=TMPFM_"."_SDTIME
+33 ; IF ZULU reset SDGMTDT to match system time
+34 IF SDGMTDT["Z"!(SDGMTDT["+0000")
Begin DoDot:2
+35 SET SDOFFSET=$$GETOFFSET(TMPFM,SDCLINIC)
+36 IF SDOFFSET="BAD OFFSET"
SET SDOFFSET=-9999
QUIT
+37 DO ADJUSTOFFSET(TMPFM,.SDOFFSET,SDCLINIC)
End DoDot:2
+38 IF '$TEST
Begin DoDot:2
+39 SET SDISOOFFSET=$$GETISOOFFSET(SDGMTDT)
+40 SET SDOFFSET=$$GETOFFSETDIFF(TMPFM,SDCLINIC,SDISOOFFSET)
End DoDot:2
+41 ;Build HLT formatted date with offset (Flip the sign on offset)
+42 SET SDFM=SDFM_SDTIME_$$FLIPOFFSET(SDOFFSET)
End DoDot:1
+43 IF TMPFM=-1
QUIT -1
+44 IF SDFM["-9999"!(POP)
QUIT -1
+45 ;
+46 ;convert date(/time) from HL7 format back to Fileman
+47 IF +SDOFFSET
SET SDFMDTM=$$HL7TFM^XLFDT(SDFM,"U")
+48 IF '(+SDOFFSET)
SET SDFMDTM=$$HL7TFM^XLFDT(SDFM)
+49 ;error occurred in conversion
if SDFMDTM<0
QUIT SDFMDTM
+50 ;check validity of date (including leap year check)
+51 SET X=$$FMTE^XLFDT(SDFMDTM)
+52 DO ^%DT
+53 ;date(/time) not valid
if Y<0
QUIT -1
+54 QUIT SDFMDTM
+55 ;
REMOVEOFFSET(TIME) ;
+1 SET TIME=$PIECE(TIME,"-")
+2 SET TIME=$PIECE(TIME,"+")
+3 SET TIME=$PIECE(TIME,"Z")
+4 QUIT TIME
GETISOOFFSET(DATE) ;
+1 NEW ISOOFFSET
+2 SET ISOOFFSET=""
+3 IF $PIECE(DATE,"+",2)'=""
SET ISOOFFSET="+"_$PIECE(DATE,"+",2)
+4 IF ISOOFFSET=""
SET ISOOFFSET="-"_$PIECE($PIECE(DATE,"T",2),"-",2)
+5 QUIT $TRANSLATE(ISOOFFSET,":")
GETOFFSET(DATE,SDCLINIC) ;
+1 NEW OFFSET
+2 SET OFFSET=""
+3 ;Clinc can be in a different time zone
+4 IF $GET(SDCLINIC)
SET OFFSET=$$GETTZOFFSET^SDESUTIL(DATE,SDCLINIC)
+5 ;get offset for VistA Instance
+6 IF OFFSET=""
SET OFFSET=$$GETTZOFFSET^SDESUTIL(DATE)
+7 IF OFFSET=-1
SET OFFSET="BAD OFFSET"
+8 QUIT OFFSET
+9 ;
GETOFFSETDIFF(DATE,SDCLINIC,SDISOOFFSET) ;Compare offsets and return the difference
+1 NEW SDCLNOFFSET,SDSYSOFFSET,OFFSET,TMPOFFSET
+2 SET (OFFSET,SDCLNOFFSET)=""
+3 SET (TMPOFFSET,SDSYSOFFSET)=$$GETOFFSET(DATE)
+4 IF $GET(SDCLINIC)
SET (TMPOFFSET,SDCLNOFFSET)=$$GETOFFSET(DATE,SDCLINIC)
+5 IF TMPOFFSET=-1
QUIT "-9999"
+6 IF $EXTRACT(SDISOOFFSET)?1N
SET SDISOOFFSET="+"_SDISOOFFSET
+7 ;If called from ISOTFM and ISO offset is different from the Clinic/System offset
+8 IF $GET(SDISOOFFSET)'=""
IF SDISOOFFSET'=TMPOFFSET
Begin DoDot:1
+9 SET OFFSET=TMPOFFSET-SDISOOFFSET
End DoDot:1
+10 ;
+11 IF $GET(SDISOOFFSET)=""
IF SDSYSOFFSET'=SDCLNOFFSET
Begin DoDot:1
+12 SET OFFSET=SDCLNOFFSET-SDSYSOFFSET
End DoDot:1
+13 if OFFSET=0
SET OFFSET=""
+14 QUIT OFFSET
+15 ;
FLIPOFFSET(OFFSET) ;Need to flip the sign because HL7TFM will flip it back.
+1 if +OFFSET=0
QUIT ""
+2 IF $EXTRACT(OFFSET)="-"
Begin DoDot:1
+3 SET OFFSET=OFFSET*-1
+4 SET OFFSET="+"_$EXTRACT(10000+OFFSET,2,5)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET OFFSET="-"_$EXTRACT(10000+OFFSET,2,5)
End DoDot:1
+7 QUIT OFFSET
+8 ;
CVTTOFM(D) ;
+1 NEW X,Y,%DT
+2 SET %DT=""
+3 SET X=$PIECE(D,"T")
+4 DO ^%DT
+5 QUIT Y
+6 ;
+7 ;
FMTGMT(SDFMDT) ;convert internal fileman format to extended GMT
+1 ;initialize variables
+2 ;*****************************************************************
+3 ;INPUT SDFMDT - Fileman date/time
+4 ;OUTPUT -1 error occurred in translation
+5 ; GMT date/time in ISO 8601 extended format (No Errors)
+6 ;*****************************************************************
+7 NEW SDDTM,SDGMT,SDTIME,SDOFFSET
+8 SET SDDTM=$$FMTHL7^XLFDT(SDFMDT)
+9 if SDDTM<0
QUIT -1
+10 ;extract out date and convert to ISO 8601 extended format
+11 SET SDGMT=$EXTRACT(SDDTM,1,4)_"-"_$EXTRACT(SDDTM,5,6)_"-"_$EXTRACT(SDDTM,7,8)
+12 ;if time is included, extract and convert to ISO 8601 external format
+13 IF $LENGTH(SDDTM)>8
Begin DoDot:1
+14 SET SDTIME=$EXTRACT(+SDDTM,9,99)
SET SDOFFSET=$$TZ^XLFDT()
+15 ;determine if seconds are included in time
+16 IF $LENGTH(SDTIME)<5
Begin DoDot:2
+17 ;no seconds included in date/time
+18 SET SDGMT=SDGMT_"T"_$EXTRACT(SDDTM,9,10)_":"_$EXTRACT(SDDTM,11,99)
End DoDot:2
+19 ;seconds included in date/time
+20 IF '$TEST
SET SDGMT=SDGMT_"T"_$EXTRACT(SDTIME,1,2)_":"_$EXTRACT(SDTIME,3,4)_":"_$EXTRACT(SDTIME,5,6)_SDOFFSET
End DoDot:1
+21 QUIT SDGMT
+22 ;
GMTTFM(SDGMTDT) ;convert ISO 8601 extended GMT date/time to fileman format
+1 ;initialize variables
+2 ;*****************************************************************
+3 ;INPUT SDGMTDT - ISO 8601 extended GMT date/time
+4 ;OUTPUT -1 error occurred in translation
+5 ; FM date/time (No Errors)
+6 ;*****************************************************************
+7 NEW SDFM,SDTIME,SDOFFSET,SDFMDTM,X,Y,%DT
+8 ;get offset for VistA Instance
+9 SET SDOFFSET=$$TZ^XLFDT()
+10 ;pattern match date(/time) for correctness
+11 if ((SDGMTDT["T")&'(SDGMTDT?4N1"-"2N1"-"2N1"T"2N1"
QUIT -1
+12 if ((SDGMTDT'["T")&'(SDGMTDT?4N1"-"2N1"-"2N))
QUIT -1
+13 ;extract out date, removing punctuation
+14 SET SDFM=$EXTRACT(SDGMTDT,1,4)_$EXTRACT(SDGMTDT,6,7)_$EXTRACT(SDGMTDT,9,10)
+15 ;set parameters to validate date/time
+16 SET %DT="TXS"
+17 ;extract out time if entered, removing all punctuation except for TZ offset
+18 IF SDGMTDT>10
Begin DoDot:1
+19 SET SDTIME=$PIECE($EXTRACT(SDGMTDT,12,99),$EXTRACT(SDOFFSET,1,1))
+20 ;exclude time if 0's else FMTE returns previous date with .24
+21 if ((SDTIME["00
QUIT
+22 ;determine if seconds are included in time
+23 IF $LENGTH(SDTIME)<6
Begin DoDot:2
+24 ;no seconds include in date/time
+25 SET SDFM=SDFM_$EXTRACT(SDGMTDT,12,13)_$EXTRACT(SDGMTDT,15,99)
End DoDot:2
+26 ;seconds included in date/time
+27 IF '$TEST
SET SDFM=SDFM_$EXTRACT(SDTIME,1,2)_$EXTRACT(SDTIME,4,5)_$EXTRACT(SDTIME,7,8)_"-"_SDOFFSET
End DoDot:1
+28 ;convert date(/time) from HL7 format back to Fileman
+29 SET SDFMDTM=$$HL7TFM^XLFDT(SDFM)
+30 ;error occurred in conversion
if SDFMDTM<0
QUIT SDFMDTM
+31 ;check validity of date (including leap year check)
+32 SET X=$$FMTE^XLFDT(SDFMDTM)
+33 DO ^%DT
+34 ;date(/time) not valid
if Y<0
QUIT -1
+35 QUIT SDFMDTM
+36 ;
SDAPIERR() ; SDAPI Error Messages.
+1 ;*****************************************************************
+2 ;INPUT N/A
+3 ;OUTPUT Extrinsic call returns error message
+4 ;*****************************************************************
+5 NEW SDERR
SET SDERR=$ORDER(^TMP($JOB,"SDAMA301",""))
+6 IF SDERR=""
QUIT ""
+7 IF +SDERR=101
QUIT "Error 101: The Appointment Database is not currently available. Please try again later."
+8 IF +SDERR=115
QUIT "Error 115: Appointment request contains invalid values. Please contact National Help Desk."
+9 QUIT "Error 117: An error has occurred, check the RSA Error Log."
ADJUSTOFFSET(FMDTTM,OFFSET,CLINIC) ;
+1 NEW MONTH,TZDATA,YEAR,TIME,TIMEDIFF,DSTADJUST,DSTDATE
+2 SET MONTH=$EXTRACT(FMDTTM,4,5)
+3 IF +MONTH'=3
IF MONTH'=11
QUIT
+4 SET CLINIC=$GET(CLINIC)
+5 SET TZDATA=$$TIMEZONEDATA^SDES2UTIL(CLINIC)
+6 IF $PIECE(TZDATA,"^",6)'="DST"
QUIT
+7 SET YEAR=$EXTRACT(FMDTTM,2,3)
+8 IF +MONTH=3
SET DSTDATE=$$DSTSTART^SDES2UTIL(YEAR,"DST")
SET DSTADJUST=4
+9 IF +MONTH=11
SET DSTDATE=$$DSTEND^SDES2UTIL(YEAR,"DST")
SET DSTADJUST=5
+10 IF $PIECE(FMDTTM,".",1)'=DSTDATE
QUIT
+11 SET TIME=$PIECE(FMDTTM,".",2)
+12 SET TIME=$EXTRACT(TIME_"0000",1,4)
+13 SET TIMEDIFF=TIME+OFFSET
+14 ; TIME=0600 OFFSET=-0500
+15 IF (DSTADJUST=5)&(TIMEDIFF>59)
QUIT
+16 IF (DSTADJUST=4)&(TIMEDIFF>259)
QUIT
+17 SET OFFSET=$PIECE(TZDATA,"^",DSTADJUST)
+18 QUIT
