- BSDSCDUP ;ihs/cmi/maw - BSD Find Duplicate Appointment entries caused by auto rebook and clean them up
- ;;5.3;Scheduling;**1016**;Nov 07,2012;Build 20
- ;
- ;
- MAIN ;EP -- main routine entry point
- D END
- D LOOP
- D CLEAN
- D SCUP
- D END
- Q
- ;
- LOOP ;-- loop through the hospital location file and find duplicates
- N BDA,BIEN,BOEN,PAT
- S CNT=0
- S BDA=0 F S BDA=$O(^SC(BDA)) Q:'BDA D
- . S BIEN=3120901 F S BIEN=$O(^SC(BDA,"S",BIEN)) Q:'BIEN D
- .. S BOEN=0 F S BOEN=$O(^SC(BDA,"S",BIEN,1,BOEN)) Q:'BOEN D
- ... S PAT=+$P($G(^SC(BDA,"S",BIEN,1,BOEN,0)),U)
- ... Q:'PAT
- ... S:'$D(^MAW($J,BDA,BIEN,PAT)) ^MAW($J,BDA,BIEN,PAT)=0
- ... S ^MAW($J,BDA,BIEN,PAT)=^MAW($J,BDA,BIEN,PAT)+1
- Q
- ;
- CLEAN ;-- clean up entries that have only one
- N TDA,TIEN,TPAT
- S TDA=0 F S TDA=$O(^MAW($J,TDA)) Q:'TDA D
- . S TIEN=0 F S TIEN=$O(^MAW($J,TDA,TIEN)) Q:'TIEN D
- .. S TPAT=0 F S TPAT=$O(^MAW($J,TDA,TIEN,TPAT)) Q:'TPAT D
- ... I $G(^MAW($J,TDA,TIEN,TPAT))<2 K ^MAW($J,TDA,TIEN,TPAT)
- Q
- ;
- SCUP ;-- now go back through the hospital location file and cleanup duplicate entries
- W !,"Cleaning up duplicate entries caused by auto rebook"
- N SDA,SIEN,SPAT,SOEN
- S SDA=0 F S SDA=$O(^MAW($J,SDA)) Q:'SDA D
- . S SIEN=0 F S SIEN=$O(^MAW($J,SDA,SIEN)) Q:'SIEN D
- .. S SPAT=0 F S SPAT=$O(^MAW($J,SDA,SIEN,SPAT)) Q:'SPAT D
- ... S SOEN=0 F S SOEN=$O(^SC(SDA,"S",SIEN,1,SOEN)) Q:'SOEN D
- .... I $P($G(^SC(SDA,"S",SIEN,1,SOEN,0)),U)=SPAT D
- ..... I $L($P($G(^SC(SDA,"S",SIEN,1,SOEN,0)),U,7))=7 W "." K ^SC(SDA,"S",SIEN,1,SOEN,0)
- Q
- ;
- END ;-- cleanup variables and quit
- K ^MAW($J)
- Q
- ;
- BSDSCDUP ;ihs/cmi/maw - BSD Find Duplicate Appointment entries caused by auto rebook and clean them up
- +1 ;;5.3;Scheduling;**1016**;Nov 07,2012;Build 20
- +2 ;
- +3 ;
- MAIN ;EP -- main routine entry point
- +1 DO END
- +2 DO LOOP
- +3 DO CLEAN
- +4 DO SCUP
- +5 DO END
- +6 QUIT
- +7 ;
- LOOP ;-- loop through the hospital location file and find duplicates
- +1 NEW BDA,BIEN,BOEN,PAT
- +2 SET CNT=0
- +3 SET BDA=0
- FOR
- SET BDA=$ORDER(^SC(BDA))
- IF 'BDA
- QUIT
- Begin DoDot:1
- +4 SET BIEN=3120901
- FOR
- SET BIEN=$ORDER(^SC(BDA,"S",BIEN))
- IF 'BIEN
- QUIT
- Begin DoDot:2
- +5 SET BOEN=0
- FOR
- SET BOEN=$ORDER(^SC(BDA,"S",BIEN,1,BOEN))
- IF 'BOEN
- QUIT
- Begin DoDot:3
- +6 SET PAT=+$PIECE($GET(^SC(BDA,"S",BIEN,1,BOEN,0)),U)
- +7 IF 'PAT
- QUIT
- +8 IF '$DATA(^MAW($JOB,BDA,BIEN,PAT))
- SET ^MAW($JOB,BDA,BIEN,PAT)=0
- +9 SET ^MAW($JOB,BDA,BIEN,PAT)=^MAW($JOB,BDA,BIEN,PAT)+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- CLEAN ;-- clean up entries that have only one
- +1 NEW TDA,TIEN,TPAT
- +2 SET TDA=0
- FOR
- SET TDA=$ORDER(^MAW($JOB,TDA))
- IF 'TDA
- QUIT
- Begin DoDot:1
- +3 SET TIEN=0
- FOR
- SET TIEN=$ORDER(^MAW($JOB,TDA,TIEN))
- IF 'TIEN
- QUIT
- Begin DoDot:2
- +4 SET TPAT=0
- FOR
- SET TPAT=$ORDER(^MAW($JOB,TDA,TIEN,TPAT))
- IF 'TPAT
- QUIT
- Begin DoDot:3
- +5 IF $GET(^MAW($JOB,TDA,TIEN,TPAT))<2
- KILL ^MAW($JOB,TDA,TIEN,TPAT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 QUIT
- +7 ;
- SCUP ;-- now go back through the hospital location file and cleanup duplicate entries
- +1 WRITE !,"Cleaning up duplicate entries caused by auto rebook"
- +2 NEW SDA,SIEN,SPAT,SOEN
- +3 SET SDA=0
- FOR
- SET SDA=$ORDER(^MAW($JOB,SDA))
- IF 'SDA
- QUIT
- Begin DoDot:1
- +4 SET SIEN=0
- FOR
- SET SIEN=$ORDER(^MAW($JOB,SDA,SIEN))
- IF 'SIEN
- QUIT
- Begin DoDot:2
- +5 SET SPAT=0
- FOR
- SET SPAT=$ORDER(^MAW($JOB,SDA,SIEN,SPAT))
- IF 'SPAT
- QUIT
- Begin DoDot:3
- +6 SET SOEN=0
- FOR
- SET SOEN=$ORDER(^SC(SDA,"S",SIEN,1,SOEN))
- IF 'SOEN
- QUIT
- Begin DoDot:4
- +7 IF $PIECE($GET(^SC(SDA,"S",SIEN,1,SOEN,0)),U)=SPAT
- Begin DoDot:5
- +8 IF $LENGTH($PIECE($GET(^SC(SDA,"S",SIEN,1,SOEN,0)),U,7))=7
- WRITE "."
- KILL ^SC(SDA,"S",SIEN,1,SOEN,0)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- END ;-- cleanup variables and quit
- +1 KILL ^MAW($JOB)
- +2 QUIT
- +3 ;
