| 1 | HLUTIL3 ;ALB/MTC - VARIOUS HL7 UTILITIES ;11/19/2003 15:37
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**2,41,109**;Oct 13, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | FNDSTAT(IEN) ;- This function will return the appropriate status based
|
|---|
| 7 | ; on the Accept Ack, Application Ack and version of the protocol
|
|---|
| 8 | ; being utilized.
|
|---|
| 9 | ;
|
|---|
| 10 | ; INPUT : IEN of the HL7 Message File (#772)
|
|---|
| 11 | ; OUTPUT: Pointer to HL7 Message Status File (#771.6) OR NULL if
|
|---|
| 12 | ; Not valid IEN or No parent.
|
|---|
| 13 | ;
|
|---|
| 14 | N PROTOCOL,PARENTP,PARENT,PROT
|
|---|
| 15 | N CHILD,RESULT
|
|---|
| 16 | N HLCA,HLAA
|
|---|
| 17 | ;
|
|---|
| 18 | S RESULT=""
|
|---|
| 19 | G:'IEN EXIT
|
|---|
| 20 | ;-- Find Parent
|
|---|
| 21 | S CHILD=$G(^HL(772,IEN,0))
|
|---|
| 22 | I CHILD="" G EXIT
|
|---|
| 23 | S PARENTP=$P(CHILD,"^",8)
|
|---|
| 24 | I (PARENTP="") G EXIT
|
|---|
| 25 | S PARENT=$G(^HL(772,PARENTP,0))
|
|---|
| 26 | ;
|
|---|
| 27 | S PROT=$P(PARENT,"^",10)
|
|---|
| 28 | S PROTOCOL=$$TYPE^HLUTIL2(PROT)
|
|---|
| 29 | S HLCA=$P(PROTOCOL,U,7)
|
|---|
| 30 | S HLAA=$P(PROTOCOL,U,8)
|
|---|
| 31 | ;
|
|---|
| 32 | ;-- if this is a responce (ack) message set to "sucessful"
|
|---|
| 33 | I $P(PARENT,U,7) S RESULT=3 G EXIT
|
|---|
| 34 | ;-- HLCA and HLAA assume original ack rules set to "awaiting ack"
|
|---|
| 35 | I HLCA="",HLAA="" S RESULT=2 G EXIT
|
|---|
| 36 | ;-- if HLCA=NE and HLAA=NE set to "sucessful"
|
|---|
| 37 | I HLCA="NE",HLAA="NE" S RESULT=3 G EXIT
|
|---|
| 38 | ;-- else set to "awaiting ack"
|
|---|
| 39 | S RESULT=2
|
|---|
| 40 | ;
|
|---|
| 41 | EXIT ;
|
|---|
| 42 | Q RESULT
|
|---|
| 43 | ;
|
|---|
| 44 | DOMAIL(HLLINK) ; This function will determine if the MailMan LLP should
|
|---|
| 45 | ; be used to x-mit the outgoing message.
|
|---|
| 46 | ; INPUT - IEN of HL LOGICAL LINK (#870)
|
|---|
| 47 | ; OUTPUT - 1=Yes, 0=N
|
|---|
| 48 | ;
|
|---|
| 49 | N X
|
|---|
| 50 | S X=$P($G(^HLCS(870,+HLLINK,0)),U,22)
|
|---|
| 51 | Q $S(X:1,1:0)
|
|---|
| 52 | ;
|
|---|
| 53 | LINK(HLINST,HLI,HLFLG) ;Return Logical Link(s) from Institution or Domain
|
|---|
| 54 | ; INPUT - HLINST=Institution name or VISN name or ien
|
|---|
| 55 | ; If HLFLG="I", institution number is passed
|
|---|
| 56 | ; If HLFLG="D", HLINST=DOMAIN name or DOMAIN ien
|
|---|
| 57 | ; If HLFLG="", Institution name or ien is assumed
|
|---|
| 58 | ; OUTPUT - HLI(LINK IEN)=LINK NAME passed by reference
|
|---|
| 59 | S HLFLG=$G(HLFLG)
|
|---|
| 60 | Q:$G(HLINST)']""
|
|---|
| 61 | N HLP S HLI=0
|
|---|
| 62 | ;Domain passed
|
|---|
| 63 | I HLFLG="D" D DOM Q
|
|---|
| 64 | ;Institution name or number
|
|---|
| 65 | I HLFLG="I"!('HLINST) D
|
|---|
| 66 | . ;patch HL*1.6*109
|
|---|
| 67 | . N X ;to protect the variable from calling routine
|
|---|
| 68 | . S DIC=4,DIC(0)="MXZ",X=HLINST D ^DIC S HLINST=+Y
|
|---|
| 69 | . ;patch HL*1.6*109 end
|
|---|
| 70 | Q:HLINST<1
|
|---|
| 71 | ;pass institution ien
|
|---|
| 72 | D CHILDREN^XUAF4("HLP","`"_HLINST) I $D(HLP) D Q
|
|---|
| 73 | .S HLINST=0 F S HLINST=$O(HLP("C",HLINST)) Q:HLINST<1 D L1
|
|---|
| 74 | L1 F S HLI=$O(^HLCS(870,"C",HLINST,HLI)) Q:HLI<1 D
|
|---|
| 75 | .S HLI(HLI)=$P(^HLCS(870,HLI,0),"^")
|
|---|
| 76 | Q
|
|---|
| 77 | DOM ;Domain
|
|---|
| 78 | ;patch HL*1.6*109 start
|
|---|
| 79 | ;to protect the variable from calling routine
|
|---|
| 80 | N X
|
|---|
| 81 | I 'HLINST S DIC=4.2,DIC(0)="MXZ",X=HLINST D ^DIC S HLINST=+Y
|
|---|
| 82 | ;patch HL*1.6*109 end
|
|---|
| 83 | ;
|
|---|
| 84 | Q:HLINST<1
|
|---|
| 85 | F S HLI=$O(^HLCS(870,"D",HLINST,HLI)) Q:HLI<1 D
|
|---|
| 86 | .S HLI(HLI)=$P(^HLCS(870,HLI,0),"^")
|
|---|
| 87 | Q ; patch HL*1.6*109: add "Q" to quit DOM
|
|---|
