- 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 Jan 18, 2025@03:40:03 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