SDRRDEL ;10N20/MAH;DELETE/EDIT RECALL REMINDERS ;01/18/2008
;;5.3;Scheduling;**536,571**;Aug 13, 1993;Build 3
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRDEL 1565 printed Dec 13, 2024@03:00:41 Page 2
SDRRDEL ;10N20/MAH;DELETE/EDIT RECALL REMINDERS ;01/18/2008
+1 ;;5.3;Scheduling;**536,571**;Aug 13, 1993;Build 3
+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
