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

EAS1111P.m

Go to the documentation of this file.
  1. EAS1111P ;ALB/PJH,BDB - Post-Install ;03/07/2013 5:00pm
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**111**;07-MAR-13;Build 59
  1. ;
  1. ;Install EAS ESR protocols for Z06
  1. ; protocols are installed enabled and use LLESROUT
  1. ;
  1. ;Follow up patch will add disable text to
  1. ; EAS EDB servers and clients
  1. ;
  1. EN ;Post Install entry point
  1. N AN,SLLN,STATION
  1. ; Get site's Station #
  1. S STATION=$P($$SITE^VASITE,"^",3),SLLN="LLESROUT"
  1. S AN("S")="ESR",AN("R")="VAMC "_STATION
  1. D PROTOCOL(STATION,SLLN,.AN)
  1. Q
  1. ;
  1. PROTOCOL(STATION,SLLN,AN) ;
  1. ;INPUT STATION = Station #
  1. ; SLLN = Sending Logical Link Name
  1. ; AN = Array containing the Application Names
  1. ;
  1. ;OUTPUT None
  1. ;
  1. ;PURPOSE Using the table in line label PROTDAT create the
  1. ; protocols (Subscriber and Event Driver) for the
  1. ; ESR TCP/IP interfaces
  1. ;
  1. N RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM,STOP
  1. ;
  1. ;ON COMPLETION INCLUDE STATION IN PROTOCOL NAME
  1. S N1="EAS ESR "_STATION_" ",V="2.3.1"
  1. ;
  1. S LNCNT=1,STOP=0
  1. F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
  1. . N D,DTXT,RESULT
  1. . S DTXT=""
  1. . F N=3:1 Q:$P(LINE,";",N)="LEND" S D(N)=$$V($P(LINE,";",N))
  1. . S NAM=D(3)_D(4)_D(5)
  1. . D:NAM["CLIENT"
  1. . . S SIEN=$$SP(NAM,D(6),D(7),D(8),D(9),D(10),D(11))
  1. . . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
  1. . D:NAM["SERVER"
  1. . . N TMPNAM,ITEMTXT
  1. . . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
  1. . . S ITEMTXT=$$GETIT(TMPNAM)
  1. . . S RESULT=$$EDP(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
  1. . . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
  1. . S LNCNT=LNCNT+1
  1. ;
  1. D BMES^XPDUTL("ESR Z06 Protocols installed with enabled status")
  1. Q
  1. ;
  1. ERROR(ERRMSG,SUBJ) ;Display error message and set STOP=1
  1. ;
  1. N ARR
  1. S STOP=1
  1. S ARR(1)="===================================================="
  1. S ARR(2)="= ERROR ="
  1. S ARR(3)="===================================================="
  1. S ARR(4)="When creating "_SUBJ
  1. S ARR(5)="===================================================="
  1. S ARR(6)="**ERROR MSG: "_$P(ERRMSG,"^",2)
  1. ;
  1. D BMES^XPDUTL(.ARR)
  1. ;
  1. Q
  1. ;
  1. V(VALUE) ;FUNCTION: If variable then pass back value of it.
  1. ;
  1. I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
  1. Q VALUE
  1. ;
  1. GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
  1. ; Transmission Description.
  1. Q:N="ORUZ06" "MEANS TEST CONVERTED/REVERSED/Unsolicited ESR to VAMC"
  1. Q ""
  1. ;
  1. PROTDAT ;;VAMC SIDE PROTOCOLS
  1. ;;@N1;;ORU-Z06 CLIENT;@SLLN;@AN("R");ACK;;D ORU^EASPREC3;@DTXT;LEND
  1. ;;@N1;;ORU-Z06 SERVER;ORU;Z06;@V;@AN("S");;@SIEN;@DTXT;LEND
  1. ;;END
  1. ;
  1. SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN,DTXT) ;
  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. ; DTXT = Disable Text
  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. S RETURN=+$O(^ORD(101,"B",PNAME,0)) I +$G(RETURN)>0 Q RETURN
  1. ;
  1. S DATA(.01)=PNAME ;PROTOCOL NAME
  1. S DATA(2)="" ;DISABLE TEXT
  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. "Z06")
  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. S RETURN=+$O(^ORD(101,"B",PNAME,0)) I +$G(RETURN)>0 Q RETURN
  1. ;
  1. S DATA(.01)=PNAME ;PROTOCOL NAME
  1. S DATA(1)=ITEMTXT ;ITEM TEXT
  1. S DATA(2)="" ;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. ;