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 Dec 13, 2024@01:41:26 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 ;
