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

SDHL7BLD.m

Go to the documentation of this file.
  1. SDHL7BLD ;SLC/AGP - RTC Order HL7 sender;11:53 AM 19 Jun 2017
  1. ;;5.3;Scheduling;**671**;Aug 13, 1993;Build 25
  1. ;
  1. ;INPUTS("REQ FILE IEN")=89 <=
  1. ;INPUTS("APPT TYPE")="followup"
  1. ;INPUTS("CLINIC")="240^20 MINUTE" <=
  1. ;INPUTS("COMMENT")="This is the new comment field"
  1. ;INPUTS("DISPOSITION BY")="10000000195^PULEO,ANTHONY" <= this is set if the order is disposition or discontinue
  1. ;INPUTS("INTERVAL")="Q7D"
  1. ;INPUTS("DISCONTINUE")=1 <= this is set if the order is discontinue
  1. ;INPUTS("NLT")=1
  1. ;INPUTS("NUMBER APPT")=4 <=
  1. ;INPUTS("ORDER IEN")=14524362 <=
  1. ;INPUTS("PATIENT")="346^RECORD, THREE" <=
  1. ;INPUTS("PREREQ",2)="XRAY"
  1. ;INPUTS("PREREQ",3)="VITALS"
  1. ;INPUTS("RTC DATE")=20170524 <=
  1. ;INPUTS("PARTIAL")=1
  1. ;
  1. Q
  1. ;
  1. EN(INPUTS) ; -- main entry point for sending a
  1. N INC,MSG,LS
  1. I $G(INPUTS("ORDER IEN")) S LS=$$LOCK1^ORX2($G(INPUTS("ORDER IEN"))) Q:'LS
  1. S INC=0
  1. S INC=INC+1,MSG(INC)=$$MSH(.INPUTS)
  1. S INC=INC+1,MSG(INC)=$$PID(.INPUTS)
  1. S INC=INC+1,MSG(INC)=$$PV1(.INPUTS)
  1. S INC=INC+1,MSG(INC)=$$SCH(.INPUTS)
  1. S INC=INC+1,MSG(INC)=$$AIL(.INPUTS)
  1. I $D(INPUTS("PREREQ")) S INC=INC+1 D AIG(.INPUTS,.MSG,INC)
  1. I $G(INPUTS("COMMENT"))'="" S INC=INC+1,MSG(INC)=$$NTE(.INPUTS)
  1. ENX ;
  1. I $G(SDZTEST) M SDZTEST=MSG Q ;testing only
  1. D MSG^XQOR("SD EVSEND OR",.MSG)
  1. D UNLK1^ORX2($G(INPUTS("ORDER IEN")))
  1. Q
  1. ;
  1. MSH(INPUTS) ;
  1. N TYPE
  1. S TYPE=$S($G(INPUTS("DISCONTINUE"))=1:"S15",1:"S12")
  1. Q "MSH|^~\&|SCHEDULING|"_$G(DUZ(2))_"|ORDER ENTRY|"_DUZ(2)_"|"_$$FMTHL7^XLFDT($$NOW^XLFDT)_"||SRM|"_INPUTS("ORDER IEN")_"^"_TYPE
  1. ;
  1. PID(INPUTS) ;
  1. Q "PID|||"_$P(INPUTS("PATIENT"),U)_"||"_$P(INPUTS("PATIENT"),U,2)
  1. ;
  1. SCH(INPUTS) ;
  1. N STR,TYPE
  1. S TYPE=$S($G(INPUTS("DISCONTINUE"))=1:"S15",1:"S12")_U_$S($D(INPUTS("PARTIAL")):"PARTIAL",1:"")
  1. S STR="SCH|"_INPUTS("REQ FILE IEN")_"|"_INPUTS("ORDER IEN")_"||||"_TYPE_"||"_$$FMTHL7^XLFDT(INPUTS("RTC DATE"))_"|"_$S($G(INPUTS("NLT"))=1:"T",1:"")_"|"
  1. S STR=STR_$G(INPUTS("INTERVAL"))_"|"_INPUTS("NUMBER APPT")_"^|||||"_INPUTS("DISPOSITION BY")_"|"
  1. S STR=STR_"|||||"_INPUTS("REQ FILE IEN")_"|"_INPUTS("ORDER IEN")
  1. Q STR
  1. ;
  1. AIL(INPUTS,X,SEG,ERRARR) ;
  1. Q "AIL|||"_INPUTS("CLINIC")
  1. ;
  1. AIG(INPUTS,MSG,X) ;
  1. N CNT,INC,FIRST,NUM
  1. S CNT=0,INC=0,FIRST=1,NUM=0
  1. F S INC=$O(INPUTS("PREREQ",INC)) Q:INC'>0 D
  1. .S CNT=CNT+1
  1. .I FIRST=1 S MSG(X)="AIG|"_CNT_"|"_U_INPUTS("PREREQ",INC)_U_U_U_U_"|||||||||||",FIRST=0 Q
  1. .S NUM=NUM+1,MSG(X,NUM)="AIG|"_CNT_"|"_U_INPUTS("PREREQ",INC)_U_U_U_U_"|||||||||||"
  1. Q
  1. ;
  1. NTE(INPUTS) ;
  1. Q "NTE|6|P|"_$$ESC(INPUTS("COMMENT"))
  1. ;
  1. PV1(INPUTS) ; -- Gets Patient location info.
  1. ;
  1. N PATRB,PATTYPE,STR,WARD
  1. S WARD=+$G(^DPT(+INPUTS("PATIENT"),.1))
  1. S PATTYPE=$S(WARD>0:"I",1:"O")
  1. S PATRB=$S(PATTYPE="I":$P($G(^DPT(+INPUTS("PATIENT"),.101)),U),1:"")
  1. S STR="PV1||"_PATTYPE_"|"_$S(WARD>0:WARD,1:+$G(INPUTS("CLINIC")))_$S($L(PATRB):U_PATRB,1:"")_"||||||||||||||||"
  1. Q STR
  1. ;
  1. ERROR ; -- Sends a DE reply to current msg
  1. ; Uses ORVP, ORNMSP, ORDUZ, ORIFN, ORERR, and PKGIFN
  1. N ORV S ORV("XQY0")="" D ERROR(ORERR,.SDMSG,.ORV)
  1. Q:ORTYPE="ORR" Q:'$L($G(ORNMSP))
  1. N OREMSG,ORVP,ORTS S:'$G(ORDUZ) ORDUZ=DUZ D:'$G(ORVP) PID
  1. S OREMSG(1)=$$MSH^ORMBLD("ORR",ORNMSP),OREMSG(2)=$$PID^ORMBLD($G(ORVP))
  1. S OREMSG(3)="ORC|DE|"_$S($G(ORIFN):ORIFN_"^OR",1:"")_"|"_$S($L($G(PKGIFN)):PKGIFN_U_ORNMSP,1:"")_"|||||||"_ORDUZ_"||||||"_ORERR
  1. D MSG^XQOR("OR EVSEND "_ORNMSP,.OREMSG)
  1. Q
  1. ;
  1. TEST(INPUTS) ; -- Build/display HL7 msgs w/o sending
  1. K SDZTEST S SDZTEST=1 D EN(.INPUTS) ; leaves msg in SDZTEST() on exit
  1. Q
  1. ;
  1. ESC(STR) ;
  1. ;ICR 4922
  1. Q $$ESC^ORHLESC(STR)