HLUTIL3 ;ALB/MTC - VARIOUS HL7 UTILITIES ;11/19/2003 15:37
;;1.6;HEALTH LEVEL SEVEN;**2,41,109**;Oct 13, 1995
;
Q
;
FNDSTAT(IEN) ;- This function will return the appropriate status based
; on the Accept Ack, Application Ack and version of the protocol
; being utilized.
;
; INPUT : IEN of the HL7 Message File (#772)
; OUTPUT: Pointer to HL7 Message Status File (#771.6) OR NULL if
; Not valid IEN or No parent.
;
N PROTOCOL,PARENTP,PARENT,PROT
N CHILD,RESULT
N HLCA,HLAA
;
S RESULT=""
G:'IEN EXIT
;-- Find Parent
S CHILD=$G(^HL(772,IEN,0))
I CHILD="" G EXIT
S PARENTP=$P(CHILD,"^",8)
I (PARENTP="") G EXIT
S PARENT=$G(^HL(772,PARENTP,0))
;
S PROT=$P(PARENT,"^",10)
S PROTOCOL=$$TYPE^HLUTIL2(PROT)
S HLCA=$P(PROTOCOL,U,7)
S HLAA=$P(PROTOCOL,U,8)
;
;-- if this is a responce (ack) message set to "sucessful"
I $P(PARENT,U,7) S RESULT=3 G EXIT
;-- HLCA and HLAA assume original ack rules set to "awaiting ack"
I HLCA="",HLAA="" S RESULT=2 G EXIT
;-- if HLCA=NE and HLAA=NE set to "sucessful"
I HLCA="NE",HLAA="NE" S RESULT=3 G EXIT
;-- else set to "awaiting ack"
S RESULT=2
;
EXIT ;
Q RESULT
;
DOMAIL(HLLINK) ; This function will determine if the MailMan LLP should
; be used to x-mit the outgoing message.
; INPUT - IEN of HL LOGICAL LINK (#870)
; OUTPUT - 1=Yes, 0=N
;
N X
S X=$P($G(^HLCS(870,+HLLINK,0)),U,22)
Q $S(X:1,1:0)
;
LINK(HLINST,HLI,HLFLG) ;Return Logical Link(s) from Institution or Domain
; INPUT - HLINST=Institution name or VISN name or ien
; If HLFLG="I", institution number is passed
; If HLFLG="D", HLINST=DOMAIN name or DOMAIN ien
; If HLFLG="", Institution name or ien is assumed
; OUTPUT - HLI(LINK IEN)=LINK NAME passed by reference
S HLFLG=$G(HLFLG)
Q:$G(HLINST)']""
N HLP S HLI=0
;Domain passed
I HLFLG="D" D DOM Q
;Institution name or number
I HLFLG="I"!('HLINST) D
. ;patch HL*1.6*109
. N X ;to protect the variable from calling routine
. S DIC=4,DIC(0)="MXZ",X=HLINST D ^DIC S HLINST=+Y
. ;patch HL*1.6*109 end
Q:HLINST<1
;pass institution ien
D CHILDREN^XUAF4("HLP","`"_HLINST) I $D(HLP) D Q
.S HLINST=0 F S HLINST=$O(HLP("C",HLINST)) Q:HLINST<1 D L1
L1 F S HLI=$O(^HLCS(870,"C",HLINST,HLI)) Q:HLI<1 D
.S HLI(HLI)=$P(^HLCS(870,HLI,0),"^")
Q
DOM ;Domain
;patch HL*1.6*109 start
;to protect the variable from calling routine
N X
I 'HLINST S DIC=4.2,DIC(0)="MXZ",X=HLINST D ^DIC S HLINST=+Y
;patch HL*1.6*109 end
;
Q:HLINST<1
F S HLI=$O(^HLCS(870,"D",HLINST,HLI)) Q:HLI<1 D
.S HLI(HLI)=$P(^HLCS(870,HLI,0),"^")
Q ; patch HL*1.6*109: add "Q" to quit DOM
HLUTIL3 ;ALB/MTC - VARIOUS HL7 UTILITIES ;11/19/2003 15:37
+1 ;;1.6;HEALTH LEVEL SEVEN;**2,41,109**;Oct 13, 1995
+2 ;
+3 QUIT
+4 ;
FNDSTAT(IEN) ;- This function will return the appropriate status based
+1 ; on the Accept Ack, Application Ack and version of the protocol
+2 ; being utilized.
+3 ;
+4 ; INPUT : IEN of the HL7 Message File (#772)
+5 ; OUTPUT: Pointer to HL7 Message Status File (#771.6) OR NULL if
+6 ; Not valid IEN or No parent.
+7 ;
+8 NEW PROTOCOL,PARENTP,PARENT,PROT
+9 NEW CHILD,RESULT
+10 NEW HLCA,HLAA
+11 ;
+12 SET RESULT=""
+13 IF 'IEN
GOTO EXIT
+14 ;-- Find Parent
+15 SET CHILD=$GET(^HL(772,IEN,0))
+16 IF CHILD=""
GOTO EXIT
+17 SET PARENTP=$PIECE(CHILD,"^",8)
+18 IF (PARENTP="")
GOTO EXIT
+19 SET PARENT=$GET(^HL(772,PARENTP,0))
+20 ;
+21 SET PROT=$PIECE(PARENT,"^",10)
+22 SET PROTOCOL=$$TYPE^HLUTIL2(PROT)
+23 SET HLCA=$PIECE(PROTOCOL,U,7)
+24 SET HLAA=$PIECE(PROTOCOL,U,8)
+25 ;
+26 ;-- if this is a responce (ack) message set to "sucessful"
+27 IF $PIECE(PARENT,U,7)
SET RESULT=3
GOTO EXIT
+28 ;-- HLCA and HLAA assume original ack rules set to "awaiting ack"
+29 IF HLCA=""
IF HLAA=""
SET RESULT=2
GOTO EXIT
+30 ;-- if HLCA=NE and HLAA=NE set to "sucessful"
+31 IF HLCA="NE"
IF HLAA="NE"
SET RESULT=3
GOTO EXIT
+32 ;-- else set to "awaiting ack"
+33 SET RESULT=2
+34 ;
EXIT ;
+1 QUIT RESULT
+2 ;
DOMAIL(HLLINK) ; This function will determine if the MailMan LLP should
+1 ; be used to x-mit the outgoing message.
+2 ; INPUT - IEN of HL LOGICAL LINK (#870)
+3 ; OUTPUT - 1=Yes, 0=N
+4 ;
+5 NEW X
+6 SET X=$PIECE($GET(^HLCS(870,+HLLINK,0)),U,22)
+7 QUIT $SELECT(X:1,1:0)
+8 ;
LINK(HLINST,HLI,HLFLG) ;Return Logical Link(s) from Institution or Domain
+1 ; INPUT - HLINST=Institution name or VISN name or ien
+2 ; If HLFLG="I", institution number is passed
+3 ; If HLFLG="D", HLINST=DOMAIN name or DOMAIN ien
+4 ; If HLFLG="", Institution name or ien is assumed
+5 ; OUTPUT - HLI(LINK IEN)=LINK NAME passed by reference
+6 SET HLFLG=$GET(HLFLG)
+7 IF $GET(HLINST)']""
QUIT
+8 NEW HLP
SET HLI=0
+9 ;Domain passed
+10 IF HLFLG="D"
DO DOM
QUIT
+11 ;Institution name or number
+12 IF HLFLG="I"!('HLINST)
Begin DoDot:1
+13 ;patch HL*1.6*109
+14 ;to protect the variable from calling routine
NEW X
+15 SET DIC=4
SET DIC(0)="MXZ"
SET X=HLINST
DO ^DIC
SET HLINST=+Y
+16 ;patch HL*1.6*109 end
End DoDot:1
+17 IF HLINST<1
QUIT
+18 ;pass institution ien
+19 DO CHILDREN^XUAF4("HLP","`"_HLINST)
IF $DATA(HLP)
Begin DoDot:1
+20 SET HLINST=0
FOR
SET HLINST=$ORDER(HLP("C",HLINST))
IF HLINST<1
QUIT
DO L1
End DoDot:1
QUIT
L1 FOR
SET HLI=$ORDER(^HLCS(870,"C",HLINST,HLI))
IF HLI<1
QUIT
Begin DoDot:1
+1 SET HLI(HLI)=$PIECE(^HLCS(870,HLI,0),"^")
End DoDot:1
+2 QUIT
DOM ;Domain
+1 ;patch HL*1.6*109 start
+2 ;to protect the variable from calling routine
+3 NEW X
+4 IF 'HLINST
SET DIC=4.2
SET DIC(0)="MXZ"
SET X=HLINST
DO ^DIC
SET HLINST=+Y
+5 ;patch HL*1.6*109 end
+6 ;
+7 IF HLINST<1
QUIT
+8 FOR
SET HLI=$ORDER(^HLCS(870,"D",HLINST,HLI))
IF HLI<1
QUIT
Begin DoDot:1
+9 SET HLI(HLI)=$PIECE(^HLCS(870,HLI,0),"^")
End DoDot:1
+10 ; patch HL*1.6*109: add "Q" to quit DOM
QUIT
