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