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 ;
