SDTMPHLC ;TMP/DRF - TMP HL7 Routine;May 29, 2018
;;5.3;Scheduling;**780,806,798,821,863**;Aug 13, 1993;Build 14
Q
;
EN(CLINID,NCDATE,NCSTOP,FUNCTION,COMMENT) ;Entry to the routine to build an HL7 message
;notification to TMP about a new Non-Clinic Day
;CLINID = Clinic ID
;NCDATE = Start time for Non-Clinic Day Date (FM)or partial day cancellation
;NCSTOP = Stop time for partial day cancellation
;FUNCTION = "C" (Cancel Day) Or "UC" (Uncancel Day) Or "P" (Cancel Partial) or "UP" (Uncancel Partial)
;COMMENT = Name Of Holiday (From HOLIDAY #40.5) Or "**CANCELLED**"
;
;Call API to create MSH segment
Q:CLINID=""
Q:NCDATE=""
Q:FUNCTION=""
Q:COMMENT=""
I FUNCTION["P",(NCDATE=""!(NCSTOP="")) Q ;Need start and stop time to cancel partial day
N ANODE,ANODE1,APTTM,CLINODE,CNODE,ERROR,LENGTH,MSG,PARMS,RTN,SEG,SNODE,START,WHOTO
;S ^ZDRF("SDTX",$H,CLINID,NCDATE,FUNCTION)=$G(NCSTOP) H 1
S (SSTOP,PSTOP,STOP)=0
I FUNCTION["C" S APTTM=$P(NCDATE,".",1)_".0"
I FUNCTION["P" S APTTM=NCDATE
S RTN=0,CAN=0 ;CAN=0 BLOCK DAYS/HOURS
S CLINODE=$G(^SC(CLINID,0))
S PSTOP=$P(CLINODE,"^",7),SSTOP=$P(CLINODE,"^",18)
;If both stop codes are null, stop the check, we know it is not a tele health clinic
Q:($G(PSTOP)="")&(($G(SSTOP))="")
S STOP=$$CHKCLIN(PSTOP) ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic
I $G(STOP)=0 Q:$G(SSTOP)'>0 S STOP=$$CHKCLIN(SSTOP) ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop ;773
Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic
S:CAN=0 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S12" ;Should be S23
S:CAN=1 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S12" ;Should be S24
I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) Q 0
S SEQ=1
D SCH("",1,.SEG,$G(ANODE),$G(SNODE))
I (CAN=0&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0
D NTE(.SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D RGS1("A",SEQ,.SEG) ;required segment
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
D AIL1(CLINID,SEQ,.SEG)
I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
S PARMS("SENDING APPLICATION")="TMP_OUT"
S PARMS("APP ACK TYPE")="AL"
S WHOTO("RECEIVING APPLICATION")="TMP VIMT"
S WHOTO("FACILITY LINK NAME")="TMP_SEND"
S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0))
S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
K CAN,APTSTATUS,SSTOP,PSTOP,STOP,CLINID,PROVID,PROVNM,XX
Q RTN
PID(DFN,SEQ,SEG) ;
N VA,VADM,VAHOW,VAROOT,VATEST,VAPA,NAME,DOB,SSN,ICN,ADDRESS
K SEG S SEG=""
S VAHOW=1
D DEM^VADPT
S NAME=VADM("NM") D STDNAME^XLFNAME(.NAME,"C")
S DOB=$P(VADM("DB"),"^"),SSN=$P(VADM("SS"),"^")
S VAHOW=""
D ADD^VADPT
S ADDRESS("STREET")=VAPA(1),ADDRESS("STREET2")=VAPA(2),ADDRESS("CITY")=VAPA(4),ADDRESS("STATE")=$P(VAPA(5),"^",2),ADDRESS("ZIP")=VAPA(6)
S ICN=$$GETICN^MPIF001(DFN)
D SET^HLOAPI(.SEG,"PID",0) ; Set segment type to PID
D SET^HLOAPI(.SEG,SEQ,1) ; Set PID-1
; set ICN into PID-3, repitition 1
D SET^HLOAPI(.SEG,+ICN,3,1,1,1) ; Component 1, subcomponent 1, Patient ICN
D SET^HLOAPI(.SEG,$P(ICN,"V",2),3,2,1,1) ; Component 1, subcomponent 2, Patient ICN checksum
D SET^HLOAPI(.SEG,DFN,4,1,1,1) ; patient DFN
D SET^HLOAPI(.SEG,"USVHA",3,4,1,1) ; component 4, subcomponent1
D SET^HLOAPI(.SEG,"0363",3,5,1,1) ; component 5
; set SSN into PID-3, repetition 2
D SET^HLOAPI(.SEG,SSN,3,1,1,2) ;component 1, subcomponent1
D SET^HLOAPI(.SEG,"USSSA",3,4,1,2) ; Component 4, subcomponent 1
D SET^HLOAPI(.SEG,"0363",3,4,3,2) ; component 4, subcomponent 3
D SET^HLOAPI(.SEG,"SS",3,5,1,2) ; component 1
;Set the name into PID-5
D SETXPN^HLOAPI4(.SEG,.NAME,5)
; Set the DOB into PID-7
D SETDT^HLOAPI4(.SEG,DOB,7)
; set the address into PID-11
D SETAD^HLOAPI4(.SEG,.ADDRESS,11)
Q
PD1 ; Not needed right now
Q
PV1(DFN,SEQ,SEG) ;
N FAC
S CLASS="OUTPATIENT"
S FAC=$$KSP^XUPARAM("INST")
D SET^HLOAPI(.SEG,"PV1",0) ; Set the segment type
D SET^HLOAPI(.SEG,SEQ,1) ; Set the PV1-1
; set the PV1-2, patient class (tbl 5-20 in the TMP HL7 specification
D SET^HLOAPI(.SEG,CLASS,2) ;
; set the PV1-4, Purpose of Visit
D SET^HLOAPI(.SEG,APTSTATUS,4)
; set the PV1-7, provider
D SET^HLOAPI(.SEG,$G(PROVID),7,1,1)
D SET^HLOAPI(.SEG,$G(PROVNM),7,2,1)
; set the PV1-39 facility id
D SET^HLOAPI(.SEG,FAC,39)
K CLASS
Q
SCH(DFN,SEQ,SEG,ANODE,SNODE) ; update for new appointments
N APTSTATUS,CONNM,END,ENTEREDBY,PREMAIL,SCHED,SCHEMAIL,STATUS,TMUNITS
S TMUNITS="M"
S LENGTH=$S(FUNCTION["C":1440,FUNCTION["P":$$FMDIFF^XLFDT(NCSTOP,NCDATE,2)/60,1:0)
S START=$$TMCONV(NCDATE,$$INST(CLINID))
S:$G(CNODE)>0 CONNM=$P(^GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^")
S (PROVID,PROVNM,PREMAIL)=""
S STATUS("ID")=$S(FUNCTION["U":"RCD",1:"NCD"),STATUS("TEXT")=COMMENT,STATUS("SYSTEM")=44
S APTSTATUS=""
S ENTEREDBY=$P(^VA(200,$G(DUZ),0),"^"),SCHEMAIL=$P($G(^VA(200,$G(DUZ),.15)),"^",1)
D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type
D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1
D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status
D SET^HLOAPI(.SEG,LENGTH,9)
D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units
D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start time
D SET^HLOAPI(.SEG,"",11,5,1,1) ; Field 11, appointment end time
D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz
D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name
D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail
D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment
D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email
D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment
Q
PV2 ; Not needed right now
Q
OBX1 ; Not needed right now
Q
OBX2 ; Not needed right now
Q
OBX3 ; Not needed right now
Q
OBX4 ; Not needed right now
Q
RGS1(FLAG,SEQ,SEG) ; At least one RGS segment is required
N GRP
S GRP=""
D SET^HLOAPI(.SEG,"RGS",0)
D SET^HLOAPI(.SEG,SEQ,1)
D SET^HLOAPI(.SEG,FLAG,2)
D SET^HLOAPI(.SEG,GRP,3)
Q
AIS1(FLAG,SEQ,SEG) ;
Q
NTE(SEQ,SEG) ;
N NOTES,CLINID,CLINNM
S NOTES=COMMENT
D SET^HLOAPI(.SEG,"NTE",0)
D SET^HLOAPI(.SEG,SEQ,1)
D SET^HLOAPI(.SEG,"NOTES",3)
D SET^HLOAPI(.SEG,NOTES,4)
Q
AIL1(CLINID,SEQ,SEG) ;
K LOC
S LOC("ID")=CLINID,LOC("TEXT")=$P(^SC(CLINID,0),"^"),LOC("SYSTEM")="44",CODE="A"
S LOC("ALTERNATE ID")=$$STATION^SDTMPHLA(CLINID)
D SET^HLOAPI(.SEG,"AIL",0)
D SET^HLOAPI(.SEG,SEQ,1)
D SET^HLOAPI(.SEG,CODE,2)
D SETCE^HLOAPI4(.SEG,.LOC,4)
D SET^HLOAPI(.SEG,START,6) ;ORIG START DATE JSON FMT
D SET^HLOAPI(.SEG,LENGTH,9) ;DURATION IN MINUTES
D SET^HLOAPI(.SEG,"M",10) ;M = MINUTES
K LOC,CODE
Q
TMCONV(X,INST) ;Uses division/institution to determine tz instead of mailman files / 773
;convert FileMan local time to Zulu timezone in JSON format: YYYY-MM-DDTHH:MM:00.000Z
;Inputs:
; X = Time
; INST = Institution
;Output:
; Zulu Time in JSON format
N OFFSET,UTC,UTC1,UTC2
I X#1=0 S X=X+.000001 ;Add 1 second if midnight to avoid midnight problem in DIUTC. The second is not included in UTC2
S OFFSET=$P($$UTC^DIUTC(X,,$G(INST),,1),"^",3)
S UTC=$$FMADD^XLFDT(X,,-$G(OFFSET),,),UTC1=$$FMTHL7^XLFDT(UTC)
S UTC2=$E(UTC1,1,4)_"-"_$E(UTC1,5,6)_"-"_$E(UTC1,7,8)_"T"_$E(UTC1,9,10)_":"_$E(UTC1,11,12)_":00.000Z"
Q UTC2
INST(CLNC) ;Derives the institution value for the clinic
;Inputs:
; CLNC = Clinic IEN from the Hospital Location (#44) file
;Output:
; INST = Institution IEN from the Institution (#4) file. Null indicates an error.
I CLNC="" Q ""
N DIV,INST,MCD0,NEWINST,TZ
S MCD0=$G(^SC(CLNC,0))
I MCD0="" Q "" ;No entry in the Hospital Location (#44) file
S INST=$P(MCD0,U,4)
I INST S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST
S DIV=$P(MCD0,U,15) I 'DIV Q ""
S INST=$P($G(^DG(40.8,DIV,0)),U,7)
S NEWINST=$$CHKINST(INST)
Q NEWINST
CHKCLIN(X) ; check to see if this is a primary or secondary stop code for a tele health clinic
I $G(X)'>0 S STOP=0 Q STOP
S STOP=0
N TEST,I,CODE,X1,X2
S X2=0
S X1=$$GET1^DIQ(40.7,X_",",1,"I") I X1="" Q STOP
S X2=$O(^SD(40.6,"B",X1,""))
S:$G(X2)>0 STOP=1
Q STOP
CHKINST(INST) ;Derives the parent institution if the passed-in institution does not have a time zone
I 'INST Q ""
N TZ,AS
S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST
S AS=$O(^DIC(4,INST,7,"B",2,"")) I AS S INST=$P(^DIC(4,INST,7,AS,0),U,2)
I INST S TZ=$P($G(^DIC(4,INST,8)),U,1)
I TZ Q INST
Q "" ;Never found an institution with a timezone
STATUS(X) ; a $Select to convert code to text too many characters in a single line. returns the text version of the appointment code
S X1=""
I $G(X)="" Q X1
S:X="N" X1="NO-SHOW"
S:X="C" X1="CANCELLED BY CLINIC"
S:X="NA" X1="NO&AUTO RE-BOOK"
S:X="CA" X1="CANCELLED BY CLINIC & AUTO RE-BOOK"
S:X="I" X1="INPATIENT APPOINTMENT"
S:X="PC" X1="CANCELLED BY PATIENT"
S:X="PCA" X1="CANCELLED BY PATIENT & AUTO-REBOOK"
S:X="NT" X1="NO ACTION TAKEN"
S:X="S" X1="SCHEDULED"
Q X1
SEND(SC,DATE,PATTERN) ;Send a transaction from SDBUILD - SD*5.3*806
;SC = Clinic
;DATE = Date
;PATTERN = New pattern being recorded
N OLDPAT,JOB,LIMIT
S LIMIT=$$DAYSINFUTURE^SDB1(SC,DT)
I DATE>$$FMADD^XLFDT(DT,LIMIT) Q ;Stop sending No Appointment Availability transactions *863
S OLDPAT=$P($G(^SC(SC,"ST",DATE,1)),"[",2),JOB=$J
;No appointments previously available, send unblock transaction
I OLDPAT="",$P(PATTERN,"[",2)]"" S SEQ=$P($G(^XTMP("SDTMPX",JOB,"SEQ")),U,1)+1,^XTMP("SDTMPX",JOB,SEQ)=SC_"^"_$H_"^"_DATE_"^"_DUZ_"^"_"UC",$P(^XTMP("SDTMPX",JOB,"SEQ"),U,1)=SEQ Q
;Appointments previously available, now none - send block transaction
I OLDPAT]"",$P(PATTERN,"[",2)="" S SEQ=$P($G(^XTMP("SDTMPX",JOB,"SEQ")),U,1)+1,^XTMP("SDTMPX",JOB,SEQ)=SC_"^"_$H_"^"_DATE_"^"_DUZ_"^"_"C",$P(^XTMP("SDTMPX",JOB,"SEQ"),U,1)=SEQ Q
Q ;Change neither creates or deletes all availability, so no transaction sent
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDTMPHLC 10130 printed Dec 13, 2024@03:01:35 Page 2
SDTMPHLC ;TMP/DRF - TMP HL7 Routine;May 29, 2018
+1 ;;5.3;Scheduling;**780,806,798,821,863**;Aug 13, 1993;Build 14
+2 QUIT
+3 ;
EN(CLINID,NCDATE,NCSTOP,FUNCTION,COMMENT) ;Entry to the routine to build an HL7 message
+1 ;notification to TMP about a new Non-Clinic Day
+2 ;CLINID = Clinic ID
+3 ;NCDATE = Start time for Non-Clinic Day Date (FM)or partial day cancellation
+4 ;NCSTOP = Stop time for partial day cancellation
+5 ;FUNCTION = "C" (Cancel Day) Or "UC" (Uncancel Day) Or "P" (Cancel Partial) or "UP" (Uncancel Partial)
+6 ;COMMENT = Name Of Holiday (From HOLIDAY #40.5) Or "**CANCELLED**"
+7 ;
+8 ;Call API to create MSH segment
+9 if CLINID=""
QUIT
+10 if NCDATE=""
QUIT
+11 if FUNCTION=""
QUIT
+12 if COMMENT=""
QUIT
+13 ;Need start and stop time to cancel partial day
IF FUNCTION["P"
IF (NCDATE=""!(NCSTOP=""))
QUIT
+14 NEW ANODE,ANODE1,APTTM,CLINODE,CNODE,ERROR,LENGTH,MSG,PARMS,RTN,SEG,SNODE,START,WHOTO
+15 ;S ^ZDRF("SDTX",$H,CLINID,NCDATE,FUNCTION)=$G(NCSTOP) H 1
+16 SET (SSTOP,PSTOP,STOP)=0
+17 IF FUNCTION["C"
SET APTTM=$PIECE(NCDATE,".",1)_".0"
+18 IF FUNCTION["P"
SET APTTM=NCDATE
+19 ;CAN=0 BLOCK DAYS/HOURS
SET RTN=0
SET CAN=0
+20 SET CLINODE=$GET(^SC(CLINID,0))
+21 SET PSTOP=$PIECE(CLINODE,"^",7)
SET SSTOP=$PIECE(CLINODE,"^",18)
+22 ;If both stop codes are null, stop the check, we know it is not a tele health clinic
+23 if ($GET(PSTOP)="")&(($GET(SSTOP))="")
QUIT
+24 ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic
SET STOP=$$CHKCLIN(PSTOP)
+25 ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop ;773
IF $GET(STOP)=0
if $GET(SSTOP)'>0
QUIT
SET STOP=$$CHKCLIN(SSTOP)
+26 ; Double check for either primary or secondary stop code to be a tele health clinic
if $GET(STOP)=0
QUIT
+27 ;Should be S23
if CAN=0
SET PARMS("MESSAGE TYPE")="SIU"
SET PARMS("EVENT")="S12"
+28 ;Should be S24
if CAN=1
SET PARMS("MESSAGE TYPE")="SIU"
SET PARMS("EVENT")="S12"
+29 IF '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR)
QUIT 0
+30 SET SEQ=1
+31 DO SCH("",1,.SEG,$GET(ANODE),$GET(SNODE))
+32 IF (CAN=0&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)))
QUIT 0
+33 DO NTE(.SEQ,.SEG)
+34 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+35 ;required segment
DO RGS1("A",SEQ,.SEG)
+36 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+37 DO AIL1(CLINID,SEQ,.SEG)
+38 IF '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR)
QUIT 0
+39 SET PARMS("SENDING APPLICATION")="TMP_OUT"
+40 SET PARMS("APP ACK TYPE")="AL"
+41 SET WHOTO("RECEIVING APPLICATION")="TMP VIMT"
+42 SET WHOTO("FACILITY LINK NAME")="TMP_SEND"
+43 SET WHOTO("FACILITY LINK IEN")=$ORDER(^HLCS(870,"B","TMP_SEND",0))
+44 SET RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
+45 KILL CAN,APTSTATUS,SSTOP,PSTOP,STOP,CLINID,PROVID,PROVNM,XX
+46 QUIT RTN
PID(DFN,SEQ,SEG) ;
+1 NEW VA,VADM,VAHOW,VAROOT,VATEST,VAPA,NAME,DOB,SSN,ICN,ADDRESS
+2 KILL SEG
SET SEG=""
+3 SET VAHOW=1
+4 DO DEM^VADPT
+5 SET NAME=VADM("NM")
DO STDNAME^XLFNAME(.NAME,"C")
+6 SET DOB=$PIECE(VADM("DB"),"^")
SET SSN=$PIECE(VADM("SS"),"^")
+7 SET VAHOW=""
+8 DO ADD^VADPT
+9 SET ADDRESS("STREET")=VAPA(1)
SET ADDRESS("STREET2")=VAPA(2)
SET ADDRESS("CITY")=VAPA(4)
SET ADDRESS("STATE")=$PIECE(VAPA(5),"^",2)
SET ADDRESS("ZIP")=VAPA(6)
+10 SET ICN=$$GETICN^MPIF001(DFN)
+11 ; Set segment type to PID
DO SET^HLOAPI(.SEG,"PID",0)
+12 ; Set PID-1
DO SET^HLOAPI(.SEG,SEQ,1)
+13 ; set ICN into PID-3, repitition 1
+14 ; Component 1, subcomponent 1, Patient ICN
DO SET^HLOAPI(.SEG,+ICN,3,1,1,1)
+15 ; Component 1, subcomponent 2, Patient ICN checksum
DO SET^HLOAPI(.SEG,$PIECE(ICN,"V",2),3,2,1,1)
+16 ; patient DFN
DO SET^HLOAPI(.SEG,DFN,4,1,1,1)
+17 ; component 4, subcomponent1
DO SET^HLOAPI(.SEG,"USVHA",3,4,1,1)
+18 ; component 5
DO SET^HLOAPI(.SEG,"0363",3,5,1,1)
+19 ; set SSN into PID-3, repetition 2
+20 ;component 1, subcomponent1
DO SET^HLOAPI(.SEG,SSN,3,1,1,2)
+21 ; Component 4, subcomponent 1
DO SET^HLOAPI(.SEG,"USSSA",3,4,1,2)
+22 ; component 4, subcomponent 3
DO SET^HLOAPI(.SEG,"0363",3,4,3,2)
+23 ; component 1
DO SET^HLOAPI(.SEG,"SS",3,5,1,2)
+24 ;Set the name into PID-5
+25 DO SETXPN^HLOAPI4(.SEG,.NAME,5)
+26 ; Set the DOB into PID-7
+27 DO SETDT^HLOAPI4(.SEG,DOB,7)
+28 ; set the address into PID-11
+29 DO SETAD^HLOAPI4(.SEG,.ADDRESS,11)
+30 QUIT
PD1 ; Not needed right now
+1 QUIT
PV1(DFN,SEQ,SEG) ;
+1 NEW FAC
+2 SET CLASS="OUTPATIENT"
+3 SET FAC=$$KSP^XUPARAM("INST")
+4 ; Set the segment type
DO SET^HLOAPI(.SEG,"PV1",0)
+5 ; Set the PV1-1
DO SET^HLOAPI(.SEG,SEQ,1)
+6 ; set the PV1-2, patient class (tbl 5-20 in the TMP HL7 specification
+7 ;
DO SET^HLOAPI(.SEG,CLASS,2)
+8 ; set the PV1-4, Purpose of Visit
+9 DO SET^HLOAPI(.SEG,APTSTATUS,4)
+10 ; set the PV1-7, provider
+11 DO SET^HLOAPI(.SEG,$GET(PROVID),7,1,1)
+12 DO SET^HLOAPI(.SEG,$GET(PROVNM),7,2,1)
+13 ; set the PV1-39 facility id
+14 DO SET^HLOAPI(.SEG,FAC,39)
+15 KILL CLASS
+16 QUIT
SCH(DFN,SEQ,SEG,ANODE,SNODE) ; update for new appointments
+1 NEW APTSTATUS,CONNM,END,ENTEREDBY,PREMAIL,SCHED,SCHEMAIL,STATUS,TMUNITS
+2 SET TMUNITS="M"
+3 SET LENGTH=$SELECT(FUNCTION["C":1440,FUNCTION["P":$$FMDIFF^XLFDT(NCSTOP,NCDATE,2)/60,1:0)
+4 SET START=$$TMCONV(NCDATE,$$INST(CLINID))
+5 if $GET(CNODE)>0
SET CONNM=$PIECE(^GMR(123.5,$PIECE(^GMR(123,CNODE,0),"^",5),0),"^")
+6 SET (PROVID,PROVNM,PREMAIL)=""
+7 SET STATUS("ID")=$SELECT(FUNCTION["U":"RCD",1:"NCD")
SET STATUS("TEXT")=COMMENT
SET STATUS("SYSTEM")=44
+8 SET APTSTATUS=""
+9 SET ENTEREDBY=$PIECE(^VA(200,$GET(DUZ),0),"^")
SET SCHEMAIL=$PIECE($GET(^VA(200,$GET(DUZ),.15)),"^",1)
+10 ; Set the segment type
DO SET^HLOAPI(.SEG,"SCH",0)
+11 ; Set the SCH-1
DO SET^HLOAPI(.SEG,SEQ,1)
+12 ;Field 6, Appointment status
DO SET^HLOAPI(.SEG,APTSTATUS,6)
+13 DO SET^HLOAPI(.SEG,LENGTH,9)
+14 ; Field 10, time units
DO SET^HLOAPI(.SEG,TMUNITS,10)
+15 ; Field 11, appointment start time
DO SET^HLOAPI(.SEG,START,11,4,1,1)
+16 ; Field 11, appointment end time
DO SET^HLOAPI(.SEG,"",11,5,1,1)
+17 ; Field 16 provider duz
DO SET^HLOAPI(.SEG,$GET(PROVID),16,1,1)
+18 ; Field 16 provider name
DO SET^HLOAPI(.SEG,$GET(PROVNM),16,2,1)
+19 ; Field 17 provider eMail
DO SET^HLOAPI(.SEG,$GET(PREMAIL),17,4,1)
+20 ; Field 20, scheduling clerk's the appointment
DO SET^HLOAPI(.SEG,$GET(ENTEREDBY),20,2,1)
+21 ;Field 21, scheduling clerk's email
DO SET^HLOAPI(.SEG,$GET(SCHEMAIL),21,4,1)
+22 ; Field 25, current status of the appointment
DO SETCE^HLOAPI4(.SEG,.STATUS,25)
+23 QUIT
PV2 ; Not needed right now
+1 QUIT
OBX1 ; Not needed right now
+1 QUIT
OBX2 ; Not needed right now
+1 QUIT
OBX3 ; Not needed right now
+1 QUIT
OBX4 ; Not needed right now
+1 QUIT
RGS1(FLAG,SEQ,SEG) ; At least one RGS segment is required
+1 NEW GRP
+2 SET GRP=""
+3 DO SET^HLOAPI(.SEG,"RGS",0)
+4 DO SET^HLOAPI(.SEG,SEQ,1)
+5 DO SET^HLOAPI(.SEG,FLAG,2)
+6 DO SET^HLOAPI(.SEG,GRP,3)
+7 QUIT
AIS1(FLAG,SEQ,SEG) ;
+1 QUIT
NTE(SEQ,SEG) ;
+1 NEW NOTES,CLINID,CLINNM
+2 SET NOTES=COMMENT
+3 DO SET^HLOAPI(.SEG,"NTE",0)
+4 DO SET^HLOAPI(.SEG,SEQ,1)
+5 DO SET^HLOAPI(.SEG,"NOTES",3)
+6 DO SET^HLOAPI(.SEG,NOTES,4)
+7 QUIT
AIL1(CLINID,SEQ,SEG) ;
+1 KILL LOC
+2 SET LOC("ID")=CLINID
SET LOC("TEXT")=$PIECE(^SC(CLINID,0),"^")
SET LOC("SYSTEM")="44"
SET CODE="A"
+3 SET LOC("ALTERNATE ID")=$$STATION^SDTMPHLA(CLINID)
+4 DO SET^HLOAPI(.SEG,"AIL",0)
+5 DO SET^HLOAPI(.SEG,SEQ,1)
+6 DO SET^HLOAPI(.SEG,CODE,2)
+7 DO SETCE^HLOAPI4(.SEG,.LOC,4)
+8 ;ORIG START DATE JSON FMT
DO SET^HLOAPI(.SEG,START,6)
+9 ;DURATION IN MINUTES
DO SET^HLOAPI(.SEG,LENGTH,9)
+10 ;M = MINUTES
DO SET^HLOAPI(.SEG,"M",10)
+11 KILL LOC,CODE
+12 QUIT
TMCONV(X,INST) ;Uses division/institution to determine tz instead of mailman files / 773
+1 ;convert FileMan local time to Zulu timezone in JSON format: YYYY-MM-DDTHH:MM:00.000Z
+2 ;Inputs:
+3 ; X = Time
+4 ; INST = Institution
+5 ;Output:
+6 ; Zulu Time in JSON format
+7 NEW OFFSET,UTC,UTC1,UTC2
+8 ;Add 1 second if midnight to avoid midnight problem in DIUTC. The second is not included in UTC2
IF X#1=0
SET X=X+.000001
+9 SET OFFSET=$PIECE($$UTC^DIUTC(X,,$GET(INST),,1),"^",3)
+10 SET UTC=$$FMADD^XLFDT(X,,-$GET(OFFSET),,)
SET UTC1=$$FMTHL7^XLFDT(UTC)
+11 SET UTC2=$EXTRACT(UTC1,1,4)_"-"_$EXTRACT(UTC1,5,6)_"-"_$EXTRACT(UTC1,7,8)_"T"_$EXTRACT(UTC1,9,10)_":"_$EXTRACT(UTC1,11,12)_":00.000Z"
+12 QUIT UTC2
INST(CLNC) ;Derives the institution value for the clinic
+1 ;Inputs:
+2 ; CLNC = Clinic IEN from the Hospital Location (#44) file
+3 ;Output:
+4 ; INST = Institution IEN from the Institution (#4) file. Null indicates an error.
+5 IF CLNC=""
QUIT ""
+6 NEW DIV,INST,MCD0,NEWINST,TZ
+7 SET MCD0=$GET(^SC(CLNC,0))
+8 ;No entry in the Hospital Location (#44) file
IF MCD0=""
QUIT ""
+9 SET INST=$PIECE(MCD0,U,4)
+10 IF INST
SET TZ=$PIECE($GET(^DIC(4,INST,8)),U,1)
IF TZ
QUIT INST
+11 SET DIV=$PIECE(MCD0,U,15)
IF 'DIV
QUIT ""
+12 SET INST=$PIECE($GET(^DG(40.8,DIV,0)),U,7)
+13 SET NEWINST=$$CHKINST(INST)
+14 QUIT NEWINST
CHKCLIN(X) ; check to see if this is a primary or secondary stop code for a tele health clinic
+1 IF $GET(X)'>0
SET STOP=0
QUIT STOP
+2 SET STOP=0
+3 NEW TEST,I,CODE,X1,X2
+4 SET X2=0
+5 SET X1=$$GET1^DIQ(40.7,X_",",1,"I")
IF X1=""
QUIT STOP
+6 SET X2=$ORDER(^SD(40.6,"B",X1,""))
+7 if $GET(X2)>0
SET STOP=1
+8 QUIT STOP
CHKINST(INST) ;Derives the parent institution if the passed-in institution does not have a time zone
+1 IF 'INST
QUIT ""
+2 NEW TZ,AS
+3 SET TZ=$PIECE($GET(^DIC(4,INST,8)),U,1)
IF TZ
QUIT INST
+4 SET AS=$ORDER(^DIC(4,INST,7,"B",2,""))
IF AS
SET INST=$PIECE(^DIC(4,INST,7,AS,0),U,2)
+5 IF INST
SET TZ=$PIECE($GET(^DIC(4,INST,8)),U,1)
+6 IF TZ
QUIT INST
+7 ;Never found an institution with a timezone
QUIT ""
STATUS(X) ; a $Select to convert code to text too many characters in a single line. returns the text version of the appointment code
+1 SET X1=""
+2 IF $GET(X)=""
QUIT X1
+3 if X="N"
SET X1="NO-SHOW"
+4 if X="C"
SET X1="CANCELLED BY CLINIC"
+5 if X="NA"
SET X1="NO&AUTO RE-BOOK"
+6 if X="CA"
SET X1="CANCELLED BY CLINIC & AUTO RE-BOOK"
+7 if X="I"
SET X1="INPATIENT APPOINTMENT"
+8 if X="PC"
SET X1="CANCELLED BY PATIENT"
+9 if X="PCA"
SET X1="CANCELLED BY PATIENT & AUTO-REBOOK"
+10 if X="NT"
SET X1="NO ACTION TAKEN"
+11 if X="S"
SET X1="SCHEDULED"
+12 QUIT X1
SEND(SC,DATE,PATTERN) ;Send a transaction from SDBUILD - SD*5.3*806
+1 ;SC = Clinic
+2 ;DATE = Date
+3 ;PATTERN = New pattern being recorded
+4 NEW OLDPAT,JOB,LIMIT
+5 SET LIMIT=$$DAYSINFUTURE^SDB1(SC,DT)
+6 ;Stop sending No Appointment Availability transactions *863
IF DATE>$$FMADD^XLFDT(DT,LIMIT)
QUIT
+7 SET OLDPAT=$PIECE($GET(^SC(SC,"ST",DATE,1)),"[",2)
SET JOB=$JOB
+8 ;No appointments previously available, send unblock transaction
+9 IF OLDPAT=""
IF $PIECE(PATTERN,"[",2)]""
SET SEQ=$PIECE($GET(^XTMP("SDTMPX",JOB,"SEQ")),U,1)+1
SET ^XTMP("SDTMPX",JOB,SEQ)=SC_"^"_$HOROLOG_"^"_DATE_"^"_DUZ_"^"_"UC"
SET $PIECE(^XTMP("SDTMPX",JOB,"SEQ"),U,1)=SEQ
QUIT
+10 ;Appointments previously available, now none - send block transaction
+11 IF OLDPAT]""
IF $PIECE(PATTERN,"[",2)=""
SET SEQ=$PIECE($GET(^XTMP("SDTMPX",JOB,"SEQ")),U,1)+1
SET ^XTMP("SDTMPX",JOB,SEQ)=SC_"^"_$HOROLOG_"^"_DATE_"^"_DUZ_"^"_"C"
SET $PIECE(^XTMP("SDTMPX",JOB,"SEQ"),U,1)=SEQ
QUIT
+12 ;Change neither creates or deletes all availability, so no transaction sent
QUIT
