SDRRDEL.m

SDRRDEL ;10N20/MAH;DELETE/EDIT RECALL REMINDERS ;01/18/2008

 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 ;;THIS ROUTINE WILL USE OPTION SDRR DELETE RECALL

 ;

EN S DIDEL=403.5,Q=0,(CLIN,CLINZ)=""  ;SD*571 added linetag EN

 S DIC=403.5,DIC(0)="AELM",DIC("A")="Select Clinic Recall Patient:  " D ^DIC  S Q=+Y I +Y<0 G EXIT

 I +Y>0 S CLIN=$P($G(^SD(403.5,+Y,0)),U,2) I $G(CLIN)]"" S CLINZ=$$GET1^DIQ(44,CLIN_",",.01)

 ;SD*571 added following logic to check if user has security key assigned to provider

 S (SDPRV,KEY,SDFLAG)="" S SDPRV=$P($G(^SD(403.5,+Y,0)),U,5) I SDPRV'="" S KEY=$P($G(^SD(403.54,SDPRV,0)),U,7) D

 .Q:KEY=""

 .N VALUE

 .S VALUE=$$LKUP^XPDKEY(KEY) K KY D OWNSKEY^XUSRB(.KY,VALUE,DUZ)

 .I $G(KY(0))=0 W !!,*7,?12,"THE PROVIDER ASSIGNED TO THIS RECALL REMINDER IS",!,?12,"ASSIGNED A SECURITY KEY WHICH YOU DO NOT HAVE.",!,?12,"PLEASE CONTACT YOUR RECALL COORDINATOR.",! R X:3 D EXIT S SDFLAG=1

 .Q

 I SDFLAG G EN

 ;

 I +Y>0 S DIR(0)="Y",DIR("A")="Are you sure you want to delete: "_$G(CLINZ),DIR("B")="NO" D ^DIR

 I Y'=1 G EXIT

 I Y=1 G KIL

 Q

KIL N SDRRFTR

 S Y=0

 K DIR

 S DIR(0)="SO^1:Failure to respond;2:Moved;3:Deceased;4:Doesn't want VA services;5:Received care at another VA;6:Other",DIR("A")="Reason for Removal" D ^DIR Q:$D(DIRUT) 

 I Y>0 S SDRRFTR=Y

 S DA=+Q S DIE="^SD(403.5,",DR="[SDRREMARKS]",DIE("NO^")="BACKOUTOK" D ^DIE

 S DIK="^SD(403.5,",DA=+Q D ^DIK

 W !!?20,"*** Now Deleting Patient Recall ***" H .5

EXIT ;

 K SDRRFTR,Q,DA,DIC,X,Y,DIDEL,DIC,DIK,DIR,CLIN,CLINZ,DIE,DR,DIRUT,KEY,SDPRV,SDFLAG

 Q

SDRRDEL   ;10N20/MAH;DELETE/EDIT RECALL REMINDERS ;01/18/2008

 +1       ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 +2       ;;THIS ROUTINE WILL USE OPTION SDRR DELETE RECALL

 +3       ;

EN        ;SD*571 added linetag EN

           SET DIDEL=403.5

           SET Q=0

           SET (CLIN,CLINZ)=""

 +1        SET DIC=403.5

           SET DIC(0)="AELM"

           SET DIC("A")="Select Clinic Recall Patient:  "

           DO ^DIC

           SET Q=+Y

           IF +Y<0

               GOTO EXIT

 +2        IF +Y>0

               SET CLIN=$PIECE($GET(^SD(403.5,+Y,0)),U,2)

               IF $GET(CLIN)]""

                   SET CLINZ=$$GET1^DIQ(44,CLIN_",",.01)

 +3       ;SD*571 added following logic to check if user has security key assigned to provider

 +4        SET (SDPRV,KEY,SDFLAG)=""

           SET SDPRV=$PIECE($GET(^SD(403.5,+Y,0)),U,5)

           IF SDPRV'=""

               SET KEY=$PIECE($GET(^SD(403.54,SDPRV,0)),U,7)

               Begin DoDot:1

 +5                IF KEY=""

                       QUIT 

 +6                NEW VALUE

 +7                SET VALUE=$$LKUP^XPDKEY(KEY)

                   KILL KY

                   DO OWNSKEY^XUSRB(.KY,VALUE,DUZ)

 +8                IF $GET(KY(0))=0

                       WRITE !!,*7,?12,"THE PROVIDER ASSIGNED TO THIS RECALL REMINDER IS",!,?12,"ASSIGNED A SECURITY KEY WHICH YOU DO NOT HAVE.",!,?12,"PLEASE CONTACT YOUR RECALL COORDINATOR.",!

                       READ X:3

                       DO EXIT

                       SET SDFLAG=1

 +9                QUIT 

               End DoDot:1

 +10       IF SDFLAG

               GOTO EN

 +11      ;

 +12       IF +Y>0

               SET DIR(0)="Y"

               SET DIR("A")="Are you sure you want to delete: "_$GET(CLINZ)

               SET DIR("B")="NO"

               DO ^DIR

 +13       IF Y'=1

               GOTO EXIT

 +14       IF Y=1

               GOTO KIL

 +15       QUIT 

KIL        NEW SDRRFTR

 +1        SET Y=0

 +2        KILL DIR

 +3        SET DIR(0)="SO^1:Failure to respond;2:Moved;3:Deceased;4:Doesn't want VA services;5:Received care at another VA;6:Other"

           SET DIR("A")="Reason for Removal"

           DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +4        IF Y>0

               SET SDRRFTR=Y

 +5        SET DA=+Q

           SET DIE="^SD(403.5,"

           SET DR="[SDRREMARKS]"

           SET DIE("NO^")="BACKOUTOK"

           DO ^DIE

 +6        SET DIK="^SD(403.5,"

           SET DA=+Q

           DO ^DIK

 +7        WRITE !!?20,"*** Now Deleting Patient Recall ***"

           HANG .5

EXIT      ;

 +1        KILL SDRRFTR,Q,DA,DIC,X,Y,DIDEL,DIC,DIK,DIR,CLIN,CLINZ,DIE,DR,DIRUT,KEY,SDPRV,SDFLAG

 +2        QUIT