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

EAS1071P.m

Go to the documentation of this file. 
  1. EAS1071P ;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.  Q
  1.  ;
  1. EN ;ENTRY POINT
  1.  ;
  1.  N ADDR,AN,PORT,SLLN,STATION,TCPDATA,AN,STOP,VER,DA,FILE,RET,ERROR
  1.  ;
  1.  ; Get site's Station #
  1.  S STATION=$P($$SITE^VASITE,"^",3)
  1.  ;
  1.  S STOP=0
  1.  Q:$$SETLL16(.SLLN)
  1.  Q:$$SETAPP(STATION,.AN)
  1.  D PROTOCOL(STATION,SLLN,.AN)
  1.  Q
  1.  ;
  1. SETLL16(SLLN) ;Create Logical link
  1.  N ADDR,PORT,RET,VISN,M,IENS
  1.  ;
  1.  S PORT=""           ;Vitria Port#
  1.  S ADDR=""           ;IP address is modified by EAS1072P
  1.  S SLLN="LLESROUT"
  1.  S RET=$$LL16^EAS1071Q(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
  1.  I +RET<0 D ERROR(RET,"ESR Send Link:"_SLLN) Q 1
  1. LL16EXIT Q STOP
  1.  ;
  1.  ;
  1. SETAPP(STATION,AN) ;
  1.  ;INPUT    STATION = Station #
  1.  ;         AN      = Array containing all the Application Names
  1.  ;
  1.  ;OUTPUT   0 : Success, 1 : Error
  1.  ;
  1.  ;PURPOSE  Create the sending and receiving application definitions.
  1.  ;
  1.  N RECVAPP,SENDAPP
  1.  S (SENDAPP,AN("S"))="VAMC "_STATION
  1.  I '$O(^HL(771,"B",SENDAPP,0)) D  Q STOP
  1.  .D ERROR("^HL7 APPLICATION PARAMETER "_SENDAPP_" NOT FOUND","Client Protocols - Install aborted")
  1.  ;
  1. ANR S AN("R")="ESR"
  1.  S RECVAPP=$$APP^EAS1071Q(AN("R"),"a","200ESR","USA")
  1.  I +RECVAPP<0 D ERROR(RECVAPP,"Receiving App:"_AN("R"))
  1. APPEXIT Q STOP
  1.  ;
  1.  ;
  1. PROTOCOL(STATION,SLLN,AN) ;
  1.  ;INPUT    STATION = Station #
  1.  ;         RLLN    = Receiving Logical Link Name
  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/Vitria TCP/IP interfaces
  1.  ;
  1.  N RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM
  1.  S N1="EAS ESR "_STATION,V="2.3.1"
  1.  ;
  1.  S LNCNT=1
  1.  F  S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END"  D  Q:STOP
  1.  . K D,RESULT
  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^EAS1071Q(NAM,D(6),D(7),D(8),D(9),D(10))
  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^EAS1071Q(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.  K D
  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.  ;
  1.  Q:N="ORUZEG" "ENROLLMENT GROUP THRESHOLD/Unsolicited ESR to VAMC"
  1.  Q:N="ORUZ04H" "INSURANCE/Unsolicited ESR to VAMC"
  1.  Q:N="ORUZ05" "DEMOGRAPHIC DATA/Unsolicited ESR to VAMC"
  1.  Q:N="ORUZ10" "INCOME TEST DATA/Unsolicited ESR to VAMC"
  1.  Q:N="ORUZ11" "ENROLLMENT/ELIGIBILITY DATA/Unsolicited ESR to VAMC"
  1.  Q:N="ORFZ10" "FINANCIAL QUERY/Reply ESR to VAMC"
  1.  Q:N="ORFZ11" "ENROLLMENT/ELIGIBILITY QUERY/Reply ESR to VAMC"
  1.  Q:N="QRYZ07" "IVM INDIVIDUAL QUERY FULL DATA/Query ESR to VAMC"
  1.  Q ""
  1.  ;
  1. PROTDAT ;;VAMC SIDE PROTOCOLS
  1.  ;;@N1;; ORU-Z04 CLIENT H;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
  1.  ;;@N1;; ORU-Z04 SERVER H;ORU;Z04;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; ORU-Z05 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
  1.  ;;@N1;; ORU-Z05 SERVER;ORU;Z05;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; ORU-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
  1.  ;;@N1;; ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
  1.  ;;@N1;; ORU-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
  1.  ;;@N1;; ORU-Z10 SERVER;ORU;Z10;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; ORU-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
  1.  ;;@N1;; ORU-Z11 SERVER;ORU;Z11;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; ORF-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
  1.  ;;@N1;; ORF-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORF^EASCM;LEND
  1.  ;;@N1;; ORF-Z10 SERVER;ORF;Z10;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; ORF-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORF^EASCM;LEND
  1.  ;;@N1;; ORF-Z11 SERVER;ORF;Z11;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; QRY-Z07 CLIENT;@SLLN;@AN("S");ORF;Z07;D QRY^EASPREC4;LEND
  1.  ;;@N1;; QRY-Z07 SERVER;QRY;Z07;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;@N1;; QRY-Z10 CLIENT;@SLLN;@AN("R");ORF;Z10;;LEND
  1.  ;;@N1;; QRY-Z11 CLIENT;@SLLN;@AN("R");ORF;Z11;;LEND
  1.  ;;@N1;; MFN-ZEG CLIENT;@SLLN;@AN("S");MFK;ZEG;D MFN^EASEGT2;LEND
  1.  ;;@N1;; MFN-ZEG SERVER;MFN;ZEG;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
  1.  ;;END
  1.  ;
  1.  ;Utilities section
  1.  ;
  1. RESET ;Delete all existing EAS ESR protocols (in the current list)
  1.  Q
  1.  N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LINE,LCT,NAM,PREFIX
  1.  ;Prompt
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="Are you really sure you wish to proceed:"
  1.  S DIR("A",1)="**WARNING**"
  1.  S DIR("A",2)=""
  1.  S DIR("A",3)="This utility will delete all ESR protocols from Vista"
  1.  S DIR("A",4)=""
  1.  D ^DIR
  1.  I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) W !!,"Aborted by user" Q
  1.  I 'Y W !!,"Aborted by user" Q
  1.  ;
  1.  W !
  1.  ; Get site's Station #
  1.  S PREFIX="EAS ESR "_$P($$SITE^VASITE,"^",3)
  1.  F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END"  D
  1.  .S NAM=PREFIX_$P(LINE,";",5)
  1.  .S DA=$O(^ORD(101,"B",NAM,0)) I 'DA W !,NAM,?35,"NOT FOUND" Q
  1.  .;If this is a SUBSCRIBER remove from SERVER
  1.  .I $O(^ORD(101,"AB",DA,0)) D REMOVE(DA,NAM)
  1.  .;Delete the protocol
  1.  .S DIK="^ORD(101,"
  1.  .D ^DIK
  1.  .W !,NAM,?35,"DELETED"
  1.  Q
  1.  ;
  1. REMOVE(CLIENT,CNAM) ;Remove clients from server
  1.  N DA,DIK,SERV,SNAM,SUB
  1.  S SERV=0
  1.  F  S SERV=$O(^ORD(101,"AB",CLIENT,SERV)) Q:'SERV  D
  1.  .S SUB=0,SNAM=$P($G(^ORD(101,SERV,0)),U)
  1.  .F  S SUB=$O(^ORD(101,"AB",CLIENT,SERV,SUB)) Q:'SUB  D
  1.  ..S DA(1)=SERV,DA=SUB,DIK="^ORD(101,"_DA(1)_",775," D ^DIK
  1.  ..W !,CNAM,?35,"REMOVED FROM : ",SNAM
  1.  Q