| 1 | HLUOPT3 ;CIOFO-O/LJA - Delete 772, 773 Entries w/Direct Kills ;02/04/2004 15:15
 | 
|---|
| 2 |  ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ; WARNING!  No locing used in DEL772 and DEL773.  You MUST already
 | 
|---|
| 6 |  ;           have the entry lock before calling here, (or be willing to
 | 
|---|
| 7 |  ;           accept the consequences.)
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 |  ; WARNING!  DEL772 and DEL773 does NOT update piece 4 (number entries)
 | 
|---|
| 10 |  ;           of the file's zero node.  Be sure to do this elsewhere.
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 | DEL772(IEN772) ; Delete 772 entry using kill commands...  (See WARNINGS above)
 | 
|---|
| 14 |  N D0,D2,DP,IEN773,P01,P03,P06,P08,P11,PP1,P22
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  ; Does 773 entry exist?
 | 
|---|
| 17 |  S IEN773=$O(^HLMA("B",IEN772,0))
 | 
|---|
| 18 |  I IEN773,'$D(^HLMA(+IEN773,0)) D
 | 
|---|
| 19 |  .  KILL ^HLMA("B",IEN772,IEN773)
 | 
|---|
| 20 |  .  S IEN773=""
 | 
|---|
| 21 |  QUIT:IEN773  ;->
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  ; Every field value must be set so as not to be null!!!
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 |  ; Get 0 node data and pieces...
 | 
|---|
| 26 |  S D0=$G(^HL(772,+IEN772,0))
 | 
|---|
| 27 |  S P01=+$P(D0,U),P03=+$P(D0,U,3)
 | 
|---|
| 28 |  S P06=$P(D0,U,6),P06=$S(P06]"":P06,1:" ")
 | 
|---|
| 29 |  S P08=+$P(D0,U,8),P011=+$P(D0,U,11)
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  ;Get 2 node data and piece
 | 
|---|
| 32 |  S D2=$G(^HL(772,+IEN772,2))
 | 
|---|
| 33 |  S P22=+$P(D2,U,2)
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  ; Get P node data and piece...
 | 
|---|
| 36 |  S DP=$G(^HL(772,+IEN772,"P"))
 | 
|---|
| 37 |  S PP1=+$P(DP,U)
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 |  ; Kill xrefs...
 | 
|---|
| 40 |  KILL ^HL(772,"A-XMIT-OUT",P011,IEN772)
 | 
|---|
| 41 |  KILL ^HL(772,"AC","I",P03,IEN772)
 | 
|---|
| 42 |  KILL ^HL(772,"AC","O",P03,IEN772)
 | 
|---|
| 43 |  KILL ^HL(772,"AF",PP1,IEN772)
 | 
|---|
| 44 |  KILL ^HL(772,"AH",P03,P06,IEN772)
 | 
|---|
| 45 |  KILL ^HL(772,"AI",P08,IEN772)
 | 
|---|
| 46 |  KILL ^HL(772,"B",P01,IEN772)
 | 
|---|
| 47 |  KILL ^HL(772,"C",P06,IEN772)
 | 
|---|
| 48 |  KILL ^HLMA("AI",P22,772,IEN772)
 | 
|---|
| 49 |  ;
 | 
|---|
| 50 |  ; Remove data...
 | 
|---|
| 51 |  KILL ^HL(772,IEN772)
 | 
|---|
| 52 |  ;
 | 
|---|
| 53 |  QUIT
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 | DEL773(IEN773) ; Delete 773 entry using kill commands...  (See WARNINGS above)
 | 
|---|
| 56 |  N D0,D2,DP,DS,P01,P02,P07,P06,P012,PP1,PS1,P22
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 |  ; Every field value must be set so as not to be null!!!
 | 
|---|
| 59 |  ;
 | 
|---|
| 60 |  ; Get 0 node data and pieces...
 | 
|---|
| 61 |  S D0=$G(^HLMA(IEN773,0))
 | 
|---|
| 62 |  S P01=+$P(D0,U),P02=$P(D0,U,2),P02=$S(P02]"":P02,1:" ")
 | 
|---|
| 63 |  S P07=+$P(D0,U,7),P06=+$P(D0,U,6),P012=+$P(D0,U,12)
 | 
|---|
| 64 |  ;
 | 
|---|
| 65 |  ;
 | 
|---|
| 66 |  ;Get 2 node data and piece
 | 
|---|
| 67 |  S D2=$G(^HLMA(IEN773,2))
 | 
|---|
| 68 |  S P22=+$P(D2,U,2)
 | 
|---|
| 69 |  ;
 | 
|---|
| 70 |  ; Get P node data and piece...
 | 
|---|
| 71 |  S DP=$G(^HLMA(IEN773,"P"))
 | 
|---|
| 72 |  S PP1=+DP
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 |  ; Get S node data and piece...
 | 
|---|
| 75 |  S DS=$G(^HLMA(IEN773,"S"))
 | 
|---|
| 76 |  S PS1=+DS
 | 
|---|
| 77 |  ;
 | 
|---|
| 78 |  ; Kill xrefs...
 | 
|---|
| 79 |  KILL ^HLMA("AC","I",P07,IEN773)
 | 
|---|
| 80 |  KILL ^HLMA("AC","O",P07,IEN773)
 | 
|---|
| 81 |  KILL ^HLMA("AD",PS1,IEN773)
 | 
|---|
| 82 |  KILL ^HLMA("AF",P06,IEN773)
 | 
|---|
| 83 |  KILL ^HLMA("AG",PP1,IEN773)
 | 
|---|
| 84 |  KILL ^HLMA("AH",P012,P02,IEN773)
 | 
|---|
| 85 |  KILL ^HLMA("B",P01,IEN773)
 | 
|---|
| 86 |  KILL ^HLMA("C",P02,IEN773)
 | 
|---|
| 87 |  KILL ^HLMA("AI",P22,773,IEN773)
 | 
|---|
| 88 |  ;
 | 
|---|
| 89 |  ; Remove data...
 | 
|---|
| 90 |  KILL ^HLMA(IEN773)
 | 
|---|
| 91 |  ;
 | 
|---|
| 92 |  QUIT
 | 
|---|
| 93 |  ;
 | 
|---|
| 94 | EOR ;HLUOPT3 - Delete 772, 773 Entries w/Direct Kills ;12/30/02 15:15
 | 
|---|