Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLUOPT3

HLUOPT3.m

Go to the documentation of this file. 
  1. HLUOPT3 ;CIOFO-O/LJA - Delete 772, 773 Entries w/Direct Kills ;05/15/2008 16:16
  1.  ;;1.6;HEALTH LEVEL SEVEN;**109,142**;Oct 13, 1995;Build 17
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;
  1.  ; WARNING!  No locking used in DEL772 and DEL773.  You MUST already
  1.  ;           have the entry lock before calling here, (or be willing to
  1.  ;           accept the consequences.)
  1.  ;
  1.  ; WARNING!  DEL772 and DEL773 does NOT update piece 4 (number entries)
  1.  ;           of the file's zero node.  Be sure to do this elsewhere.
  1.  ;
  1.  ;
  1. DEL772(IEN772) ; Delete 772 entry using kill commands...  (See WARNINGS above)
  1.  N D0,D2,DP,IEN773,P01,P03,P06,P08,P11,PP1,P22
  1.  ;
  1.  ; Does 773 entry exist?
  1.  S IEN773=$O(^HLMA("B",IEN772,0))
  1.  I IEN773,'$D(^HLMA(+IEN773,0)) D
  1.  .  KILL ^HLMA("B",IEN772,IEN773)
  1.  .  S IEN773=""
  1.  QUIT:IEN773  ;->
  1.  ;
  1.  ; Every field value must be set so as not to be null!!!
  1.  ;
  1.  ; Get 0 node data and pieces...
  1.  S D0=$G(^HL(772,+IEN772,0))
  1.  S P01=+$P(D0,U),P03=+$P(D0,U,3)
  1.  S P06=$P(D0,U,6),P06=$S(P06]"":P06,1:" ")
  1.  S P08=+$P(D0,U,8),P011=+$P(D0,U,11)
  1.  ;
  1.  ;Get 2 node data and piece
  1.  S D2=$G(^HL(772,+IEN772,2))
  1.  S P22=+$P(D2,U,2)
  1.  ;
  1.  ; Get P node data and piece...
  1.  S DP=$G(^HL(772,+IEN772,"P"))
  1.  S PP1=+$P(DP,U)
  1.  ;
  1.  ; Kill xrefs...
  1.  KILL ^HL(772,"A-XMIT-OUT",P011,IEN772)
  1.  KILL ^HL(772,"AC","I",P03,IEN772)
  1.  KILL ^HL(772,"AC","O",P03,IEN772)
  1.  KILL ^HL(772,"AF",PP1,IEN772)
  1.  KILL ^HL(772,"AH",P03,P06,IEN772)
  1.  KILL ^HL(772,"AI",P08,IEN772)
  1.  KILL ^HL(772,"B",P01,IEN772)
  1.  KILL ^HL(772,"C",P06,IEN772)
  1.  KILL ^HLMA("AI",P22,772,IEN772)
  1.  ;
  1.  ; Remove data...
  1.  KILL ^HL(772,IEN772)
  1.  ;
  1.  QUIT
  1.  ;
  1. DEL773(IEN773) ; Delete 773 entry using kill commands...  (See WARNINGS above)
  1.  N D0,D2,DP,DS,P01,P02,P07,P06,P012,PP1,PS1,P22
  1.  ;
  1.  ; Every field value must be set so as not to be null!!!
  1.  ;
  1.  ; Get 0 node data and pieces...
  1.  S D0=$G(^HLMA(IEN773,0))
  1.  S P01=+$P(D0,U),P02=$P(D0,U,2),P02=$S(P02]"":P02,1:" ")
  1.  S P07=+$P(D0,U,7),P06=+$P(D0,U,6),P012=+$P(D0,U,12)
  1.  ;
  1.  ;
  1.  ;Get 2 node data and piece
  1.  S D2=$G(^HLMA(IEN773,2))
  1.  S P22=+$P(D2,U,2)
  1.  ;
  1.  ; Get P node data and piece...
  1.  S DP=$G(^HLMA(IEN773,"P"))
  1.  S PP1=+DP
  1.  ;
  1.  ; Get S node data and piece...
  1.  S DS=$G(^HLMA(IEN773,"S"))
  1.  S PS1=+DS
  1.  ;
  1.  ; Kill xrefs...
  1.  KILL ^HLMA("AC","I",P07,IEN773)
  1.  KILL ^HLMA("AC","O",P07,IEN773)
  1.  KILL ^HLMA("AD",PS1,IEN773)
  1.  KILL ^HLMA("AF",P06,IEN773)
  1.  KILL ^HLMA("AG",PP1,IEN773)
  1.  KILL ^HLMA("AH",P012,P02,IEN773)
  1.  KILL ^HLMA("B",P01,IEN773)
  1.  KILL ^HLMA("C",P02,IEN773)
  1.  KILL ^HLMA("AI",P22,773,IEN773)
  1.  ;
  1.  ; patch HL*1.6*142 start
  1.  N HDR,FLD
  1.  S HDR=$G(^HLMA(IEN773,"MSH",1,0))
  1.  I HDR]"" D
  1.  . I $G(^HLMA(IEN773,"MSH",2,0))]"" D
  1.  .. S HDR=HDR_$G(^HLMA(IEN773,"MSH",2,0))
  1.  . S FLD=$E(HDR,4)
  1.  . I FLD]"" D
  1.  .. S HDR=$P(HDR,FLD,3,6)
  1.  .. K:HDR]"" ^HLMA("AH-NEW",HDR,P02,IEN773)
  1.  ; patch HL*1.6*142 end
  1.  ;
  1.  ; Remove data...
  1.  KILL ^HLMA(IEN773)
  1.  ;
  1.  QUIT
  1.  ;
  1. EOR ;HLUOPT3 - Delete 772, 773 Entries w/Direct Kills ;12/30/02 15:15