DVBAP210.m

DVBAP210 ;ALB/JR - AMIE EXAM (#396.6) FILE UPDATE ;12/6/2018 1:47PM

 ;;2.7;AMIE;**210**;Apr 10, 1995;Build 2

 ;

 ;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

 ;;DBQ Medical Opinion^DBQ MEDICAL OPINION

 ;;DBQ General Medical Compensation^DBQ GENERAL MEDICAL Compensation

 ;;DBQ General Medical Gulf War (including Burn Pits)^DBQ GENERAL MEDICAL Gulf War (including burn pits)

 ;;DBQ General Medical Pension^DBQ GENERAL MEDICAL Pension

 ;;DBQ HEM Hemic & lymphatic, including leukemia^DBQ HEM Hemic & lymphatic conditions, including leukemia

 ;;DBQ Prisoner of War (POW)^DBQ PRISONER OF WAR (POW)

 ;;DBQ GI Liver Hepatitis, cirrhosis & other liver conditions^DBQ GI Liver hepatitis, cirrhosis & other liver conditions

 ;;Bones (Fractures and Bone Diseases)^Bones (fractures and bone diseases)

 ;;Aid and Attendance or Housebound Examination^Aid and attendance or housebound examination

 ;;DBQ INFECT South West Asia Infectious diseases^DBQ INFECT Southwest Asia infectious diseases

 ;;DBQ MUSC Foot conditions, including Flatfoot (Pes Planus)^DBQ MUSC Foot conditions, including flatfoot (pes planus)

 ;;DBQ NEURO Seizure disorders (Epilepsy)^DBQ NEURO Seizure disorders (epilepsy)

 ;;DBQ NEURO TBI Initial^DBQ NEURO Traumatic brain injury (TBI) initial

 ;;DBQ NEURO TBI Review^DBQ NEURO Traumatic brain injury (TBI) review

 ;;DBQ PSYCH PTSD Initial^DBQ PSYCH Posttraumatic stress disorder (PTSD) initial

 ;;DBQ PSYCH PTSD Review^DBQ PSYCH Posttraumatic stress disorder (PTSD) review

 ;;DBQ Separation Health Assessment^DBQ Separation health assessment (SHA)

 ;;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

 ;;DBQ HEM Hairy Cell & other B-cell leukemias

 ;;QUIT

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBAP210   3860     printed  Feb 18, 2025@23:07:50                                                                                                                                                                                                    Page 2

DVBAP210  ;ALB/JR - AMIE EXAM (#396.6) FILE UPDATE ;12/6/2018 1:47PM

 +1       ;;2.7;AMIE;**210**;Apr 10, 1995;Build 2

 +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       ;;DBQ Medical Opinion^DBQ MEDICAL OPINION

 +2       ;;DBQ General Medical Compensation^DBQ GENERAL MEDICAL Compensation

 +3       ;;DBQ General Medical Gulf War (including Burn Pits)^DBQ GENERAL MEDICAL Gulf War (including burn pits)

 +4       ;;DBQ General Medical Pension^DBQ GENERAL MEDICAL Pension

 +5       ;;DBQ HEM Hemic & lymphatic, including leukemia^DBQ HEM Hemic & lymphatic conditions, including leukemia

 +6       ;;DBQ Prisoner of War (POW)^DBQ PRISONER OF WAR (POW)

 +7       ;;DBQ GI Liver Hepatitis, cirrhosis & other liver conditions^DBQ GI Liver hepatitis, cirrhosis & other liver conditions

 +8       ;;Bones (Fractures and Bone Diseases)^Bones (fractures and bone diseases)

 +9       ;;Aid and Attendance or Housebound Examination^Aid and attendance or housebound examination

 +10      ;;DBQ INFECT South West Asia Infectious diseases^DBQ INFECT Southwest Asia infectious diseases

 +11      ;;DBQ MUSC Foot conditions, including Flatfoot (Pes Planus)^DBQ MUSC Foot conditions, including flatfoot (pes planus)

 +12      ;;DBQ NEURO Seizure disorders (Epilepsy)^DBQ NEURO Seizure disorders (epilepsy)

 +13      ;;DBQ NEURO TBI Initial^DBQ NEURO Traumatic brain injury (TBI) initial

 +14      ;;DBQ NEURO TBI Review^DBQ NEURO Traumatic brain injury (TBI) review

 +15      ;;DBQ PSYCH PTSD Initial^DBQ PSYCH Posttraumatic stress disorder (PTSD) initial

 +16      ;;DBQ PSYCH PTSD Review^DBQ PSYCH Posttraumatic stress disorder (PTSD) review

 +17      ;;DBQ Separation Health Assessment^DBQ Separation health assessment (SHA)

 +18      ;;QUIT

 +19      ;

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       ;;DBQ HEM Hairy Cell & other B-cell leukemias

 +2       ;;QUIT

 +3       ;