INHVIHS.m

INHVIHS ; cmi/flag/maw - GIS Find Destination Based on Message Type ; [ 05/22/2002  2:55 PM ]

 ;;3.01;BHL IHS Interfaces with GIS;**1,14,16,17**;JUN 01, 2002

 ;

 ;

 ;this routine will contain all of the message types that IHS

 ;will support from other systems

 ;

DEST ;-- this is the main routine driver

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ADTA01")="HL IHS A01 IN"

 S INDEST("ADTA02")="HL IHS A02 IN"

 S INDEST("ADTA03")="HL IHS A03 IN"

 S INDEST("ADTA04")="HL IHS A04 IN"

 S INDEST("ADTA08")="HL IHS A08 IN"

 S INDEST("ADTA28")="HL IHS A28 IN"

 S INDEST("ADTA31")="HL IHS A31 IN"

 S INDEST("MFNZ01")="HL IHS Z01 IN"

 S INDEST("MFKZ01")="HL IHS Z01 IN ACK"

 S INDEST("ORUR01")="HL IHS R01 IN"

 S INDEST("RDSO01")="HL IHS O01 IN"

 S INDEST("VXQV01")="HL IHS V01 IN"

 S INDEST("VXRV02")="HL IHS V02 IN"

 S INDEST("VXXV03")="HL IHS V03 IN"

 S INDEST("VXUV04")="HL IHS V04 IN"

 X BHLDEST

 Q

 ;

PYXIS ;-- Pyxis

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("DFTP03")="HL IHS PYXIS P03 IN"

 X BHLDEST

 D DEST

 Q

 ;

THREEM ;-- parse 3M inbound stuff

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ADTA08")="HL IHS A08 IN 3M"

 X BHLDEST

 Q

 ;

MEDITECH ;-- parse the Meditech message

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ADTA01")="HL IHS MEDITECH A01 IN"

 S INDEST("ADTA02")="HL IHS MEDITECH A02 IN"

 S INDEST("ADTA03")="HL IHS MEDITECH A03 IN"

 S INDEST("ADTA04")="HL IHS MEDITECH A04 IN"

 S INDEST("ADTA05")="HL IHS MEDITECH A05 IN"

 S INDEST("ADTA06")="HL IHS MEDITECH A06 IN"

 S INDEST("ADTA08")="HL IHS MEDITECH A08 IN"

 S INDEST("ADTA11")="HL IHS MEDITECH A11 IN"

 S INDEST("ADTA28")="HL IHS MEDITECH A28 IN"

 S INDEST("ADTA31")="HL IHS MEDITECH A31 IN"

 X BHLDEST

 Q

 ;

RLAB ;-- parse ref lab messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 IN"

 X BHLDEST

 Q

 ;

QUEST ;-- parse quest messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 QUEST IN"

 X BHLDEST

 Q

 ;

LABCORP ;-- parse labcorp messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 LABCORP IN"

 S INDEST("ORU")="HL IHS LAB R01 LABCORP IN"

 X BHLDEST

 Q

 ;

UNILAB ;-- parse unilab messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 UNILAB IN"

 S INDEST("ORU")="HL IHS LAB R01 UNILAB IN"

 X BHLDEST

 Q

 ;

RML ;-- parse rml messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 RML IN"

 S INDEST("ORU")="HL IHS LAB R01 RML IN"

 X BHLDEST

 Q

 ;

SQUEST ;-- parse sonora quest messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 SONORA QUEST IN"

 S INDEST("ORU")="HL IHS LAB R01 SONORA QUEST IN"

 X BHLDEST

 Q

 ;

TRICORE ;-- parse tricore messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 TRICORE IN"

 S INDEST("ORU")="HL IHS LAB R01 TRICORE IN"

 X BHLDEST

 Q

 ;

PAML ;-- parse paml messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 PAML IN"

 S INDEST("ORU")="HL IHS LAB R01 PAML IN"

 X BHLDEST

 Q

 ;

MARSH ;-- parse tricore messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 MARSHFIELD IN"

 S INDEST("ORU")="HL IHS LAB R01 MARSHFIELD IN"

 X BHLDEST

 Q

 ;

NPL ;-- parse paml messages

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS LAB R01 NPL IN"

 S INDEST("ORU")="HL IHS LAB R01 NPL IN"

 X BHLDEST

 Q

 ;

GE ;-- parse the pacs msg

 S BHLDEST="D DEST^INHUSEN"

 S INDEST("ORUR01")="HL IHS GE R01 IN"

 S INDEST("ORU")="HL IHS GE R01 IN"

 X BHLDEST

 Q

 ;

INHVIHS   ; cmi/flag/maw - GIS Find Destination Based on Message Type ; [ 05/22/2002  2:55 PM ]

 +1       ;;3.01;BHL IHS Interfaces with GIS;**1,14,16,17**;JUN 01, 2002

 +2       ;

 +3       ;

 +4       ;this routine will contain all of the message types that IHS

 +5       ;will support from other systems

 +6       ;

DEST      ;-- this is the main routine driver

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ADTA01")="HL IHS A01 IN"

 +3        SET INDEST("ADTA02")="HL IHS A02 IN"

 +4        SET INDEST("ADTA03")="HL IHS A03 IN"

 +5        SET INDEST("ADTA04")="HL IHS A04 IN"

 +6        SET INDEST("ADTA08")="HL IHS A08 IN"

 +7        SET INDEST("ADTA28")="HL IHS A28 IN"

 +8        SET INDEST("ADTA31")="HL IHS A31 IN"

 +9        SET INDEST("MFNZ01")="HL IHS Z01 IN"

 +10       SET INDEST("MFKZ01")="HL IHS Z01 IN ACK"

 +11       SET INDEST("ORUR01")="HL IHS R01 IN"

 +12       SET INDEST("RDSO01")="HL IHS O01 IN"

 +13       SET INDEST("VXQV01")="HL IHS V01 IN"

 +14       SET INDEST("VXRV02")="HL IHS V02 IN"

 +15       SET INDEST("VXXV03")="HL IHS V03 IN"

 +16       SET INDEST("VXUV04")="HL IHS V04 IN"

 +17       XECUTE BHLDEST

 +18       QUIT 

 +19      ;

PYXIS     ;-- Pyxis

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("DFTP03")="HL IHS PYXIS P03 IN"

 +3        XECUTE BHLDEST

 +4        DO DEST

 +5        QUIT 

 +6       ;

THREEM    ;-- parse 3M inbound stuff

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ADTA08")="HL IHS A08 IN 3M"

 +3        XECUTE BHLDEST

 +4        QUIT 

 +5       ;

MEDITECH  ;-- parse the Meditech message

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ADTA01")="HL IHS MEDITECH A01 IN"

 +3        SET INDEST("ADTA02")="HL IHS MEDITECH A02 IN"

 +4        SET INDEST("ADTA03")="HL IHS MEDITECH A03 IN"

 +5        SET INDEST("ADTA04")="HL IHS MEDITECH A04 IN"

 +6        SET INDEST("ADTA05")="HL IHS MEDITECH A05 IN"

 +7        SET INDEST("ADTA06")="HL IHS MEDITECH A06 IN"

 +8        SET INDEST("ADTA08")="HL IHS MEDITECH A08 IN"

 +9        SET INDEST("ADTA11")="HL IHS MEDITECH A11 IN"

 +10       SET INDEST("ADTA28")="HL IHS MEDITECH A28 IN"

 +11       SET INDEST("ADTA31")="HL IHS MEDITECH A31 IN"

 +12       XECUTE BHLDEST

 +13       QUIT 

 +14      ;

RLAB      ;-- parse ref lab messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 IN"

 +3        XECUTE BHLDEST

 +4        QUIT 

 +5       ;

QUEST     ;-- parse quest messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 QUEST IN"

 +3        XECUTE BHLDEST

 +4        QUIT 

 +5       ;

LABCORP   ;-- parse labcorp messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 LABCORP IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 LABCORP IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

UNILAB    ;-- parse unilab messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 UNILAB IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 UNILAB IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

RML       ;-- parse rml messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 RML IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 RML IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

SQUEST    ;-- parse sonora quest messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 SONORA QUEST IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 SONORA QUEST IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

TRICORE   ;-- parse tricore messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 TRICORE IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 TRICORE IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

PAML      ;-- parse paml messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 PAML IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 PAML IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

MARSH     ;-- parse tricore messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 MARSHFIELD IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 MARSHFIELD IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

NPL       ;-- parse paml messages

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS LAB R01 NPL IN"

 +3        SET INDEST("ORU")="HL IHS LAB R01 NPL IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;

GE        ;-- parse the pacs msg

 +1        SET BHLDEST="D DEST^INHUSEN"

 +2        SET INDEST("ORUR01")="HL IHS GE R01 IN"

 +3        SET INDEST("ORU")="HL IHS GE R01 IN"

 +4        XECUTE BHLDEST

 +5        QUIT 

 +6       ;