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

SDTMPHLA.m

Go to the documentation of this file.
  1. SDTMPHLA ;MS/PB - TMP HL7 Routine;May 29, 2018
  1. ;;5.3;Scheduling;**704,733,773,780,798,812,821**;SEP 26, 2018;Build 9
  1. Q
  1. ; ;
  1. EN(DFN,APTTM) ; Entry to the routine to build an HL7 message
  1. ;notification to TMP about a new appointment in a TeleHealth Clinic
  1. ;
  1. Q:$G(DFN)=""
  1. Q:$G(APTTM)=""
  1. N PARMS,SEG,WHOTO,SNODE,ANODE,CNODE,CLINODE,ERROR,MSG,ANODE1
  1. S (SSTOP,PSTOP,STOP)=0
  1. K CLINID
  1. S RTN=0,CAN=0
  1. S ANODE=$G(^DPT(DFN,"S",APTTM,0))
  1. S ANODE1=$G(^DPT(DFN,"S",APTTM,1))
  1. ;If this appointment was made by the TMP application, stop 773
  1. I $G(MSH(9)),$D(^XTMP("SDTMP",+MSH(9))) Q
  1. S CLINID=$P(ANODE,U,1)
  1. S CLINODE=$G(^SC(CLINID,0))
  1. S XX=0 F S XX=$O(^SC(CLINID,"S",APTTM,1,XX)) Q:XX'>0 D ;Get the correct appointment node for the patient
  1. .I $P(^SC(CLINID,"S",APTTM,1,XX,0),"^")=DFN S SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0)),CNODE=$P($G(^SC(CLINID,"S",APTTM,1,XX,"CONS")),"^")
  1. S PSTOP=$P(CLINODE,"^",7),SSTOP=$P(CLINODE,"^",18)
  1. ;If both stop codes are null, stop the check, we know it is not a tele health clinic
  1. Q:($G(PSTOP)="")&(($G(SSTOP))="")
  1. 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
  1. 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
  1. Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic
  1. I $P($G(ANODE),"^",2)["C" S CAN=1
  1. S SNODE=$G(^SC(CLINID,"S",APTTM,1,1,0))
  1. S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E")
  1. S:CAN=0 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S12"
  1. S:CAN=1 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S15"
  1. I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) Q 0
  1. S SEQ=1
  1. D:CAN=0 SCH(DFN,SEQ,.SEG,$G(ANODE),$G(SNODE))
  1. I (CAN=0&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0
  1. D:CAN=1 SCHCAN(DFN,SEQ,.SEG,$G(ANODE),$G(SNODE),$G(CNODE))
  1. I (CAN=1&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0
  1. D NTE(.SEQ,.SEG)
  1. I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
  1. D PID(DFN,SEQ,.SEG)
  1. I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
  1. D PV1(DFN,SEQ,.SEG)
  1. I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
  1. D RGS1("A",SEQ,.SEG) ;required segment
  1. I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
  1. D AIL1(ANODE,SEQ,.SEG)
  1. I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0
  1. S PARMS("SENDING APPLICATION")="TMP_OUT"
  1. S PARMS("APP ACK TYPE")="AL"
  1. S WHOTO("RECEIVING APPLICATION")="TMP VIMT"
  1. S WHOTO("FACILITY LINK NAME")="TMP_SEND"
  1. S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0))
  1. S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR)
  1. K CAN,APTSTATUS,SSTOP,PSTOP,STOP,CLINID,PROVID,PROVNM,XX
  1. Q RTN
  1. PID(DFN,SEQ,SEG) ;
  1. N VA,VADM,VAHOW,VAROOT,VATEST,VAPA,NAME,DOB,SSN,ICN,ADDRESS
  1. K SEG S SEG=""
  1. S VAHOW=1
  1. D DEM^VADPT
  1. S NAME=VADM("NM") D STDNAME^XLFNAME(.NAME,"C")
  1. S DOB=$P(VADM("DB"),"^"),SSN=$P(VADM("SS"),"^")
  1. S VAHOW=""
  1. D ADD^VADPT
  1. S ADDRESS("STREET")=VAPA(1),ADDRESS("STREET2")=VAPA(2),ADDRESS("CITY")=VAPA(4),ADDRESS("STATE")=$P(VAPA(5),"^",2),ADDRESS("ZIP")=VAPA(6)
  1. S ICN=$$GETICN^MPIF001(DFN)
  1. D SET^HLOAPI(.SEG,"PID",0) ; Set segment type to PID
  1. D SET^HLOAPI(.SEG,SEQ,1) ; Set PID-1
  1. ; set ICN into PID-3, repitition 1
  1. D SET^HLOAPI(.SEG,+ICN,3,1,1,1) ; Component 1, subcomponent 1, Patient ICN
  1. D SET^HLOAPI(.SEG,$P(ICN,"V",2),3,2,1,1) ; Component 1, subcomponent 2, Patient ICN checksum
  1. D SET^HLOAPI(.SEG,DFN,4,1,1,1) ; patient DFN
  1. D SET^HLOAPI(.SEG,"USVHA",3,4,1,1) ; component 4, subcomponent1
  1. D SET^HLOAPI(.SEG,"0363",3,5,1,1) ; component 5
  1. ; set SSN into PID-3, repetition 2
  1. D SET^HLOAPI(.SEG,SSN,3,1,1,2) ;component 1, subcomponent1
  1. D SET^HLOAPI(.SEG,"USSSA",3,4,1,2) ; Component 4, subcomponent 1
  1. D SET^HLOAPI(.SEG,"0363",3,4,3,2) ; component 4, subcomponent 3
  1. D SET^HLOAPI(.SEG,"SS",3,5,1,2) ; component 1
  1. ;Set the name inot PID-5
  1. D SETXPN^HLOAPI4(.SEG,.NAME,5)
  1. ; Set the DOB into PID-7
  1. D SETDT^HLOAPI4(.SEG,DOB,7)
  1. ; set the address into PID-11
  1. D SETAD^HLOAPI4(.SEG,.ADDRESS,11)
  1. Q
  1. PD1 ; Not needed right now
  1. Q
  1. PV1(DFN,SEQ,SEG) ;
  1. N FAC
  1. S CLASS="OUTPATIENT"
  1. S FAC=$$KSP^XUPARAM("INST")
  1. D SET^HLOAPI(.SEG,"PV1",0) ; Set the segment type
  1. D SET^HLOAPI(.SEG,SEQ,1) ; Set the PV1-1
  1. ; set the PV1-2, patient class (tbl 5-20 in the TMP HL7 specification
  1. D SET^HLOAPI(.SEG,CLASS,2) ;
  1. ; set the PV1-4, Purpose of Visit
  1. D SET^HLOAPI(.SEG,APTSTATUS,4)
  1. ; set the PV1-7, provider
  1. D SET^HLOAPI(.SEG,$G(PROVID),7,1,1)
  1. D SET^HLOAPI(.SEG,$G(PROVNM),7,2,1)
  1. ; set the PV1-39 facility id
  1. D SET^HLOAPI(.SEG,FAC,39)
  1. K CLASS
  1. Q
  1. SCH(DFN,SEQ,SEG,ANODE,SNODE) ; update for new appointments
  1. N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,CONNM,PREMAIL,END
  1. S:$G(SNODE)'="" LENGTH=$P($G(SNODE),"^",2)
  1. S TMUNITS="M"
  1. ;821 Create best default LENGTH variable. Also, the main value will be found in SDECLEN variable that is
  1. ;used by SDEC07 & 08A APIs, as a key param. If not there, use the new best default variable.
  1. N LENDEF S:$G(SDECAPPTID) LENDEF=$P(^SDEC(409.84,SDECAPPTID,0),U,18) S:'$G(LENDEF) LENDEF=$P(^SC(CLINID,"SL"),U)
  1. S:$G(LENGTH)="" LENGTH=$S($G(SDECLEN):SDECLEN,1:LENDEF)
  1. S START=$$TMCONV(APTTM,$$INST(CLINID)),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END,$$INST(CLINID))
  1. S:$G(CNODE)>0 CONNM=$P(^GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^")
  1. S PROVID=$P(^SC(CLINID,0),"^",13) S:$G(PROVID)>0 PROVNM=$P(^VA(200,PROVID,0),"^"),PREMAIL=$P($G(^VA(200,PROVID,.15)),"^")
  1. K XS S (STATUS("ID"))=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED"
  1. N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID"))
  1. S STATUS("SYSTEM")=2
  1. S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E")
  1. S:$G(SNODE)'="" ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1)
  1. S:$G(SNODE)="" ENTEREDBY=$P(^VA(200,$G(DUZ),0),"^"),SCHEMAIL=$P($G(^VA(200,$G(DUZ),.15)),"^",1)
  1. D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type
  1. D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1
  1. D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status
  1. D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request
  1. D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length
  1. D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units
  1. D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time
  1. D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time
  1. D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz
  1. D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name
  1. D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail
  1. D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment
  1. D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email
  1. D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment
  1. Q
  1. SCHCAN(DFN,SEQ,SEG,ANODE,SNODE,CNODE) ; update for cancelled appointments
  1. N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,PREMAIL,END
  1. Q:$G(SNODE)="" ;SNODE=SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0))
  1. S:$G(DUZ)="" DUZ=.5
  1. S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE")
  1. S LENGTH=$P(^SC(CLINID,"SL"),"^",1),TMUNITS="M"
  1. S START=$$TMCONV(APTTM,$$INST(CLINID)),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END,$$INST(CLINID))
  1. S:$G(CNODE)>0 CONNM=$$GET1^DIQ(123,CNODE_",",1,"E")
  1. S PROVID=$P(^SC(CLINID,0),"^",13) S:$G(PROVID)>0 PROVNM=$P(^VA(200,PROVID,0),"^"),PREMAIL=$P($G(^VA(200,PROVID,.15)),"^")
  1. K XS S (STATUS("ID"),XS)=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED"
  1. N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID"))
  1. S STATUS("SYSTEM")=2
  1. S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E")
  1. S ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1)
  1. D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type
  1. D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1
  1. D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status
  1. D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request
  1. D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length
  1. D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units
  1. D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time
  1. D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time
  1. D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz
  1. D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name
  1. D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail
  1. D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment
  1. D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email
  1. D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment
  1. K SCHEMAIL
  1. Q
  1. PV2 ; Not needed right now
  1. Q
  1. OBX1 ; Not needed right now
  1. Q
  1. OBX2 ; Not needed right now
  1. Q
  1. OBX3 ; Not needed right now
  1. Q
  1. OBX4 ; Not needed right now
  1. Q
  1. RGS1(FLAG,SEQ,SEG) ; At least one RGS segment is required
  1. N GRP
  1. S GRP=""
  1. D SET^HLOAPI(.SEG,"RGS",0)
  1. D SET^HLOAPI(.SEG,SEQ,1)
  1. D SET^HLOAPI(.SEG,FLAG,2)
  1. D SET^HLOAPI(.SEG,GRP,3)
  1. Q
  1. AIS1 ;
  1. Q
  1. NTE(SEQ,SEG) ;
  1. N NOTES,CLINID,CLINNM
  1. S NOTES="THESE ARE BOOKING NOTES",CLINID=23,CLINNM="GENERAL MEDICINE"
  1. D SET^HLOAPI(.SEG,"NTE",0)
  1. D SET^HLOAPI(.SEG,SEQ,1)
  1. D SET^HLOAPI(.SEG,"NOTES",3)
  1. D SET^HLOAPI(.SEG,NOTES,4)
  1. Q
  1. AIL1(ANODE,SEQ,SEG) ;
  1. K LOC
  1. S LOC("ID")=$P(ANODE,"^",1),LOC("TEXT")=$P(^SC(LOC("ID"),0),"^"),LOC("SYSTEM")="44",CODE="A"
  1. S LOC("ALTERNATE ID")=$$STATION(CLINID) ;780
  1. D SET^HLOAPI(.SEG,"AIL",0)
  1. D SET^HLOAPI(.SEG,SEQ,1)
  1. D SET^HLOAPI(.SEG,CODE,2)
  1. D SETCE^HLOAPI4(.SEG,.LOC,4)
  1. K LOC,CODE
  1. Q
  1. 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
  1. ;Inputs:
  1. ; X = Time
  1. ; INST = Institution
  1. ;Output:
  1. ; Zulu Time in JSON format
  1. N OFFSET,UTC,UTC1,UTC2
  1. 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
  1. S OFFSET=$P($$UTC^DIUTC(X,,$G(INST),,1),"^",3)
  1. S UTC=$$FMADD^XLFDT(X,,-$G(OFFSET),,),UTC1=$$FMTHL7^XLFDT(UTC)
  1. 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"
  1. Q UTC2
  1. CHKCLIN(X) ; check to see if this is a primary or secondary stop code for a tele health clinic
  1. I $G(X)'>0 S STOP=0 Q STOP
  1. S STOP=0
  1. N TEST,I,CODE,X1,X2
  1. S X2=0
  1. S X1=$$GET1^DIQ(40.7,X_",",1,"I"),X2=$O(^SD(40.6,"B",X1,""))
  1. S:$G(X2)>0 STOP=1
  1. Q STOP
  1. 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. S X1=""
  1. Q:$G(X)=""
  1. S:X="N" X1="NO-SHOW"
  1. S:X="C" X1="CANCELLED BY CLINIC"
  1. S:X="NA" X1="NO&AUTO RE-BOOK"
  1. S:X="CA" X1="CANCELLED BY CLINIC & AUTO RE-BOOK"
  1. S:X="I" X1="INPATIENT APPOINTMENT"
  1. S:X="PC" X1="CANCELLED BY PATIENT"
  1. S:X="PCA" X1="CANCELLED BY PATIENT & AUTO-REBOOK"
  1. S:X="NT" X1="NO ACTION TAKEN"
  1. S:X="S" X1="SCHEDULED"
  1. Q X1
  1. ;
  1. INST(CLNC) ;Derives the institution value for the clinic
  1. ;Inputs:
  1. ; CLNC = Clinic IEN from the Hospital Location (#44) file
  1. ;Output:
  1. ; INST = Institution IEN from the Institution (#4) file. Null indicates an error.
  1. I CLNC="" Q ""
  1. N DIV,INST,MCD0,NEWINST,TZ
  1. S MCD0=$G(^SC(CLNC,0))
  1. I MCD0="" Q "" ;No entry in the Hospital Location (#44) file
  1. S INST=$P(MCD0,U,4)
  1. I INST S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST
  1. S DIV=$P(MCD0,U,15) I 'DIV Q ""
  1. S INST=$P($G(^DG(40.8,DIV,0)),U,7)
  1. S NEWINST=$$CHKINST(INST)
  1. Q NEWINST
  1. ;
  1. CHKINST(INST) ;Derives the parent institution if the passed-in institution does not have a time zone
  1. I 'INST Q ""
  1. N TZ,AS
  1. S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST
  1. S AS=$O(^DIC(4,INST,7,"B",2,"")) I AS S INST=$P(^DIC(4,INST,7,AS,0),U,2)
  1. I INST S TZ=$P($G(^DIC(4,INST,8)),U,1)
  1. I TZ Q INST
  1. Q "" ;Never found an institution with a timezone
  1. ;
  1. STATION(CLNC) ;Derives the station number from the clinic - 780
  1. ;Inputs:
  1. ; CLNC = Clinic IEN from the Hospital Location (#44) file
  1. ;Output:
  1. ; STATN = Station number from the Institution (#4) file. Null indicates an error.
  1. I CLNC="" Q ""
  1. N INST,MCD,MCD0,STATN,Z
  1. S MCD0=$G(^SC(CLNC,0)) I MCD0="" Q "" ;No entry in the Hospital Location (#44) file
  1. S INST=$P(MCD0,U,4) I INST]"" S STATN=$P($G(^DIC(4,INST,99)),U,1) I STATN Q STATN ;quit if found Stn#
  1. S MCD=$P(MCD0,U,15) I MCD]"" S Z=$G(^DG(40.8,MCD,0)) S STATN=$P(Z,U,2) I STATN Q STATN ;quit if found Stn#
  1. Q "" ;Could not locate station number