BMCRDEL ; IHS/PHXAO/TMJ - REFERRAL DELETE ;
;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
;IHS/OIT/FCJ ADDED ABILITY TO DELETE SEC REF
;
PRIM ;FILTER FOR PRIMARY REFERRAL AND CLOSED
S DIC("S")="I $$FILTER^BMCFLTR(0,0,0)"
S DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "
S BMCTYPR="P"
REF ;REFERRAL DELETE
S DIC="^BMCREF(",DIC(0)="AEMQ"
D GETREF
I Y<1 W !!,"No REFERRAL selected!" D EOJ Q
I BMCTYPR="P",$D(^BMCREF("S",$P(^BMCREF(BMCRIEN,0),U,2))) D D EOJ Q
.W !!,"Primary Referral cannot be Deleted, because a Secondary Ref exists.",!
.S DIR(0)="E",DIR("A")="Press any key to continue" D ^DIR K DIR
D DSPLY
D DELETE
D EOJ
Q
SECREF ;EP; DELETE SECONDARY REFERRAL
S BMCTYPR="S"
S DIC="^BMCREF(",DIC(0)="AEMQ",DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"
S DIC("A")="Select Secondary RCIS REFERRAL by Patient or by Referral Date: "
G REF
Q
;
GETREF ; GET REFERRAL IEN - Do Not Display Closed Referrals
W !!
S BMCQ=1
D DIC^BMCFMC
Q:Y<1
S BMCRIEN=+Y
S BMCQ=0
Q
;
DSPLY ;
S BMCRDSP=BMCRIEN D START2^BMCRDSP
W !!,"THE ABOVE REFERRAL AND RELATED ENTRIES WILL BE REMOVED FOREVER !!!"
Q
;
DELETE ; DELETE VISIT AND RELATED V FILES
W !,"Sure you want to delete" S %=2 D YN^DICN S %Y=$E(%Y)
Q:"Nn"[%Y
S BMCRDLT=BMCRDSP D ^BMCRDLT
I $D(^BMCREF(BMCRDSP,0)) D MSG
Q
;
EOJ ; EOJ HOUSE KEEPING
K %,%DT,%X,%Y,C,DIYS,X,Y
K BMCTYPR,BMCRIEN,BMCRDSP,BMCRDLT
Q
;
MSG ;No Delete of Referral Message
W !!,?10,"The Selected Referral was NOT deleted.......",!,?10,"This Referral either contains required Contract Health Service Data!!",!
W ?10,"OR the Referral has been CLOSED & the PCC Visit Link Created!",!!
H 5 Q
Q
BMCRDEL ; IHS/PHXAO/TMJ - REFERRAL DELETE ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
+2 ;IHS/OIT/FCJ ADDED ABILITY TO DELETE SEC REF
+3 ;
PRIM ;FILTER FOR PRIMARY REFERRAL AND CLOSED
+1 SET DIC("S")="I $$FILTER^BMCFLTR(0,0,0)"
+2 SET DIC("A")="Select RCIS REFERRAL by Patient or by Referral Date or #: "
+3 SET BMCTYPR="P"
REF ;REFERRAL DELETE
+1 SET DIC="^BMCREF("
SET DIC(0)="AEMQ"
+2 DO GETREF
+3 IF Y<1
WRITE !!,"No REFERRAL selected!"
DO EOJ
QUIT
+4 IF BMCTYPR="P"
IF $DATA(^BMCREF("S",$PIECE(^BMCREF(BMCRIEN,0),U,2)))
Begin DoDot:1
+5 WRITE !!,"Primary Referral cannot be Deleted, because a Secondary Ref exists.",!
+6 SET DIR(0)="E"
SET DIR("A")="Press any key to continue"
DO ^DIR
KILL DIR
End DoDot:1
DO EOJ
QUIT
+7 DO DSPLY
+8 DO DELETE
+9 DO EOJ
+10 QUIT
SECREF ;EP; DELETE SECONDARY REFERRAL
+1 SET BMCTYPR="S"
+2 SET DIC="^BMCREF("
SET DIC(0)="AEMQ"
SET DIC("S")="I $$FILTER^BMCFLTR(0,0,1)"
+3 SET DIC("A")="Select Secondary RCIS REFERRAL by Patient or by Referral Date: "
+4 GOTO REF
+5 QUIT
+6 ;
GETREF ; GET REFERRAL IEN - Do Not Display Closed Referrals
+1 WRITE !!
+2 SET BMCQ=1
+3 DO DIC^BMCFMC
+4 IF Y<1
QUIT
+5 SET BMCRIEN=+Y
+6 SET BMCQ=0
+7 QUIT
+8 ;
DSPLY ;
+1 SET BMCRDSP=BMCRIEN
DO START2^BMCRDSP
+2 WRITE !!,"THE ABOVE REFERRAL AND RELATED ENTRIES WILL BE REMOVED FOREVER !!!"
+3 QUIT
+4 ;
DELETE ; DELETE VISIT AND RELATED V FILES
+1 WRITE !,"Sure you want to delete"
SET %=2
DO YN^DICN
SET %Y=$EXTRACT(%Y)
+2 IF "Nn"[%Y
QUIT
+3 SET BMCRDLT=BMCRDSP
DO ^BMCRDLT
+4 IF $DATA(^BMCREF(BMCRDSP,0))
DO MSG
+5 QUIT
+6 ;
EOJ ; EOJ HOUSE KEEPING
+1 KILL %,%DT,%X,%Y,C,DIYS,X,Y
+2 KILL BMCTYPR,BMCRIEN,BMCRDSP,BMCRDLT
+3 QUIT
+4 ;
MSG ;No Delete of Referral Message
+1 WRITE !!,?10,"The Selected Referral was NOT deleted.......",!,?10,"This Referral either contains required Contract Health Service Data!!",!
+2 WRITE ?10,"OR the Referral has been CLOSED & the PCC Visit Link Created!",!!
+3 HANG 5
QUIT
+4 QUIT