Routine: EDPBDL

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)

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.",!

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

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)

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",!

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."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBDL   2998     printed  Mar 13, 2025@20:56:13                                                                                                                                                                                                      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

EDPBDL.m