- 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 Jan 18, 2025@03:59:13 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)