source: FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAIPRE2.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1RAIPRE2 ;HIRMFO/GJC- Pre-init routine ;10/23/97 09:30
2VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4EN1 ; Delete the Allow 'VA' Patient Entry field from the Rad/Nuc Med
5 ; Division data dictionary. Delete Allow 'VA' Patient Entry data
6 ; from the Rad/Nuc Med Division file.
7 Q:'($D(^DD(79,.13,0))#2) ; deleted in the past.
8 N %,DA,DIC,DIK,RALL,RAD0,RADD,RAFLD,RATXT,X,Y
9 S RATXT(1)=" ",RAD0=0,RADD=79,RAFLD=.13
10 S RATXT(2)="Deleting obsolete Allow 'VA' Patient Entry field from Rad/"
11 S RATXT(3)="Nuc Med Division data dictionary. Deleting Allow 'VA'"
12 S RATXT(4)="Patient Entry data from the Rad/Nuc Med Division file."
13 D BMES^XPDUTL(.RATXT)
14 F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
15 . S RALL=$P($G(^RA(79,RAD0,.1)),"^",3)
16 . D:RALL]"" ENKILL^RAXREF(RADD,RAFLD,RALL,.RAD0)
17 . S:RALL]"" $P(^RA(79,RAD0,.1),"^",3)=""
18 . Q
19 S DIK="^DD(79,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
20 Q
21EN2 ; Delete the Allow 'NON-VA' Patient Entry field from the Rad/Nuc Med
22 ; Division data dictionary. Delete Allow 'NON-VA' Patient Entry data
23 ; from the Rad/Nuc Med Division file.
24 Q:'($D(^DD(79,.14,0))#2) ; deleted in the past.
25 N %,DA,DIC,DIK,RALLN,RAD0,RADD,RAFLD,RATXT,X,Y
26 S RATXT(1)=" ",RAD0=0,RADD=79,RAFLD=.14
27 S RATXT(2)="Deleting obsolete Allow 'NON-VA' Patient Entry field from"
28 S RATXT(3)="Rad/Nuc Med Division data dictionary. Deleting Allow 'NON-"
29 S RATXT(4)="VA' Patient Entry data from the Rad/Nuc Med Division file."
30 D BMES^XPDUTL(.RATXT)
31 F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
32 . S RALLN=$P($G(^RA(79,RAD0,.1)),"^",4)
33 . D:RALLN]"" ENKILL^RAXREF(RADD,RAFLD,RALLN,.RAD0)
34 . S:RALLN]"" $P(^RA(79,RAD0,.1),"^",4)=""
35 . Q
36 S DIK="^DD(79,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
37 Q
38EN3 ; Delete the Ask 'Requesting Physician' field from the Rad/Nuc Med
39 ; Division data dictionary. Delete Ask 'Requesting Physician' data
40 ; from the Rad/Nuc Med Division file.
41 Q:'($D(^DD(79,.15,0))#2) ; deleted in the past.
42 N %,DA,DIC,DIK,RAD0,RADD,RAFLD,RAREQ,RATXT,X,Y
43 S RATXT(1)=" ",RAD0=0,RADD=79,RAFLD=.15
44 S RATXT(2)="Deleting obsolete Ask 'Requesting Physician' field from"
45 S RATXT(3)="Rad/Nuc Med Division data dictionary. Deleting Ask 'Requ-"
46 S RATXT(4)="esting Physician' data from the Rad/Nuc Med Division file."
47 D BMES^XPDUTL(.RATXT)
48 F S RAD0=$O(^RA(79,RAD0)) Q:RAD0'>0 D
49 . S RAREQ=$P($G(^RA(79,RAD0,.1)),"^",5)
50 . D:RAREQ]"" ENKILL^RAXREF(RADD,RAFLD,RAREQ,.RAD0)
51 . S:RAREQ]"" $P(^RA(79,RAD0,.1),"^",5)=""
52 . Q
53 S DIK="^DD(79,",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field from DD!
54 Q
55EN4 ; Delete the following fields from the Rad/Nuc Med Division
56 ; data dictionary: Last DFN Converted (75.1), Conversion Start
57 ; Time (75.1), Conversion Stop Time (75.1), Last DFN Converted
58 ; (70), Conversion Start Time (70) & Conversion Stop Time (70).
59 ; All data associated with these fields will be deleted.
60 N RADD,RAXIST S RADD=79,RAXIST=0
61 F RAFLD=2300.1:.1:2300.6 S:$D(^DD(RADD,RAFLD,0)) RAXIST=1
62 Q:'RAXIST ; fields have already been deleted!
63 N %,DA,DIC,DIK,RAD0,RADATA,RAFILE,RAFLD,RAFLDTXT,RATXT,X,Y S RAD0=0
64 S RAFILE=$S($D(^DIC(RADD,0))#2:$P(^(0),"^"),1:"Unknown")
65 F S RAD0=$O(^RA(RADD,RAD0)) Q:RAD0'>0 D
66 . F RAFLD=2300.1:.1:2300.6 D
67 .. S RAFLDTXT=$S($D(^DD(RADD,RAFLD,0))#2:$P(^(0),"^"),1:"Unknown")
68 .. Q:RAFLDTXT="Unknown" ; unidentified field
69 .. S RADATA=$P($G(^RA(RADD,RAD0,"PATCH23")),"^",$P(RAFLD,".",2))
70 .. D:RADATA]"" ENKILL^RAXREF(RADD,RAFLD,RADATA,.RAD0)
71 .. S:RADATA]"" $P(^RA(RADD,RAD0,"PATCH23"),"^",$P(RAFLD,".",2))=""
72 .. S RATXT(1)=" ",RATXT(2)="Deleting obsolete "_RAFLDTXT_" field from"
73 .. S RATXT(3)=RAFILE_" data dictionary."
74 .. S RATXT(4)="Deleting "_RAFLDTXT_" data from the"
75 .. S RATXT(5)=RAFILE_" file. Division: "_$$GET1^DIQ(4,RAD0_",",.01)
76 .. D BMES^XPDUTL(.RATXT)
77 .. S DIK="^DD("_RADD_",",DA(1)=RADD,DA=RAFLD D ^DIK ; delete field!
78 .. Q
79 . K %,DA,DIC,DIK,X,Y K ^RA(RADD,RAD0,"PATCH23") ; kill off data node
80 . Q
81 Q
82EN5 ; Change the name of 'Radiology Location' in the Label Print Fields
83 ; file (78.7) to 'Imaging Location'.
84 Q:+$O(^RA(78.7,"B","IMAGING LOCATION",0)) ; 'Imaging Location' exists
85 N RADLOC,RAFDA,RATXT S RATXT(1)=""
86 S RATXT(2)="Changing name of Label Print Field (file: 78.7)"
87 S RATXT(3)="from: 'RADIOLOGY LOCATION' to 'IMAGING LOCATION'"
88 S RADLOC=+$O(^RA(78.7,"B","RADIOLOGY LOCATION",0))
89 Q:'RADLOC D MES^XPDUTL(.RATXT)
90 S RAFDA(78.7,RADLOC_",",.01)="IMAGING LOCATION"
91 D FILE^DIE("","RAFDA","")
92 Q
93EN7 ; Un-compile the 'RA STATUS CHANGE' & 'RA EXAM EDIT' input templates
94 ; on the Rad/Nuc Med Patient file.
95 ; Variable Definition:
96 ; RAEXED -> ien of the RA EXAM EDIT template
97 ; RASTCH -> ien of the RA STATUS CHANGE template
98 ; RATXT -> array which contains the message displayed to the user
99 ;
100 N RAEXED,RASTCH,RATXT
101 S RASTCH=$$FIND1^DIC(.402,"","X","RA STATUS CHANGE")
102 I RASTCH D ; the input template exists
103 . D TMPMSG("RA STATUS CHANGE"),MES^XPDUTL(.RATXT),UNC^DIEZ(RASTCH,"D")
104 . Q
105 S RAEXED=$$FIND1^DIC(.402,"","X","RA EXAM EDIT")
106 I RAEXED K RATXT D ; the input template exists
107 . D TMPMSG("RA EXAM EDIT"),MES^XPDUTL(.RATXT),UNC^DIEZ(RAEXED,"D")
108 . Q
109 Q
110TMPMSG(X) ; Build the text array for each specific compiled input
111 ; template.
112 ; Input: X-the name of the input template
113 S RATXT(1)=""
114 S RATXT(2)="Un-compiling the `"_X_"' input template on the"
115 S RATXT(3)="Rad/Nuc Med Patient file. All the compiled templates"
116 S RATXT(4)="associated with `"_X_"' will be deleted."
117 Q
Note: See TracBrowser for help on using the repository browser.