source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBA2795.m@ 1306

DVBA2795 ;SPH - PATCH DRIVER ; 8/19/05

 ;;2.7;AMIE;**95**;Apr 10, 1995

 ;

 ; Make sure to call each exam name being sent in the patch

 ; This routine will find existing matching entries and will ensure they're disabled.

 ; Call as a pre-init or else it'll disable the exams just loaded.

EN ;

 W !!!,"**** PRE-PROCESSING ****",!!

 D DISABLE("RECTUM AND ANUS")

 D DISABLE("DIABETES MELLITUS")

 D DISABLE("ARTERIES, VEINS AND MISCELLANEOUS")

 D DISABLE("ACROMEGALY")

 D DISABLE("ARRHYTHMIAS")

 D DISABLE("REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")

 D DISABLE("BRAIN AND SPINAL CORD")

 D DISABLE("HYPERTENSION")

 D DISABLE("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")

 D DISABLE("RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)")

 D DISABLE("DENTAL AND ORAL")

 D DISABLE("GULF WAR GUIDELINES")

 D DISABLE("EATING DISORDERS")

 D DISABLE("CRANIAL NERVES")

 D DISABLE("ESOPHAGUS AND HIATAL HERNIA")

 D DISABLE("AUDIO")

 D DISABLE("EYE EXAMINATION")

 D DISABLE("SKIN DISEASES (OTHER THAN SCARS)")

 D DISABLE("FEET")

 D MENTALUP

 Q

POST ;

 W !!!,"**** POST-PROCESSING ****",!!

 D POSTP("RECTUM AND ANUS")

 D POSTP("DIABETES MELLITUS")

 D POSTP("ARTERIES, VEINS AND MISCELLANEOUS")

 D POSTP("ACROMEGALY")

 D POSTP("ARRHYTHMIAS")

 D POSTP("REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")

 D POSTP("BRAIN AND SPINAL CORD")

 D POSTP("HYPERTENSION")

 D POSTP("INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)")

 D POSTP("RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)")

 D POSTP("DENTAL AND ORAL")

 D POSTP("GULF WAR GUIDELINES")

 D POSTP("EATING DISORDERS")

 D POSTP("CRANIAL NERVES")

 D POSTP("ESOPHAGUS AND HIATAL HERNIA")

 D POSTP("AUDIO")

 D POSTP("EYE EXAMINATION")

 D POSTP("SKIN DISEASES (OTHER THAN SCARS)")

 D POSTP("FEET")

 D RBXREF

 Q

POSTP(NM) ;

 ; Rename XXXXXXX~95F to XXXXXXX~95

 N DVBABCNT,DVBABIEN,DVBABST,DVBACH

 N DVBABCN2,DVBABIE2,DVBABS2

 S DVBABCNT=0,DVBABIEN=0

 F  S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN  D

 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)

 .I $P(DVBABST,"~",1)=NM  I $P(DVBABST,"~",2)="95F"  D

 ..;Check and be sure a 95 version isn't in the file yet

 ..S DVBABCN2=0,DVBABIE2=0,DVBACH=0

 ..F  S DVBABIE2=$O(^DVB(396.18,DVBABIE2)) Q:'DVBABIE2  D

 ...S DVBABS2=$P($G(^DVB(396.18,DVBABIE2,0)),"^",1)

 ...I $P(DVBABS2,"~",1)=NM  I $P(DVBABS2,"~",2)="95"  S DVBACH=1

 ..;If 95 version is found, delete new 95F version and don't import

 ..I DVBACH=1  D

 ...W "FOUND EXISTING "_NM_".  NO MODIFICATIONS MADE.",!

 ...K ^DVB(396.18,DVBABIEN)

 ..;If 95 version isn't found, go ahead and rename new 95F to 95

 ..I DVBACH=0  D

 ...S $P(^DVB(396.18,DVBABIEN,0),"^",1)=NM_"~95"

 ...W "ACTIVATED: "_$P($G(^DVB(396.18,DVBABIEN,0)),"^",1),!

 K DVBABCNT,DVBABIEN,DVBABST,DVBACH

 Q

RBXREF ;

 ; Rebuild cross-references

 ; XRef: B

 W !!,"REBUILDING 'B' XREF",!

 N DA,DIK,REGIEN,ROOT

 S ROOT=$$ROOT^DILFD(396.18,,1)  K @ROOT@("B")

 S REGIEN=0

 F  S REGIEN=$O(@ROOT@(REGIEN))  Q:'REGIEN  D

 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^B"

 . S DA(1)=REGIEN  D ENALL^DIK

 ; 

 ; XRef: AV

 W !!,"REBUILDING 'AV' XREF",!

 N DA,DIK,REGIEN,ROOT

 S ROOT=$$ROOT^DILFD(396.18,,1)  K @ROOT@("AV")

 S REGIEN=0

 F  S REGIEN=$O(@ROOT@(REGIEN))  Q:'REGIEN  D

 . S DIK=$$ROOT^DILFD(396.18,","_REGIEN_","),DIK(1)=".01^AV"

 . S DA(1)=REGIEN  D ENALL^DIK

 K DA,DIK,REGIEN,ROOT

 Q 

DISABLE(NM) ;

 ; First look for matches and turn off the "selectable by user field"

 ; This will keep the entry from showing in the list

 ; Next, look at disabled date.  If there's no date, set it to today.

 ; File is 396.18.  Field 3 is de-activation date.  Field 7 is selectable by user (0=no)

 N DVBABCNT,DVBABIEN,DVBABST,DVBACH

 S DVBABCNT=0,DVBABIEN=0

 F  S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN  D

 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)

 .I $P(DVBABST,"~",1)=NM  I $P(DVBABST,"~",2)'="95"  D

 ..S DVBACH=0

 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0"  S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1

 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)=""  S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVBACH=1  ; This is deactivation date 

 ..I DVBACH=1  W "MODIFIED: "_DVBABST,!

 K DVBABCNT,DVBABIEN,DVBABST,DVBACH

 Q

MENTALUP ;

 ; Update mental health exam

 ; Turn off V89 and turn on V92

 W !!,"CHECKING MENTAL DISORDERS...",!!

 N DVBABCNT,DVBABIEN,DVBABST,NM,DVBACH

 S DVBABCNT=0,DVBABIEN=0

 F  S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN  D

 .S DVBABST=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1)

 .S NM="MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)~89"

 .I $P(DVBABST,"^",1)=NM  D

 ..S DVBACH=0

 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="0"  S $P(^DVB(396.18,DVBABIEN,6),"^",1)="0",DVBACH=1 ; Turn off selectable by user

 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)=""  S $P(^DVB(396.18,DVBABIEN,2),"^",2)=DT,DVHACH=1 ; Turn on deactivation date

 ..I DVBACH=1  W "TURNED OFF V89 OF MENTAL DISORDERS EXAM",!

 .S NM="MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)~92"

 .I $P(DVBABST,"^",1)=NM  D

 ..S DVBACH=0

 ..I $P(^DVB(396.18,DVBABIEN,6),"^",1)'="1"  S $P(^DVB(396.18,DVBABIEN,6),"^",1)="1",DVBACH=1 ; Turn on selectable by user

 ..I $P(^DVB(396.18,DVBABIEN,2),"^",1)=""  S $P(^DVB(396.18,DVBABIEN,2),"^",1)=DT,DVBACH=1 ; This is activation date

 ..I $P(^DVB(396.18,DVBABIEN,2),"^",2)'=""  S $P(^DVB(396.18,DVBABIEN,2),"^",2)="",DVBACH=1 ; This is deactivation date

 ..I DVBACH=1  W "TURNED ON V92 OF MENTAL DISORDERS EXAM",!

 K DVBABCNT,DVBABIEN,DVBABST,NM,DVBACH

 Q