- 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
