IMRDEL ;ISC-SF/JLI,HCIOFO/FT-DELETE AN ENTRY FROM FILE 158 ;5/15/98  15:40
 ;;2.1;IMMUNOLOGY CASE REGISTRY;**2**;Feb 09, 1998
 ;[IMR DELETE ENTRY] - Delete an Entry from the Case Study File
 I '$D(^XUSEC("IMRMGR",DUZ)) S IMRLOC="IMRDEL" D ACESSERR^IMRERR D H^XUS K IMRLOC
 W !,$C(7),"BE ABSOLUTELY SURE BEFORE USING THIS OPTION -- IT WILL DELETE ALL DATA",!,"FOR THE SPECIFIED INDIVIDUAL FROM THE IMMUNOLOGY CASE FILE",!
 S IMRNEW=0 D ASK^IMREDIT G:DA'>0 EXIT
 R !!,"ARE YOU ABSOLUTELY SURE? N// ",X:DTIME G:"Yy"'[$E(X_".") EXIT
 D EN(DA,+Y)
 D EXIT
 Q
EN(DA,IMRP103) ;Removes entry and sends message to the national data set.
 D:'$D(IMRSTN) IMROPN^IMRXOR
 S DIK="^IMR(158," D ^DIK K DIK S DFN=IMRP103 D DEM^VADPT K DFN S X=$P(VADM(2),U) K VA,VADM
 D XOR^IMRXOR S IMRPAT=X
 D DOMAIN^IMRUTL ;get the domain name for ICR
 S IMRDOMN="S.IMRHDATA@"_IMRDOMN ;append domain to server name
 S X=10987654321 D XOR^IMRXOR S IMRCODE="START"_U_IMRSTN_U_DT_U_"1"_U_X
 K IMRTEXT
 S IMRTEXT(1)=IMRCODE,IMRTEXT(2)="PA"_U_IMRPAT,^(3)="DELETED",XMY(IMRDOMN)="",XMTEXT="IMRTEXT(",XMSUB="IMMUNOLOGY DATA "_IMRSTN_" DELETION"
 D ^XMD
 K XMDUZ,XMTEXT,XMSUB,XMY
 Q
 ;
EXIT K IMRP103,IMRPAT,IMRSTN,DA,IMRCODE,IMRDOMN,IMRNEW,IMRTEXT,X,Y,%,%Y,C,DD,DFN,DGA1,DGT,DIC,DIPGM,DISYS,DIX,DIY,DZ,POP,VAERR,XCNP,XMZ
 Q