- DVBAP206 ;ALB/JR - AMIE EXAM (#396.6) FILE UPDATE ;7/9/2018 12:00PM
- ;;2.7;AMIE;**206**;Apr 10, 1995;Build 10
- ;
- ;this routine is used as a post-init in a KIDS build
- ;to modify the AMIE EXAM file (#396.6)
- ;
- Q
- ;
- POST ; entry point
- D MES^XPDUTL(" ")
- D BMES^XPDUTL("Updating the AMIE EXAM file (#396.6)...")
- D MES^XPDUTL(" ")
- ;
- D NAMECHG ;change exam names
- D INACT ;inactivate exams
- ;
- D MES^XPDUTL(" ")
- D BMES^XPDUTL("Update of AMIE EXAM file (#396.6) completed.")
- D MES^XPDUTL(" ")
- Q
- NAMECHG ;* change exam names
- ;
- ; DVBAXX is in format:
- ; OLD EXAM NAME^NEW EXAM NAME
- ;
- N DVBAX,DVBAXX,DVBADA,DA,DR,DIC,DIE,X,Y,DVBASTR
- D MES^XPDUTL(" ")
- D BMES^XPDUTL("Changing names in AMIE EXAM file (#396.6)...")
- D MES^XPDUTL(" ")
- F DVBAX=1:1 S DVBAXX=$P($T(CHNG+DVBAX),";;",2) Q:DVBAXX="QUIT" D
- .F DVBADA=0:0 S DVBADA=+$O(^DVB(396.6,"B",$E($P(DVBAXX,U,1),1,30),DVBADA)) Q:DVBADA=0 D
- ..I $D(^DVB(396.6,DVBADA,0)),$P(^DVB(396.6,DVBADA,0),U,5)="A" D
- ...S DA=DVBADA,DR=".01///^S X=$P(DVBAXX,U,2)",DIE="^DVB(396.6," D ^DIE
- ...D MES^XPDUTL(" ")
- ...D MES^XPDUTL(" Entry #"_DVBADA_" for "_$P(DVBAXX,U,1))
- ...D BMES^XPDUTL(" ... field (#.01) updated to "_$P(DVBAXX,U,2)_".")
- ...D MES^XPDUTL(" ")
- ..I '$D(^DVB(396.6,DVBADA,0)) D
- ...D MES^XPDUTL(" ")
- ...S DVBASTR="Can't find entry for "_$P(DVBAXX,U,1)
- ...D BMES^XPDUTL(DVBASTR_" ...field (#.01) not updated.")
- Q
- ;
- CHNG ;name changes - old exam name^new exam name
- ;;AID AND ATTENDANCE OR HOUSEBOUND EXAMINATION^Aid and Attendance or Housebound Examination
- ;;BONES (FRACTURES AND BONE DISEASE)^Bones (Fractures and Bone Diseases)
- ;;DBQ DENTAL Dental & oral (other than TMJ)^DBQ DENTAL Dental & oral (other than TMD)
- ;;DBQ GI Liver conditions Hepatitis, cirrhosis & other liver^DBQ GI Liver Hepatitis, cirrhosis & other liver conditions
- ;;DBQ General Medical Gulf War^DBQ General Medical Gulf War (including Burn Pits)
- ;;DBQ MUSC Foot miscellaneous^DBQ MUSC Foot conditions, including Flatfoot (Pes Planus)
- ;;DBQ MUSC Hip & thigh^DBQ MUSC Hip & thigh conditions
- ;;DBQ Medical SHA^DBQ Separation Health Assessment
- ;;DBQ RHEUM Arthritis: non-degen (inflam, imm, cryst, infect)^DBQ RHEUM Arthritis non-degen (inflam, imm, cryst, infect)
- ;;SOCIAL AND INDUSTRIAL SURVEY^Social and Industrial Survey
- ;;QUIT
- ;
- INACT ;* inactivate exams
- ;
- ; DVBAXX is in format:
- ; EXAM NAME
- ;
- N DVBAX,DVBAXX,DVBADA,DA,DR,DIC,DIE,X,Y,DVBASTR
- D MES^XPDUTL(" ")
- D BMES^XPDUTL("Inactivating procedures AMIE EXAM file (#396.6)...")
- D MES^XPDUTL(" ")
- F DVBAX=1:1 S DVBAXX=$P($T(OLD+DVBAX),";;",2) Q:DVBAXX="QUIT" D
- .F DVBADA=0:0 S DVBADA=+$O(^DVB(396.6,"B",$E(DVBAXX,1,30),DVBADA)) Q:DVBADA=0 D
- ..I $D(^DVB(396.6,DVBADA,0)),$P(^DVB(396.6,DVBADA,0),U,5)="A" D
- ...S DA=DVBADA,DR=".5///INACTIVE",DIE="^DVB(396.6," D ^DIE
- ...D MES^XPDUTL(" ")
- ...D MES^XPDUTL(" Entry #"_DVBADA_" for "_DVBAXX)
- ...D BMES^XPDUTL(" ... inactivated")
- ...D MES^XPDUTL(" ")
- ..I '$D(^DVB(396.6,DVBADA,0)) D
- ...D MES^XPDUTL(" ")
- ...S DVBASTR="Can't find entry for "_DVBAXX
- ...D BMES^XPDUTL(DVBASTR_" ...exam cannot be inactivated.")
- Q
- ;
- OLD ;national procedures to be inactivated - exam name
- ;;ACROMEGALY
- ;;AMPUTATION, RESIDUALS OF
- ;;ARRHYTHMIAS
- ;;ARTERIES, VEINS AND MISCELLANEOUS
- ;;AUDIO
- ;;BRAIN AND SPINAL CORD
- ;;CHRONIC FATIGUE SYNDROME
- ;;COLD INJURY PROTOCOL EXAMINATION
- ;;CRANIAL NERVES
- ;;CUSHING'S SYNDROME
- ;;DENTAL AND ORAL
- ;;DIABETES MELLITUS
- ;;DIGESTIVE CONDITIONS, MISCELLANEOUS
- ;;EAR DISEASE
- ;;EATING DISORDERS (MENTAL DISORDERS)
- ;;ENDOCRINE DISEASES, MISCELLANEOUS
- ;;EPILEPSY AND NARCOLEPSY
- ;;ESOPHAGUS AND HIATAL HERNIA
- ;;EYE EXAMINATION
- ;;FEET
- ;;FIBROMYALGIA
- ;;GENERAL MEDICAL EXAMINATION
- ;;GENITOURINARY EXAMINATION
- ;;GULF WAR GUIDELINES
- ;;GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST
- ;;HAND, THUMB, AND FINGERS
- ;;HEART
- ;;HEMIC DISORDERS
- ;;HIV-RELATED ILLNESS
- ;;HYPERTENSION
- ;;INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES
- ;;INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)
- ;;INTESTINES (LARGE AND SMALL)
- ;;JOINTS (SHOULDER/ELBOW/WRIST/HIP/KNEE/ANKLE)
- ;;LIVER, GALL BLADDER, AND PANCREAS
- ;;LYMPHATIC DISORDERS
- ;;MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)
- ;;MOUTH, LIPS, AND TONGUE
- ;;MUSCLES
- ;;NEUROLOGICAL DISORDERS, MISCELLANEOUS
- ;;NOSE, SINUS, LARYNX, AND PHARYNX
- ;;PERIPHERAL NERVES
- ;;PRISONER OF WAR PROTOCOL EXAMINATION
- ;;PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES
- ;;RECTUM AND ANUS
- ;;RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)
- ;;RESPIRATORY DISEASES, MISCELLANEOUS
- ;;REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)
- ;;SCARS
- ;;SENSE OF SMELL AND TASTE
- ;;SKIN DISEASES (OTHER THAN SCARS)
- ;;SPINE
- ;;STOMACH, DUODENUM AND PERITONEAL ADHESIONS
- ;;THYROID AND PARATHYROID DISEASES
- ;;TRAUMATIC BRAIN INJURY (TBI)
- ;;QUIT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAP206 4955 printed Feb 18, 2025@23:07:49 Page 2
- DVBAP206 ;ALB/JR - AMIE EXAM (#396.6) FILE UPDATE ;7/9/2018 12:00PM
- +1 ;;2.7;AMIE;**206**;Apr 10, 1995;Build 10
- +2 ;
- +3 ;this routine is used as a post-init in a KIDS build
- +4 ;to modify the AMIE EXAM file (#396.6)
- +5 ;
- +6 QUIT
- +7 ;
- POST ; entry point
- +1 DO MES^XPDUTL(" ")
- +2 DO BMES^XPDUTL("Updating the AMIE EXAM file (#396.6)...")
- +3 DO MES^XPDUTL(" ")
- +4 ;
- +5 ;change exam names
- DO NAMECHG
- +6 ;inactivate exams
- DO INACT
- +7 ;
- +8 DO MES^XPDUTL(" ")
- +9 DO BMES^XPDUTL("Update of AMIE EXAM file (#396.6) completed.")
- +10 DO MES^XPDUTL(" ")
- +11 QUIT
- NAMECHG ;* change exam names
- +1 ;
- +2 ; DVBAXX is in format:
- +3 ; OLD EXAM NAME^NEW EXAM NAME
- +4 ;
- +5 NEW DVBAX,DVBAXX,DVBADA,DA,DR,DIC,DIE,X,Y,DVBASTR
- +6 DO MES^XPDUTL(" ")
- +7 DO BMES^XPDUTL("Changing names in AMIE EXAM file (#396.6)...")
- +8 DO MES^XPDUTL(" ")
- +9 FOR DVBAX=1:1
- SET DVBAXX=$PIECE($TEXT(CHNG+DVBAX),";;",2)
- if DVBAXX="QUIT"
- QUIT
- Begin DoDot:1
- +10 FOR DVBADA=0:0
- SET DVBADA=+$ORDER(^DVB(396.6,"B",$EXTRACT($PIECE(DVBAXX,U,1),1,30),DVBADA))
- if DVBADA=0
- QUIT
- Begin DoDot:2
- +11 IF $DATA(^DVB(396.6,DVBADA,0))
- IF $PIECE(^DVB(396.6,DVBADA,0),U,5)="A"
- Begin DoDot:3
- +12 SET DA=DVBADA
- SET DR=".01///^S X=$P(DVBAXX,U,2)"
- SET DIE="^DVB(396.6,"
- DO ^DIE
- +13 DO MES^XPDUTL(" ")
- +14 DO MES^XPDUTL(" Entry #"_DVBADA_" for "_$PIECE(DVBAXX,U,1))
- +15 DO BMES^XPDUTL(" ... field (#.01) updated to "_$PIECE(DVBAXX,U,2)_".")
- +16 DO MES^XPDUTL(" ")
- End DoDot:3
- +17 IF '$DATA(^DVB(396.6,DVBADA,0))
- Begin DoDot:3
- +18 DO MES^XPDUTL(" ")
- +19 SET DVBASTR="Can't find entry for "_$PIECE(DVBAXX,U,1)
- +20 DO BMES^XPDUTL(DVBASTR_" ...field (#.01) not updated.")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 QUIT
- +22 ;
- CHNG ;name changes - old exam name^new exam name
- +1 ;;AID AND ATTENDANCE OR HOUSEBOUND EXAMINATION^Aid and Attendance or Housebound Examination
- +2 ;;BONES (FRACTURES AND BONE DISEASE)^Bones (Fractures and Bone Diseases)
- +3 ;;DBQ DENTAL Dental & oral (other than TMJ)^DBQ DENTAL Dental & oral (other than TMD)
- +4 ;;DBQ GI Liver conditions Hepatitis, cirrhosis & other liver^DBQ GI Liver Hepatitis, cirrhosis & other liver conditions
- +5 ;;DBQ General Medical Gulf War^DBQ General Medical Gulf War (including Burn Pits)
- +6 ;;DBQ MUSC Foot miscellaneous^DBQ MUSC Foot conditions, including Flatfoot (Pes Planus)
- +7 ;;DBQ MUSC Hip & thigh^DBQ MUSC Hip & thigh conditions
- +8 ;;DBQ Medical SHA^DBQ Separation Health Assessment
- +9 ;;DBQ RHEUM Arthritis: non-degen (inflam, imm, cryst, infect)^DBQ RHEUM Arthritis non-degen (inflam, imm, cryst, infect)
- +10 ;;SOCIAL AND INDUSTRIAL SURVEY^Social and Industrial Survey
- +11 ;;QUIT
- +12 ;
- INACT ;* inactivate exams
- +1 ;
- +2 ; DVBAXX is in format:
- +3 ; EXAM NAME
- +4 ;
- +5 NEW DVBAX,DVBAXX,DVBADA,DA,DR,DIC,DIE,X,Y,DVBASTR
- +6 DO MES^XPDUTL(" ")
- +7 DO BMES^XPDUTL("Inactivating procedures AMIE EXAM file (#396.6)...")
- +8 DO MES^XPDUTL(" ")
- +9 FOR DVBAX=1:1
- SET DVBAXX=$PIECE($TEXT(OLD+DVBAX),";;",2)
- if DVBAXX="QUIT"
- QUIT
- Begin DoDot:1
- +10 FOR DVBADA=0:0
- SET DVBADA=+$ORDER(^DVB(396.6,"B",$EXTRACT(DVBAXX,1,30),DVBADA))
- if DVBADA=0
- QUIT
- Begin DoDot:2
- +11 IF $DATA(^DVB(396.6,DVBADA,0))
- IF $PIECE(^DVB(396.6,DVBADA,0),U,5)="A"
- Begin DoDot:3
- +12 SET DA=DVBADA
- SET DR=".5///INACTIVE"
- SET DIE="^DVB(396.6,"
- DO ^DIE
- +13 DO MES^XPDUTL(" ")
- +14 DO MES^XPDUTL(" Entry #"_DVBADA_" for "_DVBAXX)
- +15 DO BMES^XPDUTL(" ... inactivated")
- +16 DO MES^XPDUTL(" ")
- End DoDot:3
- +17 IF '$DATA(^DVB(396.6,DVBADA,0))
- Begin DoDot:3
- +18 DO MES^XPDUTL(" ")
- +19 SET DVBASTR="Can't find entry for "_DVBAXX
- +20 DO BMES^XPDUTL(DVBASTR_" ...exam cannot be inactivated.")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 QUIT
- +22 ;
- OLD ;national procedures to be inactivated - exam name
- +1 ;;ACROMEGALY
- +2 ;;AMPUTATION, RESIDUALS OF
- +3 ;;ARRHYTHMIAS
- +4 ;;ARTERIES, VEINS AND MISCELLANEOUS
- +5 ;;AUDIO
- +6 ;;BRAIN AND SPINAL CORD
- +7 ;;CHRONIC FATIGUE SYNDROME
- +8 ;;COLD INJURY PROTOCOL EXAMINATION
- +9 ;;CRANIAL NERVES
- +10 ;;CUSHING'S SYNDROME
- +11 ;;DENTAL AND ORAL
- +12 ;;DIABETES MELLITUS
- +13 ;;DIGESTIVE CONDITIONS, MISCELLANEOUS
- +14 ;;EAR DISEASE
- +15 ;;EATING DISORDERS (MENTAL DISORDERS)
- +16 ;;ENDOCRINE DISEASES, MISCELLANEOUS
- +17 ;;EPILEPSY AND NARCOLEPSY
- +18 ;;ESOPHAGUS AND HIATAL HERNIA
- +19 ;;EYE EXAMINATION
- +20 ;;FEET
- +21 ;;FIBROMYALGIA
- +22 ;;GENERAL MEDICAL EXAMINATION
- +23 ;;GENITOURINARY EXAMINATION
- +24 ;;GULF WAR GUIDELINES
- +25 ;;GYNECOLOGICAL CONDITIONS AND DISORDERS OF THE BREAST
- +26 ;;HAND, THUMB, AND FINGERS
- +27 ;;HEART
- +28 ;;HEMIC DISORDERS
- +29 ;;HIV-RELATED ILLNESS
- +30 ;;HYPERTENSION
- +31 ;;INFECTIOUS, IMMUNE, AND NUTRITIONAL DISABILITIES
- +32 ;;INITIAL EVALUATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)
- +33 ;;INTESTINES (LARGE AND SMALL)
- +34 ;;JOINTS (SHOULDER/ELBOW/WRIST/HIP/KNEE/ANKLE)
- +35 ;;LIVER, GALL BLADDER, AND PANCREAS
- +36 ;;LYMPHATIC DISORDERS
- +37 ;;MENTAL DISORDERS (EXCEPT PTSD AND EATING DISORDERS)
- +38 ;;MOUTH, LIPS, AND TONGUE
- +39 ;;MUSCLES
- +40 ;;NEUROLOGICAL DISORDERS, MISCELLANEOUS
- +41 ;;NOSE, SINUS, LARYNX, AND PHARYNX
- +42 ;;PERIPHERAL NERVES
- +43 ;;PRISONER OF WAR PROTOCOL EXAMINATION
- +44 ;;PULMONARY TUBERCULOSIS AND MYCOBACTERIAL DISEASES
- +45 ;;RECTUM AND ANUS
- +46 ;;RESPIRATORY (OBSTRUCTIVE, RESTRICTIVE, AND INTERSTITIAL)
- +47 ;;RESPIRATORY DISEASES, MISCELLANEOUS
- +48 ;;REVIEW EXAMINATION FOR POST-TRAUMATIC STRESS DISORDER (PTSD)
- +49 ;;SCARS
- +50 ;;SENSE OF SMELL AND TASTE
- +51 ;;SKIN DISEASES (OTHER THAN SCARS)
- +52 ;;SPINE
- +53 ;;STOMACH, DUODENUM AND PERITONEAL ADHESIONS
- +54 ;;THYROID AND PARATHYROID DISEASES
- +55 ;;TRAUMATIC BRAIN INJURY (TBI)
- +56 ;;QUIT
- +57 ;