ORY177 ;SLC/DAN - Clean up broken pointer to deleted parameters ;4/3/03 12:03
;;3.0;ORDER ENTRY/RESULTS REPORTING;**177**;Dec 17, 1997
;Remove entries from file 8989.5 that were left over after
;improper deletion of parameters
;
;DBIA Section
;3985 - allows direct read of XTV(8989.5 and XTV(8989.51
;10013 - DIK
;10141 - XPDUTL
;
N IEN,ENT,PAR,DA,DIK
D BMES^XPDUTL("Cleaning up broken pointers...")
S ENT="" F S ENT=$O(^XTV(8989.5,"B",ENT)) Q:ENT="" D
.Q:ENT'["DIC(4.2" ;Quit if not a system level entity
.S IEN=0 F S IEN=$O(^XTV(8989.5,"B",ENT,IEN)) Q:'+IEN D
..S PAR=$P($G(^XTV(8989.5,IEN,0)),"^",2) Q:'+PAR ;Stop if no parameter
..I '$D(^XTV(8989.51,PAR)) S DIK="^XTV(8989.5,",DA=IEN D ^DIK
D BMES^XPDUTL("Finished cleaning up broken pointers...")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY177 799 printed Dec 13, 2024@02:38:54 Page 2
ORY177 ;SLC/DAN - Clean up broken pointer to deleted parameters ;4/3/03 12:03
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**177**;Dec 17, 1997
+2 ;Remove entries from file 8989.5 that were left over after
+3 ;improper deletion of parameters
+4 ;
+5 ;DBIA Section
+6 ;3985 - allows direct read of XTV(8989.5 and XTV(8989.51
+7 ;10013 - DIK
+8 ;10141 - XPDUTL
+9 ;
+10 NEW IEN,ENT,PAR,DA,DIK
+11 DO BMES^XPDUTL("Cleaning up broken pointers...")
+12 SET ENT=""
FOR
SET ENT=$ORDER(^XTV(8989.5,"B",ENT))
if ENT=""
QUIT
Begin DoDot:1
+13 ;Quit if not a system level entity
if ENT'["DIC(4.2"
QUIT
+14 SET IEN=0
FOR
SET IEN=$ORDER(^XTV(8989.5,"B",ENT,IEN))
if '+IEN
QUIT
Begin DoDot:2
+15 ;Stop if no parameter
SET PAR=$PIECE($GET(^XTV(8989.5,IEN,0)),"^",2)
if '+PAR
QUIT
+16 IF '$DATA(^XTV(8989.51,PAR))
SET DIK="^XTV(8989.5,"
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+17 DO BMES^XPDUTL("Finished cleaning up broken pointers...")
+18 QUIT
