- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUTIL3 2696 printed Jan 18, 2025@03:01:44 Page 2
- 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