Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EAS1071Q

EAS1071Q.m

Go to the documentation of this file.
  1. EAS1071Q ;ALB/PJH - Patch Post-Install functions EAS*1*71 ; 11/27/07 3:03pm
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
  1. ;
  1. Q ;Entry Points Only
  1. ;
  1. ;Functions are called by EAS1071P
  1. ;
  1. LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
  1. ;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
  1. ; LLPTYP = LLP Type (ex. "TCP")
  1. ; DEVTYP = Device Type - Systems Monitor - display ONLY
  1. ; QSIZE = Queue Size
  1. ; TCPADDR = TCP/IP Address
  1. ; TCPPORT = TCP/IP Port #
  1. ; TCPSTYP = TCP/IP Service Type
  1. ; C - Client (Sender)
  1. ; S - Single Listener
  1. ; M - Multi Listener
  1. ; PERSIST = Is connection persistent Y or N
  1. ; STNODE = Startup Node - TaskMan Node to start on
  1. ;
  1. ;OUTPUT IEN of entry (#870) Success
  1. ; -1^Error Message Error
  1. ;
  1. ;PURPOSE Create a Logical Link for TCP/IP transmissions.
  1. ;
  1. N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
  1. S FILE=870
  1. ; If already exists then skip
  1. ;
  1. Q:+$O(^HLCS(870,"B",LLNAME,0))>0 ""
  1. ;
  1. ; set v1.6 field values
  1. S DATA(.01)=LLNAME ;LOGICAL LINK NAME
  1. S DATA(2)=$O(^HLCS(869.1,"B",LLPTYP,0)) ;LLP TYPE
  1. S DATA(3)=DEVTYP ;QUEUE TYPE
  1. ;S DATA(4.5)=1 ;AUTOSTART
  1. S DATA(21)=QSIZE ;QUEUE SIZE
  1. D:TCPSTYP="C" ;IF CLIENT(SENDER)
  1. . S DATA(200.02)=3 ;RE-TRANSMISSION ATTEMPTS
  1. . S DATA(200.021)="R" ;EXCEED RE-TRANSMISSION
  1. . S DATA(200.04)=90 ;READ TIMEOUT
  1. . S DATA(200.05)=270 ;ACK TIMEOUT
  1. S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
  1. S DATA(400.02)=TCPPORT ;TCP/IP PORT
  1. S DATA(400.03)=TCPSTYP ;TCP/IP SERVICE TYPE
  1. S DATA(400.04)=PERSIST ;PERSISTENT
  1. S DATA(400.06)=STNODE ;STARTUP NODE
  1. S DATA(14)=1 ;SUSPENDED
  1. ;
  1. S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
  1. S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
  1. ;
  1. Q RETURN
  1. ;
  1. APP(ANAME,STATUS,STATION,COUNTRY) ;
  1. ;INPUT ANAME = Application Name (ex. "HEC 500")
  1. ; STATUS = "a"CTIVE or "i"INACTIVE
  1. ; STATION = STATION # (ex. 500)
  1. ; COUNTRY = COUNTRY NAME (ex. "USA")
  1. ;
  1. ;OUTPUT IEN of entry (#771) Success
  1. ; -1^Error Message Error
  1. ;
  1. ;PURPOSE Create an Application
  1. ;
  1. N DATA,FILE,RETURN,ERROR,DA
  1. S FILE=771
  1. ; If already exists then skip
  1. ;
  1. Q:+$O(^HL(771,"B",ANAME,0))>0 ""
  1. S DATA(.01)=ANAME
  1. S DATA(2)=STATUS
  1. S DATA(3)=STATION
  1. S DATA(7)=$O(^HL(779.004,"B",COUNTRY,0))
  1. S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
  1. S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
  1. Q RETURN
  1. ;
  1. SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
  1. ;INPUT PNAME = Protocol Name
  1. ; LL = Logical Link Name (ex. "LL VAMC 500")
  1. ; RECVAPP = Receiving Application Name (ex. "VAMC 500")
  1. ; RMSGTYP = Response Message Type (ex. "ACK")
  1. ; REVTTYP = Response Event Type. Usually empty, used more
  1. ; in response to a Query with an ORF message.
  1. ; MSGPRTN = Message Processing Routine - Routine to parse
  1. ; regular transmission of data - MUMPS format
  1. ; (ex. "D ^IVMBORU")
  1. ;
  1. ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
  1. ; -1^Error Message
  1. ;
  1. ;PURPOSE Create a Subscriber Protocol
  1. ;
  1. N DATA,FILE,RETURN,ERROR,DA,DGENDA
  1. S FILE=101
  1. ; If already exists then skip
  1. ;
  1. Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
  1. ;
  1. S DATA(.01)=PNAME ;PROTOCOL NAME
  1. S DATA(4)="S" ;PROTOCOL TYPE
  1. S DATA(770.11)=$O(^HL(771.2,"B",RMSGTYP,0)) ;RESPONSE MSG TYPE
  1. S DATA(770.2)=$O(^HL(771,"B",RECVAPP,0)) ;RECEIVING APP
  1. S:REVTTYP]"" DATA(770.4)=$O(^HL(779.001,"B",REVTTYP,0)) ;EVENT TYPE
  1. S DATA(770.7)=$O(^HLCS(870,"B",LL,0)) ;LOGICAL LINK
  1. S DATA(771)=MSGPRTN ;MSG PROCESSING RTN
  1. S DATA(773.1)=1 ;SEND FACILITY REQUIRED
  1. S DATA(773.2)=1 ;RECV FACILITY REQUIRED
  1. S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
  1. S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
  1. Q RETURN
  1. ;
  1. EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
  1. ;INPUT PNAME = Protocol Name
  1. ; MTYP = Message Type Name (ex. "ORU")
  1. ; ETYP = Event Type Name (ex. "Z09")
  1. ; VER = HL7 Version # (ex. 2.3.1)
  1. ; SENDAPP = Sending Application Name (ex. "VAMC 290")
  1. ; ACKPRTN = Acknowledgement Processing Routine -
  1. ; Routine to parse an ACK transmission -
  1. ; MUMPs format (ex. "D ^IVMBACK")
  1. ; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
  1. ; DTXT = Disable Text
  1. ; ITEMTXT = Item Text
  1. ;
  1. ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
  1. ; -1^Error Message Error
  1. ;
  1. ;PURPOSE Create an Event Driver Protocol and the Sub-File to
  1. ; contain pointers to the Subscriber Protocol file
  1. ;
  1. N DATA,FILE,DGENDA,RETURN,ERROR,DA
  1. S FILE=101
  1. ; If already exists then skip
  1. ;
  1. Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
  1. ;
  1. S DATA(.01)=PNAME ;PROTOCOL NAME
  1. S DATA(1)=ITEMTXT ;ITEM TEXT
  1. S DATA(2)=DTXT ;DISABLE TEXT
  1. S DATA(4)="E" ;PROTOCOL TYPE
  1. S DATA(5)=+$G(DUZ) ;CREATOR
  1. S DATA(770.1)=$O(^HL(771,"B",SENDAPP,0)) ;SENDING APP
  1. S DATA(770.3)=$O(^HL(771.2,"B",MTYP,0)) ;MSG TYPE
  1. S DATA(770.4)=$O(^HL(779.001,"B",ETYP,0)) ;EVENT TYPE
  1. S DATA(770.8)=$O(^HL(779.003,"B","AL",0)) ;ACCEPT ACK CODE
  1. S DATA(770.9)=$O(^HL(779.003,"B","AL",0)) ;APPLICATION ACK TYPE
  1. S DATA(770.95)=$O(^HL(771.5,"B",VER,0)) ;VERSION ID
  1. S DATA(772)=ACKPRTN ;ACK PROCESSING RTN
  1. S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
  1. I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
  1. S DGENDA(1)=RETURN
  1. ;
  1. ; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
  1. S FILE=101.0775
  1. K DATA
  1. S DATA(.01)=SUBIEN
  1. S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
  1. S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
  1. ;
  1. EDPEXIT Q RETURN
  1. ;