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

SDHL7.m

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