source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAIPRE1.m@ 728

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1RAIPRE1 ;HIRMFO/GJC- Pre-init routine ;4/19/97 12:05
2VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4EN1 ; Delete the Stop Codes multiple (field: 160 <|> sub-file: 71.06)
5 ; and associated data from the Rad/Nuc Med Procedures file (71).
6 Q:'($D(^DD(71.06,0))#2) ; has been deleted in the past!
7 N DIC,DIU,RATXT S RATXT(1)=" "
8 S RATXT(2)="Deleting obsolete Stop Codes multiple from Rad/Nuc Med Procedures"
9 S RATXT(3)="data dictionary. Deleting Stop Code data from the Rad/Nuc Med"
10 S RATXT(4)="Procedures file. Please be patient, this may take a while."
11 D BMES^XPDUTL(.RATXT)
12 S DIU=71.06,DIU(0)="DS" D EN^DIU2
13 Q
14EN2 ; Delete the Principal Clinic field from the Imaging Locations file.
15 Q:'($D(^DD(79.1,75,0))#2) ; has been deleted in the past
16 N %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAPC,RATXT,X,Y
17 S RATXT(1)=" ",RAD0=0,RADD=79.1,RAFLD=75
18 S RATXT(2)="Deleting obsolete Principal Clinic field from Imaging Locations data"
19 S RATXT(3)="dictionary. Deleting Principal Clinic data from the "
20 S RATXT(3)=$G(RATXT(3))_"Imaging Locations file."
21 D BMES^XPDUTL(.RATXT)
22 F S RAD0=$O(^RA(79.1,RAD0)) Q:RAD0'>0 D
23 . S RAPC=$P($G(^RA(79.1,RAD0,"PC")),"^")
24 . D:RAPC]"" ENKILL^RAXREF(RADD,RAFLD,RAPC,.RAD0)
25 . K ^RA(79.1,RAD0,"PC") ; delete the data node!
26 . Q
27 S DIK="^DD(79.1,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
28 Q
29EN4 ; Delete the Common Procedure Group field from the Rad/Nuc Med
30 ; Common Procedure data dictionary. Delete Common Procedure
31 ; Group data from the Rad/Nuc Med Common Procedure file.
32 Q:'($D(^DD(71.3,2,0))#2) ; deleted in the past.
33 N %,DA,DIC,DIK,RACPG,RAD0,RADD,RAFLD,RATXT,X,Y
34 S RATXT(1)=" ",RAD0=0,RADD=71.3,RAFLD=2
35 S RATXT(2)="Deleting obsolete Common Procedure Group field from Rad/Nuc Med"
36 S RATXT(3)="Common Procedure data dictionary. Deleting Common Procedure"
37 S RATXT(4)="Group data from the Rad/Nuc Med Common Procedure file."
38 D BMES^XPDUTL(.RATXT)
39 F S RAD0=$O(^RAMIS(RADD,RAD0)) Q:RAD0'>0 D
40 . S RACPG=$P($G(^RAMIS(RADD,RAD0,0)),"^",3)
41 . D:RACPG]"" ENKILL^RAXREF(RADD,RAFLD,RACPG,.RAD0)
42 . S:RACPG]"" $P(^RAMIS(RADD,RAD0,0),"^",3)=""
43 . Q
44 S DIK="^DD(71.3,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
45 Q
46EN10 ; Delete the Input Devices multiple (field: 50 <|> sub-file: 79.11)
47 ; and associated data from the Imaging Locations file (79.1).
48 Q:'($D(^DD(79.11,0))#2) ; has been deleted in the past!
49 N DIC,DIU,RATXT S RATXT(1)=" "
50 S RATXT(2)="Deleting obsolete Input Devices multiple from Imaging Locations"
51 S RATXT(3)="data dictionary. Deleting Imaging Devices data from the"
52 S RATXT(4)="Imaging Locations file."
53 D BMES^XPDUTL(.RATXT)
54 S DIU=79.11,DIU(0)="DS" D EN^DIU2
55 K ^RA(79.1,"AD") ; delete the file-wide xref DIU2 misses!
56 Q
57EN11 ; Delete the Device Assignment Explanation word processing field (75)
58 ; from the Imaging Type file (79.2). All associated data will be
59 ; deleted
60 Q:'($D(^DD(79.22,0))#2) ; has been deleted in the past!
61 N DIC,DIU,RATXT S RATXT(1)=" "
62 S RATXT(2)="Deleting obsolete Device Assignment Explanation word processing field"
63 S RATXT(3)="from Imaging Type data dictionary. Deleting Device Assignment"
64 S RATXT(4)="Explanation data from the Imaging type file."
65 D BMES^XPDUTL(.RATXT)
66 S DIU=79.22,DIU(0)="DS" D EN^DIU2
67 Q
Note: See TracBrowser for help on using the repository browser.