source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRDEL.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1IMRDEL ;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
11EN(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 ;
24EXIT 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
Note: See TracBrowser for help on using the repository browser.