IVM16PF ;HEC/KSD - Patch Pre-Install rtn functions IVM*2*34;01.23.2001 ; 9/20/01 4:16pm
;;2.0;INCOME VERIFICATION;**34**;01.23.2001
;
Q ; NO DIRECT ACCESS - CALL FUNCTION
;
LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
; LLPTYP = LLP Type (ex. "TCP")
; DEVTYP = Device Type - Systems Monitor - display ONLY
; QSIZE = Queue Size
; TCPADDR = TCP/IP Address
; TCPPORT = TCP/IP Port #
; TCPSTYP = TCP/IP Service Type
; C - Client (Sender)
; S - Single Listener
; M - Multi Listener
; PERSIST = Is connection persistent Y or N
; STNODE = Startup Node - TaskMan Node to start on
;
;OUTPUT IEN of entry (#870) Success
; -1^Error Message Error
;
;PURPOSE Create a Logical Link for TCP/IP transmissions.
;
N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
S FILE=870
; If already exists then skip
;
Q:+$O(^HLCS(870,"B",LLNAME,0))>0 ""
;
; set v1.6 field values
S DATA(.01)=LLNAME ;LOGICAL LINK NAME
S DATA(2)=$O(^HLCS(869.1,"B",LLPTYP,0)) ;LLP TYPE
S DATA(3)=DEVTYP ;QUEUE TYPE
S DATA(4.5)=1 ;AUTOSTART
S DATA(21)=QSIZE ;QUEUE SIZE
D:TCPSTYP="C" ;IF CLIENT(SENDER)
. S DATA(200.02)=3 ;RE-TRANSMISSION ATTEMPTS
. S DATA(200.021)="R" ;EXCEED RE-TRANSMISSION
. S DATA(200.04)=90 ;READ TIMEOUT
. S DATA(200.05)=270 ;ACK TIMEOUT
S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
S DATA(400.02)=TCPPORT ;TCP/IP PORT
S DATA(400.03)=TCPSTYP ;TCP/IP SERVICE TYPE
S DATA(400.04)=PERSIST ;PERSISTENT
S DATA(400.06)=STNODE ;STARTUP NODE
;
S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
;
Q RETURN
;
APP(ANAME,STATUS,STATION,COUNTRY) ;
;INPUT ANAME = Application Name (ex. "HEC 500")
; STATUS = "a"CTIVE or "i"INACTIVE
; STATION = STATION # (ex. 500)
; COUNTRY = COUNTRY NAME (ex. "USA")
;
;OUTPUT IEN of entry (#771) Success
; -1^Error Message Error
;
;PURPOSE Create an Application
;
N DATA,FILE,RETURN,ERROR,DA
S FILE=771
; If already exists then skip
;
Q:+$O(^HL(771,"B",ANAME,0))>0 ""
S DATA(.01)=ANAME
S DATA(2)=STATUS
S DATA(3)=STATION
S DATA(7)=$O(^HL(779.004,"B",COUNTRY,0))
S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
Q RETURN
;
SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
;INPUT PNAME = Protocol Name
; LL = Logical Link Name (ex. "LL VAMC 500")
; RECVAPP = Receiving Application Name (ex. "VAMC 500")
; RMSGTYP = Response Message Type (ex. "ACK")
; REVTTYP = Response Event Type. Usually empty, used more
; in response to a Query with an ORF message.
; MSGPRTN = Message Processing Routine - Routine to parse
; regular transmission of data - MUMPS format
; (ex. "D ^IVMBORU")
;
;OUTPUT IEN entry (#101) for Subscriber Protocol Success
; -1^Error Message
;
;PURPOSE Create a Subscriber Protocol
;
N DATA,FILE,RETURN,ERROR,DA,DGENDA
S FILE=101
; If already exists then skip
;
Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
S DATA(.01)=PNAME ;PROTOCOL NAME
S DATA(4)="S" ;PROTOCOL TYPE
S DATA(770.11)=$O(^HL(771.2,"B",RMSGTYP,0)) ;RESPONSE MSG TYPE
S DATA(770.2)=$O(^HL(771,"B",RECVAPP,0)) ;RECEIVING APP
S:REVTTYP]"" DATA(770.4)=$O(^HL(779.001,"B",REVTTYP,0)) ;EVENT TYPE
S DATA(770.7)=$O(^HLCS(870,"B",LL,0)) ;LOGICAL LINK
S DATA(771)=MSGPRTN ;MSG PROCESSING RTN
S DATA(773.1)=1 ;SEND FACILITY REQUIRED
S DATA(773.2)=1 ;RECV FACILITY REQUIRED
S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
Q RETURN
;
EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
;INPUT PNAME = Protocol Name
; MTYP = Message Type Name (ex. "ORU")
; ETYP = Event Type Name (ex. "Z11")
; VER = HL7 Version # (ex. 2.1)
; SENDAPP = Sending Application Name (ex. "HEC 500")
; ACKPRTN = Acknowledgement Processing Routine -
; Routine to parse an ACK transmission -
; MUMPs format (ex. "D ^IVMBACK")
; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
; DTXT = Disable Text
; ITEMTXT = Item Text
;
;OUTPUT IEN entry (#101) of Event Driver Protocol Success
; -1^Error Message Error
;
;PURPOSE Create an Event Driver Protocol and the Sub-File to
; contain pointers to the Subscriber Protocol file
;
N DATA,FILE,DGENDA,RETURN,ERROR,DA
S FILE=101
; If already exists then skip
;
Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
S DATA(.01)=PNAME ;PROTOCOL NAME
S DATA(1)=ITEMTXT ;ITEM TEXT
S DATA(2)=DTXT ;DISABLE TEXT
S DATA(4)="E" ;PROTOCOL TYPE
S DATA(770.1)=$O(^HL(771,"B",SENDAPP,0)) ;SENDING APP
S DATA(770.3)=$O(^HL(771.2,"B",MTYP,0)) ;MSG TYPE
S DATA(770.4)=$O(^HL(779.001,"B",ETYP,0)) ;EVENT TYPE
S DATA(770.8)=$O(^HL(779.003,"B","AL",0)) ;ACCEPT ACK CODE
S DATA(770.9)=$O(^HL(779.003,"B","AL",0)) ;APPLICATION ACK TYPE
S DATA(770.95)=$O(^HL(771.5,"B",VER,0)) ;VERSION ID
S DATA(772)=ACKPRTN ;ACK PROCESSING RTN
S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
S DGENDA(1)=RETURN
;
; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
S FILE=101.0775
K DATA
S DATA(.01)=SUBIEN
S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
;
EDPEXIT Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM16PF 6354 printed Dec 13, 2024@02:00:23 Page 2
IVM16PF ;HEC/KSD - Patch Pre-Install rtn functions IVM*2*34;01.23.2001 ; 9/20/01 4:16pm
+1 ;;2.0;INCOME VERIFICATION;**34**;01.23.2001
+2 ;
+3 ; NO DIRECT ACCESS - CALL FUNCTION
QUIT
+4 ;
LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
+1 ;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
+2 ; LLPTYP = LLP Type (ex. "TCP")
+3 ; DEVTYP = Device Type - Systems Monitor - display ONLY
+4 ; QSIZE = Queue Size
+5 ; TCPADDR = TCP/IP Address
+6 ; TCPPORT = TCP/IP Port #
+7 ; TCPSTYP = TCP/IP Service Type
+8 ; C - Client (Sender)
+9 ; S - Single Listener
+10 ; M - Multi Listener
+11 ; PERSIST = Is connection persistent Y or N
+12 ; STNODE = Startup Node - TaskMan Node to start on
+13 ;
+14 ;OUTPUT IEN of entry (#870) Success
+15 ; -1^Error Message Error
+16 ;
+17 ;PURPOSE Create a Logical Link for TCP/IP transmissions.
+18 ;
+19 NEW FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
+20 SET FILE=870
+21 ; If already exists then skip
+22 ;
+23 if +$ORDER(^HLCS(870,"B",LLNAME,0))>0
QUIT ""
+24 ;
+25 ; set v1.6 field values
+26 ;LOGICAL LINK NAME
SET DATA(.01)=LLNAME
+27 ;LLP TYPE
SET DATA(2)=$ORDER(^HLCS(869.1,"B",LLPTYP,0))
+28 ;QUEUE TYPE
SET DATA(3)=DEVTYP
+29 ;AUTOSTART
SET DATA(4.5)=1
+30 ;QUEUE SIZE
SET DATA(21)=QSIZE
+31 ;IF CLIENT(SENDER)
if TCPSTYP="C"
Begin DoDot:1
+32 ;RE-TRANSMISSION ATTEMPTS
SET DATA(200.02)=3
+33 ;EXCEED RE-TRANSMISSION
SET DATA(200.021)="R"
+34 ;READ TIMEOUT
SET DATA(200.04)=90
+35 ;ACK TIMEOUT
SET DATA(200.05)=270
End DoDot:1
+36 ;TCP/IP ADDRESS
SET DATA(400.01)=TCPADDR
+37 ;TCP/IP PORT
SET DATA(400.02)=TCPPORT
+38 ;TCP/IP SERVICE TYPE
SET DATA(400.03)=TCPSTYP
+39 ;PERSISTENT
SET DATA(400.04)=PERSIST
+40 ;STARTUP NODE
SET DATA(400.06)=STNODE
+41 ;
+42 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+43 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+44 ;
+45 QUIT RETURN
+46 ;
APP(ANAME,STATUS,STATION,COUNTRY) ;
+1 ;INPUT ANAME = Application Name (ex. "HEC 500")
+2 ; STATUS = "a"CTIVE or "i"INACTIVE
+3 ; STATION = STATION # (ex. 500)
+4 ; COUNTRY = COUNTRY NAME (ex. "USA")
+5 ;
+6 ;OUTPUT IEN of entry (#771) Success
+7 ; -1^Error Message Error
+8 ;
+9 ;PURPOSE Create an Application
+10 ;
+11 NEW DATA,FILE,RETURN,ERROR,DA
+12 SET FILE=771
+13 ; If already exists then skip
+14 ;
+15 if +$ORDER(^HL(771,"B",ANAME,0))>0
QUIT ""
+16 SET DATA(.01)=ANAME
+17 SET DATA(2)=STATUS
+18 SET DATA(3)=STATION
+19 SET DATA(7)=$ORDER(^HL(779.004,"B",COUNTRY,0))
+20 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+21 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+22 QUIT RETURN
+23 ;
SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
+1 ;INPUT PNAME = Protocol Name
+2 ; LL = Logical Link Name (ex. "LL VAMC 500")
+3 ; RECVAPP = Receiving Application Name (ex. "VAMC 500")
+4 ; RMSGTYP = Response Message Type (ex. "ACK")
+5 ; REVTTYP = Response Event Type. Usually empty, used more
+6 ; in response to a Query with an ORF message.
+7 ; MSGPRTN = Message Processing Routine - Routine to parse
+8 ; regular transmission of data - MUMPS format
+9 ; (ex. "D ^IVMBORU")
+10 ;
+11 ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
+12 ; -1^Error Message
+13 ;
+14 ;PURPOSE Create a Subscriber Protocol
+15 ;
+16 NEW DATA,FILE,RETURN,ERROR,DA,DGENDA
+17 SET FILE=101
+18 ; If already exists then skip
+19 ;
+20 if +$ORDER(^ORD(101,"B",PNAME,0))>0
QUIT ""
+21 ;PROTOCOL NAME
SET DATA(.01)=PNAME
+22 ;PROTOCOL TYPE
SET DATA(4)="S"
+23 ;RESPONSE MSG TYPE
SET DATA(770.11)=$ORDER(^HL(771.2,"B",RMSGTYP,0))
+24 ;RECEIVING APP
SET DATA(770.2)=$ORDER(^HL(771,"B",RECVAPP,0))
+25 ;EVENT TYPE
if REVTTYP]""
SET DATA(770.4)=$ORDER(^HL(779.001,"B",REVTTYP,0))
+26 ;LOGICAL LINK
SET DATA(770.7)=$ORDER(^HLCS(870,"B",LL,0))
+27 ;MSG PROCESSING RTN
SET DATA(771)=MSGPRTN
+28 ;SEND FACILITY REQUIRED
SET DATA(773.1)=1
+29 ;RECV FACILITY REQUIRED
SET DATA(773.2)=1
+30 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+31 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+32 QUIT RETURN
+33 ;
EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
+1 ;INPUT PNAME = Protocol Name
+2 ; MTYP = Message Type Name (ex. "ORU")
+3 ; ETYP = Event Type Name (ex. "Z11")
+4 ; VER = HL7 Version # (ex. 2.1)
+5 ; SENDAPP = Sending Application Name (ex. "HEC 500")
+6 ; ACKPRTN = Acknowledgement Processing Routine -
+7 ; Routine to parse an ACK transmission -
+8 ; MUMPs format (ex. "D ^IVMBACK")
+9 ; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
+10 ; DTXT = Disable Text
+11 ; ITEMTXT = Item Text
+12 ;
+13 ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
+14 ; -1^Error Message Error
+15 ;
+16 ;PURPOSE Create an Event Driver Protocol and the Sub-File to
+17 ; contain pointers to the Subscriber Protocol file
+18 ;
+19 NEW DATA,FILE,DGENDA,RETURN,ERROR,DA
+20 SET FILE=101
+21 ; If already exists then skip
+22 ;
+23 if +$ORDER(^ORD(101,"B",PNAME,0))>0
QUIT ""
+24 ;PROTOCOL NAME
SET DATA(.01)=PNAME
+25 ;ITEM TEXT
SET DATA(1)=ITEMTXT
+26 ;DISABLE TEXT
SET DATA(2)=DTXT
+27 ;PROTOCOL TYPE
SET DATA(4)="E"
+28 ;SENDING APP
SET DATA(770.1)=$ORDER(^HL(771,"B",SENDAPP,0))
+29 ;MSG TYPE
SET DATA(770.3)=$ORDER(^HL(771.2,"B",MTYP,0))
+30 ;EVENT TYPE
SET DATA(770.4)=$ORDER(^HL(779.001,"B",ETYP,0))
+31 ;ACCEPT ACK CODE
SET DATA(770.8)=$ORDER(^HL(779.003,"B","AL",0))
+32 ;APPLICATION ACK TYPE
SET DATA(770.9)=$ORDER(^HL(779.003,"B","AL",0))
+33 ;VERSION ID
SET DATA(770.95)=$ORDER(^HL(771.5,"B",VER,0))
+34 ;ACK PROCESSING RTN
SET DATA(772)=ACKPRTN
+35 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+36 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
GOTO EDPEXIT
+37 SET DGENDA(1)=RETURN
+38 ;
+39 ; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
+40 SET FILE=101.0775
+41 KILL DATA
+42 SET DATA(.01)=SUBIEN
+43 SET RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+44 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+45 ;
EDPEXIT QUIT RETURN
+1 ;
