| 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 | ; | 
|---|