| [613] | 1 | DVBA2773 ;SPH - PATCH DRIVER ; 9/21/05
|
|---|
| 2 | ;;2.7;AMIE;**73**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; Make sure to call each exam name being sent in the patch
|
|---|
| 5 | ; This routine will find existing matching entries and will ensure they're disabled.
|
|---|
| 6 | ; Call as a pre-init or else it'll disable the exams just loaded.
|
|---|
| 7 | EN ;
|
|---|
| 8 | W !!!,"**** PRE-PROCESSING ****",!!
|
|---|
| 9 | D DISABLE("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
|
|---|
| 10 | Q
|
|---|
| 11 | POST ;
|
|---|
| 12 | W !!!,"**** POST-PROCESSING ****",!!
|
|---|
| 13 | D POSTP("MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)")
|
|---|
| 14 | D RBXREF
|
|---|
| 15 | Q
|
|---|
| 16 | POSTP(NM) ;
|
|---|
| 17 | ; Rename XXXXXXX~73F to XXXXXXX~95
|
|---|
| 18 | N DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
|---|
| 19 | N DVBABCN2,DVBABIE2,DVBABS2
|
|---|
| 20 | S DVBABCNT=0,DVBABIEN=0
|
|---|
| 21 | F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
|
|---|
| 22 | .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
|
|---|
| 23 | .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)="73F" D
|
|---|
| 24 | ..;Check and be sure a 95 version isn't in the file yet
|
|---|
| 25 | ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
|
|---|
| 26 | ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
|
|---|
| 27 | ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
|
|---|
| 28 | ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)="95" S DVBACH=1
|
|---|
| 29 | ..;If 95 version is found, delete new 73F version and don't import
|
|---|
| 30 | ..I DVBACH=1 D
|
|---|
| 31 | ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
|
|---|
| 32 | ...K ^DVB(396.18,DVBABIEN)
|
|---|
| 33 | ..;If 95 version isn't found, go ahead and rename new 73F to 95
|
|---|
| 34 | ..I DVBACH=0 D
|
|---|
| 35 | ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~95"
|
|---|
| 36 | ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
|
|---|
| 37 | K DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
|---|
| 38 | Q
|
|---|
| 39 | RBXREF ;
|
|---|
| 40 | ; Rebuild cross-references
|
|---|
| 41 | ; XRef: B
|
|---|
| 42 | W !!,"REBUILDING 'B' XREF",!
|
|---|
| 43 | N DA,DIK,REGIEN,ROOT
|
|---|
| 44 | S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
|
|---|
| 45 | S REGIEN=0
|
|---|
| 46 | F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
|
|---|
| 47 | . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
|
|---|
| 48 | . S DA(1)=REGIEN D ENALL^DIK
|
|---|
| 49 | ;
|
|---|
| 50 | ; XRef: AV
|
|---|
| 51 | W !!,"REBUILDING 'AV' XREF",!
|
|---|
| 52 | N DA,DIK,REGIEN,ROOT
|
|---|
| 53 | S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
|
|---|
| 54 | S REGIEN=0
|
|---|
| 55 | F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
|
|---|
| 56 | . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
|
|---|
| 57 | . S DA(1)=REGIEN D ENALL^DIK
|
|---|
| 58 | K DA,DIK,REGIEN,ROOT
|
|---|
| 59 | Q
|
|---|
| 60 | DISABLE(NM) ;
|
|---|
| 61 | ; First look for matches and turn off the "selectable by user field"
|
|---|
| 62 | ; This will keep the entry from showing in the list
|
|---|
| 63 | ; Next, look at disabled date. If there's no date, set it to today.
|
|---|
| 64 | ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
|
|---|
| 65 | ; Ignore 73F entries
|
|---|
| 66 | N DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
|---|
| 67 | S DVBABCNT=0,DVBABIEN=0
|
|---|
| 68 | F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
|
|---|
| 69 | .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
|
|---|
| 70 | .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'="95" D
|
|---|
| 71 | ..S DVBACH=0
|
|---|
| 72 | ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
|
|---|
| 73 | ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
|
|---|
| 74 | ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
|
|---|
| 75 | K DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
|---|
| 76 | Q
|
|---|
