DG687PST ;BAY/JAT;cleanup of "AADA" crossref on file 45
;;5.3;Registration;**687*;Aug 13,1993
;
; This is a post-init routine for DG*5.3*687
; The purpose is to cleanup the "AADA" crossreference on field #70
; of the Patient Treatment file (#45). Any entries for which
; there is no PTF zero node is to be deleted.
;
EN ;
D BMES^XPDUTL("Deleting bogus ""AADA"" cross references")
N DGDTE,DGPTIEN,CNT
S DGDTE=0
S CNT=0
F S DGDTE=$O(^DGPT("AADA",DGDTE)) Q:'DGDTE D
.S DGPTIEN=0
.F S DGPTIEN=$O(^DGPT("AADA",DGDTE,DGPTIEN)) Q:'DGPTIEN D
..I '$D(^DGPT(DGPTIEN,0)) D
...S CNT=CNT+1
...K ^DGPT("AADA",DGDTE,DGPTIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG687PST 657 printed Sep 23, 2025@20:16:26 Page 2
DG687PST ;BAY/JAT;cleanup of "AADA" crossref on file 45
+1 ;;5.3;Registration;**687*;Aug 13,1993
+2 ;
+3 ; This is a post-init routine for DG*5.3*687
+4 ; The purpose is to cleanup the "AADA" crossreference on field #70
+5 ; of the Patient Treatment file (#45). Any entries for which
+6 ; there is no PTF zero node is to be deleted.
+7 ;
EN ;
+1 DO BMES^XPDUTL("Deleting bogus ""AADA"" cross references")
+2 NEW DGDTE,DGPTIEN,CNT
+3 SET DGDTE=0
+4 SET CNT=0
+5 FOR
SET DGDTE=$ORDER(^DGPT("AADA",DGDTE))
if 'DGDTE
QUIT
Begin DoDot:1
+6 SET DGPTIEN=0
+7 FOR
SET DGPTIEN=$ORDER(^DGPT("AADA",DGDTE,DGPTIEN))
if 'DGPTIEN
QUIT
Begin DoDot:2
+8 IF '$DATA(^DGPT(DGPTIEN,0))
Begin DoDot:3
+9 SET CNT=CNT+1
+10 KILL ^DGPT("AADA",DGDTE,DGPTIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
