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

EAS1071B.m

Go to the documentation of this file. 
  1. EAS1071B ;ALB/PJH - EAS*1*71; ; 22 Jan 2014  12:46 PM
  1.  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,96**;15-MAR-01;Build 18
  1.  Q
  1.  ;
  1. EN(ARR) ;ENTRY POINT
  1.  ;
  1.  N DA,DIK,LINE,LCT,NAM,PREFIX,RESULT
  1.  ;
  1.  S ARR="HEC messaging NOT disabled"
  1.  ;
  1.  ; Get site's Station #
  1.  S PREFIX="VAMC "_$P($$SITE^VASITE,"^",3)_" "
  1.  ;
  1.  I $$SOR^EAS1071C(PREFIX,PREFIX) D  Q
  1.  .S ARR="Unable to disable messaging, HEC is SOR"
  1.  ;
  1.  ;Remove HEC client subscriber protocols from shared servers.  Only quit processing if not EAS1096P
  1.  F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END"  D  I '$G(EAS1096P) Q:STOP
  1.  .S NAM=PREFIX_$P(LINE,";",3)_" CLIENT"
  1.  .S SIEN101=$O(^ORD(101,"B",NAM,0))
  1.  .I +SIEN101=0 D  Q
  1.  ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
  1.  ..S RETURN=-1_"^"_ERROR
  1.  ..D ERROR(RETURN,"Event Driver:"_NAM)
  1.  .;If this is a SUBSCRIBER remove from SERVER
  1.  .I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE(SIEN101,NAM)
  1.  ;
  1.  ;Add disable text to HEC to ESR servers
  1.  F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END"  D
  1.  .S NAM=PREFIX_$P(LINE,";",3)
  1.  .;Insert disable text
  1.  .S RESULT=$$EDP(NAM,"Disable VistA to HEC Messaging")
  1.  .I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
  1.  ;
  1.  S:'STOP ARR="HEC messaging disabled"
  1.  Q
  1.  ;
  1. EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
  1.  ;
  1.  N DATA,FILE,DGENDA,RETURN,ERROR,DA
  1.  S FILE=101
  1.  S IEN101=$O(^ORD(101,"B",PNAME,0))
  1.  I 'IEN101 D  Q RETURN
  1.  . S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
  1.  . S RETURN=-1_"^"_ERROR
  1.  ;
  1.  S DATA(2)=DTXT
  1.  S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
  1.  I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR
  1.  ;
  1.  Q RETURN
  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.  Q
  1.  ;
  1. PROTDAT ;VistA to HEC clients on shared Event Drivers
  1.  ;;ORU-Z07
  1.  ;;ORU-Z09
  1.  ;;ORF-Z07
  1.  ;;END
  1.  ;;NOTE THAT THESE ARE HANDLED BY QRY^EAS1071A
  1.  ;;QRY-Z10
  1.  ;;QRY-Z11
  1.  ;;END
  1.  ;
  1. PROTDAT1 ;HEC to Vista Event Drivers to disable
  1.  ;;ORU-Z04 SERVER H
  1.  ;;ORU-Z04 SERVER V
  1.  ;;ORU-Z05 SERVER
  1.  ;;ORU-Z10 SERVER
  1.  ;;ORU-Z11 SERVER
  1.  ;;ORF-Z10 SERVER
  1.  ;;ORF-Z11 SERVER
  1.  ;;QRY-Z07 SERVER
  1.  ;;MFN-ZEG SERVER
  1.  ;;END
  1.  ;
  1. RESET(ARR) ;Enable or Attach HEC protocols
  1.  ; Do not perform Reset for EAS1096P Project
  1.  I $G(EAS1096P) Q
  1.  ;
  1.  N DA,DIK,ERROR,IEN101,LINE,LCT,NAM,PREFIX,SIEN101,SNAM,STOP
  1.  ;
  1.  S ARR="HEC messaging NOT re enabled"
  1.  ;
  1.  ; Get site's Station #
  1.  S PREFIX="VAMC "_$P($$SITE^VASITE,"^",3)_" ",STOP=0
  1.  ;
  1.  ;Enable to VistA to HEC Legacy servers
  1.  F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END"  D
  1.  .S NAM=PREFIX_$P(LINE,";",3)
  1.  .;Remove disable text
  1.  .S RESULT=$$EDP(NAM,"")
  1.  .I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
  1.  ;
  1.  ;
  1.  ;Add HEC client protocols to shared servers
  1.  F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END"  D
  1.  .S FILE=101
  1.  .;Server protocol
  1.  .S NAM=PREFIX_$P(LINE,";",3)_" SERVER"
  1.  .I NAM["Z04" S NAM=NAM_" V"
  1.  .S IEN101=$O(^ORD(101,"B",NAM,0))
  1.  .; Fix Error reporting
  1.  .I 'IEN101 D  Q  ;RETURN
  1.  ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
  1.  ..S RETURN=-1_"^"_ERROR
  1.  ..D ERROR(RETURN,"Server:"_NAM)
  1.  .;
  1.  .;Client protocol (subscriber)
  1.  .S SNAM=PREFIX_$P(LINE,";",3)_" CLIENT"
  1.  .I SNAM["Z04" S SNAM=SNAM_" V"
  1.  .S SIEN101=$O(^ORD(101,"B",SNAM,0))
  1.  .I +SIEN101=0 D  Q
  1.  ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
  1.  ..S RETURN=-1_"^"_ERROR
  1.  ..D ERROR(RETURN,"Subscriber:"_SNAM)
  1.  .;Skip if already present
  1.  .I $D(^ORD(101,IEN101,775,"B",SIEN101)) D  Q
  1.  ..D WARN(NAM,SNAM)
  1.  .;Add subscriber to event driver
  1.  .S RETURN=$$SUBSCR(IEN101,SIEN101)
  1.  .I +RETURN<0 D ERROR(RETURN,"driver with Subscriber:"_SNAM) Q
  1.  ;
  1.  S:'STOP ARR="HEC messaging re enabled"
  1.  Q
  1.  ;
  1.  ;
  1. ERROR(ERRMSG,SUBJ) ;Display Install Error message and set STOP
  1.  N ARR
  1.  ;
  1.  S STOP=1
  1.  ;
  1.  S ARR(1)="===================================================="
  1.  S ARR(2)="=                   ERROR                          ="
  1.  S ARR(3)="===================================================="
  1.  S ARR(4)="When updating "_SUBJ
  1.  S ARR(5)="===================================================="
  1.  S ARR(5)="**ERROR MSG: "_$P(ERRMSG,"^",2)
  1.  ;
  1.  ;Display result of RPC and any warnings or errors for EAS1096P only
  1.  I $G(EAS1096P) D BMES^XPDUTL(.ARR)
  1.  Q
  1.  ;
  1. WARN(EDP,SP) ;Display Warning Message
  1.  N ARR
  1.  ;
  1.  S ARR(1)="===================================================="
  1.  S ARR(2)="=                 WARNING                          ="
  1.  S ARR(3)="===================================================="
  1.  S ARR(4)="When updating "_EDP
  1.  S ARR(5)="===================================================="
  1.  S ARR(5)="**"_SP_" is already defined**"
  1.  ;
  1.  Q
  1.  ;
  1. SUBSCR(IEN101,SIEN101) ;Add client to event driver as a subscriber
  1.  ;
  1.  N DATA,DGENDA,ERROR,FILE,RETURN
  1.  S DGENDA(1)=IEN101
  1.  S FILE=101.0775
  1.  S DATA(.01)=SIEN101
  1.  S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
  1.  S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR