| 1 | EAS1071C ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:02pm
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
|
|---|
| 3 | ;
|
|---|
| 4 | LINK ;Link QRY Z10/Z11 protocols to shared servers
|
|---|
| 5 | N ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
|
|---|
| 6 | S LNCNT=1
|
|---|
| 7 | F S LINE=$T(PROTDAT1+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
|
|---|
| 8 | .S NAM=PREFHEC_$P(LINE,";",3)_" SERVER"
|
|---|
| 9 | .S IEN101=$O(^ORD(101,"B",NAM,0))
|
|---|
| 10 | .I +IEN101=0 D Q
|
|---|
| 11 | ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
|
|---|
| 12 | ..S RETURN=-1_"^"_ERROR
|
|---|
| 13 | ..D ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
|
|---|
| 14 | .;
|
|---|
| 15 | .;Client Protocol
|
|---|
| 16 | .S SNAM=@("PREF"_SYS)
|
|---|
| 17 | .S SNAM=SNAM_$P(LINE,";",3)_" CLIENT"
|
|---|
| 18 | .S SIEN101=$O(^ORD(101,"B",SNAM,0))
|
|---|
| 19 | .I +SIEN101=0 D Q
|
|---|
| 20 | ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
|
|---|
| 21 | ..S RETURN=-1_"^"_ERROR
|
|---|
| 22 | ..D ABORT2^EAS1071A(RETURN,"Subscriber:"_SNAM)
|
|---|
| 23 | .;Skip if already present
|
|---|
| 24 | .I $D(^ORD(101,IEN101,775,"B",SIEN101)) D Q
|
|---|
| 25 | ..D WARN^EAS1071A(NAM,SNAM)
|
|---|
| 26 | ..S LNCNT=LNCNT+1
|
|---|
| 27 | .;Add subscriber to event driver
|
|---|
| 28 | .S RETURN=$$SUBSCR^EAS1071A(IEN101,SIEN101)
|
|---|
| 29 | .I +RETURN<0 D ABORT2^EAS1071A(RETURN,"driver with Subscriber:"_SNAM) Q
|
|---|
| 30 | .S LNCNT=LNCNT+1
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | UNLINK(PREF) ;Remove Z10/Z11 client subscriber protocols from shared servers
|
|---|
| 34 | F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END" D Q:STOP
|
|---|
| 35 | .S NAM=PREF_$P(LINE,";",3)_" CLIENT"
|
|---|
| 36 | .S SIEN101=$O(^ORD(101,"B",NAM,0))
|
|---|
| 37 | .I +SIEN101=0 D Q
|
|---|
| 38 | ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
|
|---|
| 39 | ..S RETURN=-1_"^"_ERROR
|
|---|
| 40 | ..D ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
|
|---|
| 41 | .;If this is a SUBSCRIBER remove from SERVER
|
|---|
| 42 | .I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE^EAS1071A(SIEN101,NAM)
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | PROTDAT1 ;
|
|---|
| 46 | ;;QRY-Z10
|
|---|
| 47 | ;;QRY-Z11
|
|---|
| 48 | ;;END
|
|---|
| 49 | ;
|
|---|
| 50 | SOR(PREF,PREFHEC) ;Check if SOR
|
|---|
| 51 | N IENC,IENS,NAMC,NAMS
|
|---|
| 52 | S NAMS=PREFHEC_"QRY-Z10 SERVER"
|
|---|
| 53 | ;get server ien
|
|---|
| 54 | S IENS=$O(^ORD(101,"B",NAMS,0)) Q:'IENS 0
|
|---|
| 55 | ;check subscriber protocols
|
|---|
| 56 | S IENC=+$G(^ORD(101,IENS,775,1,0)) Q:'IENC 0
|
|---|
| 57 | ;Check subscriber if is for this system
|
|---|
| 58 | I $P($G(^ORD(101,IENC,0)),U)[PREF Q 1
|
|---|
| 59 | ;
|
|---|
| 60 | Q 0
|
|---|
| 61 | ;
|
|---|
| 62 | Z07(PREF,PREFHEC) ;Check if Z07 messaging is set up
|
|---|
| 63 | N IENC,IENS,FOUND,NAMC,NAMS
|
|---|
| 64 | S NAMC=PREF_"ORU-Z07 CLIENT",NAMS=PREFHEC_"ORU-Z07 SERVER"
|
|---|
| 65 | ;get server ien
|
|---|
| 66 | S IENS=$O(^ORD(101,"B",NAMS,0)) Q:'IENS 0
|
|---|
| 67 | ;check subscriber protocols
|
|---|
| 68 | S IENC=0,FOUND=0
|
|---|
| 69 | F S IENC=$O(^ORD(101,IENS,775,"B",IENC)) Q:'IENC D Q:FOUND
|
|---|
| 70 | .;Check subscriber if is for this system
|
|---|
| 71 | .S:$P($G(^ORD(101,IENC,0)),U)=NAMC FOUND=1
|
|---|
| 72 | ;
|
|---|
| 73 | Q FOUND
|
|---|
