| [613] | 1 | IMRDEL ;ISC-SF/JLI,HCIOFO/FT-DELETE AN ENTRY FROM FILE 158 ;5/15/98 15:40
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**2**;Feb 09, 1998
|
|---|
| 3 | ;[IMR DELETE ENTRY] - Delete an Entry from the Case Study File
|
|---|
| 4 | I '$D(^XUSEC("IMRMGR",DUZ)) S IMRLOC="IMRDEL" D ACESSERR^IMRERR D H^XUS K IMRLOC
|
|---|
| 5 | W !,$C(7),"BE ABSOLUTELY SURE BEFORE USING THIS OPTION -- IT WILL DELETE ALL DATA",!,"FOR THE SPECIFIED INDIVIDUAL FROM THE IMMUNOLOGY CASE FILE",!
|
|---|
| 6 | S IMRNEW=0 D ASK^IMREDIT G:DA'>0 EXIT
|
|---|
| 7 | R !!,"ARE YOU ABSOLUTELY SURE? N// ",X:DTIME G:"Yy"'[$E(X_".") EXIT
|
|---|
| 8 | D EN(DA,+Y)
|
|---|
| 9 | D EXIT
|
|---|
| 10 | Q
|
|---|
| 11 | EN(DA,IMRP103) ;Removes entry and sends message to the national data set.
|
|---|
| 12 | D:'$D(IMRSTN) IMROPN^IMRXOR
|
|---|
| 13 | 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
|
|---|
| 14 | D XOR^IMRXOR S IMRPAT=X
|
|---|
| 15 | D DOMAIN^IMRUTL ;get the domain name for ICR
|
|---|
| 16 | S IMRDOMN="S.IMRHDATA@"_IMRDOMN ;append domain to server name
|
|---|
| 17 | S X=10987654321 D XOR^IMRXOR S IMRCODE="START"_U_IMRSTN_U_DT_U_"1"_U_X
|
|---|
| 18 | K IMRTEXT
|
|---|
| 19 | S IMRTEXT(1)=IMRCODE,IMRTEXT(2)="PA"_U_IMRPAT,^(3)="DELETED",XMY(IMRDOMN)="",XMTEXT="IMRTEXT(",XMSUB="IMMUNOLOGY DATA "_IMRSTN_" DELETION"
|
|---|
| 20 | D ^XMD
|
|---|
| 21 | K XMDUZ,XMTEXT,XMSUB,XMY
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | 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
|
|---|
| 25 | Q
|
|---|
