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 ---[H[J[2J[HDVBAP210 3860 printed Apr 09, 2024@20:53:04 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 ;
