source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS1071C.m

EAS1071C        ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:02pm
        ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
        ;
LINK    ;Link QRY Z10/Z11 protocols to shared servers
        N ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
        S LNCNT=1
        F  S LINE=$T(PROTDAT1+LNCNT) Q:$P(LINE,";",3)="END"  D  Q:STOP
        .S NAM=PREFHEC_$P(LINE,";",3)_" SERVER"
        .S IEN101=$O(^ORD(101,"B",NAM,0))
        .I +IEN101=0 D  Q
        ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
        ..S RETURN=-1_"^"_ERROR
        ..D ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
        .;
        .;Client Protocol
        .S SNAM=@("PREF"_SYS)
        .S SNAM=SNAM_$P(LINE,";",3)_" CLIENT"
        .S SIEN101=$O(^ORD(101,"B",SNAM,0))
        .I +SIEN101=0 D  Q
        ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
        ..S RETURN=-1_"^"_ERROR
        ..D ABORT2^EAS1071A(RETURN,"Subscriber:"_SNAM)
        .;Skip if already present
        .I $D(^ORD(101,IEN101,775,"B",SIEN101)) D  Q
        ..D WARN^EAS1071A(NAM,SNAM)
        ..S LNCNT=LNCNT+1
        .;Add subscriber to event driver
        .S RETURN=$$SUBSCR^EAS1071A(IEN101,SIEN101)
        .I +RETURN<0 D ABORT2^EAS1071A(RETURN,"driver with Subscriber:"_SNAM) Q
        .S LNCNT=LNCNT+1
        Q
        ;
UNLINK(PREF)    ;Remove Z10/Z11 client subscriber protocols from shared servers
        F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END"  D  Q:STOP
        .S NAM=PREF_$P(LINE,";",3)_" CLIENT"
        .S SIEN101=$O(^ORD(101,"B",NAM,0))
        .I +SIEN101=0 D  Q
        ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
        ..S RETURN=-1_"^"_ERROR
        ..D ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
        .;If this is a SUBSCRIBER remove from SERVER
        .I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE^EAS1071A(SIEN101,NAM)
        Q
        ;
PROTDAT1        ;
        ;;QRY-Z10
        ;;QRY-Z11
        ;;END
        ;
SOR(PREF,PREFHEC)       ;Check if SOR
        N IENC,IENS,NAMC,NAMS
        S NAMS=PREFHEC_"QRY-Z10 SERVER"
        ;get server ien
        S IENS=$O(^ORD(101,"B",NAMS,0)) Q:'IENS 0
        ;check subscriber protocols
        S IENC=+$G(^ORD(101,IENS,775,1,0)) Q:'IENC 0
        ;Check subscriber if is for this system
        I $P($G(^ORD(101,IENC,0)),U)[PREF Q 1
        ;
        Q 0
        ;
Z07(PREF,PREFHEC)       ;Check if Z07 messaging is set up
        N IENC,IENS,FOUND,NAMC,NAMS
        S NAMC=PREF_"ORU-Z07 CLIENT",NAMS=PREFHEC_"ORU-Z07 SERVER"
        ;get server ien
        S IENS=$O(^ORD(101,"B",NAMS,0)) Q:'IENS 0
        ;check subscriber protocols
        S IENC=0,FOUND=0
        F  S IENC=$O(^ORD(101,IENS,775,"B",IENC)) Q:'IENC  D  Q:FOUND
        .;Check subscriber if is for this system
        .S:$P($G(^ORD(101,IENC,0)),U)=NAMC FOUND=1
        ;
        Q FOUND