EDPBDL ;SLC/KCM - Delete/Inactivate Config Entries ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
BED ; Delete Room/Area entries
N AREA,IEN
D SETAREA(.AREA) Q:'AREA
W !,"EDIS Delete Room-Bed Tool",!
W !,"This will delete or inactivate an entry from the TRACKING ROOM-BED file."
W !,"This may take time, as it must search for usage of the Room-Bed entry."
W !,"If the entry has been referenced, it will be inactivated."
W !,"Otherwise the entry will be deleted.",!
F S IEN=$$LKBED(AREA) Q:'IEN D DELBED(IEN)
Q
LKBED(AREA) ; Lookup a bed
N DIC,X,Y,DTOUT,DUOUT
S DIC="^EDPB(231.8,",DIC(0)="AEMQ"
S DIC("S")="I ($P(^(0),U,2)=DUZ(2)),($P(^(0),U,3)=AREA)"
D ^DIC
Q:+Y>0 +Y
Q ""
;
DELBED(IEN) ; Delete bed if nothing references it, otherwise inactivate
N NM,DA,DIE,DR,DIK,DTOUT,DUOUT
S NM=$P($G(^EDPB(231.8,IEN,0)),U)
I $$BEDUSED(IEN) D
. S DA=IEN,DR=".01///Z"_NM_";.04///1",DIE="^EDPB(231.8,"
. D ^DIE W !,NM," inactivated and renamed 'Z"_NM_"'.",!
E D
. S DA=IEN,DIK="^EDPB(231.8," D ^DIK
. W !,$S($D(^EDPB(231.8,DA,0)):" not",1:"")_" deleted.",!
Q
BEDUSED(IEN) ; Return true if log entry references bed
W !,"Searching for usages of ",$P(^EDPB(231.8,IEN,0),U)
N I,FOUND,COUNT
S I=0,FOUND=0,COUNT=0
F S I=$O(^EDP(230.1,I)) Q:'I D Q:FOUND
. I $P($G(^EDP(230.1,I,3)),U,4)=IEN W "...found" S FOUND=1
. S COUNT=COUNT+1 I COUNT#100=0 W "."
Q FOUND
BOARD ; Delete Board entries
Q
CODE ; Delete Selection entries
N AREA,SET
D SETAREA(.AREA) Q:'AREA
W !,"EDIS Delete Selection Tool",!
W !,"This will delete a locally defined selection from"
W !,"an EDIS selection list.",!
S SET=$$LKSEL(AREA) Q:'SET
;
N DIC,X,Y,X0,NM,DTOUT,DUOUT
S DIC="^EDPB(233.2,"_SET_",1,",DIC(0)="AEMQ"
S DIC("W")="W $P(^(0),U,4)"
D ^DIC
Q:Y<1
S X0=^EDPB(233.2,SET,1,+Y,0),NM=$P(^EDPB(233.1,+$P(X0,U,2),0),U)
I $E(NM,1,3)="edp" W !,"Cannot delete nationally defined item." Q
D DELCODE(SET,+Y)
Q
LKSEL(AREA) ; Choose selection list for deletion
N DIR,X,Y,DTOUT,DUOUT,DIRUT
S DIR(0)="SABO^1:Status;2:Disposition;3:Delay Reason;4:Source"
S DIR("A")="Selection List (1/2/3/4):"
S DIR("A",1)="Choose the list you with to delete from -"
S DIR("A",2)="1: Status",DIR("A",3)="2: Disposition"
S DIR("A",4)="3: Delay Reason",DIR("A",5)="4: Source"
D ^DIR
Q:'Y ""
;
N SETNM,IEN
S SETNM=$S(1:".status",2:".disposition",3:".delay",4:".arrival",1:"")
Q:SETNM="" ""
S SETNM=$$STA^XUAF4(DUZ(2))_SETNM
S IEN=$O(^EDPB(233.2,"B",SETNM,0))
I 'IEN W !,"No locally defined selections found." Q ""
Q IEN
;
DELCODE(SET,DA) ; Delete from inside selection multiple
N DIK
W !,$P(^EDPB(233.2,SET,1,DA,0),U,4)
S DIK="^EDPB(233.2,"_SET_",1,",DA(1)=SET D ^DIK
W " ",$S($D(^EDPB(233.2,SET,1,DA,0)):" not",1:"")," deleted",!
Q
;
SETAREA(AREA) ; Set to default area for institution in DUZ(2)
S AREA=$O(^EDPB(231.9,"C",DUZ(2),0))
I 'AREA W !,"No tracking area is configured."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBDL 2998 printed Dec 13, 2024@01:51:31 Page 2
EDPBDL ;SLC/KCM - Delete/Inactivate Config Entries ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
BED ; Delete Room/Area entries
+1 NEW AREA,IEN
+2 DO SETAREA(.AREA)
if 'AREA
QUIT
+3 WRITE !,"EDIS Delete Room-Bed Tool",!
+4 WRITE !,"This will delete or inactivate an entry from the TRACKING ROOM-BED file."
+5 WRITE !,"This may take time, as it must search for usage of the Room-Bed entry."
+6 WRITE !,"If the entry has been referenced, it will be inactivated."
+7 WRITE !,"Otherwise the entry will be deleted.",!
+8 FOR
SET IEN=$$LKBED(AREA)
if 'IEN
QUIT
DO DELBED(IEN)
+9 QUIT
LKBED(AREA) ; Lookup a bed
+1 NEW DIC,X,Y,DTOUT,DUOUT
+2 SET DIC="^EDPB(231.8,"
SET DIC(0)="AEMQ"
+3 SET DIC("S")="I ($P(^(0),U,2)=DUZ(2)),($P(^(0),U,3)=AREA)"
+4 DO ^DIC
+5 if +Y>0
QUIT +Y
+6 QUIT ""
+7 ;
DELBED(IEN) ; Delete bed if nothing references it, otherwise inactivate
+1 NEW NM,DA,DIE,DR,DIK,DTOUT,DUOUT
+2 SET NM=$PIECE($GET(^EDPB(231.8,IEN,0)),U)
+3 IF $$BEDUSED(IEN)
Begin DoDot:1
+4 SET DA=IEN
SET DR=".01///Z"_NM_";.04///1"
SET DIE="^EDPB(231.8,"
+5 DO ^DIE
WRITE !,NM," inactivated and renamed 'Z"_NM_"'.",!
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET DA=IEN
SET DIK="^EDPB(231.8,"
DO ^DIK
+8 WRITE !,$SELECT($DATA(^EDPB(231.8,DA,0)):" not",1:"")_" deleted.",!
End DoDot:1
+9 QUIT
BEDUSED(IEN) ; Return true if log entry references bed
+1 WRITE !,"Searching for usages of ",$PIECE(^EDPB(231.8,IEN,0),U)
+2 NEW I,FOUND,COUNT
+3 SET I=0
SET FOUND=0
SET COUNT=0
+4 FOR
SET I=$ORDER(^EDP(230.1,I))
if 'I
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^EDP(230.1,I,3)),U,4)=IEN
WRITE "...found"
SET FOUND=1
+6 SET COUNT=COUNT+1
IF COUNT#100=0
WRITE "."
End DoDot:1
if FOUND
QUIT
+7 QUIT FOUND
BOARD ; Delete Board entries
+1 QUIT
CODE ; Delete Selection entries
+1 NEW AREA,SET
+2 DO SETAREA(.AREA)
if 'AREA
QUIT
+3 WRITE !,"EDIS Delete Selection Tool",!
+4 WRITE !,"This will delete a locally defined selection from"
+5 WRITE !,"an EDIS selection list.",!
+6 SET SET=$$LKSEL(AREA)
if 'SET
QUIT
+7 ;
+8 NEW DIC,X,Y,X0,NM,DTOUT,DUOUT
+9 SET DIC="^EDPB(233.2,"_SET_",1,"
SET DIC(0)="AEMQ"
+10 SET DIC("W")="W $P(^(0),U,4)"
+11 DO ^DIC
+12 if Y<1
QUIT
+13 SET X0=^EDPB(233.2,SET,1,+Y,0)
SET NM=$PIECE(^EDPB(233.1,+$PIECE(X0,U,2),0),U)
+14 IF $EXTRACT(NM,1,3)="edp"
WRITE !,"Cannot delete nationally defined item."
QUIT
+15 DO DELCODE(SET,+Y)
+16 QUIT
LKSEL(AREA) ; Choose selection list for deletion
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT
+2 SET DIR(0)="SABO^1:Status;2:Disposition;3:Delay Reason;4:Source"
+3 SET DIR("A")="Selection List (1/2/3/4):"
+4 SET DIR("A",1)="Choose the list you with to delete from -"
+5 SET DIR("A",2)="1: Status"
SET DIR("A",3)="2: Disposition"
+6 SET DIR("A",4)="3: Delay Reason"
SET DIR("A",5)="4: Source"
+7 DO ^DIR
+8 if 'Y
QUIT ""
+9 ;
+10 NEW SETNM,IEN
+11 SET SETNM=$SELECT(1:".status",2:".disposition",3:".delay",4:".arrival",1:"")
+12 if SETNM=""
QUIT ""
+13 SET SETNM=$$STA^XUAF4(DUZ(2))_SETNM
+14 SET IEN=$ORDER(^EDPB(233.2,"B",SETNM,0))
+15 IF 'IEN
WRITE !,"No locally defined selections found."
QUIT ""
+16 QUIT IEN
+17 ;
DELCODE(SET,DA) ; Delete from inside selection multiple
+1 NEW DIK
+2 WRITE !,$PIECE(^EDPB(233.2,SET,1,DA,0),U,4)
+3 SET DIK="^EDPB(233.2,"_SET_",1,"
SET DA(1)=SET
DO ^DIK
+4 WRITE " ",$SELECT($DATA(^EDPB(233.2,SET,1,DA,0)):" not",1:"")," deleted",!
+5 QUIT
+6 ;
SETAREA(AREA) ; Set to default area for institution in DUZ(2)
+1 SET AREA=$ORDER(^EDPB(231.9,"C",DUZ(2),0))
+2 IF 'AREA
WRITE !,"No tracking area is configured."
+3 QUIT
