SDHL7 ;SLC/AGP - RTC Order HL7 receiver;11:53 AM 19 Jun 2017
;;5.3;Scheduling;**671,682**;Aug 13, 1993;Build 10
;
;RESULT("REQ FILE IEN")=0 REQUEST IEN if defined then the user is trying to modify or discontinue the order before scheduling disposition it.
;RESULT("APPT TYPE")="followup" Generic HL7 type for appointment type.Should be modify in the future when VSE and CPRS have more time to work on it
;RESULT("CHANGE")=1 If defined the REQ IEN (REQ FILE IEN) should be defined the user change the order before scheduling disposition it.
;RESULT("CLINIC")="240^20 MINUTE" file 44 IEN^entry .01 field
;RESULT("COMMENT")="This is the new comment field"
;RESULT("DISCONTINUE")=1 If defined the REQ IEN (REQ FILE IEN) should be defined the user discontinue the order before scheduling disposition it.
;RESULT("ENTERED BY")="10000000195^PULEO,ANTHONY" the person who entere
;RESULT("INTERVAL")="Q7D" only defined if the number of appointments in greater then 1
;RESULT("MSG ID")="" ID to track rejection ORDER IEN^ACTION (S03, S05,S01)
;RESULT("NEW ORDER")=1 this is the request of a new RTC order being placed in CPRS.
;RESULT("NLT")=1 If this is a No Later Than appointment request
;RESULT("NUMBER APPT")=4 total number of appointment requested
;RESULT("ORDER IEN")=14524362 IEN from file 100
;RESULT("PATIENT")="346^RECORD, THREE"
;RESULT("PREREQ,1)="LAB" user can select prereq in CPRS. It is up to scheduling if they want to use this information
;RESULT("PREREQ",2)="XRAY"
;RESULT("PREREQ",3)="VITALS"
;RESULT("RTC DATE")=20170524 Requested date for the Return To Clinic appointment
;RESULT("SIGNED BY")="10000000195^PULEO,ANTHONY" the person who signedthe order, file 200 IEN^entry .01 field
;
;if RESULT("REJECTION ERROR") is defined. It means CPRS rejected the message update. The user should be aware of the error message
;so the data should cann be cleanup
;
;TODO: WIRE UP RESULT("REJECTION ERROR") TO REPORT BACK TO THE GUI
;
EN(MSG) ; -- main entry point for OR RECEIVE where MSG contains HL7 msg
N ACTION,AIG,AIL,ARQ,DATE,ENTER,ERROR,FREQ,FAILMSA,HASMSA,INST,MSH,NODE,NUM,NXT,PAT,RESULT,SDMSG,X,PID,PV1,SEG,SIGN
S ERROR=""
S SDMSG=$S($L($G(MSG)):MSG,1:"MSG") ; MSG="NAME" or MSG(#)=message
I '$O(@SDMSG@(0)) S ERROR="Missing HL7 message" Q
S MSH=0 F S MSH=$O(@SDMSG@(MSH)) Q:MSH'>0 Q:$E(@SDMSG@(MSH),1,3)="MSH"
I 'MSH S ERROR="Missing or invalid MSH segment" Q
S X=0,FAILMSA=0,HASMSA=0 F S X=$O(@SDMSG@(X)) Q:X'>0!(ERROR'="")!(HASMSA=1) D
.S SEG=$P(@SDMSG@(X),"|"),NODE=$P(@SDMSG@(X),"|",2,99)
.I SEG="MSA" S HASMSA=1
.S SEG=SEG_"(.RESULT,X,NODE,.ERROR)"
.D @SEG
I FAILMSA=1 D REJECT(.RESULT) G ENX
I HASMSA=1 G ENX
I ERROR'="" D SENDFAIL(.ERROR,.RESULT) G ENX
;HANDLE REJECTION ERRORS
I $D(RESULT("REJECTION ERROR")) S ^TMP($J,"REJECT",RESULT("REQ FILE IEN"))=RESULT("REJECTION ERROR") G ENX
;DISCONTINUE REQUEST
I $G(RESULT("DISCONTINUE"))=1 D VALDDIS(.RESULT,.ERROR)
I ERROR="" D DISCONT(.RESULT,.ERROR)
I ERROR'="" D SENDFAIL(.ERROR,.RESULT) G ENX
;NEW OR CHANGE REQUEST
I $G(RESULT("DISCONTINUE"))'=1 D VALIDATE(.RESULT,.ERROR)
I ERROR="" D SAVEREC(.RESULT,.ERROR)
I ERROR'="" D SENDFAIL(.ERROR,.RESULT) G ENX
D SENDOK(.RESULT)
ENX ;
Q
;
MSA(RESULT,X,SEG,ERROR) ;
I $P(SEG,"|")'="AR" Q
S RESULT("REJECTION ERROR")=$P(SEG,"|",2) S FAILMSA=1
Q
;
MSH(RESULT,X,SEG,ERROR) ;
S RESULT("MSG ID")=$P(SEG,"|",9)
S RESULT("MSG DATE/TIME")=$$HL7TFM^XLFDT($P(SEG,"|",6),"L")
Q
;
ARQ(RESULT,X,SEG,ERROR) ;
S RESULT("ORDER IEN")=+$P(SEG,"|"),RESULT("REQ FILE IEN")=+$P(SEG,"|",2)
S RESULT("APPT TYPE")=$P($P(SEG,"|",5),U,2)
S ACTION=$P(SEG,"|",6) S RESULT($S(ACTION="S05":"DISCONTINUE",ACTION="S03":"CHANGE",1:"NEW ORDER"))=1
S DATE=$P(SEG,"|",8),TIME=$P(SEG,"|",9)
I TIME="T" S RESULT("NLT")=1
S RESULT("RTC DATE")=$$HL7TFM^XLFDT($S(TIME="T":$P(DATE,U,2),1:$P(DATE,U)),"L")
S FREQ=$P(SEG,"|",10),NUM=$P(SEG,"|",11)
S RESULT("NUMBER APPT")=NUM I NUM>0 S RESULT("INTERVAL")=+$E(FREQ,2,3)
S RESULT("SIGNED BY")=$P(SEG,"|",12)
S RESULT("ENTERED BY")=$P(SEG,"|",16)
Q
;
AIL(RESULT,X,SEG,ERROR) ;
S RESULT("CLINIC")=$P(SEG,"|",3)
Q
AIG(RESULT,X,SEG,ERROR) ;
N INST,NODE
S RESULT("PREREQ",$P(SEG,"|"))=$P($P(SEG,"|",2),U,2)
S INST=0 F S INST=$O(@SDMSG@(X,INST)) Q:INST'>0 D
.S NODE=$P(@SDMSG@(X,INST),"|",2,99)
.S RESULT("PREREQ",$P(NODE,"|"))=$P($P(NODE,"|",2),U,2)
Q
;
NTE(RESULT,X,SEG,ERROR) ;
S RESULT("COMMENT")=$$UNESC($P(SEG,"|",3))
Q
;
PID(RESULT,X,SEG,ERROR) ;
S RESULT("PATIENT")=$P(SEG,"|",3)_U_$P(SEG,"|",5)
Q
;
PV1(RESULT,X,SEG,ERROR) ; -- Gets Patient location info.
; may not be needed for scheduling
;PV1="PV1||"_TYPE_"|"_LOC_$S($L(RB):U_RB,1:"")_"||||||||||||||||"_$G(VISIT)
Q
;
FMDATE(Y) ; -- Convert HL7 date/time to FM format
Q $$HL7TFM^XLFDT(Y)
;
;
REJECT(RESULT) ;
; SHOW TO USER
; RESULT("REJECTION ERROR")
Q
;
VALIDATE(RESULT,ERROR) ;
S (RTCD,SBIEN,PATIEN,ORDIEN,CLNIEN,NUMAPP,CHGREQ,EBIEN)=""
;RTC DATE VALIDATION
S RTCD=$G(RESULT("RTC DATE"))
I RTCD="" S ERROR="An RTC Date is requried" Q
I (RTCD?7N)=0 S ERROR="RTC order date format error. Use calendar or format T+2W. Time not allowed." Q
;SIGNED BY VALIDATION
S SBIEN=$P($G(RESULT("SIGNED BY")),"^",1)
I SBIEN="" S ERROR="An IEN is required as the first piece of Signed By" Q
I (SBIEN?1N.N)=0 S ERROR="The Signed By IEN is must be a number" Q
;ENTERED BY VALIDATION
S EBIEN=$P($G(RESULT("ENTERED BY")),"^",1)
I EBIEN="" S ERROR="An IEN is required as the first piece of Entered By" Q
I (EBIEN?1N.N)=0 S ERROR="The Entered By IEN is must be a number" Q
;PATIENT VALIDATION
S PATIEN=$P($G(RESULT("PATIENT")),"^",1)
I PATIEN="" S ERROR="Contact Help desk for assistance with patient's account. RTC Error with patient's IEN(1)" Q
I (PATIEN?1N.N)=0 S ERROR="Contact Help desk for assistance with patient's account. RTC Error with patient's IEN(2)" Q
;CLINIC VALIDATION
S CLNIEN=$P($G(RESULT("CLINIC")),"^",1)
I CLNIEN="" S ERROR="A RTC Clinic location is required." Q
I (CLNIEN?1N.N)=0 S ERROR="An appropriate RTC Clinic location is required."
;ORDER IEN VALIDATION
S ORDIEN=$P($G(RESULT("ORDER IEN")),"^",1)
I ORDIEN="" S ERROR="An IEN is required as the first piece of Order" Q
I (ORDIEN?1N.N)=0 S ERROR="An Order IEN must be a number" Q
;MULTIPLE APPOINTMENT VALIDATION
S NUMAPP=$G(RESULT("NUMBER APPT"))
S INTERV=$G(RESULT("INTERVAL"))
I NUMAPP'="" D
.I (NUMAPP?1N.N)=0 D
..S ERROR="Enter the numeric number of RTC appointment needed."
.I +NUMAPP>1 D
..I +INTERV=0 D
...S ERROR="Enter a numeric interval in days for the multiple RTC appointments."
I ERROR'="" Q
;NO LATER THAN VALIDATION
I $G(RESULT("NLT"))'="" D
.I $G(RESULT("NLT"))'=1&($G(RESULT("NLT"))'=0) S ERROR="If set, NLT must be a 1 or 0" Q
;COMMENT VALIDATION
I $L($G(RESULT("COMMENT")))>75 S ERROR="Comment is greater than 75 characters" Q
;CHANGE VALIDATION
S CHGREQ=$G(RESULT("CHANGE"))
I CHGREQ'="",CHGREQ'=1,CHGREQ'=0 S ERROR="If set, Change must be a 1 or 0"
I CHGREQ=1 D
.;REQEUST IEN VALIDATION
.S REQIEN=$G(RESULT("REQ FILE IEN"))
.I REQIEN="" D
..S ERROR="If change is set to 1, then a Request IEN is required" Q
.I (REQIEN?1N.N)=0 D
..S ERROR="Request IEN must be a number" Q
I ERROR'="" Q
Q
;
VALDDIS(RESULT,ERROR) ; VALIDATE A DISCONTINUE REQUEST
;REQEUST IEN VALIDATION
S REQIEN=$G(RESULT("REQ FILE IEN"))
I REQIEN="" S ERROR="If disconintue is set to 1, then a Request IEN isrequired" Q
I (REQIEN?1N.N)=0 S ERROR="Request IEN must be a number" Q
;ENTERED BY VALIDATION
S EBIEN=$P($G(RESULT("ENTERED BY")),"^",1)
I EBIEN="" S ERROR="A Entered By IEN is required" Q
I (EBIEN?1N.N)=0 S ERROR="The Entered By IEN must be a number" Q
Q
;
DISCONT(RESULT,ERROR) ;
;SETUP
S U="^"
;
N ARCINP,ARCRET,APPTIEN,ARCLE
;;DISCONTINUE REQUEST
S (APPTIEN,ARCRET,ARCLE)=""
S APPTIEN=$G(RESULT("REQ FILE IEN"))
I +APPTIEN>0 D
.I $G(RESULT("DISCONTINUE"))=1 D
..S ARCINP(1)=APPTIEN
..S ARCINP(2)="REMOVED/NO LONGER NECESSARY"
..S ARCINP(3)=$P($G(RESULT("ENTERED BY")),U,1)
..S ARCINP(4)=DT
..D ARCLOSE^SDECAR(.ARCRET,.ARCINP)
;CHECK FOR ARCLOSE ERRORS
S ARCLE=$P(ARCRET,$C(30),2)
I $P(ARCLE,U,1)=-1 S ERROR=$P(ARCLE,U,2)
Q
;
SAVEREC(RESULT,ERROR) ;
;SETUP
S U="^"
;
;NEW/CHANGE REQUEST
Q:$G(RESULT("NEW ORDER"))'=1&($G(RESULT("CHANGE"))'=1)
N ARINP,APPTCHG,PTIEN,SDATE,DDDT,MARDDS,COUNT,ATYPIEN,STCREC,SCPER,SETRET,ARSETE
S (APPTCHG,PTIEN,SDATE,DDDT,MARDDS,COUNT,ATYPIEN,STCREC,SCPER,SETRET,ARSETE)=""
S APPTCHG=$G(RESULT("CHANGE"))
I APPTCHG=1 D
.S ARINP(1)=APPTIEN
;PATIENT
S PTIEN=$P($G(RESULT("PATIENT")),U,1)
S ARINP(2)=PTIEN
;ENTERED DATE TIME
S Y=DT X ^DD("DD") S ARINP(3)=Y
;REQUEST TYPE
S ARINP(5)="RTC"
;CLINIC
S ARINP(6)=$P($G(RESULT("CLINIC")),U,1)
;ENTERED BY
S ARINP(7)=$P($G(RESULT("ENTERED BY")),U,1)
;PRIORITY
S ARINP(8)="FUTURE" I $G(RESULT("RTC DATE"))=DT D
.S ARINP(8)="ASAP"
;REQUESTED BY
S ARINP(9)="PROVIDER"
;PROVIDER
S ARINP(10)=$P($G(RESULT("SIGNED BY")),U,1)
;RTC DATE
S RTCDTI=$G(RESULT("RTC DATE"))
S Y=RTCDTI X ^DD("DD") S ARINP(11)=Y
;COMMENTS
S ARINP(12)=$G(RESULT("COMMENT"))
I $G(RESULT("NLT"))=1 D
.S ARINP(12)="#NLT#"_$G(RESULT("COMMENT"))
;ENROLLMENT GROUP
S PCE="" S PCE=$P($G(^DPT(PTIEN,"ENR")),U,1) I PCE'="" D
.S ARINP(13)=$$GET1^DIQ(27.11,PCE,.07,"E")
;MULTIPLE APPOINTMENT REQUEST
S ARINP(14)="NO" ;DEFAULT
S ARINP(20)="" ;DEFAULT
I $G(RESULT("NUMBER APPT"))'="" D
.I $G(RESULT("NUMBER APPT"))>1 D
..S ARINP(14)="YES"
..S ARINP(15)=$G(RESULT("INTERVAL"))
..S ARINP(16)=$G(RESULT("NUMBER APPT"))
..S DDDT=$G(RESULT("RTC DATE"))
..F I=1:1:$G(RESULT("NUMBER APPT")) D
...S X1=DDDT,X2=RESULT("INTERVAL") D C^%DTC S SDATE=X
...S MARDDS=MARDDS_$S(MARDDS="":SDATE,1:"|"_SDATE)
...S ARINP(20)=MARDDS
;SERVICE CONNECTED
S SCPER=$P($G(^DPT(PTIEN,.3)),"^",2)
I SCPER'="" D
.S ARINP(19)=SCPER
.I SCPER>49 D
..S ARINP(18)="YES"
..S ATYPIEN=$O(^SD(409.1,"B","SERVICE CONNECTED",ATYPIEN))
E S ARINP(18)="NO" S ATYPIEN=$O(^SD(409.1,"B","REGULAR",ATYPIEN))
I ATYPIEN'="" D
.S ARINP(22)=ATYPIEN
;CLINIC STOP CODE
D GETSTC^SDECCON(STCREC,$P($G(RESULT("CLINIC")),U,1))
I STCREC'="" D
.S ARINP(21)=$P($G(STCREC),U,1)
;ESTABLISHED PATIENT
S ARINP(23)="E"
;NO LATER THAN
I $G(RESULT("NLT"))'="" D
.S ARINP(26)=$G(RESULT("NLT"))
;ORDER IEN
I $G(RESULT("ORDER IEN"))'="" D
.S ARINP(28)=RESULT("ORDER IEN")
;PREREQ
I $D(RESULT("PREREQ")) D
.N PR,CC
.S PREREQ=""
.S CC=0 F S CC=$O(RESULT("PREREQ",CC)) Q:CC'>0 D
..S PR=$G(RESULT("PREREQ",CC)) Q:PR=""
..S PREREQ=$S(PREREQ'="":PREREQ_";"_PR,1:PR)
.S ARINP(27)=PREREQ
;CREATE THE APPOINTMENT REQUEST
D ARSET^SDECAR2(.SETRET,.ARINP)
;CHECK FOR ARSET ERRORS
S ARSETE=$P(SETRET,$C(30),2)
I $P(ARSETE,U,1)="-1" S ERROR=$P(ARSETE,U,2) Q
;GET ARIEN
S RESULT("REQ FILE IEN")=+ARSETE
Q
;
SENDFAIL(ERROR,RESULT) ;
;S ORV("XQY0")="" D ERROR^OERR(ERROR,.SDMSG,.ORV)
;Q:ORTYPE="ORR" Q:'$L($G(ORNMSP))
N SDEMSG
;N ORVP,ORTS S:'$G(ORDUZ) ORDUZ=PAT_";DPT(" D:'$G(ORVP) PID
S SDEMSG(1)="MSH|^~\&|SCHEDULING|"_$G(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_RESULT("MSG ID")
S SDEMSG(2)="MSA|AR|"_$P(ERROR,$C(30,31))_"|||207^"_$P(ERROR,$C(30,31))
S OREMSG(3)="ERR|^^^"
D MSG^XQOR("SD EVSEND OR",.SDEMSG)
Q
;
SENDOK(RESULT) ;
N SDMSG
S SDMSG(1)="MSH|^~\&|SCHEDULING|"_$G(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_RESULT("MSG ID")
S SDMSG(2)="MSA|AA|OK^"_$G(RESULT("REQ FILE IEN"))_"|||"
D MSG^XQOR("SD EVSEND OR",.SDMSG)
Q
;
;TODO: GET ANTHONY'S HELP TO FORMAT MESSAGE TO SEND STATUS (SCHEDULED,DISPOSITION,TRANSFERED,ETC...) UPDATE TO CPRS
UPSTAT(ORDIEN,STATUS) ;
Q:ORDIEN=""
Q:STATUS=""
N SDMSG
S SDMSG(1)="MSH|^~\&|SCHEDULING|"_$G(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_RESULT("MSG ID")
S SDMSG(2)="MSA|AA|OK^"_$G(RESULT("REQ FILE IEN"))_"|||"
D MSG^XQOR("SD EVSEND OR",.SDMSG)
Q
;
UNESC(STR) ;
;ICR 4922
Q $$UNESC^ORHLESC(STR)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDHL7 12233 printed Nov 22, 2024@18:07:52 Page 2
SDHL7 ;SLC/AGP - RTC Order HL7 receiver;11:53 AM 19 Jun 2017
+1 ;;5.3;Scheduling;**671,682**;Aug 13, 1993;Build 10
+2 ;
+3 ;RESULT("REQ FILE IEN")=0 REQUEST IEN if defined then the user is trying to modify or discontinue the order before scheduling disposition it.
+4 ;RESULT("APPT TYPE")="followup" Generic HL7 type for appointment type.Should be modify in the future when VSE and CPRS have more time to work on it
+5 ;RESULT("CHANGE")=1 If defined the REQ IEN (REQ FILE IEN) should be defined the user change the order before scheduling disposition it.
+6 ;RESULT("CLINIC")="240^20 MINUTE" file 44 IEN^entry .01 field
+7 ;RESULT("COMMENT")="This is the new comment field"
+8 ;RESULT("DISCONTINUE")=1 If defined the REQ IEN (REQ FILE IEN) should be defined the user discontinue the order before scheduling disposition it.
+9 ;RESULT("ENTERED BY")="10000000195^PULEO,ANTHONY" the person who entere
+10 ;RESULT("INTERVAL")="Q7D" only defined if the number of appointments in greater then 1
+11 ;RESULT("MSG ID")="" ID to track rejection ORDER IEN^ACTION (S03, S05,S01)
+12 ;RESULT("NEW ORDER")=1 this is the request of a new RTC order being placed in CPRS.
+13 ;RESULT("NLT")=1 If this is a No Later Than appointment request
+14 ;RESULT("NUMBER APPT")=4 total number of appointment requested
+15 ;RESULT("ORDER IEN")=14524362 IEN from file 100
+16 ;RESULT("PATIENT")="346^RECORD, THREE"
+17 ;RESULT("PREREQ,1)="LAB" user can select prereq in CPRS. It is up to scheduling if they want to use this information
+18 ;RESULT("PREREQ",2)="XRAY"
+19 ;RESULT("PREREQ",3)="VITALS"
+20 ;RESULT("RTC DATE")=20170524 Requested date for the Return To Clinic appointment
+21 ;RESULT("SIGNED BY")="10000000195^PULEO,ANTHONY" the person who signedthe order, file 200 IEN^entry .01 field
+22 ;
+23 ;if RESULT("REJECTION ERROR") is defined. It means CPRS rejected the message update. The user should be aware of the error message
+24 ;so the data should cann be cleanup
+25 ;
+26 ;TODO: WIRE UP RESULT("REJECTION ERROR") TO REPORT BACK TO THE GUI
+27 ;
EN(MSG) ; -- main entry point for OR RECEIVE where MSG contains HL7 msg
+1 NEW ACTION,AIG,AIL,ARQ,DATE,ENTER,ERROR,FREQ,FAILMSA,HASMSA,INST,MSH,NODE,NUM,NXT,PAT,RESULT,SDMSG,X,PID,PV1,SEG,SIGN
+2 SET ERROR=""
+3 ; MSG="NAME" or MSG(#)=message
SET SDMSG=$SELECT($LENGTH($GET(MSG)):MSG,1:"MSG")
+4 IF '$ORDER(@SDMSG@(0))
SET ERROR="Missing HL7 message"
QUIT
+5 SET MSH=0
FOR
SET MSH=$ORDER(@SDMSG@(MSH))
if MSH'>0
QUIT
if $EXTRACT(@SDMSG@(MSH),1,3)="MSH"
QUIT
+6 IF 'MSH
SET ERROR="Missing or invalid MSH segment"
QUIT
+7 SET X=0
SET FAILMSA=0
SET HASMSA=0
FOR
SET X=$ORDER(@SDMSG@(X))
if X'>0!(ERROR'="")!(HASMSA=1)
QUIT
Begin DoDot:1
+8 SET SEG=$PIECE(@SDMSG@(X),"|")
SET NODE=$PIECE(@SDMSG@(X),"|",2,99)
+9 IF SEG="MSA"
SET HASMSA=1
+10 SET SEG=SEG_"(.RESULT,X,NODE,.ERROR)"
+11 DO @SEG
End DoDot:1
+12 IF FAILMSA=1
DO REJECT(.RESULT)
GOTO ENX
+13 IF HASMSA=1
GOTO ENX
+14 IF ERROR'=""
DO SENDFAIL(.ERROR,.RESULT)
GOTO ENX
+15 ;HANDLE REJECTION ERRORS
+16 IF $DATA(RESULT("REJECTION ERROR"))
SET ^TMP($JOB,"REJECT",RESULT("REQ FILE IEN"))=RESULT("REJECTION ERROR")
GOTO ENX
+17 ;DISCONTINUE REQUEST
+18 IF $GET(RESULT("DISCONTINUE"))=1
DO VALDDIS(.RESULT,.ERROR)
+19 IF ERROR=""
DO DISCONT(.RESULT,.ERROR)
+20 IF ERROR'=""
DO SENDFAIL(.ERROR,.RESULT)
GOTO ENX
+21 ;NEW OR CHANGE REQUEST
+22 IF $GET(RESULT("DISCONTINUE"))'=1
DO VALIDATE(.RESULT,.ERROR)
+23 IF ERROR=""
DO SAVEREC(.RESULT,.ERROR)
+24 IF ERROR'=""
DO SENDFAIL(.ERROR,.RESULT)
GOTO ENX
+25 DO SENDOK(.RESULT)
ENX ;
+1 QUIT
+2 ;
MSA(RESULT,X,SEG,ERROR) ;
+1 IF $PIECE(SEG,"|")'="AR"
QUIT
+2 SET RESULT("REJECTION ERROR")=$PIECE(SEG,"|",2)
SET FAILMSA=1
+3 QUIT
+4 ;
MSH(RESULT,X,SEG,ERROR) ;
+1 SET RESULT("MSG ID")=$PIECE(SEG,"|",9)
+2 SET RESULT("MSG DATE/TIME")=$$HL7TFM^XLFDT($PIECE(SEG,"|",6),"L")
+3 QUIT
+4 ;
ARQ(RESULT,X,SEG,ERROR) ;
+1 SET RESULT("ORDER IEN")=+$PIECE(SEG,"|")
SET RESULT("REQ FILE IEN")=+$PIECE(SEG,"|",2)
+2 SET RESULT("APPT TYPE")=$PIECE($PIECE(SEG,"|",5),U,2)
+3 SET ACTION=$PIECE(SEG,"|",6)
SET RESULT($SELECT(ACTION="S05":"DISCONTINUE",ACTION="S03":"CHANGE",1:"NEW ORDER"))=1
+4 SET DATE=$PIECE(SEG,"|",8)
SET TIME=$PIECE(SEG,"|",9)
+5 IF TIME="T"
SET RESULT("NLT")=1
+6 SET RESULT("RTC DATE")=$$HL7TFM^XLFDT($SELECT(TIME="T":$PIECE(DATE,U,2),1:$PIECE(DATE,U)),"L")
+7 SET FREQ=$PIECE(SEG,"|",10)
SET NUM=$PIECE(SEG,"|",11)
+8 SET RESULT("NUMBER APPT")=NUM
IF NUM>0
SET RESULT("INTERVAL")=+$EXTRACT(FREQ,2,3)
+9 SET RESULT("SIGNED BY")=$PIECE(SEG,"|",12)
+10 SET RESULT("ENTERED BY")=$PIECE(SEG,"|",16)
+11 QUIT
+12 ;
AIL(RESULT,X,SEG,ERROR) ;
+1 SET RESULT("CLINIC")=$PIECE(SEG,"|",3)
+2 QUIT
AIG(RESULT,X,SEG,ERROR) ;
+1 NEW INST,NODE
+2 SET RESULT("PREREQ",$PIECE(SEG,"|"))=$PIECE($PIECE(SEG,"|",2),U,2)
+3 SET INST=0
FOR
SET INST=$ORDER(@SDMSG@(X,INST))
if INST'>0
QUIT
Begin DoDot:1
+4 SET NODE=$PIECE(@SDMSG@(X,INST),"|",2,99)
+5 SET RESULT("PREREQ",$PIECE(NODE,"|"))=$PIECE($PIECE(NODE,"|",2),U,2)
End DoDot:1
+6 QUIT
+7 ;
NTE(RESULT,X,SEG,ERROR) ;
+1 SET RESULT("COMMENT")=$$UNESC($PIECE(SEG,"|",3))
+2 QUIT
+3 ;
PID(RESULT,X,SEG,ERROR) ;
+1 SET RESULT("PATIENT")=$PIECE(SEG,"|",3)_U_$PIECE(SEG,"|",5)
+2 QUIT
+3 ;
PV1(RESULT,X,SEG,ERROR) ; -- Gets Patient location info.
+1 ; may not be needed for scheduling
+2 ;PV1="PV1||"_TYPE_"|"_LOC_$S($L(RB):U_RB,1:"")_"||||||||||||||||"_$G(VISIT)
+3 QUIT
+4 ;
FMDATE(Y) ; -- Convert HL7 date/time to FM format
+1 QUIT $$HL7TFM^XLFDT(Y)
+2 ;
+3 ;
REJECT(RESULT) ;
+1 ; SHOW TO USER
+2 ; RESULT("REJECTION ERROR")
+3 QUIT
+4 ;
VALIDATE(RESULT,ERROR) ;
+1 SET (RTCD,SBIEN,PATIEN,ORDIEN,CLNIEN,NUMAPP,CHGREQ,EBIEN)=""
+2 ;RTC DATE VALIDATION
+3 SET RTCD=$GET(RESULT("RTC DATE"))
+4 IF RTCD=""
SET ERROR="An RTC Date is requried"
QUIT
+5 IF (RTCD?7N)=0
SET ERROR="RTC order date format error. Use calendar or format T+2W. Time not allowed."
QUIT
+6 ;SIGNED BY VALIDATION
+7 SET SBIEN=$PIECE($GET(RESULT("SIGNED BY")),"^",1)
+8 IF SBIEN=""
SET ERROR="An IEN is required as the first piece of Signed By"
QUIT
+9 IF (SBIEN?1N.N)=0
SET ERROR="The Signed By IEN is must be a number"
QUIT
+10 ;ENTERED BY VALIDATION
+11 SET EBIEN=$PIECE($GET(RESULT("ENTERED BY")),"^",1)
+12 IF EBIEN=""
SET ERROR="An IEN is required as the first piece of Entered By"
QUIT
+13 IF (EBIEN?1N.N)=0
SET ERROR="The Entered By IEN is must be a number"
QUIT
+14 ;PATIENT VALIDATION
+15 SET PATIEN=$PIECE($GET(RESULT("PATIENT")),"^",1)
+16 IF PATIEN=""
SET ERROR="Contact Help desk for assistance with patient's account. RTC Error with patient's IEN(1)"
QUIT
+17 IF (PATIEN?1N.N)=0
SET ERROR="Contact Help desk for assistance with patient's account. RTC Error with patient's IEN(2)"
QUIT
+18 ;CLINIC VALIDATION
+19 SET CLNIEN=$PIECE($GET(RESULT("CLINIC")),"^",1)
+20 IF CLNIEN=""
SET ERROR="A RTC Clinic location is required."
QUIT
+21 IF (CLNIEN?1N.N)=0
SET ERROR="An appropriate RTC Clinic location is required."
+22 ;ORDER IEN VALIDATION
+23 SET ORDIEN=$PIECE($GET(RESULT("ORDER IEN")),"^",1)
+24 IF ORDIEN=""
SET ERROR="An IEN is required as the first piece of Order"
QUIT
+25 IF (ORDIEN?1N.N)=0
SET ERROR="An Order IEN must be a number"
QUIT
+26 ;MULTIPLE APPOINTMENT VALIDATION
+27 SET NUMAPP=$GET(RESULT("NUMBER APPT"))
+28 SET INTERV=$GET(RESULT("INTERVAL"))
+29 IF NUMAPP'=""
Begin DoDot:1
+30 IF (NUMAPP?1N.N)=0
Begin DoDot:2
+31 SET ERROR="Enter the numeric number of RTC appointment needed."
End DoDot:2
+32 IF +NUMAPP>1
Begin DoDot:2
+33 IF +INTERV=0
Begin DoDot:3
+34 SET ERROR="Enter a numeric interval in days for the multiple RTC appointments."
End DoDot:3
End DoDot:2
End DoDot:1
+35 IF ERROR'=""
QUIT
+36 ;NO LATER THAN VALIDATION
+37 IF $GET(RESULT("NLT"))'=""
Begin DoDot:1
+38 IF $GET(RESULT("NLT"))'=1&($GET(RESULT("NLT"))'=0)
SET ERROR="If set, NLT must be a 1 or 0"
QUIT
End DoDot:1
+39 ;COMMENT VALIDATION
+40 IF $LENGTH($GET(RESULT("COMMENT")))>75
SET ERROR="Comment is greater than 75 characters"
QUIT
+41 ;CHANGE VALIDATION
+42 SET CHGREQ=$GET(RESULT("CHANGE"))
+43 IF CHGREQ'=""
IF CHGREQ'=1
IF CHGREQ'=0
SET ERROR="If set, Change must be a 1 or 0"
+44 IF CHGREQ=1
Begin DoDot:1
+45 ;REQEUST IEN VALIDATION
+46 SET REQIEN=$GET(RESULT("REQ FILE IEN"))
+47 IF REQIEN=""
Begin DoDot:2
+48 SET ERROR="If change is set to 1, then a Request IEN is required"
QUIT
End DoDot:2
+49 IF (REQIEN?1N.N)=0
Begin DoDot:2
+50 SET ERROR="Request IEN must be a number"
QUIT
End DoDot:2
End DoDot:1
+51 IF ERROR'=""
QUIT
+52 QUIT
+53 ;
VALDDIS(RESULT,ERROR) ; VALIDATE A DISCONTINUE REQUEST
+1 ;REQEUST IEN VALIDATION
+2 SET REQIEN=$GET(RESULT("REQ FILE IEN"))
+3 IF REQIEN=""
SET ERROR="If disconintue is set to 1, then a Request IEN isrequired"
QUIT
+4 IF (REQIEN?1N.N)=0
SET ERROR="Request IEN must be a number"
QUIT
+5 ;ENTERED BY VALIDATION
+6 SET EBIEN=$PIECE($GET(RESULT("ENTERED BY")),"^",1)
+7 IF EBIEN=""
SET ERROR="A Entered By IEN is required"
QUIT
+8 IF (EBIEN?1N.N)=0
SET ERROR="The Entered By IEN must be a number"
QUIT
+9 QUIT
+10 ;
DISCONT(RESULT,ERROR) ;
+1 ;SETUP
+2 SET U="^"
+3 ;
+4 NEW ARCINP,ARCRET,APPTIEN,ARCLE
+5 ;;DISCONTINUE REQUEST
+6 SET (APPTIEN,ARCRET,ARCLE)=""
+7 SET APPTIEN=$GET(RESULT("REQ FILE IEN"))
+8 IF +APPTIEN>0
Begin DoDot:1
+9 IF $GET(RESULT("DISCONTINUE"))=1
Begin DoDot:2
+10 SET ARCINP(1)=APPTIEN
+11 SET ARCINP(2)="REMOVED/NO LONGER NECESSARY"
+12 SET ARCINP(3)=$PIECE($GET(RESULT("ENTERED BY")),U,1)
+13 SET ARCINP(4)=DT
+14 DO ARCLOSE^SDECAR(.ARCRET,.ARCINP)
End DoDot:2
End DoDot:1
+15 ;CHECK FOR ARCLOSE ERRORS
+16 SET ARCLE=$PIECE(ARCRET,$CHAR(30),2)
+17 IF $PIECE(ARCLE,U,1)=-1
SET ERROR=$PIECE(ARCLE,U,2)
+18 QUIT
+19 ;
SAVEREC(RESULT,ERROR) ;
+1 ;SETUP
+2 SET U="^"
+3 ;
+4 ;NEW/CHANGE REQUEST
+5 if $GET(RESULT("NEW ORDER"))'=1&($GET(RESULT("CHANGE"))'=1)
QUIT
+6 NEW ARINP,APPTCHG,PTIEN,SDATE,DDDT,MARDDS,COUNT,ATYPIEN,STCREC,SCPER,SETRET,ARSETE
+7 SET (APPTCHG,PTIEN,SDATE,DDDT,MARDDS,COUNT,ATYPIEN,STCREC,SCPER,SETRET,ARSETE)=""
+8 SET APPTCHG=$GET(RESULT("CHANGE"))
+9 IF APPTCHG=1
Begin DoDot:1
+10 SET ARINP(1)=APPTIEN
End DoDot:1
+11 ;PATIENT
+12 SET PTIEN=$PIECE($GET(RESULT("PATIENT")),U,1)
+13 SET ARINP(2)=PTIEN
+14 ;ENTERED DATE TIME
+15 SET Y=DT
XECUTE ^DD("DD")
SET ARINP(3)=Y
+16 ;REQUEST TYPE
+17 SET ARINP(5)="RTC"
+18 ;CLINIC
+19 SET ARINP(6)=$PIECE($GET(RESULT("CLINIC")),U,1)
+20 ;ENTERED BY
+21 SET ARINP(7)=$PIECE($GET(RESULT("ENTERED BY")),U,1)
+22 ;PRIORITY
+23 SET ARINP(8)="FUTURE"
IF $GET(RESULT("RTC DATE"))=DT
Begin DoDot:1
+24 SET ARINP(8)="ASAP"
End DoDot:1
+25 ;REQUESTED BY
+26 SET ARINP(9)="PROVIDER"
+27 ;PROVIDER
+28 SET ARINP(10)=$PIECE($GET(RESULT("SIGNED BY")),U,1)
+29 ;RTC DATE
+30 SET RTCDTI=$GET(RESULT("RTC DATE"))
+31 SET Y=RTCDTI
XECUTE ^DD("DD")
SET ARINP(11)=Y
+32 ;COMMENTS
+33 SET ARINP(12)=$GET(RESULT("COMMENT"))
+34 IF $GET(RESULT("NLT"))=1
Begin DoDot:1
+35 SET ARINP(12)="#NLT#"_$GET(RESULT("COMMENT"))
End DoDot:1
+36 ;ENROLLMENT GROUP
+37 SET PCE=""
SET PCE=$PIECE($GET(^DPT(PTIEN,"ENR")),U,1)
IF PCE'=""
Begin DoDot:1
+38 SET ARINP(13)=$$GET1^DIQ(27.11,PCE,.07,"E")
End DoDot:1
+39 ;MULTIPLE APPOINTMENT REQUEST
+40 ;DEFAULT
SET ARINP(14)="NO"
+41 ;DEFAULT
SET ARINP(20)=""
+42 IF $GET(RESULT("NUMBER APPT"))'=""
Begin DoDot:1
+43 IF $GET(RESULT("NUMBER APPT"))>1
Begin DoDot:2
+44 SET ARINP(14)="YES"
+45 SET ARINP(15)=$GET(RESULT("INTERVAL"))
+46 SET ARINP(16)=$GET(RESULT("NUMBER APPT"))
+47 SET DDDT=$GET(RESULT("RTC DATE"))
+48 FOR I=1:1:$GET(RESULT("NUMBER APPT"))
Begin DoDot:3
+49 SET X1=DDDT
SET X2=RESULT("INTERVAL")
DO C^%DTC
SET SDATE=X
+50 SET MARDDS=MARDDS_$SELECT(MARDDS="":SDATE,1:"|"_SDATE)
+51 SET ARINP(20)=MARDDS
End DoDot:3
End DoDot:2
End DoDot:1
+52 ;SERVICE CONNECTED
+53 SET SCPER=$PIECE($GET(^DPT(PTIEN,.3)),"^",2)
+54 IF SCPER'=""
Begin DoDot:1
+55 SET ARINP(19)=SCPER
+56 IF SCPER>49
Begin DoDot:2
+57 SET ARINP(18)="YES"
+58 SET ATYPIEN=$ORDER(^SD(409.1,"B","SERVICE CONNECTED",ATYPIEN))
End DoDot:2
End DoDot:1
+59 IF '$TEST
SET ARINP(18)="NO"
SET ATYPIEN=$ORDER(^SD(409.1,"B","REGULAR",ATYPIEN))
+60 IF ATYPIEN'=""
Begin DoDot:1
+61 SET ARINP(22)=ATYPIEN
End DoDot:1
+62 ;CLINIC STOP CODE
+63 DO GETSTC^SDECCON(STCREC,$PIECE($GET(RESULT("CLINIC")),U,1))
+64 IF STCREC'=""
Begin DoDot:1
+65 SET ARINP(21)=$PIECE($GET(STCREC),U,1)
End DoDot:1
+66 ;ESTABLISHED PATIENT
+67 SET ARINP(23)="E"
+68 ;NO LATER THAN
+69 IF $GET(RESULT("NLT"))'=""
Begin DoDot:1
+70 SET ARINP(26)=$GET(RESULT("NLT"))
End DoDot:1
+71 ;ORDER IEN
+72 IF $GET(RESULT("ORDER IEN"))'=""
Begin DoDot:1
+73 SET ARINP(28)=RESULT("ORDER IEN")
End DoDot:1
+74 ;PREREQ
+75 IF $DATA(RESULT("PREREQ"))
Begin DoDot:1
+76 NEW PR,CC
+77 SET PREREQ=""
+78 SET CC=0
FOR
SET CC=$ORDER(RESULT("PREREQ",CC))
if CC'>0
QUIT
Begin DoDot:2
+79 SET PR=$GET(RESULT("PREREQ",CC))
if PR=""
QUIT
+80 SET PREREQ=$SELECT(PREREQ'="":PREREQ_";"_PR,1:PR)
End DoDot:2
+81 SET ARINP(27)=PREREQ
End DoDot:1
+82 ;CREATE THE APPOINTMENT REQUEST
+83 DO ARSET^SDECAR2(.SETRET,.ARINP)
+84 ;CHECK FOR ARSET ERRORS
+85 SET ARSETE=$PIECE(SETRET,$CHAR(30),2)
+86 IF $PIECE(ARSETE,U,1)="-1"
SET ERROR=$PIECE(ARSETE,U,2)
QUIT
+87 ;GET ARIEN
+88 SET RESULT("REQ FILE IEN")=+ARSETE
+89 QUIT
+90 ;
SENDFAIL(ERROR,RESULT) ;
+1 ;S ORV("XQY0")="" D ERROR^OERR(ERROR,.SDMSG,.ORV)
+2 ;Q:ORTYPE="ORR" Q:'$L($G(ORNMSP))
+3 NEW SDEMSG
+4 ;N ORVP,ORTS S:'$G(ORDUZ) ORDUZ=PAT_";DPT(" D:'$G(ORVP) PID
+5 SET SDEMSG(1)="MSH|^~\&|SCHEDULING|"_$GET(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_RESULT("MSG ID")
+6 SET SDEMSG(2)="MSA|AR|"_$PIECE(ERROR,$CHAR(30,31))_"|||207^"_$PIECE(ERROR,$CHAR(30,31))
+7 SET OREMSG(3)="ERR|^^^"
+8 DO MSG^XQOR("SD EVSEND OR",.SDEMSG)
+9 QUIT
+10 ;
SENDOK(RESULT) ;
+1 NEW SDMSG
+2 SET SDMSG(1)="MSH|^~\&|SCHEDULING|"_$GET(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_RESULT("MSG ID")
+3 SET SDMSG(2)="MSA|AA|OK^"_$GET(RESULT("REQ FILE IEN"))_"|||"
+4 DO MSG^XQOR("SD EVSEND OR",.SDMSG)
+5 QUIT
+6 ;
+7 ;TODO: GET ANTHONY'S HELP TO FORMAT MESSAGE TO SEND STATUS (SCHEDULED,DISPOSITION,TRANSFERED,ETC...) UPDATE TO CPRS
UPSTAT(ORDIEN,STATUS) ;
+1 if ORDIEN=""
QUIT
+2 if STATUS=""
QUIT
+3 NEW SDMSG
+4 SET SDMSG(1)="MSH|^~\&|SCHEDULING|"_$GET(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_RESULT("MSG ID")
+5 SET SDMSG(2)="MSA|AA|OK^"_$GET(RESULT("REQ FILE IEN"))_"|||"
+6 DO MSG^XQOR("SD EVSEND OR",.SDMSG)
+7 QUIT
+8 ;
UNESC(STR) ;
+1 ;ICR 4922
+2 QUIT $$UNESC^ORHLESC(STR)
