| 1 | RAIPRE1 ;HIRMFO/GJC- Pre-init routine ;4/19/97 12:05
|
|---|
| 2 | VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | EN1 ; 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
|
|---|
| 14 | EN2 ; 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
|
|---|
| 29 | EN4 ; 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
|
|---|
| 46 | EN10 ; 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
|
|---|
| 57 | EN11 ; 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
|
|---|
