- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1071C 2407 printed Apr 23, 2025@18:07:22 Page 2
- EAS1071C ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:02pm
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
- +2 ;
- LINK ;Link QRY Z10/Z11 protocols to shared servers
- +1 NEW ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
- +2 SET LNCNT=1
- +3 FOR
- SET LINE=$TEXT(PROTDAT1+LNCNT)
- if $PIECE(LINE,";",3)="END"
- QUIT
- Begin DoDot:1
- +4 SET NAM=PREFHEC_$PIECE(LINE,";",3)_" SERVER"
- +5 SET IEN101=$ORDER(^ORD(101,"B",NAM,0))
- +6 IF +IEN101=0
- Begin DoDot:2
- +7 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
- +8 SET RETURN=-1_"^"_ERROR
- +9 DO ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
- End DoDot:2
- QUIT
- +10 ;
- +11 ;Client Protocol
- +12 SET SNAM=@("PREF"_SYS)
- +13 SET SNAM=SNAM_$PIECE(LINE,";",3)_" CLIENT"
- +14 SET SIEN101=$ORDER(^ORD(101,"B",SNAM,0))
- +15 IF +SIEN101=0
- Begin DoDot:2
- +16 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
- +17 SET RETURN=-1_"^"_ERROR
- +18 DO ABORT2^EAS1071A(RETURN,"Subscriber:"_SNAM)
- End DoDot:2
- QUIT
- +19 ;Skip if already present
- +20 IF $DATA(^ORD(101,IEN101,775,"B",SIEN101))
- Begin DoDot:2
- +21 DO WARN^EAS1071A(NAM,SNAM)
- +22 SET LNCNT=LNCNT+1
- End DoDot:2
- QUIT
- +23 ;Add subscriber to event driver
- +24 SET RETURN=$$SUBSCR^EAS1071A(IEN101,SIEN101)
- +25 IF +RETURN<0
- DO ABORT2^EAS1071A(RETURN,"driver with Subscriber:"_SNAM)
- QUIT
- +26 SET LNCNT=LNCNT+1
- End DoDot:1
- if STOP
- QUIT
- +27 QUIT
- +28 ;
- UNLINK(PREF) ;Remove Z10/Z11 client subscriber protocols from shared servers
- +1 FOR LCT=1:1
- SET LINE=$TEXT(PROTDAT1+LCT)
- if $PIECE(LINE,";",3)="END"
- QUIT
- Begin DoDot:1
- +2 SET NAM=PREF_$PIECE(LINE,";",3)_" CLIENT"
- +3 SET SIEN101=$ORDER(^ORD(101,"B",NAM,0))
- +4 IF +SIEN101=0
- Begin DoDot:2
- +5 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
- +6 SET RETURN=-1_"^"_ERROR
- +7 DO ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
- End DoDot:2
- QUIT
- +8 ;If this is a SUBSCRIBER remove from SERVER
- +9 IF $ORDER(^ORD(101,"AB",SIEN101,0))
- DO REMOVE^EAS1071A(SIEN101,NAM)
- End DoDot:1
- if STOP
- QUIT
- +10 QUIT
- +11 ;
- PROTDAT1 ;
- +1 ;;QRY-Z10
- +2 ;;QRY-Z11
- +3 ;;END
- +4 ;
- SOR(PREF,PREFHEC) ;Check if SOR
- +1 NEW IENC,IENS,NAMC,NAMS
- +2 SET NAMS=PREFHEC_"QRY-Z10 SERVER"
- +3 ;get server ien
- +4 SET IENS=$ORDER(^ORD(101,"B",NAMS,0))
- if 'IENS
- QUIT 0
- +5 ;check subscriber protocols
- +6 SET IENC=+$GET(^ORD(101,IENS,775,1,0))
- if 'IENC
- QUIT 0
- +7 ;Check subscriber if is for this system
- +8 IF $PIECE($GET(^ORD(101,IENC,0)),U)[PREF
- QUIT 1
- +9 ;
- +10 QUIT 0
- +11 ;
- Z07(PREF,PREFHEC) ;Check if Z07 messaging is set up
- +1 NEW IENC,IENS,FOUND,NAMC,NAMS
- +2 SET NAMC=PREF_"ORU-Z07 CLIENT"
- SET NAMS=PREFHEC_"ORU-Z07 SERVER"
- +3 ;get server ien
- +4 SET IENS=$ORDER(^ORD(101,"B",NAMS,0))
- if 'IENS
- QUIT 0
- +5 ;check subscriber protocols
- +6 SET IENC=0
- SET FOUND=0
- +7 FOR
- SET IENC=$ORDER(^ORD(101,IENS,775,"B",IENC))
- if 'IENC
- QUIT
- Begin DoDot:1
- +8 ;Check subscriber if is for this system
- +9 if $PIECE($GET(^ORD(101,IENC,0)),U)=NAMC
- SET FOUND=1
- End DoDot:1
- if FOUND
- QUIT
- +10 ;
- +11 QUIT FOUND
