source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRI16.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1SPNPRI16 ;SD/WDE/Pre init action for patch 16;11/1/2001
2 ;;2.0;Spinal Cord Dysfunction;**16**;01/02/97
3EN ;
4 ;--------------------------------------------------------------------
5154 ;remove data and fields in 154
6 W !,"Please stand by while I remove the obsolete data",!," and fields in the SCD (SPINAL CORD) REGISTRY file (#154)."
7 S SPNCNT=0
8 S SPNDFN=0 F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:(SPNDFN="")!('+SPNDFN) D
9 .S SPNCNT=SPNCNT+1 I SPNCNT#40=0 W "."
10 .I SPNCNT#610=0 W "Working"
11 .F SPNX=8.7,8.5,.04,9,2.3 D
12 ..S SPNCHK=$$GET1^DIQ(154,SPNDFN_",",SPNX)
13 ..I $L(SPNCHK)>0 S DA=SPNDFN,DIE="^SPNL(154,",DR=SPNX_"///@" D ^DIE
14 ..S SPNCHK=""
15 ..Q
16 .Q
17 ;now remove the fields in 154
18 K DA,DR,SPNX,DIE,SPNCHK,SPNDFN
19 F SPNX=8.7,8.5,.04,9,2.3 D
20 .S DA=SPNX,DA(1)=154,DIK="^DD(154," D ^DIK
21 K DIK,DA,DR,SPNX,SPNCHK
22 ;--------------------------------------------------------------------
231541 ;remove data and fields in 154.1
24 W !,"Please stand by while I remove the obsolete data",!," and fields in the OUTCOMES file (#154.1)."
25 S SPNIEN=0 F S SPNIEN=$O(^SPNL(154.1,SPNIEN)) Q:(SPNIEN="")!('+SPNIEN) D
26 .S SPNCNT=SPNCNT+1 I SPNCNT#40=0 W "."
27 .I SPNCNT#610=0 W "Working"
28 .F SPNX=2.1,2.11,2.12,9 D
29 ..S SPNCHK=$$GET1^DIQ(154.1,SPNIEN_",",SPNX)
30 ..I $L(SPNCHK)>0 S DA=SPNIEN,DIE="^SPNL(154.1,",DR=SPNX_"///@" D ^DIE
31 ..Q
32 .Q
33 K DA,DR,SPNX,DIE,SPNCHK,SPNIEN
34 ;remove the fields now in 154.1
35 F SPNX=2.1,2.11,2.12,9 D
36 .S DA=SPNX,DA(1)=154.1,DIK="^DD(154.1," D ^DIK
37 K DIK,DA,DR,SPNX,SPNCHK
38 ;----------------------------------------------------------------------
3915491 ;remove data and fields from file 154.91
40 W !,"Please stand by while I remove the obsolete data",!," and fields in the SCD SITE PARAMETERS file (#154.91)"
41 S SPNIEN=0 F S SPNIEN=$O(^SPNL(154.91,SPNIEN)) Q:(SPNIEN="")!('+SPNIEN) D
42 .S SPNCNT=SPNCNT+1 I SPNCNT#40=0 W "."
43 .I SPNCNT#610=0 W "Working"
44 .F SPNX=1,2,3 D
45 ..S SPNCHK=$$GET1^DIQ(154.91,SPNIEN_",",SPNX)
46 ..I $L(SPNCHK)>0 S DA=SPNIEN,DIE="^SPNL(154.91,",DR=SPNX_"///@" D ^DIE
47 ..Q
48 K DA,DR,SPNX,DIE,SPNCHK,SPNIEN
49 ;remove the fields IN 154.91
50 F SPNX=1,2,3 D
51 .S DA=SPNX,DA(1)=154.91,DIK="^DD(154.91," D ^DIK
52 K DIK,DA,DR,SPNX,SPNCHK,SPNIEN
53 ;----------------------------------------------------------------------
5415493 ;remove data and fields and file 154.93
55 W !,"Please stand by while I remove the obsolete data",!," and the file CURRENT TRANSMISSION CYCLE (#154.93)."
56 S DIU="^SPNL(154.93,",DIU(0)="DST" D EN^DIU2
57 K DIU
58 ;----------------------------------------------------------------------
5915494 ;remove data and fields and file 154.94
60 W !,"Please stand by while I remove the obsolete data",!," and the file TRANSMISSION CYCLE HISTORY (#154.94)."
61 S DIU="^SPNL(154.94,",DIU(0)="DST" D EN^DIU2
62 K DIU
63 ;----------------------------------------------------------------------
641549 ;remove data and fields and file 154.9
65 W !,"Please stand by while I remove the obsolete data",!," and the file PATIENT TRANSMISSION STATUS (#154.9)."
66 S DIU="^SPNL(154.9,",DIU(0)="DST" D EN^DIU2
67 K DIU
68 K DIE,DA,DR,SPNX,SPNIEN,SPNCHK
69 Q
Note: See TracBrowser for help on using the repository browser.