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