AQAQDEL.m

AQAQDEL ;IHS/ANMC/LJF - DELETE ENTRY IN CREDENTIALS FILE; [ 10/01/91  9:46 AM ]

 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 ;

 W @IOF,!!?20,"DELETE ENTRY FROM CREDENTIALS FILE",!!

 W !?5,"WARNING!!! This option deletes an entry in the Credentials"

 W !?5,"file.  Only providers entered in error should be deleted!"

 W !?5,"Once a provider is no longer associated with your facility,"

 W !?5,"the entry should be inactivated.  To insure this, only entries"

 W !?5,"with no data beyond the provider's name can be deleted.",!!

 ;

PROV ;***>  select provider entry to be deleted

 K DIC S DIC("A")="Select PROVIDER NAME:  ",DIC(0)="AQEMZ",DIC=9002165

 D ^DIC G END:Y=-1 S AQAQPROV=Y

 ;

 ;***>  check for data in credentials files

 K ^UTILITY("DIQ1",$J)

 S (DIC,AQAQFILE)=9002165,DR=".02:.19;.31:4",DIQ(0)="N",DA=+AQAQPROV

 D EN^DIQ1

 I $D(^UTILITY("DIQ1",$J,AQAQFILE,DA)) W !!,*7,?5,"**DATA IN CREDENTIALS FILE FOR THIS PROVIDER!  CANNOT DELETE ENTRY!!**" G END

 I $D(^AQAQML("C",+AQAQPROV)) W !!,*7,?5,"**DATA IN MEDICAL LICENSURE FILE FOR THIS PROVIDER!  CANNOT DELETE ENTRY!!**" G END

 I $D(^AQAQMB("C",+AQAQPROV)) W !!,*7,?5,"**DATA IN BOARD CERTIFICATION FILE FOR THIS PROVIDER!  CANNOT DELETE ENTRY!!**" G END

 ;

 ;***>  ask again if want to delete entry

 K DIR S DIR(0)="Y",DIR("B")="NO"

 S DIR("A")="OKAY TO DELETE "_$P(^DIC(16,$P(AQAQPROV,U,2),0),U)_" ENTRY"

 D ^DIR G END:Y'=1

 ;

 ;***>  delete entry

 W !!,"DELETING ENTRY.........."

 S DIK="^AQAQC(",DA=+AQAQPROV D ^DIK

 W !!,"DELETION COMPLETED",!!

 ;

 ;***> eoj

END D KILL^AQAQUTIL K ^UTILITY("DIQ1",$J) Q

AQAQDEL   ;IHS/ANMC/LJF - DELETE ENTRY IN CREDENTIALS FILE; [ 10/01/91  9:46 AM ]

 +1       ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 +2       ;

 +3        WRITE @IOF,!!?20,"DELETE ENTRY FROM CREDENTIALS FILE",!!

 +4        WRITE !?5,"WARNING!!! This option deletes an entry in the Credentials"

 +5        WRITE !?5,"file.  Only providers entered in error should be deleted!"

 +6        WRITE !?5,"Once a provider is no longer associated with your facility,"

 +7        WRITE !?5,"the entry should be inactivated.  To insure this, only entries"

 +8        WRITE !?5,"with no data beyond the provider's name can be deleted.",!!

 +9       ;

PROV      ;***>  select provider entry to be deleted

 +1        KILL DIC

           SET DIC("A")="Select PROVIDER NAME:  "

           SET DIC(0)="AQEMZ"

           SET DIC=9002165

 +2        DO ^DIC

           IF Y=-1

               GOTO END

           SET AQAQPROV=Y

 +3       ;

 +4       ;***>  check for data in credentials files

 +5        KILL ^UTILITY("DIQ1",$JOB)

 +6        SET (DIC,AQAQFILE)=9002165

           SET DR=".02:.19;.31:4"

           SET DIQ(0)="N"

           SET DA=+AQAQPROV

 +7        DO EN^DIQ1

 +8        IF $DATA(^UTILITY("DIQ1",$JOB,AQAQFILE,DA))

               WRITE !!,*7,?5,"**DATA IN CREDENTIALS FILE FOR THIS PROVIDER!  CANNOT DELETE ENTRY!!**"

               GOTO END

 +9        IF $DATA(^AQAQML("C",+AQAQPROV))

               WRITE !!,*7,?5,"**DATA IN MEDICAL LICENSURE FILE FOR THIS PROVIDER!  CANNOT DELETE ENTRY!!**"

               GOTO END

 +10       IF $DATA(^AQAQMB("C",+AQAQPROV))

               WRITE !!,*7,?5,"**DATA IN BOARD CERTIFICATION FILE FOR THIS PROVIDER!  CANNOT DELETE ENTRY!!**"

               GOTO END

 +11      ;

 +12      ;***>  ask again if want to delete entry

 +13       KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +14       SET DIR("A")="OKAY TO DELETE "_$PIECE(^DIC(16,$PIECE(AQAQPROV,U,2),0),U)_" ENTRY"

 +15       DO ^DIR

           IF Y'=1

               GOTO END

 +16      ;

 +17      ;***>  delete entry

 +18       WRITE !!,"DELETING ENTRY.........."

 +19       SET DIK="^AQAQC("

           SET DA=+AQAQPROV

           DO ^DIK

 +20       WRITE !!,"DELETION COMPLETED",!!

 +21      ;

 +22      ;***> eoj

END        DO KILL^AQAQUTIL

           KILL ^UTILITY("DIQ1",$JOB)

           QUIT