| 1 | IVM16PF ;HEC/KSD - Patch Pre-Install rtn functions IVM*2*34;01.23.2001 ; 9/20/01 4:16pm
|
---|
| 2 | ;;2.0;INCOME VERIFICATION;**34**;01.23.2001
|
---|
| 3 | ;
|
---|
| 4 | Q ; NO DIRECT ACCESS - CALL FUNCTION
|
---|
| 5 | ;
|
---|
| 6 | LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
|
---|
| 7 | ;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
|
---|
| 8 | ; LLPTYP = LLP Type (ex. "TCP")
|
---|
| 9 | ; DEVTYP = Device Type - Systems Monitor - display ONLY
|
---|
| 10 | ; QSIZE = Queue Size
|
---|
| 11 | ; TCPADDR = TCP/IP Address
|
---|
| 12 | ; TCPPORT = TCP/IP Port #
|
---|
| 13 | ; TCPSTYP = TCP/IP Service Type
|
---|
| 14 | ; C - Client (Sender)
|
---|
| 15 | ; S - Single Listener
|
---|
| 16 | ; M - Multi Listener
|
---|
| 17 | ; PERSIST = Is connection persistent Y or N
|
---|
| 18 | ; STNODE = Startup Node - TaskMan Node to start on
|
---|
| 19 | ;
|
---|
| 20 | ;OUTPUT IEN of entry (#870) Success
|
---|
| 21 | ; -1^Error Message Error
|
---|
| 22 | ;
|
---|
| 23 | ;PURPOSE Create a Logical Link for TCP/IP transmissions.
|
---|
| 24 | ;
|
---|
| 25 | N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
|
---|
| 26 | S FILE=870
|
---|
| 27 | ; If already exists then skip
|
---|
| 28 | ;
|
---|
| 29 | Q:+$O(^HLCS(870,"B",LLNAME,0))>0 ""
|
---|
| 30 | ;
|
---|
| 31 | ; set v1.6 field values
|
---|
| 32 | S DATA(.01)=LLNAME ;LOGICAL LINK NAME
|
---|
| 33 | S DATA(2)=$O(^HLCS(869.1,"B",LLPTYP,0)) ;LLP TYPE
|
---|
| 34 | S DATA(3)=DEVTYP ;QUEUE TYPE
|
---|
| 35 | S DATA(4.5)=1 ;AUTOSTART
|
---|
| 36 | S DATA(21)=QSIZE ;QUEUE SIZE
|
---|
| 37 | D:TCPSTYP="C" ;IF CLIENT(SENDER)
|
---|
| 38 | . S DATA(200.02)=3 ;RE-TRANSMISSION ATTEMPTS
|
---|
| 39 | . S DATA(200.021)="R" ;EXCEED RE-TRANSMISSION
|
---|
| 40 | . S DATA(200.04)=90 ;READ TIMEOUT
|
---|
| 41 | . S DATA(200.05)=270 ;ACK TIMEOUT
|
---|
| 42 | S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
|
---|
| 43 | S DATA(400.02)=TCPPORT ;TCP/IP PORT
|
---|
| 44 | S DATA(400.03)=TCPSTYP ;TCP/IP SERVICE TYPE
|
---|
| 45 | S DATA(400.04)=PERSIST ;PERSISTENT
|
---|
| 46 | S DATA(400.06)=STNODE ;STARTUP NODE
|
---|
| 47 | ;
|
---|
| 48 | S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
|
---|
| 49 | S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
|
---|
| 50 | ;
|
---|
| 51 | Q RETURN
|
---|
| 52 | ;
|
---|
| 53 | APP(ANAME,STATUS,STATION,COUNTRY) ;
|
---|
| 54 | ;INPUT ANAME = Application Name (ex. "HEC 500")
|
---|
| 55 | ; STATUS = "a"CTIVE or "i"INACTIVE
|
---|
| 56 | ; STATION = STATION # (ex. 500)
|
---|
| 57 | ; COUNTRY = COUNTRY NAME (ex. "USA")
|
---|
| 58 | ;
|
---|
| 59 | ;OUTPUT IEN of entry (#771) Success
|
---|
| 60 | ; -1^Error Message Error
|
---|
| 61 | ;
|
---|
| 62 | ;PURPOSE Create an Application
|
---|
| 63 | ;
|
---|
| 64 | N DATA,FILE,RETURN,ERROR,DA
|
---|
| 65 | S FILE=771
|
---|
| 66 | ; If already exists then skip
|
---|
| 67 | ;
|
---|
| 68 | Q:+$O(^HL(771,"B",ANAME,0))>0 ""
|
---|
| 69 | S DATA(.01)=ANAME
|
---|
| 70 | S DATA(2)=STATUS
|
---|
| 71 | S DATA(3)=STATION
|
---|
| 72 | S DATA(7)=$O(^HL(779.004,"B",COUNTRY,0))
|
---|
| 73 | S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
|
---|
| 74 | S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
|
---|
| 75 | Q RETURN
|
---|
| 76 | ;
|
---|
| 77 | SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
|
---|
| 78 | ;INPUT PNAME = Protocol Name
|
---|
| 79 | ; LL = Logical Link Name (ex. "LL VAMC 500")
|
---|
| 80 | ; RECVAPP = Receiving Application Name (ex. "VAMC 500")
|
---|
| 81 | ; RMSGTYP = Response Message Type (ex. "ACK")
|
---|
| 82 | ; REVTTYP = Response Event Type. Usually empty, used more
|
---|
| 83 | ; in response to a Query with an ORF message.
|
---|
| 84 | ; MSGPRTN = Message Processing Routine - Routine to parse
|
---|
| 85 | ; regular transmission of data - MUMPS format
|
---|
| 86 | ; (ex. "D ^IVMBORU")
|
---|
| 87 | ;
|
---|
| 88 | ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
|
---|
| 89 | ; -1^Error Message
|
---|
| 90 | ;
|
---|
| 91 | ;PURPOSE Create a Subscriber Protocol
|
---|
| 92 | ;
|
---|
| 93 | N DATA,FILE,RETURN,ERROR,DA,DGENDA
|
---|
| 94 | S FILE=101
|
---|
| 95 | ; If already exists then skip
|
---|
| 96 | ;
|
---|
| 97 | Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
|
---|
| 98 | S DATA(.01)=PNAME ;PROTOCOL NAME
|
---|
| 99 | S DATA(4)="S" ;PROTOCOL TYPE
|
---|
| 100 | S DATA(770.11)=$O(^HL(771.2,"B",RMSGTYP,0)) ;RESPONSE MSG TYPE
|
---|
| 101 | S DATA(770.2)=$O(^HL(771,"B",RECVAPP,0)) ;RECEIVING APP
|
---|
| 102 | S:REVTTYP]"" DATA(770.4)=$O(^HL(779.001,"B",REVTTYP,0)) ;EVENT TYPE
|
---|
| 103 | S DATA(770.7)=$O(^HLCS(870,"B",LL,0)) ;LOGICAL LINK
|
---|
| 104 | S DATA(771)=MSGPRTN ;MSG PROCESSING RTN
|
---|
| 105 | S DATA(773.1)=1 ;SEND FACILITY REQUIRED
|
---|
| 106 | S DATA(773.2)=1 ;RECV FACILITY REQUIRED
|
---|
| 107 | S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
|
---|
| 108 | S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
|
---|
| 109 | Q RETURN
|
---|
| 110 | ;
|
---|
| 111 | EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
|
---|
| 112 | ;INPUT PNAME = Protocol Name
|
---|
| 113 | ; MTYP = Message Type Name (ex. "ORU")
|
---|
| 114 | ; ETYP = Event Type Name (ex. "Z11")
|
---|
| 115 | ; VER = HL7 Version # (ex. 2.1)
|
---|
| 116 | ; SENDAPP = Sending Application Name (ex. "HEC 500")
|
---|
| 117 | ; ACKPRTN = Acknowledgement Processing Routine -
|
---|
| 118 | ; Routine to parse an ACK transmission -
|
---|
| 119 | ; MUMPs format (ex. "D ^IVMBACK")
|
---|
| 120 | ; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
|
---|
| 121 | ; DTXT = Disable Text
|
---|
| 122 | ; ITEMTXT = Item Text
|
---|
| 123 | ;
|
---|
| 124 | ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
|
---|
| 125 | ; -1^Error Message Error
|
---|
| 126 | ;
|
---|
| 127 | ;PURPOSE Create an Event Driver Protocol and the Sub-File to
|
---|
| 128 | ; contain pointers to the Subscriber Protocol file
|
---|
| 129 | ;
|
---|
| 130 | N DATA,FILE,DGENDA,RETURN,ERROR,DA
|
---|
| 131 | S FILE=101
|
---|
| 132 | ; If already exists then skip
|
---|
| 133 | ;
|
---|
| 134 | Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
|
---|
| 135 | S DATA(.01)=PNAME ;PROTOCOL NAME
|
---|
| 136 | S DATA(1)=ITEMTXT ;ITEM TEXT
|
---|
| 137 | S DATA(2)=DTXT ;DISABLE TEXT
|
---|
| 138 | S DATA(4)="E" ;PROTOCOL TYPE
|
---|
| 139 | S DATA(770.1)=$O(^HL(771,"B",SENDAPP,0)) ;SENDING APP
|
---|
| 140 | S DATA(770.3)=$O(^HL(771.2,"B",MTYP,0)) ;MSG TYPE
|
---|
| 141 | S DATA(770.4)=$O(^HL(779.001,"B",ETYP,0)) ;EVENT TYPE
|
---|
| 142 | S DATA(770.8)=$O(^HL(779.003,"B","AL",0)) ;ACCEPT ACK CODE
|
---|
| 143 | S DATA(770.9)=$O(^HL(779.003,"B","AL",0)) ;APPLICATION ACK TYPE
|
---|
| 144 | S DATA(770.95)=$O(^HL(771.5,"B",VER,0)) ;VERSION ID
|
---|
| 145 | S DATA(772)=ACKPRTN ;ACK PROCESSING RTN
|
---|
| 146 | S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
|
---|
| 147 | I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
|
---|
| 148 | S DGENDA(1)=RETURN
|
---|
| 149 | ;
|
---|
| 150 | ; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
|
---|
| 151 | S FILE=101.0775
|
---|
| 152 | K DATA
|
---|
| 153 | S DATA(.01)=SUBIEN
|
---|
| 154 | S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
|
---|
| 155 | S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
|
---|
| 156 | ;
|
---|
| 157 | EDPEXIT Q RETURN
|
---|
| 158 | ;
|
---|