HLUOPT3 ;CIOFO-O/LJA - Delete 772, 773 Entries w/Direct Kills ;02/04/2004 15:15
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
;
; WARNING! No locing used in DEL772 and DEL773. You MUST already
; have the entry lock before calling here, (or be willing to
; accept the consequences.)
;
; WARNING! DEL772 and DEL773 does NOT update piece 4 (number entries)
; of the file's zero node. Be sure to do this elsewhere.
;
;
DEL772(IEN772) ; Delete 772 entry using kill commands... (See WARNINGS above)
N D0,D2,DP,IEN773,P01,P03,P06,P08,P11,PP1,P22
;
; Does 773 entry exist?
S IEN773=$O(^HLMA("B",IEN772,0))
I IEN773,'$D(^HLMA(+IEN773,0)) D
. KILL ^HLMA("B",IEN772,IEN773)
. S IEN773=""
QUIT:IEN773 ;->
;
; Every field value must be set so as not to be null!!!
;
; Get 0 node data and pieces...
S D0=$G(^HL(772,+IEN772,0))
S P01=+$P(D0,U),P03=+$P(D0,U,3)
S P06=$P(D0,U,6),P06=$S(P06]"":P06,1:" ")
S P08=+$P(D0,U,8),P011=+$P(D0,U,11)
;
;Get 2 node data and piece
S D2=$G(^HL(772,+IEN772,2))
S P22=+$P(D2,U,2)
;
; Get P node data and piece...
S DP=$G(^HL(772,+IEN772,"P"))
S PP1=+$P(DP,U)
;
; Kill xrefs...
KILL ^HL(772,"A-XMIT-OUT",P011,IEN772)
KILL ^HL(772,"AC","I",P03,IEN772)
KILL ^HL(772,"AC","O",P03,IEN772)
KILL ^HL(772,"AF",PP1,IEN772)
KILL ^HL(772,"AH",P03,P06,IEN772)
KILL ^HL(772,"AI",P08,IEN772)
KILL ^HL(772,"B",P01,IEN772)
KILL ^HL(772,"C",P06,IEN772)
KILL ^HLMA("AI",P22,772,IEN772)
;
; Remove data...
KILL ^HL(772,IEN772)
;
QUIT
;
DEL773(IEN773) ; Delete 773 entry using kill commands... (See WARNINGS above)
N D0,D2,DP,DS,P01,P02,P07,P06,P012,PP1,PS1,P22
;
; Every field value must be set so as not to be null!!!
;
; Get 0 node data and pieces...
S D0=$G(^HLMA(IEN773,0))
S P01=+$P(D0,U),P02=$P(D0,U,2),P02=$S(P02]"":P02,1:" ")
S P07=+$P(D0,U,7),P06=+$P(D0,U,6),P012=+$P(D0,U,12)
;
;
;Get 2 node data and piece
S D2=$G(^HLMA(IEN773,2))
S P22=+$P(D2,U,2)
;
; Get P node data and piece...
S DP=$G(^HLMA(IEN773,"P"))
S PP1=+DP
;
; Get S node data and piece...
S DS=$G(^HLMA(IEN773,"S"))
S PS1=+DS
;
; Kill xrefs...
KILL ^HLMA("AC","I",P07,IEN773)
KILL ^HLMA("AC","O",P07,IEN773)
KILL ^HLMA("AD",PS1,IEN773)
KILL ^HLMA("AF",P06,IEN773)
KILL ^HLMA("AG",PP1,IEN773)
KILL ^HLMA("AH",P012,P02,IEN773)
KILL ^HLMA("B",P01,IEN773)
KILL ^HLMA("C",P02,IEN773)
KILL ^HLMA("AI",P22,773,IEN773)
;
; Remove data...
KILL ^HLMA(IEN773)
;
QUIT
;
EOR ;HLUOPT3 - Delete 772, 773 Entries w/Direct Kills ;12/30/02 15:15
HLUOPT3 ;CIOFO-O/LJA - Delete 772, 773 Entries w/Direct Kills ;02/04/2004 15:15
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
+3 ;
+4 ; WARNING! No locing used in DEL772 and DEL773. You MUST already
+5 ; have the entry lock before calling here, (or be willing to
+6 ; accept the consequences.)
+7 ;
+8 ; WARNING! DEL772 and DEL773 does NOT update piece 4 (number entries)
+9 ; of the file's zero node. Be sure to do this elsewhere.
+10 ;
+11 ;
DEL772(IEN772) ; Delete 772 entry using kill commands... (See WARNINGS above)
+1 NEW D0,D2,DP,IEN773,P01,P03,P06,P08,P11,PP1,P22
+2 ;
+3 ; Does 773 entry exist?
+4 SET IEN773=$ORDER(^HLMA("B",IEN772,0))
+5 IF IEN773
IF '$DATA(^HLMA(+IEN773,0))
Begin DoDot:1
+6 KILL ^HLMA("B",IEN772,IEN773)
+7 SET IEN773=""
End DoDot:1
+8 ;->
IF IEN773
QUIT
+9 ;
+10 ; Every field value must be set so as not to be null!!!
+11 ;
+12 ; Get 0 node data and pieces...
+13 SET D0=$GET(^HL(772,+IEN772,0))
+14 SET P01=+$PIECE(D0,U)
SET P03=+$PIECE(D0,U,3)
+15 SET P06=$PIECE(D0,U,6)
SET P06=$SELECT(P06]"":P06,1:" ")
+16 SET P08=+$PIECE(D0,U,8)
SET P011=+$PIECE(D0,U,11)
+17 ;
+18 ;Get 2 node data and piece
+19 SET D2=$GET(^HL(772,+IEN772,2))
+20 SET P22=+$PIECE(D2,U,2)
+21 ;
+22 ; Get P node data and piece...
+23 SET DP=$GET(^HL(772,+IEN772,"P"))
+24 SET PP1=+$PIECE(DP,U)
+25 ;
+26 ; Kill xrefs...
+27 KILL ^HL(772,"A-XMIT-OUT",P011,IEN772)
+28 KILL ^HL(772,"AC","I",P03,IEN772)
+29 KILL ^HL(772,"AC","O",P03,IEN772)
+30 KILL ^HL(772,"AF",PP1,IEN772)
+31 KILL ^HL(772,"AH",P03,P06,IEN772)
+32 KILL ^HL(772,"AI",P08,IEN772)
+33 KILL ^HL(772,"B",P01,IEN772)
+34 KILL ^HL(772,"C",P06,IEN772)
+35 KILL ^HLMA("AI",P22,772,IEN772)
+36 ;
+37 ; Remove data...
+38 KILL ^HL(772,IEN772)
+39 ;
+40 QUIT
+41 ;
DEL773(IEN773) ; Delete 773 entry using kill commands... (See WARNINGS above)
+1 NEW D0,D2,DP,DS,P01,P02,P07,P06,P012,PP1,PS1,P22
+2 ;
+3 ; Every field value must be set so as not to be null!!!
+4 ;
+5 ; Get 0 node data and pieces...
+6 SET D0=$GET(^HLMA(IEN773,0))
+7 SET P01=+$PIECE(D0,U)
SET P02=$PIECE(D0,U,2)
SET P02=$SELECT(P02]"":P02,1:" ")
+8 SET P07=+$PIECE(D0,U,7)
SET P06=+$PIECE(D0,U,6)
SET P012=+$PIECE(D0,U,12)
+9 ;
+10 ;
+11 ;Get 2 node data and piece
+12 SET D2=$GET(^HLMA(IEN773,2))
+13 SET P22=+$PIECE(D2,U,2)
+14 ;
+15 ; Get P node data and piece...
+16 SET DP=$GET(^HLMA(IEN773,"P"))
+17 SET PP1=+DP
+18 ;
+19 ; Get S node data and piece...
+20 SET DS=$GET(^HLMA(IEN773,"S"))
+21 SET PS1=+DS
+22 ;
+23 ; Kill xrefs...
+24 KILL ^HLMA("AC","I",P07,IEN773)
+25 KILL ^HLMA("AC","O",P07,IEN773)
+26 KILL ^HLMA("AD",PS1,IEN773)
+27 KILL ^HLMA("AF",P06,IEN773)
+28 KILL ^HLMA("AG",PP1,IEN773)
+29 KILL ^HLMA("AH",P012,P02,IEN773)
+30 KILL ^HLMA("B",P01,IEN773)
+31 KILL ^HLMA("C",P02,IEN773)
+32 KILL ^HLMA("AI",P22,773,IEN773)
+33 ;
+34 ; Remove data...
+35 KILL ^HLMA(IEN773)
+36 ;
+37 QUIT
+38 ;
EOR ;HLUOPT3 - Delete 772, 773 Entries w/Direct Kills ;12/30/02 15:15
