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

SDHL7APT.m

Go to the documentation of this file. 
  1. SDHL7APT ;MS/TG,PH - TMP HL7 Routine;AUG 17, 2018
  1.  ;;5.3;Scheduling;**704,714,754,773,780,798,810,817,821,848,859,863**;Aug 13, 1993;Build 14
  1.  ;
  1.  ;  Integration Agreements:
  1.  Q
  1.  ;
  1. PROCSIU ;Process SI^S12 messages from the "TMP VISTA" Subscriber protocol
  1.  ;ENT ;
  1.  ;EN ;
  1.  ;
  1.  ; This routine and subroutines assume that all VistA HL7 environment
  1.  ; variables are properly initialized and will produce a fatal error
  1.  ; if they are missing.
  1.  ;
  1.  ;  The message will be checked to see if it is a valid SIU. If valid - the SIU will process the 1st RGS group
  1.  ;  on the current facility. Any subsequent RGS groups will be sent to facilities as specified in AIL.3.4
  1.  ;  In the event the appointment does not file on the remote facility (ie; an AE is received from that remote facility)
  1.  ;  an AE (with the appropriate error text) will be returned to HealthShare.
  1.  ;  Input:
  1.  ;          HL7 environment variables
  1.  ;
  1.  ; Output:
  1.  ;          Positive (AA) or negative acknowledgement (AE - with appropriate error text)
  1.  ;
  1.  ;  Integration Agreements: NONE
  1.  ;
  1.  N MSGROOT,DATAROOT,QRY,XMT,ERR,RNAME,IX,REQIEN     ;817 reqien
  1.  K SDTMPHL
  1.  S (MSGROOT,QRY,XMT,ERR,RNAME)=""
  1.  S U="^"
  1.  ;
  1.  ; Inbound SIU messages are small enough to be held in a local array.
  1.  ; The following lines commented out support use of temporary globals and are
  1.  ; left for debugging purposes.
  1.  ;
  1.  S MSGROOT="SDHL7APT"
  1.  K @MSGROOT
  1.  N EIN S EIN=HL("EID") ;ien of HL7 server receiving msg 821
  1.  D LOADXMT^SDHL7APU(.HL,.XMT)         ;Load inbound message information
  1.  K ACKMSG S ACKMSG=$G(HL("MID"))
  1.  S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER"
  1.  ;
  1.  N CNT,SEG
  1.  K @MSGROOT
  1.  D LOADMSG^SDHL7APU(MSGROOT)
  1.  D PARSEMSG^SDHL7APU(MSGROOT,.HL)
  1.  ;
  1.  N APPTYPE,AILNTE,DFN,RET,CNT,PID,PV1,RGS,AIS,AIG,AISNTE,OVB,OFFSET,AIP,RTCID,AIPNTE,INP,SETID,EXTIME,SCHNTE,SCH,SDMTC,QRYDFN,MSGCONID,LST,MYRESULT,HLA,PTIEN,SCPER,ATYPIEN
  1.  N AIGNTE,AIL,ARSETE,CURDTTM,ERROR,FLMNFMT,EESTAT,GRPCNT,GRPNO,OBX,PREVSEG,PTIEN,SCHDFN,SCPERC,SDDDT,SDECATID,SDUSER,CHILD,MSAHDR,SDECTYP
  1.  N SDECCR,SDECEND,SDECLEN,SDECNOTE,SDECRES,SDECSTART,SDECY,SDEKG,SDEL,SDID,SDLAB,SDMRTC,SDPARENT,SDCHILD,SDECAPTID,SDECDATE,FIRST
  1.  N SDREQBY,SDSVCP,SDSVCPR,INTRA,SDXRAY,SEGTYPE,INST,FLMNFMT2,SDAPTYP,STA,STATUS,STOP,PROVIEN,ERRCND,ERRSND,ERRTXT,URL,MSH,SDECNOT,RTN,SDCL
  1.  ;
  1.  S (MSGCONID,SCHDFN)=""
  1.  S CNT=1,SETID=1,PREVSEG="",GRPCNT=0,PTIEN="",ERRTXT="",ERRSND=""
  1.  ;
  1.  ; Loop to receive HL7 message segments.
  1.  S ERR=0
  1.  F  Q:'$D(@MSGROOT@(CNT))  Q:ERR  D  S CNT=CNT+1,PREVSEG=SEGTYPE
  1.  .S SEGTYPE=$G(@MSGROOT@(CNT,0))
  1.  .I SEGTYPE="MSH" M MSH=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="SCH" M SCH=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="NTE",(PREVSEG="SCH") M SCHNTE=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="PID" M PID=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="PV1" M PV1=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="OBX" M OBX=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="RGS" D  Q
  1.  ..S SETID=$G(@MSGROOT@(CNT,1))
  1.  ..I +SETID=0 S ERR=1,ERRTXT="Invalid RGS SetID received" Q
  1.  ..M RGS(SETID)=@MSGROOT@(CNT)
  1.  ..S GRPCNT=GRPCNT+1
  1.  .I SEGTYPE="AIS" M AIS(SETID)=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="NTE",(PREVSEG="AIS") M AISNTE(SETID)=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="AIG" M AIG(SETID)=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="NTE",(PREVSEG="AIG") M AIGNTE(SETID)=@MSGROOT@(CNT) Q 
  1.  .I SEGTYPE="AIL" M AIL(SETID)=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="NTE",(PREVSEG="AIL") M AILNTE(SETID)=@MSGROOT@(CNT) Q 
  1.  .I SEGTYPE="AIP" M AIP(SETID)=@MSGROOT@(CNT) Q
  1.  .I SEGTYPE="NTE",(PREVSEG="AIP") M AIPNTE(SETID)=@MSGROOT@(CNT)
  1.  I $G(AIL(2,4))="R" D  ;Check to see if this is an intrafacility rtc order and set the rtc number to null on the second AIL second so both appts file.
  1.  .I $G(AIL(2,4))=$G(AIL(1,4)) S AIL(2,4)="",AIL(2,4)=""
  1.  ;
  1.  S MSAHDR="MSA^1^^100^AE^"
  1.  I +ERR D  Q
  1.  .S ERR=$G(MSAHDR)_$E(ERRTXT,1,52)
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  K SCHNW,INP,PCE,SCPER,ATYPIEN
  1.  ; Loop to populate MSGARY, INP arrays which are used in ^SDECAR2 (to create appt request) and ^SDEC07 (to create appt)
  1.  N MSGARY,SDCL,SDCL2,SDCL3
  1.  D MSH^SDHL7APU(.MSH,.INP,.MSGARY)
  1.  D SCH^SDHL7APU(.SCH,.INP,.MSGARY)
  1.  I +ERR D  Q   ;859-check Cancel Reason
  1.  .S ERR=$G(MSAHDR)_$E(ERRTXT,1,52)
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  D SCHNTE^SDHL7APU(.SCHNTE,.INP,.MSGARY)
  1.  D PID^SDHL7APU(.PID,.INP,.MSGARY)
  1.  D PV1^SDHL7APU(.PV1,.INP,.MSGARY)
  1.  D OBX^SDHL7APU(.OBX,.INP)
  1.  F IX=1:1:GRPCNT D
  1.  .D RGS^SDHL7APU(.RGS,IX,.INP)
  1.  .D AIS^SDHL7APU(.AIS,IX,.INP,.MSGARY)
  1.  .D AISNTE^SDHL7APU(.AISNTE,IX,.INP)
  1.  .D AIG^SDHL7APU(.AIG,IX,.INP)
  1.  .D AIGNTE^SDHL7APU(.AIGNTE,IX,.INP)
  1.  .D AIL^SDHL7APU(.AIL,IX,.INP,.MSGARY)
  1.  .D AILNTE^SDHL7APU(.AILNTE,IX,.INP)
  1.  .D AIP^SDHL7APU(.AIP,IX,.INP,.MSGARY)
  1.  .D AIPNTE^SDHL7APU(.AIPNTE,IX,.INP)
  1.  N %,NOW
  1.  D NOW^%DTC S CURDTTM=$$TMCONV^SDTMPHLA(%,$$KSP^XUPARAM("INST")) ;773
  1.  S NOW=$$HTFM^XLFDT($H),INP(3)=$$FMTE^XLFDT(NOW)
  1.  S INP(11)=INP(3)
  1.  S INP(5)="APPT"
  1.  S INP(8)="FUTURE"
  1.  ;
  1.  N X11 S X11=$P($G(SDAPTYP),"|") S:$G(X11)="" X11="A"
  1.  S INP(9)=$S(X11="A":"PATIENT",1:"PROVIDER") ;request by provider or patient. RTC orders and consults will always be PROVIDER otherwise it is PATIENT
  1.  K DFN
  1.  S (DFN,INP(2))=$$GETDFN^MPIF001(MSGARY("MPI"))
  1.  I $P(DFN,U,2)="NO ICN"!($P(DFN,U,2)="ICN NOT IN DATABASE") D  Q
  1.  .S ERR=$G(MSAHDR)_"PATIENT ICN NOT FOUND"
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  ;
  1.  N STOPME
  1.  I $P($G(SDAPTYP),"|",1)="C"!($P($G(SDAPTYP),"|",1)="R") D CHKCON^SDHLAPT2(DFN,SDAPTYP) I $G(STOPME)=1 Q
  1.  I $G(SDCL)="" D  Q
  1.  .S ERR=$G(MSAHDR)_"CLINIC ID IS NULL",STOPME=1
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  Q:$G(STOPME)=1
  1.  I '$D(^SC($G(SDCL),0)) D  Q
  1.  .Q:$G(AIL(1,3,1,4))'=$P(^DIC(4,$$KSP^XUPARAM("INST"),99),"^")
  1.  .S ERR=$G(MSAHDR)_"NOT A CLINIC AT THIS SITE "_$G(SDCL)
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  S STOPME=0
  1.  I $G(SDCL2)>0 D
  1.  .Q:$G(AIL(2,3,1,4))'=$P(^DIC(4,$$KSP^XUPARAM("INST"),99),"^")
  1.  .I '$D(^SC($G(SDCL2),0)) S ERR=$G(MSAHDR)_"NOT A CLINIC AT THIS SITE "_$G(SDCL2),STOPME=1 D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  Q:$G(STOPME)=1
  1.  K INP D INP^SDHL7APU
  1.  ;
  1.  S RET=""
  1.  ;IF a regular appt, not rtc or consult check to see if the appointment is in 409.85
  1.  I $P(SDAPTYP,"|",1)="A" D
  1.  .Q:$$UPPER^SDUL1(MSGARY("HL7EVENT"))'="S12"
  1.  .I $G(AIL(2,4,1,4))=$G(SDPARENT) S (INP(25),SCH(24,1,1),SDPARENT)=""  ;859 prevent adding parent in ARSET below
  1.  .S:INP(3)="" INP(3)=DT S RTN=0 D ARSET^SDECAR2(.RTN,.INP)
  1.  .S REQIEN=+$P(RTN,$c(30),2),SDAPTYP="A|"_REQIEN      ;817- define REQIEN for later  ;810- SDECAR2 routine should be used instead of SDHLAPT1 version of ARSET
  1.  I $G(SDMTC)=1 D CHKCHILD^SDHL7APU ; if multi check to see if the child order is in 409.85, if not add it
  1.  ;714 - PB get the division associated with the clinic and pass to the function to convert utc to local time
  1.  N TMPSTART,D1,D2
  1.  S:$G(SDCL)>0 D1=$P(^SC(SDCL,0),"^",15),D2=$$GET1^DIQ(40.8,D1_",",.07,"I")
  1.  S FLMNFMT=$$JSONTFM^SDHLAPT2(SDECSTART,D2),TMPSTART=FLMNFMT,SDECSTART=$$FMTE^XLFDT(FLMNFMT)
  1.  I FLMNFMT<1 D  Q
  1.  .S ERR=$G(MSAHDR)_"Invalid Start Date sent"
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  ;
  1.  ;PB - 714 fix to stop duplicate appointments for the patient
  1.  S STOPME=0
  1.  I $G(^DPT(DFN,"S",FLMNFMT,0))&($G(MSGARY("HL7EVENT"))="S12") D
  1.  .Q:$P($G(^DPT(DFN,"S",FLMNFMT,0)),"^",2)["C"
  1.  .S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT),STOPME=1
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  Q:$G(STOPME)=1
  1.  S STOPME=0
  1.  I $G(INTRA)=1 D
  1.  .S FLMNFMT2=$$FMADD^XLFDT(FLMNFMT,,,5)
  1.  .Q:$G(MSGARY("HL7EVENT"))'="S12"
  1.  .I $D(^DPT(DFN,"S",FLMNFMT,0)) D
  1.  ..I $P($G(^DPT(DFN,"S",FLMNFMT,0)),"^",2)'["C" D
  1.  ...S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT2),STOPME=1
  1.  ...D SENDERR^SDHL7APU(ERR)
  1.  ...K @MSGROOT
  1.  .Q:$G(STOPME)=1
  1.  .I $D(^DPT(DFN,"S",FLMNFMT2,0)) D
  1.  ..I $P($G(^DPT(DFN,"S",FLMNFMT2,0)),"^",2)'["C" D
  1.  ...S ERR=$G(MSAHDR)_"PATIENT ALREADY HAS AN APPT AT ON "_$$FMTE^XLFDT(FLMNFMT2),STOPME=1
  1.  ...D SENDERR^SDHL7APU(ERR)
  1.  ...K @MSGROOT
  1.  Q:$G(STOPME)=1
  1.  I $L(SDECLEN),$L($G(SCH(10))) D
  1.  .I $G(SCH(10))="MIN" S SDECEND=$$FMADD^XLFDT(FLMNFMT,,,$G(SDECLEN))
  1.  .I $G(SCH(10))="HR" S SDECEND=$$FMADD^XLFDT(FLMNFMT,,$G(SDECLEN))
  1.  ;
  1.  N TMPARR,LEN
  1.  S LEN=0,ERRSND=0,ERRTXT="",MSGROOT="SDTMPHL"
  1.  K @MSGROOT
  1.  ;
  1.  ; Loop to send RGS>1 groups to remote facilities. Abort entire SIU if any facility returns AE from remote.
  1.  F GRPNO=2:1:GRPCNT D  Q:+ERRSND
  1.  .K @MSGROOT
  1.  .S CNT=1,INTRA=0
  1.  .I $D(SCH) S:$G(FCHILD)>0 SCH(7,1,4)=FCHILD S @MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.SCH,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) K FCHILD
  1.  .I $D(SCHNTE) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.SCHNTE,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .I $D(PID) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PID,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .I $D(PV1) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.PV1,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .M TMPARR=RGS(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AIS(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AISNTE(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AIG(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AIL(GRPNO)
  1.  .I $D(TMPARR) D
  1.  ..S STA=$G(TMPARR(3,1,4)) S STA=$$GETSTA^SDHL7APU(STA)
  1.  ..S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AILNTE(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AIP(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .M TMPARR=AIPNTE(GRPNO)
  1.  .I $D(TMPARR) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.TMPARR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
  1.  .K TMPARR
  1.  .S:$G(AIL(1,3,1,4))=$G(AIL(2,3,1,4)) INTRA=1
  1.  .I $G(INTRA)=1 D NEWTIME^SDHLAPT2
  1.  .N HLRESLT,X
  1.  .I $G(INTRA)=0,'$$CHKLL^HLUTIL($G(STA)) D  Q     ;821 quit@single dot, so errtxt can be sent now
  1.  ..S ERRSND=1,ERRTXT=$E("Invalid Link assoc with institution: "_$G(STA),1,52)
  1.  .N HLA,HLEVN   ;821 new instead of kill
  1.  .N MC,HLFS,HLCS,IXX
  1.  .F IXX=1:1:CNT S HLA("HLS",IXX)=$G(@MSGROOT@(IXX))
  1.  .M HLA("HLA")=HLA("HLS")
  1.  .;the following HL* variables are created by DIRECT^HLMA
  1.  .N HL,HLCS,HLDOM,HLECH,HLFS,HLINST,HLINSTN,HLMTIEN,HLNEXT,HLNODE,HLPARAM,HLPROD,HLQ,HLQUITQ,SDLINK,OROK,MSASEG,ERRRSP
  1.  .N SDPARENT,SDCHILD,SDMRTC,SDAPTYP,AIL  ;Fix 2464
  1.  .;  more HL News, to protect Orig incoming HL* variables vs Intra/Inter msgs occurring real time below.   ;821
  1.  .N HLL,HLMTIENS,HL771RF,HL771SF,HLARTYP,HLASTMSG,HLASTRSP,HLDBACK,HLDBSIZE,HLDP,HLDREAD,HLDRETR,HLDWAIT,HLIED,HLEIDS,HLENROU,HLFORMAT,HLHDRO,HLLSTN,HLMIDAR
  1.  .N HLORNOD,HLOS,HLP,HLPID,HLPROU,HLQUIT,HLREC,HLRESLT,HLRETRA,HLFREQ,HLTCP,HLTCPADD,HLTCPCS,HLTPCI,HLTCPLNK,HLTCPO,HLTCPORT,HLTCPRET,HLTMBUF,HLEXROU,HLMTIENA
  1.  .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D
  1.  ..K HL
  1.  ..D:$G(INTRA)=0 INIT^HLFNC2("SD IFS EVENT DRIVER",.HL)
  1.  ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND INTRAFACILITY",.HL) ;if intra
  1.  .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D
  1.  ..K HL
  1.  ..D:$G(INTRA)=0 INIT^HLFNC2("SD TMP S15 SERVER EVENT DRIVER",.HL)
  1.  ..D:$G(INTRA)=1 INIT^HLFNC2("SD TMP SEND CANCEL INTRA",.HL) ;if intra
  1.  .I $G(STA)="" S STA=$G(AIL(2,3,1,4)),STA=$$GETSTA^SDHL7APU(STA)
  1.  .D LINK^HLUTIL3(STA,.SDLINK,"I")
  1.  .S SDLINK=$O(SDLINK(0))
  1.  .I SDLINK="" D  Q
  1.  ..Q:$G(INTRA)=1
  1.  ..S ERRSND=1,ERRTXT=$E("Message link undefined for facility: "_$G(STA),1,52)
  1.  .S SDLINK=SDLINK(SDLINK)
  1.  .;817 removed code setting HLL("LINKS") for INTRA type appts. Not used for internal HL7 processing. TMP-1559
  1.  .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D
  1.  ..S:$G(INTRA)=0 HLL("LINKS",1)="SD IFS SUBSCRIBER"_U_$G(SDLINK)
  1.  .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D
  1.  ..S:$G(INTRA)=0 HLL("LINKS",1)="SD TMP S15 CLIENT SUBSCRIBER"_U_$G(SDLINK)
  1.  .S HLMTIEN=""
  1.  .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D
  1.  ..D:$G(INTRA)=0 DIRECT^HLMA("SD IFS EVENT DRIVER","LM",1,.OROK)
  1.  ..I $G(INTRA)=1 D GENERATE^HLMA("SD TMP SEND INTRAFACILITY","LM",1,.OROK) S HLMTIEN=+OROK
  1.  .I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D
  1.  ..D:$G(INTRA)=0 DIRECT^HLMA("SD TMP S15 SERVER EVENT DRIVER","LM",1,.OROK)
  1.  ..I $G(INTRA)=1 D GENERATE^HLMA("SD TMP SEND CANCEL INTRA","LM",1,.OROK) S HLMTIEN=+OROK
  1.  .I 'HLMTIEN S ERRSND=1,ERRTXT=$E("ERROR-PROVIDER FACILITY #"_$G(STA)_":"_$P(OROK,U,2)_":"_$P(OROK,U,3),1,99) Q   ;821 increase all Errtxt from 48 to 99
  1.  .K @MSGROOT
  1.  .;Process response
  1.  .I $G(INTRA)=0 D
  1.  ..N HLNODE,SEG,I,RESP,IK
  1.  ..F IK=1:1 X HLNEXT Q:HLQUIT'>0  D
  1.  ...S RESP(IK)=HLNODE
  1.  ..S MSASEG=$G(RESP(2))
  1.  ..I $E(MSASEG,1,3)="MSA",$P(MSASEG,"|",2)="AE" S ERRSND=1,ERRTXT=$$STRIP^SDHL7APU($P(MSASEG,"|",4)),ERRTXT=$E(ERRTXT,1,52)
  1.  ;
  1.  I +ERRSND D  Q   ;**** Provider side error, exit and do not file patient side appt. ****
  1.  .S ERR=$G(MSAHDR)_ERRTXT
  1.  .D SENDERR^SDHL7APU(ERR)
  1.  .K @MSGROOT
  1.  ;Begin Appt filing
  1.  K @MSGROOT
  1.  S (SDSVCP,SDSVCPR,SDEKG,SDXRAY,SDLAB,SDECCR,SDECY,SDID,APPTYPE,EESTAT,SDEL)="",SDCL=$G(AIL(1,3,1,1))
  1.  S SDECRES=$$RESLKUP^SDHL7APU($G(SDCL))
  1.  S SDECRES=SDECRES,OVB=1
  1.  S (SDMRTC,MSGARY("SDMRTC"))=$S($G(SDMRTC)=1:"TRUE",1:"FALSE"),SDLAB="",PROVIEN=MSGARY("PROVIEN")
  1.  I $P(SDAPTYP,"|",1)="R" D
  1.  .S $P(SDAPTYP,"|",1)="A"
  1.  .I $G(SDPARENT)]"",$P(SDAPTYP,"|",2)=$G(SDPARENT),$P($G(^SDEC(409.85,$G(SDPARENT),3)),"^")="" S SDPARENT=""   ;SDPARENT with no SDCHILD scenario-erase parent. 863 fix 2562, prevent null subscript
  1.  K INP D INP^SDHL7APU
  1.  S (ERRCND,ERRTXT)=""
  1.  N SUCCESS
  1.  S SUCCESS=0
  1.  S (PROVIEN,DUZ)=$G(MSGARY("DUZ"))
  1.  S:$G(DUZ)="" (PROVIEN,DUZ)=.5
  1.  S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE"))
  1.  S (INP(11),SDDDT)=$G(SCH(11,1,8))
  1.  ;   Begin S12 processing (make)
  1.  I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S12" D
  1.  .S URL=$G(AILNTE)
  1.  .I $P($G(SDAPTYP),"|")="A"&($G(SDAPT)>0) D
  1.  ..;S $P(SDAPTYP,"|",2)=SDAPT      ; *848 - this 409.84 ien should not be set in SDAPTYP, which is a 409.85 file variable
  1.  ..S:$G(SDDDT)="" (INP(11),SDDDT)=$P(SDECSTART,"@",1),SDECATID="WALKIN"
  1.  .S:$P($G(SDAPTYP),"|",1)="R" $P(SDAPTYP,"|",1)="A"
  1.  .S:$G(SDPARENT)=$P(SDAPTYP,"|",2) SDPARENT=""
  1.  .I $$APPTYPE^SDHL7APU(SDCL)=1 S APPTYPE=1  ;780
  1.  .I $$PATCH^XPDUTL("SD*5.3*694") S SDECEND=$$FMTE^XLFDT(SDECEND)
  1.  .D APPADD^SDEC07(.SDECY,SDECSTART,SDECEND,DFN,SDECRES,SDECLEN,SDECNOTE,SDECATID,SDECCR,SDMRTC,SDDDT,SDREQBY,SDLAB,PROVIEN,SDID,SDAPTYP,SDSVCP,SDSVCPR,SDCL,SDEKG,SDXRAY,APPTYPE,EESTAT,OVB,$G(SDPARENT),SDEL) ;ADD NEW APPOINTMENT
  1.  .K SDAPT S SDAPT=+$P($G(^TMP("SDEC07",$J,2)),"^") ;if appointment is made this is the appointment number ien from 409.84
  1.  .S URL=$G(AILNTE)
  1.  .D:$L(URL) GETAPT^SDHL7APU(URL,SDCL,$G(TMPSTART)) ; If the appointment has been made in SDEC(409,84, update the url in the Hospital Location file.
  1.  .N TMP2 S TMP2=$G(^TMP("SDEC07",$J,2))
  1.  .I ((+$P(TMP2,"^",1)>0)&($L($P(TMP2,"^",3))<1)) S SUCCESS=1
  1.  .I SUCCESS=0 S ERRTXT=$P($G(^TMP("SDEC07",$J,2)),"^",3)
  1.  .I ((SUCCESS=0)&(ERRTXT="")) D
  1.  ..S ERRTXT=$P($G(^TMP("SDEC07",$J,3)),"^",2)
  1.  .I $L(ERRTXT) S ERRCND=9999
  1.  .S DUZ(2)=$G(STA)
  1.  .I $G(SUCCESS)>0 D
  1.  ..N INPA S INPA(1)=$S($G(REQIEN):REQIEN,1:$P(SDAPTYP,"|",2)),INPA(2)="SA",INPA(3)=$G(DUZ),DUZ(2)=$G(STA)    ;INPA(1) is the IEN of the PARENT order  ;817 If RTC, then add new Req (i.e. REQIEN) will exist.
  1.  ..S INPA(4)=$$FMTE^XLFDT(DT)
  1.  ..N RET D ARCLOSE^SDECAR(.RET,.INPA) ; Dispositions the order.
  1.  ..I $G(SDPARENT)'="" N CLOSEOUT S CLOSEOUT=0 I $G(RTCID)>0 S:$G(RTCID)=$P($G(^SDEC(409.85,+$G(SDPARENT),3)),"^",3) CLOSEOUT=1
  1.  ..I $G(CLOSEOUT)=1 D   ;if this is the last child close out the parent and all child orders
  1.  ...N INP S INP(1)=+SDPARENT,INP(2)="SA",INP(3)=$G(DUZ),DUZ(2)=$G(STA)
  1.  ...S INP(4)=$$FMTE^XLFDT(DT)
  1.  ...D ARCLOSE^SDECAR(.RET,.INP)
  1.  ...;Parent Appointment Request Closed now loop thru the 3 node and update each of the children to disposition of "MC"
  1.  ...I $G(SDPARENT)>0 K X12 S X12=0 F  S X12=$O(^SDEC(409.85,SDPARENT,2,X12)) Q:X12'>0  D
  1.  ....S INP(1)=$P(^SDEC(409.85,SDPARENT,2,X12,0),"^"),INP(2)="MC",INP(3)=$G(DUZ),DUZ(2)=$G(STA)
  1.  ....S INP(4)=$$FMTE^XLFDT(DT)
  1.  ....D ARCLOSE^SDECAR(.RET,.INP)
  1.  ;  Begin S15 processing (cancel)
  1.  I $$UPPER^SDUL1(MSGARY("HL7EVENT"))="S15" D
  1.  .N XDT,%D,X,Y,STARTDT,ERRTXT,ERRCND
  1.  .S SDECCR=$G(SCH(6,1,2)),SDUSER=$G(MSGARY("DUZ"))
  1.  .S:$G(SDUSER)="" SDUSER=.5
  1.  .S %DT="RXT",X=SDECSTART D ^%DT S STARTDT=Y
  1.  .S SDECAPTID=$$GETAPP^SDHLAPT1(DFN,SDECRES,STARTDT)
  1.  .S DUZ=$G(MSGARY("DUZ"))
  1.  .S:$G(DUZ)="" DUZ=.5
  1.  .S:$G(DUZ(2))="" DUZ(2)=$G(MSGARY("HLTHISSITE"))
  1.  .D APPDEL^SDEC08(.SDECY,SDECAPTID,SDECTYP,$G(SDECCR),$G(SDECNOT),$G(SDECDATE),$G(SDUSER))
  1.  .S ERRTXT=$P($G(^TMP("SDEC",$J,2)),"^")
  1.  .I +$L(ERRTXT)>0 S ERRCND=9999
  1.  .D CHKCAN^SDHLAPT2(DFN,SDCL,STARTDT)
  1.  ;
  1.  I +ERRCND S ERRTXT=$$ERRLKP^SDHL7APU(ERRTXT)
  1.  S ERRTXT=$$STRIP^SDHL7APU(ERRTXT)
  1.  ;
  1.  D ACK^SDHL7APU
  1.  Q