| 1 | DVBA2798 ;SPH - PATCH DRIVER ; 10/20/05
|
---|
| 2 | ;;2.7;AMIE;**98**;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="98F" ; What the version will be in the incoming file
|
---|
| 10 | S DVBVERSN="98" ; What the final version should be named
|
---|
| 11 | W !!!,"**** PRE-PROCESSING ****",!!
|
---|
| 12 | D DISABLE("GENERAL MEDICAL EXAMINATION")
|
---|
| 13 | Q
|
---|
| 14 | POST ;
|
---|
| 15 | N DVBVERSS,DVBVERSN
|
---|
| 16 | S DVBVERSS="98F" ; What the version will be in the incoming file
|
---|
| 17 | S DVBVERSN="98" ; What the final version should be named
|
---|
| 18 | W !!!,"**** POST-PROCESSING ****",!!
|
---|
| 19 | D POSTP("GENERAL MEDICAL EXAMINATION")
|
---|
| 20 | D RBXREF
|
---|
| 21 | Q
|
---|
| 22 | POSTP(NM) ;
|
---|
| 23 | ; Rename XXXXXXX~imported version to XXXXXXX~new version
|
---|
| 24 | N DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 25 | N DVBABCN2,DVBABIE2,DVBABS2
|
---|
| 26 | S DVBABCNT=0,DVBABIEN=0
|
---|
| 27 | F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
|
---|
| 28 | .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
|
---|
| 29 | .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)=DVBVERSS D
|
---|
| 30 | ..;Check and be sure the new version isn't in the file yet
|
---|
| 31 | ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0
|
---|
| 32 | ..F S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2 D
|
---|
| 33 | ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)
|
---|
| 34 | ...I $P(DVBABS2,"~",1)=NM I $P(DVBABS2,"~",2)=DVBVERSN S DVBACH=1
|
---|
| 35 | ..;If new version is found, delete the import version and don't import
|
---|
| 36 | ..I DVBACH=1 D
|
---|
| 37 | ...W "FOUND EXISTING "_NM_". NO MODIFICATIONS MADE.",!
|
---|
| 38 | ...K ^DVB(396.18,DVBABIEN)
|
---|
| 39 | ..;If existing version isn't found, go ahead and rename imported entry to new version name
|
---|
| 40 | ..I DVBACH=0 D
|
---|
| 41 | ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~"_DVBVERSN
|
---|
| 42 | ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!
|
---|
| 43 | K DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 44 | Q
|
---|
| 45 | RBXREF ;
|
---|
| 46 | ; Rebuild cross-references
|
---|
| 47 | ; XRef: B
|
---|
| 48 | W !!,"REBUILDING 'B' XREF",!
|
---|
| 49 | N DA,DIK,REGIEN,ROOT
|
---|
| 50 | S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("B")
|
---|
| 51 | S REGIEN=0
|
---|
| 52 | F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
|
---|
| 53 | . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"
|
---|
| 54 | . S DA(1)=REGIEN D ENALL^DIK
|
---|
| 55 | ;
|
---|
| 56 | ; XRef: AV
|
---|
| 57 | W !!,"REBUILDING 'AV' XREF",!
|
---|
| 58 | N DA,DIK,REGIEN,ROOT
|
---|
| 59 | S ROOT=$$ROOT^DILFD(396.18,,1) K @ROOT@("AV")
|
---|
| 60 | S REGIEN=0
|
---|
| 61 | F S REGIEN=$O(@ROOT@(REGIEN)) Q:'REGIEN D
|
---|
| 62 | . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"
|
---|
| 63 | . S DA(1)=REGIEN D ENALL^DIK
|
---|
| 64 | K DA,DIK,REGIEN,ROOT
|
---|
| 65 | Q
|
---|
| 66 | DISABLE(NM) ;
|
---|
| 67 | ; First look for matches and turn off the "selectable by user field"
|
---|
| 68 | ; This will keep the entry from showing in the list
|
---|
| 69 | ; Next, look at disabled date. If there's no date, set it to today.
|
---|
| 70 | ; File is 396.18. Field 3 is de-activation date. Field 7 is selectable by user (0=no)
|
---|
| 71 | N DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 72 | S DVBABCNT=0,DVBABIEN=0
|
---|
| 73 | F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D
|
---|
| 74 | .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)
|
---|
| 75 | .I $P(DVBABST,"~",1)=NM I $P(DVBABST,"~",2)'=DVBVERSN D
|
---|
| 76 | ..S DVBACH=0
|
---|
| 77 | ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0" S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1
|
---|
| 78 | ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)="" S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1 ; This is deactivation date
|
---|
| 79 | ..I DVBACH=1 W "MODIFIED: "_DVBABST,!
|
---|
| 80 | K DVBABCNT,DVBABIEN,DVBABST,DVBACH
|
---|
| 81 | Q
|
---|