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

IVM16PF.m

Go to the documentation of this file.
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
 ;