[613] | 1 | DVBA2811 ;SPH - PATCH DRIVER ; 5/19/06
|
---|
| 2 | ;;2.7;AMIE;**111**;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 | PRE ;
|
---|
| 8 | N DVBVERSS,DVBVERSN
|
---|
| 9 | S DVBVERSS="111F" ; What the version will be in the incoming file
|
---|
| 10 | S DVBVERSN="111" ; What the final version should be named
|
---|
| 11 | W !!!,"**** PRE-PROCESSING ****",!!
|
---|
| 12 | D DISABLE("EPILEPSY AND NARCOLEPSY")
|
---|
| 13 | D DISABLE("ESOPHAGUS AND HIATAL HERNIA")
|
---|
| 14 | D DISABLE("FEET")
|
---|
| 15 | D DISABLE("HAND, THUMB, AND FINGERS")
|
---|
| 16 | D DISABLE("MUSCLES")
|
---|
| 17 | D DISABLE("SKIN DISEASES (OTHER THAN SCARS)")
|
---|
| 18 | D DISABLE("SPINE")
|
---|
| 19 | D DISABLE("GENERAL MEDICAL EXAMINATION")
|
---|
| 20 | Q
|
---|
| 21 | POST ;
|
---|
| 22 | N DVBVERSS,DVBVERSN
|
---|
| 23 | S DVBVERSS="111F" ; What the version will be in the incoming file
|
---|
| 24 | S DVBVERSN="111" ; What the final version should be named
|
---|
| 25 | W !!!,"**** POST-PROCESSING ****",!!
|
---|
| 26 | D POSTP("EPILEPSY AND NARCOLEPSY")
|
---|
| 27 | D POSTP("ESOPHAGUS AND HIATAL HERNIA")
|
---|
| 28 | D POSTP("FEET")
|
---|
| 29 | D POSTP("HAND, THUMB, AND FINGERS")
|
---|
| 30 | D POSTP("MUSCLES")
|
---|
| 31 | D POSTP("SKIN DISEASES (OTHER THAN SCARS)")
|
---|
| 32 | D POSTP("SPINE")
|
---|
| 33 | D POSTP("GENERAL MEDICAL EXAMINATION")
|
---|
| 34 | D RBXREF
|
---|
| 35 | Q
|
---|
| 36 | POSTP(NM) ;
|
---|
| 37 | ; Rename XXXXXXX~imported version to XXXXXXX~new version
|
---|
| 38 | N DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 39 | N DVBABCN2,DVBABIE2,DVBABS2
|
---|
| 40 | S DVBABCNT=0,DVBABIEN=0
|
---|
| 41 | F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
|
---|
| 42 | .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
|
---|
| 43 | .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
|
---|
| 44 | ..;Check and be sure the new version isn't in the file yet
|
---|
| 45 | ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
|
---|
| 46 | ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
|
---|
| 47 | ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
|
---|
| 48 | ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
|
---|
| 49 | ..;If new version is found, delete the import version and don't import
|
---|
| 50 | ..I DVBACH=1 D
|
---|
| 51 | ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
|
---|
| 52 | ...K ^DVB(396.18,DVBABIEN)
|
---|
| 53 | ..;If existing version isn't found, go ahead and rename imported entry to new version name
|
---|
| 54 | ..I DVBACH=0 D
|
---|
| 55 | ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
|
---|
| 56 | ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
|
---|
| 57 | K DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 58 | Q
|
---|
| 59 | RBXREF ;
|
---|
| 60 | ; Rebuild cross-references
|
---|
| 61 | ; XRef: B
|
---|
| 62 | W !!,"CLEANING UP FILES AND REBUILDING 2 CROSS-REFERENCES.",!,"THIS MAY TAKE A FEW MINUTES.",!
|
---|
| 63 | W !!,"REBUILDING 'B' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
|
---|
| 64 | N DA,DIK,REGIEN,ROOT
|
---|
| 65 | S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
|
---|
| 66 | S REGIEN=0
|
---|
| 67 | F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
|
---|
| 68 | . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
|
---|
| 69 | . S DA(1)=REGIEN D ENALL^DIK
|
---|
| 70 | ;
|
---|
| 71 | ; XRef: AV
|
---|
| 72 | W !!,"REBUILDING 'AV' XREF, CAPRI TEMPLATE DEFINITIONS FILE",!
|
---|
| 73 | N DA,DIK,REGIEN,ROOT
|
---|
| 74 | S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
|
---|
| 75 | S REGIEN=0
|
---|
| 76 | F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
|
---|
| 77 | . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
|
---|
| 78 | . S DA(1)=REGIEN D ENALL^DIK
|
---|
| 79 | K DA,DIK,REGIEN,ROOT
|
---|
| 80 | Q
|
---|
| 81 | DISABLE(NM) ;
|
---|
| 82 | ; First look for matches and turn off the "selectable by user field"
|
---|
| 83 | ; This will keep the entry from showing in the list
|
---|
| 84 | ; Next, look at disabled date. If there's no date, set it to today.
|
---|
| 85 | ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
|
---|
| 86 | N DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 87 | S DVBABCNT=0,DVBABIEN=0
|
---|
| 88 | F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
|
---|
| 89 | .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
|
---|
| 90 | .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
|
---|
| 91 | ..S DVBACH=0
|
---|
| 92 | ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
|
---|
| 93 | ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
|
---|
| 94 | ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
|
---|
| 95 | K DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 96 | Q
|
---|