- DG687PST ;BAY/JAT;cleanup of "AADA" crossref on file 45
- ;;5.3;Registration;**68,1015**;Aug 13,1993;Build 21
- ;
- ; 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
- DG687PST ;BAY/JAT;cleanup of "AADA" crossref on file 45
- +1 ;;5.3;Registration;**68,1015**;Aug 13,1993;Build 21
- +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